From a3f0f2091d3a433ce0099400419d579accc4f6e3 Mon Sep 17 00:00:00 2001 From: ESL Date: Thu, 30 Mar 2023 23:01:59 -0400 Subject: [PATCH] current ports refactoring -- finished --- i.c | 34 ---------------------------------- i.h | 9 +++------ s.c | 23 ++++++++++------------- src/s.scm | 2 +- 4 files changed, 14 insertions(+), 54 deletions(-) diff --git a/i.c b/i.c index fed7ccd..5742770 100644 --- a/i.c +++ b/i.c @@ -3119,40 +3119,6 @@ define_instruction(setcerr) { gonexti(); gonexti(); } -/* -define_instruction(cinv) { - if (ac == void_obj()) { - ac = cx__2Acurrent_2Dinput_2A; - assert(is_iport(ac)); - } else { - ckr(ac); - cx__2Acurrent_2Dinput_2A = ac; - } - gonexti(); -} - -define_instruction(coutv) { - if (ac == void_obj()) { - ac = cx__2Acurrent_2Doutput_2A; - assert(is_oport(ac)); - } else { - ckw(ac); - cx__2Acurrent_2Doutput_2A = ac; - } - gonexti(); -} - -define_instruction(cerrv) { - if (ac == void_obj()) { - ac = cx__2Acurrent_2Derror_2A; - assert(is_oport(ac)); - } else { - ckw(ac); - cx__2Acurrent_2Derror_2A = ac; - } - gonexti(); -} -*/ define_instruction(sip) { ac = iport_file_obj(stdin); diff --git a/i.h b/i.h index 13c9c23..46924e2 100644 --- a/i.h +++ b/i.h @@ -470,12 +470,9 @@ declare_instruction(void, "Y9", 0, "void", declare_instruction(cin, "Pi", 0, "%current-input-port", '0', AUTOGL) declare_instruction(cout, "Po", 0, "%current-output-port", '0', AUTOGL) declare_instruction(cerr, "Pe", 0, "%current-error-port", '0', AUTOGL) -declare_instruction(setcin, "Psi", 0, "%set-current-input-port!", '0', AUTOGL) -declare_instruction(setcout, "Pso", 0, "%set-current-output-port!",'0', AUTOGL) -declare_instruction(setcerr, "Pse", 0, "%set-current-error-port!", '0', AUTOGL) -//declare_instruction(cinv, "Pi!\0Y9", 0, "current-input-port", 'u', AUTOGL) -//declare_instruction(coutv, "Po!\0Y9", 0, "current-output-port", 'u', AUTOGL) -//declare_instruction(cerrv, "Pe!\0Y9", 0, "current-error-port", 'u', AUTOGL) +declare_instruction(setcin, "Psi", 0, "%set-current-input-port!", '1', AUTOGL) +declare_instruction(setcout, "Pso", 0, "%set-current-output-port!",'1', AUTOGL) +declare_instruction(setcerr, "Pse", 0, "%set-current-error-port!", '1', AUTOGL) declare_instruction(funp, "K0", 0, "procedure?", '1', AUTOGL) declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL) declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL) diff --git a/s.c b/s.c index 27e40ec..e36885e 100644 --- a/s.c +++ b/s.c @@ -621,12 +621,12 @@ char *s_code[] = { "rror),@(y12:write-string)[02}}${.7,.7,.4^[02}.5W6]6", "P", "simple-error", - "%!0Y9Pe!,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:re" - "set)[20", + "%!0Pe,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:reset" + ")[20", "P", "assertion-violation", - "%!0Y9Pe!,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-mess" - "age)[03}'1Z9]2", + "%!0Pe,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-message" + ")[03}'1Z9]2", "C", 0, "${'(l3:y4:kind;y7:message;y9:irritants;),'(y14:),@(y15:n" @@ -729,9 +729,8 @@ char *s_code[] = { "@(y5:port?)@!(y12:binary-port?)", "C", 0, - "&0{%2.1?{.0,@(y24:%25set-current-input-port!)[21}.0]2}%x,&0{%1.0,@(y24" - ":%25set-current-input-port!)[11}%x,&0{%0Pi]0}%x,&3{|00|11|22%%}@!(y29:" - "%25current-input-port-parameter)", + "&0{%2.1?{.0Psi]2}.0]2}%x,&0{%1.0Psi]1}%x,&0{%0Pi]0}%x,&3{|00|11|22%%}@" + "!(y29:%25current-input-port-parameter)", "S", "current-input-port", "l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y19:%25current-input-port;;;l2:l2" @@ -740,9 +739,8 @@ char *s_code[] = { "-port-parameter;;", "C", 0, - "&0{%2.1?{.0,@(y25:%25set-current-output-port!)[21}.0]2}%x,&0{%1.0,@(y2" - "5:%25set-current-output-port!)[11}%x,&0{%0Po]0}%x,&3{|00|11|22%%}@!(y3" - "0:%25current-output-port-parameter)", + "&0{%2.1?{.0Pso]2}.0]2}%x,&0{%1.0Pso]1}%x,&0{%0Po]0}%x,&3{|00|11|22%%}@" + "!(y30:%25current-output-port-parameter)", "S", "current-output-port", "l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y20:%25current-output-port;;;l2:l" @@ -751,9 +749,8 @@ char *s_code[] = { "tput-port-parameter;;", "C", 0, - "&0{%2.1?{.0,@(y24:%25set-current-error-port!)[21}.0]2}%x,&0{%1.0,@(y24" - ":%25set-current-error-port!)[11}%x,&0{%0Pe]0}%x,&3{|00|11|22%%}@!(y29:" - "%25current-error-port-parameter)", + "&0{%2.1?{.0Pse]2}.0]2}%x,&0{%1.0Pse]1}%x,&0{%0Pe]0}%x,&3{|00|11|22%%}@" + "!(y29:%25current-error-port-parameter)", "S", "current-error-port", "l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y19:%25current-error-port;;;l2:l2" diff --git a/src/s.scm b/src/s.scm index bb32e67..439b7e4 100644 --- a/src/s.scm +++ b/src/s.scm @@ -1239,7 +1239,7 @@ (letrec ([default-handler (case-lambda - [() default-handler] ;this one its own parent + [() default-handler] ; make this one its own parent [(obj) (if (error-object? obj) (apply simple-error (error-object-kind obj) (error-object-message obj) (error-object-irritants obj))