From e6c23e25c1aaae45f3943b3f97a402557b3d477c Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sun, 15 Sep 2019 10:40:06 -0400
Subject: [PATCH] Issue #337

Added `open-binary-input-file` and `open-binary-output-file` from R7RS.
---
 CHANGELOG.md                  |  1 +
 include/cyclone/runtime.h     |  2 ++
 runtime.c                     | 28 ++++++++++++++++++++++++----
 scheme/cyclone/primitives.sld | 12 ++++++++++++
 4 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 1adad59d..d9485532 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -7,6 +7,7 @@ https://github.com/cyclone-scheme/cyclone-winds
 
 Bug Fixes
 
+- Added `open-binary-input-file` and `open-binary-output-file` from R7RS.
 - Validate the number of arguments passed to `if` expressions.
 - Raise a useful error instead of aborting the whole program (!) when apply attempts to execute an object of the wrong type.
 - Better handling of edge cases where an object of the wrong type is executed instead of a closure. Previously there were cases where this would cause the runtime to crash.
diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index c74c82d0..6f6223f3 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -243,6 +243,8 @@ port_type Cyc_stdin(void);
 port_type Cyc_stderr(void);
 port_type Cyc_io_open_input_file(void *data, object str);
 port_type Cyc_io_open_output_file(void *data, object str);
+port_type Cyc_io_open_binary_input_file(void *data, object str);
+port_type Cyc_io_open_binary_output_file(void *data, object str);
 port_type *Cyc_io_open_output_string(void *data);
 port_type *Cyc_io_open_input_string(void *data, object str);
 port_type *Cyc_io_open_input_bytevector(void *data, object bv);
diff --git a/runtime.c b/runtime.c
index 886e4b4d..d0a6aae6 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4167,32 +4167,52 @@ port_type Cyc_stderr()
   return p;
 }
 
-port_type Cyc_io_open_input_file(void *data, object str)
+port_type _Cyc_io_open_input_file(void *data, object str, const char *mode)
 {
   const char *fname;
   Cyc_check_str(data, str);
   fname = ((string_type *) str)->str;
   make_input_port(p, NULL, CYC_IO_BUF_LEN);
-  p.fp = fopen(fname, "r");
+  p.fp = fopen(fname, mode);
   if (p.fp == NULL) {
     Cyc_rt_raise2(data, "Unable to open file", str);
   }
   return p;
 }
 
-port_type Cyc_io_open_output_file(void *data, object str)
+port_type _Cyc_io_open_output_file(void *data, object str, const char *mode)
 {
   const char *fname;
   Cyc_check_str(data, str);
   fname = ((string_type *) str)->str;
   make_port(p, NULL, 0);
-  p.fp = fopen(fname, "w");
+  p.fp = fopen(fname, mode);
   if (p.fp == NULL) {
     Cyc_rt_raise2(data, "Unable to open file", str);
   }
   return p;
 }
 
+port_type Cyc_io_open_input_file(void *data, object str)
+{
+  return _Cyc_io_open_input_file(data, str, "r");
+}
+
+port_type Cyc_io_open_output_file(void *data, object str)
+{
+  return _Cyc_io_open_output_file(data, str, "w");
+}
+
+port_type Cyc_io_open_binary_input_file(void *data, object str)
+{
+  return _Cyc_io_open_input_file(data, str, "rb");
+}
+
+port_type Cyc_io_open_binary_output_file(void *data, object str)
+{
+  return _Cyc_io_open_output_file(data, str, "wb");
+}
+
 object Cyc_io_close_input_port(void *data, object port)
 {
   return Cyc_io_close_port(data, port);
diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld
index 28e6d7c1..d4577799 100644
--- a/scheme/cyclone/primitives.sld
+++ b/scheme/cyclone/primitives.sld
@@ -196,6 +196,8 @@
          symbol?
          open-input-file
          open-output-file
+         open-binary-input-file
+         open-binary-output-file
          close-port
          close-input-port
          close-output-port
@@ -366,6 +368,8 @@
          (symbol? 1 1)
          (open-input-file 1 1)
          (open-output-file 1 1)
+         (open-binary-input-file 1 1)
+         (open-binary-output-file 1 1)
          (close-port 1 1)
          (close-input-port 1 1)
          (close-output-port 1 1)
@@ -553,6 +557,8 @@
          ((eq? p 'Cyc-current-exception-handler)  "Cyc_current_exception_handler")
          ((eq? p 'open-input-file)       "Cyc_io_open_input_file")
          ((eq? p 'open-output-file)      "Cyc_io_open_output_file")
+         ((eq? p 'open-binary-input-file)       "Cyc_io_open_binary_input_file")
+         ((eq? p 'open-binary-output-file)      "Cyc_io_open_binary_output_file")
          ((eq? p 'close-port)            "Cyc_io_close_port")
          ((eq? p 'close-input-port)      "Cyc_io_close_input_port")
          ((eq? p 'close-output-port)     "Cyc_io_close_output_port")
@@ -714,6 +720,8 @@
         Cyc-end-thread!
         open-input-file
         open-output-file
+        open-binary-input-file
+        open-binary-output-file
         close-port
         close-input-port
         close-output-port
@@ -802,6 +810,8 @@
         ((eq? p 'Cyc-stderr) "port_type")
         ((eq? p 'open-input-file) "port_type")
         ((eq? p 'open-output-file) "port_type")
+        ((eq? p 'open-binary-input-file) "port_type")
+        ((eq? p 'open-binary-output-file) "port_type")
         ;((eq? p 'Cyc-fast-plus) "object")
         ;((eq? p 'Cyc-fast-sub) "object")
         ;((eq? p 'Cyc-fast-mul) "object")
@@ -860,6 +870,8 @@
                  Cyc-stderr
                  open-input-file
                  open-output-file
+                 open-binary-input-file
+                 open-binary-output-file
                  Cyc-installation-dir
                  Cyc-compilation-environment
                  string->number