izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add BS, CR, LF, SPC ASCII consts

Browse Source 
Previously, these words would be ascii emitters, but seldom used
except for the SPC emitter. However, I would often end up hardcoding
these constants. With useless emitters removed and ASCII constants
added, we have a more usable system.

Also, fix broken test harness.
This commit is contained in:
Virgil Dupras 2021-01-02 10:19:42 -05:00
parent cbf9ecfb1e
commit 527f5977d7
5 changed files with 45 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
arch/z80/trs80/xcomp.fs
View File

@ -15,6 +15,6 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
( TRS-80 wants CR-only newlines ) ( TRS-80 wants CR-only newlines )
," 13 0x50 RAM+ C! BLK$ FD$ " EOT, ," CR 0x50 RAM+ C! BLK$ FD$ " EOT,
ORG @ |M 2 PC! 2 PC! ORG @ |M 2 PC! 2 PC!
H@ |M 2 PC! 2 PC! H@ |M 2 PC! 2 PC!

74
blk.fs
View File

@ -450,7 +450,7 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
( We divide by 2 because each PC represents a word. ) ( We divide by 2 because each PC represents a word. )
: PC H@ ORG @ - 1 RSHIFT ; : PC H@ ORG @ - 1 RSHIFT ;
( ----- 052 ) ( ----- 052 )
: _oor ." arg out of range: " .X SPC ." PC: " PC .X NL> ABORT ; : _oor ." arg out of range: " .X SPC> ." PC: " PC .X NL> ABORT ;
: _r8c DUP 7 > IF _oor THEN ; : _r8c DUP 7 > IF _oor THEN ;
: _r32c DUP 31 > IF _oor THEN ; : _r32c DUP 31 > IF _oor THEN ;
: _r16+c _r32c DUP 16 < IF _oor THEN ; : _r16+c _r32c DUP 16 < IF _oor THEN ;
@ -624,13 +624,13 @@ CREATE FBUF 64 ALLOT0
: _pln ( lineno -- ) : _pln ( lineno -- )
DUP _lpos DUP 64 + SWAP DO ( lno ) DUP _lpos DUP 64 + SWAP DO ( lno )
I EDPOS @ _cpos = IF '^' EMIT THEN I EDPOS @ _cpos = IF '^' EMIT THEN
I C@ DUP 0x20 < IF DROP 0x20 THEN I C@ DUP SPC < IF DROP SPC THEN
EMIT EMIT
LOOP ( lno ) 1+ . ; LOOP ( lno ) 1+ . ;
: _zbuf 64 0 FILL ; ( buf -- ) : _zbuf 64 0 FILL ; ( buf -- )
( ----- 108 ) ( ----- 108 )
: _type ( buf -- ) : _type ( buf -- )
C< DUP 0xd = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a ) C< DUP CR = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a )
BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ; BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ;
( user-facing lines are 1-based ) ( user-facing lines are 1-based )
: T 1- DUP 64 * EDPOS ! _pln ; : T 1- DUP 64 * EDPOS ! _pln ;
@ -654,19 +654,19 @@ CREATE FBUF 64 ALLOT0
BEGIN BEGIN
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
= NOT IF DROP FBUF THEN ( a2 a1 ) = NOT IF DROP FBUF THEN ( a2 a1 )
TUCK C@ 0xd = ( a1 a2 f1 ) TUCK C@ CR = ( a1 a2 f1 )
OVER BLK) = OR ( a1 a2 f1|f2 ) OVER BLK) = OR ( a1 a2 f1|f2 )
UNTIL ( a1 a2 ) UNTIL ( a1 a2 )
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ; DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ;
: F FBUF _type _F EDPOS @ 64 / _pln ; : F FBUF _type _F EDPOS @ 64 / _pln ;
( ----- 111 ) ( ----- 111 )
: _blen ( buf -- length of str in buf ) : _blen ( buf -- length of str in buf )
DUP BEGIN C@+ 0x20 < UNTIL -^ 1- ; DUP BEGIN C@+ SPC < UNTIL -^ 1- ;
: _rbufsz ( size of linebuf to the right of curpos ) : _rbufsz ( size of linebuf to the right of curpos )
EDPOS @ 64 MOD 63 -^ ; EDPOS @ 64 MOD 63 -^ ;
: _lnfix ( --, ensure no ctl chars in line before EDPOS ) : _lnfix ( --, ensure no ctl chars in line before EDPOS )
EDPOS @ DUP 0xffc0 AND 2DUP = IF 2DROP EXIT THEN DO EDPOS @ DUP 0xffc0 AND 2DUP = IF 2DROP EXIT THEN DO
I _cpos DUP C@ 0x20 < IF 0x20 SWAP C! ELSE DROP THEN LOOP ; I _cpos DUP C@ SPC < IF SPC SWAP C! ELSE DROP THEN LOOP ;
: _i ( i without _pln and _type. used in VE ) : _i ( i without _pln and _type. used in VE )
_rbufsz IBUF _blen 2DUP > IF _rbufsz IBUF _blen 2DUP > IF
_lnfix TUCK - ( ilen chars-to-move ) _lnfix TUCK - ( ilen chars-to-move )
@ -781,17 +781,17 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
: width large? IF 64 ELSE COLS THEN ; : width large? IF 64 ELSE COLS THEN ;
: acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ; : acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ;
: num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ; : num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ;
: nspcs ( n -- , spit n space ) 0 DO SPC LOOP ; : nspcs ( n -- , spit n space ) 0 DO SPC> LOOP ;
: aty 0 SWAP AT-XY ; : aty 0 SWAP AT-XY ;
: clrscr COLS LINES * 0 DO 0x20 I CELL! LOOP ; : clrscr COLS LINES * 0 DO SPC I CELL! LOOP ;
: gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ; : gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ;
: status 0 aty ." BLK" SPC BLK> ? SPC ACC ? : status 0 aty ." BLK" SPC> BLK> ? SPC> ACC ?
SPC pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC SPC> pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC>
BLKDTY @ IF '*' EMIT THEN 4 nspcs ; BLKDTY @ IF '*' EMIT THEN 4 nspcs ;
: nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; : nums 17 1 DO 2 I + aty I . SPC> SPC> LOOP ;
( ----- 127 ) ( ----- 127 )
: mode! ( c -- ) 4 col- CELL! ; : mode! ( c -- ) 4 col- CELL! ;
: @emit C@ 0x20 MAX 0x7f MIN EMIT ; : @emit C@ SPC MAX 0x7f MIN EMIT ;
: contents : contents
16 0 DO 16 0 DO
large? IF 3 ELSE 0 THEN I 3 + AT-XY large? IF 3 ELSE 0 THEN I 3 + AT-XY
@ -810,7 +810,7 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
: cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ; : cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ;
: buftype ( buf ln -- ) : buftype ( buf ln -- )
3 OVER AT-XY KEY DUP EMIT 3 OVER AT-XY KEY DUP EMIT
DUP 0x20 < IF 2DROP DROP EXIT THEN DUP SPC < IF 2DROP DROP EXIT THEN
( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c ) ( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ; SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ;
: bufp ( buf -- ) : bufp ( buf -- )
@ -824,8 +824,8 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
: $[ BLK> @ acc@ - selblk ; : $[ BLK> @ acc@ - selblk ;
: $] BLK> @ acc@ + selblk ; : $] BLK> @ acc@ + selblk ;
: $t PREVBLK @ selblk ; : $t PREVBLK @ selblk ;
: $I 'I' mode! IBUF 1 buftype _i bufs contents 0x20 mode! ; : $I 'I' mode! IBUF 1 buftype _i bufs contents SPC mode! ;
: $F 'F' mode! FBUF 2 buftype _F bufs setpos 0x20 mode! ; : $F 'F' mode! FBUF 2 buftype _F bufs setpos SPC mode! ;
: $Y Y bufs ; : $Y Y bufs ;
: $E _E bufs contents ; : $E _E bufs contents ;
: $X acc@ _X bufs contents ; : $X acc@ _X bufs contents ;
@ -855,9 +855,9 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
: $R ( replace mode ) : $R ( replace mode )
'R' mode! 'R' mode!
BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN
DUP 0x20 >= IF DUP SPC >= IF
DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0 DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0
THEN UNTIL 0x20 mode! contents ; THEN UNTIL SPC mode! contents ;
: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ; : $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ;
: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ; : $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ;
: $D $H 64 icpy : $D $H 64 icpy
@ -927,7 +927,7 @@ VARIABLE aspprevx
ROT TUCK + 0x10 - ( sz a end ) ROT TUCK + 0x10 - ( sz a end )
TUCK SWAP 0 ROT> ( sz end sum end a ) DO ( sz end sum ) TUCK SWAP 0 ROT> ( sz end sum end a ) DO ( sz end sum )
I C@ + LOOP ( sz end sum ) SWAP ( sz sum end ) I C@ + LOOP ( sz end sum ) SWAP ( sz sum end )
'T' C!+^ 'M' C!+^ 'R' C!+^ 0x20 C!+^ 'S' C!+^ 'T' C!+^ 'M' C!+^ 'R' C!+^ SPC C!+^ 'S' C!+^
'E' C!+^ 'G' C!+^ 'A' C!+^ 0 C!+^ 0 C!+^ 'E' C!+^ 'G' C!+^ 'A' C!+^ 0 C!+^ 0 C!+^
( sum's LSB ) OVER C!+^ ( MSB ) SWAP 8 RSHIFT OVER C! 1+ ( sum's LSB ) OVER C!+^ ( MSB ) SWAP 8 RSHIFT OVER C! 1+
( sz end ) 0 C!+^ 0 C!+^ 0 C!+^ SWAP 0x4a + SWAP C! ; ( sz end ) 0 C!+^ 0 C!+^ 0 C!+^ SWAP 0x4a + SWAP C! ;
@ -1717,7 +1717,7 @@ with "390 LOAD"
( ----- 356 ) ( ----- 356 )
SYSVARS 0x53 + :** EMIT SYSVARS 0x53 + :** EMIT
: STYPE C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; : STYPE C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ;
: BS 8 EMIT ; : SPC 32 EMIT ; : BS 0x8 ; : LF 0xa ; : CR 0xd ; : SPC 0x20 ; : SPC> SPC EMIT ;
: NL> 0x50 RAM+ C@ ?DUP IF EMIT ELSE 13 EMIT 10 EMIT THEN ; : NL> 0x50 RAM+ C@ ?DUP IF EMIT ELSE 13 EMIT 10 EMIT THEN ;
: ERR STYPE ABORT ; : ERR STYPE ABORT ;
: (uflw) LIT" stack underflow" ERR ; : (uflw) LIT" stack underflow" ERR ;
@ -1962,11 +1962,11 @@ SYSVARS 0x0c + :** C<*
( ----- 377 ) ( ----- 377 )
: _ ( a -- a+8 ) : _ ( a -- a+8 )
DUP ( a a ) DUP ( a a )
':' EMIT DUP .x SPC ':' EMIT DUP .x SPC>
4 0 DO DUP @ |L .x .x SPC 2+ LOOP 4 0 DO DUP @ |L .x .x SPC> 2+ LOOP
DROP ( a ) DROP ( a )
8 0 DO 8 0 DO
C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT C@+ DUP SPC 0x7e =><= NOT IF DROP '.' THEN EMIT
LOOP NL> ; LOOP NL> ;
: DUMP ( n a -- ) : DUMP ( n a -- )
SWAP 8 /MOD SWAP IF 1+ THEN SWAP 8 /MOD SWAP IF 1+ THEN
@ -1978,10 +1978,10 @@ SYSVARS 0x0c + :** C<*
( already at IN( ? ) ( already at IN( ? )
IN> @ IN( = IF EXIT THEN IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> ! IN> @ 1- IN> !
BS SPC BS BS EMIT SPC> BS EMIT
; ;
( del is same as backspace ) ( del is same as backspace )
: BS? DUP 0x7f = SWAP 0x8 = OR ; : BS? DUP 0x7f = SWAP BS = OR ;
SYSVARS 0x55 + :** KEY? SYSVARS 0x55 + :** KEY?
: KEY BEGIN KEY? UNTIL ; : KEY BEGIN KEY? UNTIL ;
( cont.: read one char into input buffer and returns whether we ( cont.: read one char into input buffer and returns whether we
@ -1989,8 +1989,8 @@ SYSVARS 0x55 + :** KEY?
( ----- 379 ) ( ----- 379 )
: (rdlnc) ( -- c ) : (rdlnc) ( -- c )
( buffer overflow? same as if we typed a newline ) ( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) IN> @ IN) = IF LF ELSE KEY THEN ( c )
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) DUP LF = IF DROP CR THEN ( lf? same as cr )
( backspace? handle and exit ) ( backspace? handle and exit )
DUP BS? IF _bs EXIT THEN DUP BS? IF _bs EXIT THEN
( echo back ) ( echo back )
@ -2001,7 +2001,7 @@ SYSVARS 0x55 + :** KEY?
thus ! automatically null-terminates our string ) thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c ) IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL ) ( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ; DUP CR = IF DROP 0 THEN ;
( ----- 380 ) ( ----- 380 )
( Read one line in input buffer and make IN> point to it ) ( Read one line in input buffer and make IN> point to it )
: (rdln) : (rdln)
@ -2023,7 +2023,7 @@ SYSVARS 0x55 + :** KEY?
: RDLN$ : RDLN$
H@ 0x32 ( IN(* ) RAM+ ! H@ 0x32 ( IN(* ) RAM+ !
( plus 2 for extra bytes after buffer: 1 for ( plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. ) the last typed LF and one for the following NULL. )
IN) IN( - ALLOT IN) IN( - ALLOT
(infl) (infl)
['] RDLN< ['] C<* **! ['] RDLN< ['] C<* **!
@ -2033,7 +2033,7 @@ SYSVARS 0x55 + :** KEY?
: LIST : LIST
BLK@ BLK@
16 0 DO 16 0 DO
I 1+ DUP 10 < IF SPC THEN . SPC I 1+ DUP 10 < IF SPC> THEN . SPC>
64 I * BLK( + DUP 64 + SWAP DO 64 I * BLK( + DUP 64 + SWAP DO
I C@ DUP 0x1f > IF EMIT ELSE DROP LEAVE THEN I C@ DUP 0x1f > IF EMIT ELSE DROP LEAVE THEN
LOOP LOOP
@ -2044,7 +2044,7 @@ SYSVARS 0x55 + :** KEY?
BEGIN BEGIN
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
FIND NOT IF (parse) ELSE EXECUTE THEN FIND NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF SPC LIT" ok" STYPE NL> THEN C<? NOT IF SPC> LIT" ok" STYPE NL> THEN
AGAIN ; AGAIN ;
( Read from BOOT C< PTR and inc it. ) ( Read from BOOT C< PTR and inc it. )
: (boot<) : (boot<)
@ -2075,7 +2075,7 @@ SYSVARS 0x55 + :** KEY?
( ----- 385 ) ( ----- 385 )
: LOAD+ BLK> @ + LOAD ; : LOAD+ BLK> @ + LOAD ;
( b1 b2 -- ) ( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . SPC LOAD LOOP ; : LOADR 1+ SWAP DO I DUP . SPC> LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; : LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
( ----- 390 ) ( ----- 390 )
( xcomp core high ) ( xcomp core high )
@ -2168,17 +2168,17 @@ Load range: B402-B403
: XYPOS! COLS LINES * MOD DUP XYPOS @ CURSOR! XYPOS ! ; : XYPOS! COLS LINES * MOD DUP XYPOS @ CURSOR! XYPOS ! ;
: AT-XY ( x y -- ) COLS * + XYPOS! ; : AT-XY ( x y -- ) COLS * + XYPOS! ;
'? NEWLN NIP NOT [IF] '? NEWLN NIP NOT [IF]
: NEWLN ( ln -- ) COLS * DUP COLS + SWAP DO 0x20 I CELL! LOOP ; : NEWLN ( ln -- ) COLS * DUP COLS + SWAP DO SPC I CELL! LOOP ;
[THEN] [THEN]
: _lf XYMODE C@ IF EXIT THEN : _lf XYMODE C@ IF EXIT THEN
XYPOS @ COLS / 1+ LINES MOD DUP NEWLN XYPOS @ COLS / 1+ LINES MOD DUP NEWLN
COLS * XYPOS! ; COLS * XYPOS! ;
: _bs 0x20 ( blank ) XYPOS @ TUCK CELL! ( pos ) 1- XYPOS! ; : _bs SPC XYPOS @ TUCK CELL! ( pos ) 1- XYPOS! ;
( ----- 403 ) ( ----- 403 )
: (emit) : (emit)
DUP 0x08 = IF DROP _bs EXIT THEN DUP BS? IF DROP _bs EXIT THEN
DUP 0x0d = IF DROP _lf EXIT THEN DUP CR = IF DROP _lf EXIT THEN
DUP 0x20 < IF DROP EXIT THEN DUP SPC < IF DROP EXIT THEN
XYPOS @ CELL! XYPOS @ CELL!
XYPOS @ 1+ DUP COLS MOD IF XYPOS! ELSE DROP _lf THEN ; XYPOS @ 1+ DUP COLS MOD IF XYPOS! ELSE DROP _lf THEN ;
: GRID$ 0 XYPOS ! 0 XYMODE C! ; : GRID$ 0 XYPOS ! 0 XYMODE C! ;
@ -2750,7 +2750,7 @@ them. We insert a blank one at the end of those 7. )
( blank row ) 0xff _data ; ( blank row ) 0xff _data ;
: CELL! ( c pos ) : CELL! ( c pos )
0x7800 OR _ctl ( tilenum ) 0x7800 OR _ctl ( tilenum )
0x20 - ( glyph ) 0x5f MOD _data ; SPC - ( glyph ) 0x5f MOD _data ;
( ----- 472 ) ( ----- 472 )
: CURSOR! ( new old -- ) : CURSOR! ( new old -- )
DUP 0x3800 OR _ctl [ TMS_DATAPORT LITN ] PC@ DUP 0x3800 OR _ctl [ TMS_DATAPORT LITN ] PC@

BIN
cvm/stage.bin
View File

Binary file not shown.

5
doc/dict.txt
View File

@ -256,12 +256,15 @@ KEY -- c Get char c from direct input
NL> -- Emit newline NL> -- Emit newline
PC! c a -- Spit c to port a PC! c a -- Spit c to port a
PC@ a -- c Fetch c from port a PC@ a -- c Fetch c from port a
SPC -- Emit space character SPC> -- Emit space character
WORD -- a Read one word from buffered input and push its WORD -- a Read one word from buffered input and push its
addr. Always null terminated. If ASCII EOT is addr. Always null terminated. If ASCII EOT is
encountered, a will point to it (it is cons- encountered, a will point to it (it is cons-
idered a word). idered a word).
These ASCII consts are defined:
BS CR LF SPC
KEY? and EMIT are ialiases to (key?) and (emit) (see TTY proto- KEY? and EMIT are ialiases to (key?) and (emit) (see TTY proto-
col in protocol.txt). KEY is a loop over KEY?. col in protocol.txt). KEY is a loop over KEY?.

6
tests/harness.fs
View File

@ -2,8 +2,8 @@
"#" means "assert". We stop at first failure, indicating "#" means "assert". We stop at first failure, indicating
the failure through IO on port 1 ) the failure through IO on port 1 )
: fail SPC ." failed" LF 1 1 PC! BYE ; : fail SPC> ." failed" NL> 1 1 PC! BYE ;
: # IF SPC ." pass" LF ELSE fail THEN ; : # IF SPC> ." pass" NL> ELSE fail THEN ;
: #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ; : #eq 2DUP SWAP . SPC> '=' EMIT SPC> . '?' EMIT = # ;