mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
current ports refactoring -- work in progress
This commit is contained in:
ESL
parent
aac5aa4993
commit
ac11df30ac
5 changed files with 770 additions and 691 deletions
66
i.c
66
i.c
|
|
@ -9,6 +9,9 @@ extern obj cx__2Atransformers_2A;
|
|||
extern obj cx__2Adynamic_2Dstate_2A;
|
||||
extern obj cx_continuation_2Dadapter_2Dcode;
|
||||
extern obj cx_callmv_2Dadapter_2Dclosure;
|
||||
extern obj cx__2Acurrent_2Dinput_2A;
|
||||
extern obj cx__2Acurrent_2Doutput_2A;
|
||||
extern obj cx__2Acurrent_2Derror_2A;
|
||||
|
||||
#define istagged(o, t) istagged_inlined(o, t)
|
||||
|
||||
|
|
@ -3080,18 +3083,70 @@ define_instruction(opp) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(cin) {
|
||||
ac = cx__2Acurrent_2Dinput_2A;
|
||||
assert(is_iport(ac));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(cout) {
|
||||
ac = cx__2Acurrent_2Doutput_2A;
|
||||
assert(is_oport(ac));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(cerr) {
|
||||
ac = cx__2Acurrent_2Derror_2A;
|
||||
assert(is_oport(ac));
|
||||
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); /* TODO: keep in global var -- in r7rs it is a parameter */
|
||||
ac = iport_file_obj(stdin);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(sop) {
|
||||
ac = oport_file_obj(stdout); /* TODO: keep in global var -- in r7rs it is a parameter */
|
||||
ac = oport_file_obj(stdout);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(sep) {
|
||||
ac = oport_file_obj(stderr); /* TODO: keep in global var -- in r7rs it is a parameter */
|
||||
ac = oport_file_obj(stderr);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
|
@ -4616,6 +4671,11 @@ static obj *init_module(obj *r, obj *sp, obj *hp, const char **mod)
|
|||
/* partially hand-coded module (prototyped in i.scm) */
|
||||
char *i_code[] = {
|
||||
|
||||
/* initialize current port variables */
|
||||
"C", 0,
|
||||
"P10Pi!" "P11Po!" "P12Pe!",
|
||||
|
||||
/* internal continuation switch code */
|
||||
"P", "%dynamic-state-reroot!",
|
||||
"%1.0,,#0.0,&1{%1.0,yq~?{${.2d,:0^[01}.0ad,.1aa,y,.1,.3c,.1sa.3,.1sdf,."
|
||||
"4san,.4sd.3sy_1.0[30}]1}.!0.0^_1[11",
|
||||
|
|
|
|||
38
i.h
38
i.h
|
|
@ -467,12 +467,18 @@ declare_instruction(boolp, "Y1", 0, "boolean?",
|
|||
declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL)
|
||||
declare_instruction(voidp, "Y8", 0, "void?", '1', AUTOGL)
|
||||
declare_instruction(void, "Y9", 0, "void", '0', AUTOGL)
|
||||
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(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(funp, "K0", 0, "procedure?", '1', AUTOGL)
|
||||
declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL)
|
||||
declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL)
|
||||
declare_instruction(sip, "P10", 0, "current-input-port", '0', AUTOGL)
|
||||
declare_instruction(sop, "P11", 0, "current-output-port", '0', AUTOGL)
|
||||
declare_instruction(sep, "P12", 0, "current-error-port", '0', AUTOGL)
|
||||
declare_instruction(sip, "P10", 0, "standard-input-port", '0', AUTOGL)
|
||||
declare_instruction(sop, "P11", 0, "standard-output-port", '0', AUTOGL)
|
||||
declare_instruction(sep, "P12", 0, "standard-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)
|
||||
|
|
@ -488,23 +494,23 @@ declare_instruction(cop, "P61", 0, "close-output-port",
|
|||
declare_instruction(fop, "P71", 0, "flush-output-port", '1', AUTOGL)
|
||||
declare_instruction(gos, "P90", 0, "get-output-string", '1', AUTOGL)
|
||||
declare_instruction(gob, "P91", 0, "get-output-bytevector", '1', AUTOGL)
|
||||
declare_instruction(rdc, "R0\0P10", 0, "read-char", 'u', AUTOGL)
|
||||
declare_instruction(rdac, "R1\0P10", 0, "peek-char", 'u', AUTOGL)
|
||||
declare_instruction(rdcr, "R2\0P10", 0, "char-ready?", 'u', AUTOGL)
|
||||
declare_instruction(rd8, "R3\0P10", 0, "read-u8", 'u', AUTOGL)
|
||||
declare_instruction(rda8, "R4\0P10", 0, "peek-u8", 'u', AUTOGL)
|
||||
declare_instruction(rd8r, "R5\0P10", 0, "u8-ready?", 'u', AUTOGL)
|
||||
declare_instruction(rdc, "R0\0Pi", 0, "read-char", 'u', AUTOGL)
|
||||
declare_instruction(rdac, "R1\0Pi", 0, "peek-char", 'u', AUTOGL)
|
||||
declare_instruction(rdcr, "R2\0Pi", 0, "char-ready?", 'u', AUTOGL)
|
||||
declare_instruction(rd8, "R3\0Pi", 0, "read-u8", 'u', AUTOGL)
|
||||
declare_instruction(rda8, "R4\0Pi", 0, "peek-u8", 'u', AUTOGL)
|
||||
declare_instruction(rd8r, "R5\0Pi", 0, "u8-ready?", 'u', AUTOGL)
|
||||
declare_instruction(eofp, "R8", 0, "eof-object?", '1', AUTOGL)
|
||||
declare_instruction(eof, "R9", 0, "eof-object", '0', AUTOGL)
|
||||
declare_instruction(wrc, "W0\0P11", 0, "write-char", 'b', AUTOGL)
|
||||
declare_instruction(wrc, "W0\0Po", 0, "write-char", 'b', AUTOGL)
|
||||
declare_instruction(wrs, "W1", 0, "%write-string1", '2', AUTOGL)
|
||||
declare_instruction(wr8, "W2\0P11", 0, "write-u8", 'b', AUTOGL)
|
||||
declare_instruction(wr8, "W2\0Po", 0, "write-u8", 'b', AUTOGL)
|
||||
declare_instruction(wrb, "W3", 0, "%write-bytevector1", '2', AUTOGL)
|
||||
declare_instruction(wrcd, "W4\0P11", 0, "display", 'b', AUTOGL)
|
||||
declare_instruction(wrcw, "W5\0P11", 0, "write", 'b', AUTOGL)
|
||||
declare_instruction(wrnl, "W6\0P11", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0P11", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
|
||||
declare_instruction(wrcd, "W4\0Po", 0, "display", 'b', AUTOGL)
|
||||
declare_instruction(wrcw, "W5\0Po", 0, "write", 'b', AUTOGL)
|
||||
declare_instruction(wrnl, "W6\0Po", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0Po", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0Po", 0, "write-simple", 'b', AUTOGL)
|
||||
declare_instruction(fexis, "F0", 0, "file-exists?", '1', AUTOGL)
|
||||
declare_instruction(frem, "F1", 0, "delete-file", '1', AUTOGL)
|
||||
declare_instruction(fren, "F2", 0, "rename-file", '2', AUTOGL)
|
||||
|
|
|
|||
46
s.c
46
s.c
|
|
@ -621,12 +621,12 @@ char *s_code[] = {
|
|||
"rror),@(y12:write-string)[02}}${.7,.7,.4^[02}.5W6]6",
|
||||
|
||||
"P", "simple-error",
|
||||
"%!0P12,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:rese"
|
||||
"t)[20",
|
||||
"%!0Pe,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:reset"
|
||||
")[20",
|
||||
|
||||
"P", "assertion-violation",
|
||||
"%!0P12,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-messag"
|
||||
"e)[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"
|
||||
|
|
@ -757,9 +757,9 @@ char *s_code[] = {
|
|||
"%2.1,${.3,@(y16:open-output-file)[01},@(y14:call-with-port)[22",
|
||||
|
||||
"P", "read-line",
|
||||
"%!0P51,.1u?{P10}{.1a},t,,#0.2,.4,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C"
|
||||
"=}_1?{.0R8?{.1}{f}?{.0]2}:1P90,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W"
|
||||
"0f,:0^[21}.!0.0^_1[31",
|
||||
"%!0P51,.1u?{Pi}{.1a},t,,#0.2,.4,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C="
|
||||
"}_1?{.0R8?{.1}{f}?{.0]2}:1P90,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0"
|
||||
"f,:0^[21}.!0.0^_1[31",
|
||||
|
||||
"P", "read-substring!",
|
||||
"%4.1,,#0.5,.4,.4,.3,.8,&5{%1:0,.1I<!?{:3,.1I-]1}:4R0,.0R8?{:3,.2I=?{.0"
|
||||
|
|
@ -772,12 +772,12 @@ char *s_code[] = {
|
|||
"C", 0,
|
||||
"&0{%4.1,.4,.4,.3,@(y15:read-substring!)[44}%x,&0{%3.1,.1S3,.4,.3,@(y15"
|
||||
":read-substring!)[34}%x,&0{%2.1,.1S3,'0,.3,@(y15:read-substring!)[24}%"
|
||||
"x,&0{%1P10,.1S3,'0,.3,@(y15:read-substring!)[14}%x,&4{|10|21|32|43%%}@"
|
||||
"!(y12:read-string!)",
|
||||
"x,&0{%1Pi,.1S3,'0,.3,@(y15:read-substring!)[14}%x,&4{|10|21|32|43%%}@!"
|
||||
"(y12:read-string!)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1,.1,@(y14:read-substring)[22}%x,&0{%1P10,.1,@(y14:read-substrin"
|
||||
"g)[12}%x,&2{|10|21%%}@!(y11:read-string)",
|
||||
"&0{%2.1,.1,@(y14:read-substring)[22}%x,&0{%1Pi,.1,@(y14:read-substring"
|
||||
")[12}%x,&2{|10|21%%}@!(y11:read-string)",
|
||||
|
||||
"P", "read-subbytevector!",
|
||||
"%4.1,,#0.5,.4,.4,.3,.8,&5{%1:0,.1I<!?{:3,.1I-]1}:4R3,.0R8?{:3,.2I=?{.0"
|
||||
|
|
@ -790,12 +790,12 @@ char *s_code[] = {
|
|||
"C", 0,
|
||||
"&0{%4.1,.4,.4,.3,@(y19:read-subbytevector!)[44}%x,&0{%3.1,.1B3,.4,.3,@"
|
||||
"(y19:read-subbytevector!)[34}%x,&0{%2.1,.1B3,'0,.3,@(y19:read-subbytev"
|
||||
"ector!)[24}%x,&0{%1P10,.1B3,'0,.3,@(y19:read-subbytevector!)[14}%x,&4{"
|
||||
"|10|21|32|43%%}@!(y16:read-bytevector!)",
|
||||
"ector!)[24}%x,&0{%1Pi,.1B3,'0,.3,@(y19:read-subbytevector!)[14}%x,&4{|"
|
||||
"10|21|32|43%%}@!(y16:read-bytevector!)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1,.1,@(y18:read-subbytevector)[22}%x,&0{%1P10,.1,@(y18:read-subb"
|
||||
"ytevector)[12}%x,&2{|10|21%%}@!(y15:read-bytevector)",
|
||||
"&0{%2.1,.1,@(y18:read-subbytevector)[22}%x,&0{%1Pi,.1,@(y18:read-subby"
|
||||
"tevector)[12}%x,&2{|10|21%%}@!(y15:read-bytevector)",
|
||||
|
||||
"P", "%read",
|
||||
"%2,,,,,,,,,,,,,,,,,,,,,,#0#1#2#3#4#5#6#7#8#9#(i10)#(i11)#(i12)#(i13)#("
|
||||
|
|
@ -917,12 +917,12 @@ char *s_code[] = {
|
|||
"),.2d,'(s17:unexpected token:),@(y10:read-error)[(i25)4",
|
||||
|
||||
"C", 0,
|
||||
"&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,P10,@(y5:%25read)[02}%x,&2{|00|11"
|
||||
"%%}@!(y4:read)",
|
||||
"&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,Pi,@(y5:%25read)[02}%x,&2{|00|11%"
|
||||
"%}@!(y4:read)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%1t,.1,@(y5:%25read)[12}%x,&0{%0t,P10,@(y5:%25read)[02}%x,&2{|00|11"
|
||||
"%%}@!(y11:read-simple)",
|
||||
"&0{%1t,.1,@(y5:%25read)[12}%x,&0{%0t,Pi,@(y5:%25read)[02}%x,&2{|00|11%"
|
||||
"%}@!(y11:read-simple)",
|
||||
|
||||
"P", "write-substring",
|
||||
"%4.1,,#0.0,.3,.7,.7,&4{%1:0,.1I<!?{]1}:1,.1,:2S4W0'1,.1I+,:3^[11}.!0.0"
|
||||
|
|
@ -930,8 +930,8 @@ char *s_code[] = {
|
|||
|
||||
"C", 0,
|
||||
"&0{%4.1,.4,.4,.3,@(y15:write-substring)[44}%x,&0{%3.1,.1S3,.4,.3,@(y15"
|
||||
":write-substring)[34}%x,&0{%2.1,.1W1]2}%x,&0{%1P11,.1W1]1}%x,&4{|10|21"
|
||||
"|32|43%%}@!(y12:write-string)",
|
||||
":write-substring)[34}%x,&0{%2.1,.1W1]2}%x,&0{%1Po,.1W1]1}%x,&4{|10|21|"
|
||||
"32|43%%}@!(y12:write-string)",
|
||||
|
||||
"P", "write-subbytevector",
|
||||
"%4.1,,#0.0,.3,.7,.7,&4{%1:0,.1I<!?{]1}:1,.1,:2B4W2'1,.1I+,:3^[11}.!0.0"
|
||||
|
|
@ -939,8 +939,8 @@ char *s_code[] = {
|
|||
|
||||
"C", 0,
|
||||
"&0{%4.1,.4,.4,.3,@(y19:write-subbytevector)[44}%x,&0{%3.1,.1B3,.4,.3,@"
|
||||
"(y19:write-subbytevector)[34}%x,&0{%2.1,.1W3]2}%x,&0{%1P11,.1W3]1}%x,&"
|
||||
"4{|10|21|32|43%%}@!(y16:write-bytevector)",
|
||||
"(y19:write-subbytevector)[34}%x,&0{%2.1,.1W3]2}%x,&0{%1Po,.1W3]1}%x,&4"
|
||||
"{|10|21|32|43%%}@!(y16:write-bytevector)",
|
||||
|
||||
"P", "command-line",
|
||||
"%0'0,n,,#0.0,&1{%2.1Z0,.0?{'1,.3I+,.2,.2c,:0^[32}.1A9]3}.!0.0^_1[02",
|
||||
|
|
|
|||
4
src/k.sf
4
src/k.sf
|
|
@ -735,6 +735,10 @@
|
|||
|
||||
(define *dynamic-state* (list #f)) ; for dynamic-wind
|
||||
|
||||
(define *current-input* #f)
|
||||
(define *current-output* #f)
|
||||
(define *current-error* #f)
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; String representation of S-expressions and code arguments
|
||||
|
|
|
|||
Loading…
Reference in a new issue