current ports refactoring -- finished

This commit is contained in:
ESL 2023-03-30 23:01:59 -04:00
parent 6b463a9480
commit a3f0f2091d
4 changed files with 14 additions and 54 deletions

34
i.c
View file

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

9
i.h
View file

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

23
s.c
View file

@ -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:<error-object>),@(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"

View file

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