mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
a few extra i/o instructions & procedures
This commit is contained in:
ESL
parent
4f2732e536
commit
25196416c7
4 changed files with 202 additions and 22 deletions
53
i.c
53
i.c
|
|
@ -2118,11 +2118,6 @@ define_instruction(boolp) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(eofp) {
|
||||
ac = obj_from_bool(iseof(ac));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(funp) {
|
||||
ac = obj_from_bool(isvmclo(ac));
|
||||
gonexti();
|
||||
|
|
@ -2153,6 +2148,20 @@ define_instruction(sep) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(ipop) {
|
||||
cxtype_iport_t *vt; ckr(ac);
|
||||
vt = iportvt(ac); assert(vt);
|
||||
ac = obj_from_bool(vt != (cxtype_iport_t *)IPORT_CLOSED_NTAG);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(opop) {
|
||||
cxtype_oport_t *vt; ckw(ac);
|
||||
vt = oportvt(ac); assert(vt);
|
||||
ac = obj_from_bool(vt != (cxtype_oport_t *)OPORT_CLOSED_NTAG);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(otip) {
|
||||
FILE *fp = fopen(stringchars(ac), "r");
|
||||
if (fp == NULL) fail("can't open input file");
|
||||
|
|
@ -2208,6 +2217,40 @@ define_instruction(gos) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
define_instruction(rdc) {
|
||||
int c; ckr(ac);
|
||||
c = iportgetc(ac);
|
||||
if (unlikely(c == EOF)) ac = mkeof();
|
||||
else ac = obj_from_char(c);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(rdac) {
|
||||
int c; ckr(ac);
|
||||
c = iportpeekc(ac);
|
||||
if (unlikely(c == EOF)) ac = mkeof();
|
||||
else ac = obj_from_char(c);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(rdcr) {
|
||||
ckr(ac);
|
||||
ac = obj_from_bool(1); /* no portable way to detect hanging? */
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(eofp) {
|
||||
ac = obj_from_bool(iseof(ac));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(eof) {
|
||||
ac = mkeof();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
define_instruction(wrc) {
|
||||
obj x = ac, y = spop(); ckc(x); ckw(y);
|
||||
oportputc(char_from_obj(x), y);
|
||||
|
|
|
|||
9
i.h
9
i.h
|
|
@ -416,13 +416,14 @@ declare_instruction(scmp, "O2", 0, "%scmp", 2, INLINED)
|
|||
declare_instruction(sicmp, "O3", 0, "%sicmp", 2, INLINED)
|
||||
declare_instruction(symp, "Y0", 0, "%symp", 1, INLINED)
|
||||
declare_instruction(boolp, "Y1", 0, "%boolp", 1, INLINED)
|
||||
declare_instruction(eofp, "Y9", 0, "%eofp", 1, INLINED)
|
||||
declare_instruction(funp, "K0", 0, "%funp", 1, INLINED)
|
||||
declare_instruction(ipp, "P00", 0, "%ipp", 1, INLINED)
|
||||
declare_instruction(opp, "P01", 0, "%opp", 1, INLINED)
|
||||
declare_instruction(sip, "P10", 0, "%sip", 0, INLINED)
|
||||
declare_instruction(sop, "P11", 0, "%sop", 0, INLINED)
|
||||
declare_instruction(sep, "P12", 0, "%sep", 0, INLINED)
|
||||
declare_instruction(ipop, "P20", 0, "%ipop", 1, INLINED)
|
||||
declare_instruction(opop, "P21", 0, "%opop", 1, INLINED)
|
||||
declare_instruction(otip, "P40", 0, "%otip", 1, INLINED)
|
||||
declare_instruction(otop, "P41", 0, "%otop", 1, INLINED)
|
||||
declare_instruction(ois, "P50", 0, "%ois", 1, INLINED)
|
||||
|
|
@ -430,6 +431,12 @@ declare_instruction(oos, "P51", 0, "%oos", 0, INLINED)
|
|||
declare_instruction(cip, "P60", 0, "%cip", 1, INLINED)
|
||||
declare_instruction(cop, "P61", 0, "%cop", 1, INLINED)
|
||||
declare_instruction(gos, "P9", 0, "%gos", 1, INLINED)
|
||||
declare_instruction(rdc, "R0", 0, "%rdc", 1, INLINED)
|
||||
declare_instruction(rdac, "R1", 0, "%rdac", 1, INLINED)
|
||||
declare_instruction(rdcr, "R2", 0, "%rdcr", 1, INLINED)
|
||||
declare_instruction(eofp, "R8", 0, "%eofp", 1, INLINED)
|
||||
declare_instrshadow(eofp, "Y9", 0, NULL, 0, INLINED)
|
||||
declare_instruction(eof, "R9", 0, "%eof", 0, INLINED)
|
||||
declare_instruction(wrc, "W0", 0, "%wrc", 2, INLINED)
|
||||
declare_instruction(wrs, "W1", 0, "%wrs", 2, INLINED)
|
||||
declare_instruction(wrcd, "W4", 0, "%wrcd", 2, INLINED)
|
||||
|
|
|
|||
79
s.c
79
s.c
|
|
@ -1663,6 +1663,22 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0P01]1}@!(y22:%25residual-output-port?)",
|
||||
|
||||
"input-port-open?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ipop;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py26:%25residual-input-port-open?;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y26:%25residual-input-port-open?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P20]1}@!(y26:%25residual-input-port-open?)",
|
||||
|
||||
"output-port-open?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25opop;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py27:%25residual-output-port-open?;y12:syntax-rules;;"
|
||||
";l2:y1:_;y27:%25residual-output-port-open?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P21]1}@!(y27:%25residual-output-port-open?)",
|
||||
|
||||
"current-input-port",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25sip;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py28:%25residual-current-input-port;y12:syntax-rules;;;l2:y1:_;y"
|
||||
|
|
@ -1743,13 +1759,61 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0P9]1}@!(y27:%25residual-get-output-string)",
|
||||
|
||||
0,
|
||||
"&0{%1.0P00,.0?{.0]2}.1P01]2}@!(y5:port?)",
|
||||
|
||||
0,
|
||||
"&0{%1.0P00?{.0P60}.0P01?{.0P61]1}]1}@!(y10:close-port)",
|
||||
|
||||
0,
|
||||
"&0{%2.0,&1{%!0${:0,@(y10:close-port)[01}.0,@(y5:%25sdmv),@(y5:%25appl)"
|
||||
"[12},.1,.3,&2{%0:1,:0[01},@(y5:%25cwmv)[22}@!(y14:call-with-port)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1P40,@(y14:call-with-port)[22}@!(y20:call-with-input-file)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1P41,@(y14:call-with-port)[22}@!(y21:call-with-output-file)",
|
||||
|
||||
"read-char",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y4:%25rdc;l1:y4:%25sip;;;;l2:l2:y"
|
||||
"1:_;y1:p;;l2:y4:%25rdc;y1:p;;;l2:py1:_;y4:args;;py19:%25residual-read-"
|
||||
"char;y4:args;;;l2:y1:_;y19:%25residual-read-char;;",
|
||||
|
||||
"peek-char",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:%25rdac;l1:y4:%25sip;;;;l2:l2:"
|
||||
"y1:_;y1:p;;l2:y5:%25rdac;y1:p;;;l2:py1:_;y4:args;;py19:%25residual-pee"
|
||||
"k-char;y4:args;;;l2:y1:_;y19:%25residual-peek-char;;",
|
||||
|
||||
"char-ready?",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:%25rdcr;l1:y4:%25sip;;;;l2:l2:"
|
||||
"y1:_;y1:p;;l2:y5:%25rdcr;y1:p;;;l2:y1:_;y21:%25residual-char-ready?;;",
|
||||
|
||||
0,
|
||||
"&0{%1P51,t,,#0.3,.3,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C=}_1?{.0R8?{."
|
||||
"1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0f,:0^[21}.!0."
|
||||
"0^_1[21}@!(y10:%25read-line)",
|
||||
|
||||
"read-line",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l2:y10:%25read-line;l1:y4:%25sip;;;;"
|
||||
"l2:l2:y1:_;y1:p;;l2:y10:%25read-line;y1:p;;;l2:y1:_;y19:%25residual-re"
|
||||
"ad-line;;",
|
||||
|
||||
"eof-object?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25eofp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py21:%25residual-eof-object?;y12:syntax-rules;;;l2:y1"
|
||||
":_;y21:%25residual-eof-object?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0Y9]1}@!(y21:%25residual-eof-object?)",
|
||||
"&0{%1.0R8]1}@!(y21:%25residual-eof-object?)",
|
||||
|
||||
"eof-object",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25eof;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py20:%25residual-eof-object;y12:syntax-rules;;;l2:y1:_;y20:%25re"
|
||||
"sidual-eof-object;;",
|
||||
|
||||
0,
|
||||
"&0{%0R9]0}@!(y20:%25residual-eof-object)",
|
||||
|
||||
"write-char",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25wrc;y1:x;l1:y4:%25sop;"
|
||||
|
|
@ -1904,6 +1968,19 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%!1.0u?{'(i10),.2E9]2}.0a,.2E9]2}@!(y24:%25residual-string->number)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R0]1}.0aR0]1}@!(y19:%25residual-read-char)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R1]1}.0aR1]1}@!(y19:%25residual-peek-char)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R2]1}.0aR2]1}@!(y21:%25residual-char-ready?)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10,@(y10:%25read-line)[11}.0a,@(y10:%25read-line)[11}@!(y1"
|
||||
"9:%25residual-read-line)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W0]2}.0a,.2W0]2}@!(y20:%25residual-write-char)",
|
||||
|
||||
|
|
|
|||
83
src/s.scm
83
src/s.scm
|
|
@ -664,6 +664,10 @@
|
|||
|
||||
(define-inline (output-port? x) %residual-output-port? (%opp x))
|
||||
|
||||
(define-inline (input-port-open? x) %residual-input-port-open? (%ipop x))
|
||||
|
||||
(define-inline (output-port-open? x) %residual-output-port-open? (%opop x))
|
||||
|
||||
(define-inline (current-input-port) %residual-current-input-port (%sip))
|
||||
|
||||
(define-inline (current-output-port) %residual-current-output-port (%sop))
|
||||
|
|
@ -684,17 +688,26 @@
|
|||
|
||||
(define-inline (get-output-string x) %residual-get-output-string (%gos x))
|
||||
|
||||
;call-with-port
|
||||
;call-with-input-file
|
||||
;call-with-output-file
|
||||
;port?
|
||||
;input-port-open?
|
||||
;output-port-open?
|
||||
;with-input-from-file
|
||||
;with-output-to-file
|
||||
(define (port? x) (or (input-port? x) (output-port? x)))
|
||||
|
||||
(define (close-port p)
|
||||
(if (input-port? p) (close-input-port p))
|
||||
(if (output-port? p) (close-output-port p)))
|
||||
|
||||
(define (call-with-port port proc)
|
||||
(call-with-values (lambda () (proc port))
|
||||
(lambda vals (close-port port) (apply values vals))))
|
||||
|
||||
(define (call-with-input-file fname proc)
|
||||
(call-with-port (open-input-file fname) proc))
|
||||
|
||||
(define (call-with-output-file fname proc)
|
||||
(call-with-port (open-output-file fname) proc))
|
||||
|
||||
;with-input-from-file -- requires parameterize
|
||||
;with-output-to-file -- requires parameterize
|
||||
;open-binary-input-file
|
||||
;open-binary-output-file
|
||||
;close-port
|
||||
;open-input-bytevector
|
||||
;open-output-bytevector
|
||||
;get-output-bytevector
|
||||
|
|
@ -704,11 +717,46 @@
|
|||
; Input
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-syntax read-char
|
||||
(syntax-rules ()
|
||||
[(_) (%rdc (%sip))]
|
||||
[(_ p) (%rdc p)]
|
||||
[(_ . args) (%residual-read-char . args)]
|
||||
[_ %residual-read-char]))
|
||||
|
||||
(define-syntax peek-char
|
||||
(syntax-rules ()
|
||||
[(_) (%rdac (%sip))]
|
||||
[(_ p) (%rdac p)]
|
||||
[(_ . args) (%residual-peek-char . args)]
|
||||
[_ %residual-peek-char]))
|
||||
|
||||
(define-syntax char-ready?
|
||||
(syntax-rules ()
|
||||
[(_) (%rdcr (%sip))]
|
||||
[(_ p) (%rdcr p)]
|
||||
[_ %residual-char-ready?]))
|
||||
|
||||
(define (%read-line p)
|
||||
(let ([op (%oos)])
|
||||
(let loop ([read-nothing? #t])
|
||||
(let ([c (%rdc p)])
|
||||
(cond [(or (%eofp c) (char=? c #\newline))
|
||||
(if (and (%eofp c) read-nothing?) c
|
||||
(let ([s (%gos op)]) (%cop op) s))]
|
||||
[(char=? c #\return) (loop #f)]
|
||||
[else (%wrc c op) (loop #f)])))))
|
||||
|
||||
(define-syntax read-line
|
||||
(syntax-rules ()
|
||||
[(_) (%read-line (%sip))]
|
||||
[(_ p) (%read-line p)]
|
||||
[_ %residual-read-line]))
|
||||
|
||||
(define-inline (eof-object? x) %residual-eof-object? (%eofp x))
|
||||
(define-inline (eof-object) %residual-eof-object (%eof))
|
||||
|
||||
;read
|
||||
;read-char
|
||||
;peek-char
|
||||
;read-line
|
||||
;char-ready?
|
||||
;read-string
|
||||
;read-u8
|
||||
;peek-u8
|
||||
|
|
@ -716,8 +764,6 @@
|
|||
;read-bytevector
|
||||
;read-bytevector!
|
||||
|
||||
(define-inline (eof-object? x) %residual-eof-object? (%eofp x))
|
||||
;eof-object
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -773,6 +819,8 @@
|
|||
[(_ . args) (%residual-write-simple . args)]
|
||||
[_ %residual-write-simple]))
|
||||
|
||||
;flush-output-port
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; System interface
|
||||
|
|
@ -939,6 +987,11 @@
|
|||
(define %residual-number->string (unary-binary-adaptor number->string))
|
||||
(define %residual-string->number (unary-binary-adaptor string->number))
|
||||
|
||||
(define %residual-read-char (nullary-unary-adaptor read-char))
|
||||
(define %residual-peek-char (nullary-unary-adaptor peek-char))
|
||||
(define %residual-char-ready? (nullary-unary-adaptor char-ready?))
|
||||
(define %residual-read-line (nullary-unary-adaptor read-line))
|
||||
|
||||
(define %residual-write-char (unary-binary-adaptor write-char))
|
||||
(define %residual-write-string (unary-binary-adaptor write-string))
|
||||
(define %residual-newline (nullary-unary-adaptor newline))
|
||||
|
|
|
|||
Loading…
Reference in a new issue