From c35bba32ec1c087ecd0ad72eeb07572ea2d8906f Mon Sep 17 00:00:00 2001 From: ESL Date: Thu, 30 Mar 2023 16:24:03 -0400 Subject: [PATCH] file open refactoring -- work in progress --- i.c | 12 ++++-------- i.h | 8 ++++---- s.c | 6 ++++++ src/s.scm | 24 ++++++++++++++++++++---- 4 files changed, 34 insertions(+), 16 deletions(-) diff --git a/i.c b/i.c index 71acaec..856a0cb 100644 --- a/i.c +++ b/i.c @@ -3098,29 +3098,25 @@ define_instruction(opop) { define_instruction(oif) { FILE *fp = fopen(stringchars(ac), "r"); - if (fp == NULL) fail("can't open input file"); - ac = iport_file_obj(fp); + ac = (fp == NULL) ? bool_obj(0) : iport_file_obj(fp); gonexti(); } define_instruction(oof) { FILE *fp = fopen(stringchars(ac), "w"); - if (fp == NULL) fail("can't open output file"); - ac = oport_file_obj(fp); + ac = (fp == NULL) ? bool_obj(0) : oport_file_obj(fp); gonexti(); } define_instruction(obif) { FILE *fp = fopen(stringchars(ac), "rb"); - if (fp == NULL) fail("can't open binary input file"); - ac = iport_file_obj(fp); + ac = (fp == NULL) ? bool_obj(0) : iport_file_obj(fp); gonexti(); } define_instruction(obof) { FILE *fp = fopen(stringchars(ac), "wb"); - if (fp == NULL) fail("can't open binary output file"); - ac = oport_file_obj(fp); + ac = (fp == NULL) ? bool_obj(0) : oport_file_obj(fp); gonexti(); } diff --git a/i.h b/i.h index 017d8f5..037c43e 100644 --- a/i.h +++ b/i.h @@ -474,10 +474,10 @@ declare_instruction(sop, "P11", 0, "current-output-port", declare_instruction(sep, "P12", 0, "current-error-port", '0', AUTOGL) declare_instruction(ipop, "P20", 0, "input-port-open?", '1', AUTOGL) declare_instruction(opop, "P21", 0, "output-port-open?", '1', AUTOGL) -declare_instruction(oif, "P40", 0, "open-input-file", '1', AUTOGL) -declare_instruction(oof, "P41", 0, "open-output-file", '1', AUTOGL) -declare_instruction(obif, "P42", 0, "open-binary-input-file", '1', AUTOGL) -declare_instruction(obof, "P43", 0, "open-binary-output-file", '1', AUTOGL) +declare_instruction(oif, "P40", 0, "%open-input-file", '1', AUTOGL) +declare_instruction(oof, "P41", 0, "%open-output-file", '1', AUTOGL) +declare_instruction(obif, "P42", 0, "%open-binary-input-file", '1', AUTOGL) +declare_instruction(obof, "P43", 0, "%open-binary-output-file", '1', AUTOGL) declare_instruction(ois, "P50", 0, "open-input-string", '1', AUTOGL) declare_instruction(oos, "P51", 0, "open-output-string", '0', AUTOGL) declare_instruction(oib, "P52", 0, "open-input-bytevector", '1', AUTOGL) diff --git a/s.c b/s.c index 3321455..df16e80 100644 --- a/s.c +++ b/s.c @@ -2,6 +2,12 @@ char *s_code[] = { + "C", 0, + "@(y16:%25open-input-file)@!(y15:open-input-file)" + "@(y17:%25open-output-file)@!(y16:open-output-file)" + "@(y23:%25open-binary-input-file)@!(y22:open-binary-input-file)" + "@(y24:%25open-binary-output-file)@!(y23:open-binary-output-file)", + "S", "let-syntax", "l4:y12:syntax-rules;n;l2:l2:y1:_;l2:l2:y2:kw;y4:init;;y3:...;;;l1:y5:b" "egin;;;l2:py1:_;pl2:l2:y2:kw;y4:init;;y3:...;;y5:forms;;;l3:py13:synta" diff --git a/src/s.scm b/src/s.scm index 4fcf16c..0c9c31f 100644 --- a/src/s.scm +++ b/src/s.scm @@ -1359,10 +1359,10 @@ ; (current-input-port) ; need to be made into a parameter ; (current-output-port) ; need to be made into a parameter ; (current-error-port) ; need to be made into a parameter -; (open-input-file s) -; (open-binary-input-file s) -; (open-output-file x) -; (open-binary-output-file x) +; (%open-input-file s) + +; (%open-binary-input-file s) + +; (%open-output-file x) + +; (%open-binary-output-file x) + ; (close-input-port p) ; (close-output-port p) ; (open-input-string s) @@ -1376,6 +1376,22 @@ (define textual-port? port?) ; all ports are bimodal (define binary-port? port?) ; all ports are bimodal +(define-inline (open-input-file fn) + (or (%open-input-file fn) + (file-error "cannot open input file" fn))) + +(define-inline (open-output-file fn) + (or (%open-output-file fn) + (file-error "cannot open output file" fn))) + +(define-inline (open-binary-input-file fn) + (or (%open-binary-input-file fn) + (file-error "cannot open binary input file" fn))) + +(define-inline (open-binary-output-file fn) + (or (%open-binary-output-file fn) + (file-error "cannot open binary output file" fn))) + (define (close-port p) (if (input-port? p) (close-input-port p)) (if (output-port? p) (close-output-port p)))