Issue #337

Added `open-binary-input-file` and `open-binary-output-file` from R7RS.

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.

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);

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);

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