add some file open functions

include/picrin/port.h

@@ -1,11 +1,13 @@
 #ifndef PORT_H__
 #define PORT_H__
 
+#include <stdio.h>
+
 enum pic_port_flag {
-  PIC_PORT_IN,
+  PIC_PORT_IN = 1,
-  PIC_PORT_OUT,
+  PIC_PORT_OUT = 2,
-  PIC_PORT_TEXT,
+  PIC_PORT_TEXT = 4,
-  PIC_PORT_BINARY
+  PIC_PORT_BINARY = 8
 };
 
 enum pic_port_status {

src/file.c

@@ -1,6 +1,74 @@
 #include <stdio.h>
 
 #include "picrin.h"
+#include "picrin/port.h"
+
+static pic_value
+generic_open_file(pic_state *pic, const char *fname, char *mode, short flags)
+{
+  struct pic_port *port;
+  FILE *fp;
+
+  fp = fopen(fname, mode);
+  if (! fp) {
+    pic_error(pic, "could not open file");
+  }
+
+  port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
+  port->file = fp;
+  port->flags = flags;
+  port->status = PIC_PORT_OPEN;
+
+  return pic_obj_value(port);
+}
+
+pic_value
+pic_file_open_input_file(pic_state *pic)
+{
+  static const short flags = PIC_PORT_IN | PIC_PORT_TEXT;
+  char *fname;
+  size_t size;
+
+  pic_get_args(pic, "s", &fname, &size);
+
+  return generic_open_file(pic, fname, "r", flags);
+}
+
+pic_value
+pic_file_open_input_binary_file(pic_state *pic)
+{
+  static const short flags = PIC_PORT_IN | PIC_PORT_BINARY;
+  char *fname;
+  size_t size;
+
+  pic_get_args(pic, "s", &fname, &size);
+
+  return generic_open_file(pic, fname, "rb", flags);
+}
+
+pic_value
+pic_file_open_output_file(pic_state *pic)
+{
+  static const short flags = PIC_PORT_OUT | PIC_PORT_TEXT;
+  char *fname;
+  size_t size;
+
+  pic_get_args(pic, "s", &fname, &size);
+
+  return generic_open_file(pic, fname, "w", flags);
+}
+
+pic_value
+pic_file_open_output_binary_file(pic_state *pic)
+{
+  static const short flags = PIC_PORT_OUT | PIC_PORT_BINARY;
+  char *fname;
+  size_t size;
+
+  pic_get_args(pic, "s", &fname, &size);
+
+  return generic_open_file(pic, fname, "wb", flags);
+}
 
 pic_value
 pic_file_exists_p(pic_state *pic)
@@ -37,6 +105,10 @@ pic_file_delete(pic_state *pic)
 void
 pic_init_file(pic_state *pic)
 {
+  pic_defun(pic, "open-input-file", pic_file_open_input_file);
+  pic_defun(pic, "open-input-binary-file", pic_file_open_input_binary_file);
+  pic_defun(pic, "open-output-file", pic_file_open_output_file);
+  pic_defun(pic, "open-output-binary-file", pic_file_open_output_binary_file);
   pic_defun(pic, "file-exists?", pic_file_exists_p);
   pic_defun(pic, "delete-file", pic_file_delete);
 }

src/gc.c

@@ -268,7 +268,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   }
   case PIC_TT_PORT: {
     struct pic_port *port = (struct pic_port *)obj;
-    if (port->status == PIC_OPEN) {
+    if (port->status == PIC_PORT_OPEN) {
       fclose(port->file);
     }
     break;