( requires core, parse ) ( Managing variables in a core module is tricky. Sure, we have (sysv), but here we need to allocate a big buffer, and that cannot be done through (sysv). What we do is that we allocate that buffer at runtime and use (sysv) to point to it, a pointer that is set during the initialization routine. ) 64 CONSTANT INBUFSZ ( points to INBUF ) (sysv) IN( ( points to INBUF's end ) (sysv) IN) ( current position in INBUF ) (sysv) IN> ( flush input buffer ) ( set IN> to IN( and set IN> @ to null ) : (infl) 0 IN( @ DUP IN> ! ! ; ( Initializes the readln subsystem ) : (c<$) H@ IN( ! INBUFSZ ALLOT H@ IN) ! (infl) ; ( handle backspace: go back one char in IN>, if possible, then emit SPC + BS ) : (inbs) ( already at IN( ? ) IN> @ IN( @ = IF EXIT THEN IN> @ 1 - IN> ! SPC BS ; ( read one char into input buffer and returns whether we should continue, that is, whether newline was not met. ) : (rdlnc) ( -- f ) ( buffer overflow? stop now ) IN> @ IN) @ = IF 0 EXIT THEN ( get and echo back ) KEY DUP ( c c ) ( del? same as backspace ) DUP 0x7f = IF DROP DROP 0x8 DUP THEN EMIT ( c ) ( bacspace? handle and exit ) DUP 0x8 = IF (inbs) EXIT THEN ( write and advance ) DUP ( keep as result ) ( c c ) IN> @ ! 1 IN> +! ( c ) ( not newline? exit now ) DUP 0xa = NOT IF EXIT THEN ( c ) ( newline? make our result 0 and write it to indicate EOL ) DROP 0 DUP IN> @ ! ( c ) ; ( Read one line in input buffer and make IN> point to it ) : (rdln) ( Should we prompt? if we're executing a word, FLAGS bit 0, then we shouldn't. ) FLAGS @ 0x1 AND NOT IF LF '>' EMIT SPC THEN (infl) BEGIN (rdlnc) NOT UNTIL IN( @ IN> ! ; ( And finally, implement a replacement for the (c<) routine ) : (c<) IN> @ C@ ( c ) ( not EOL? good, inc and return ) DUP IF 1 IN> +! EXIT THEN ( c ) ( EOL ? readline. we still return typed char though ) (rdln) ( c ) ;