This commit is contained in:
Virgil Dupras 2020-05-24 20:50:26 -04:00
parent 6a507bcaac
commit 98d23bc59b
10 changed files with 27 additions and 42 deletions

14
blk/288
View File

@ -3,14 +3,8 @@ PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
IY PUSHqq, HL POPqq, ( <-- IP )
HL PUSHqq,
( skip to null char )
A XORr, ( look for null )
B A LDrr,
C A LDrr,
CPIR,
( CPIR advances HL regardless of comparison, so goes one
char after NULL. This is good, because that's what we
want... )
HL PUSHqq, IY POPqq, ( --> IP )
E (HL) LDrr, D 0 LDrn,
DE INCss, DE INCss,
DE ADDIYss,
HL INCss, HL PUSHqq,
JPNEXT,

View File

@ -1,5 +1,5 @@
( Name of BOOT word )
L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, 0 A,
4 A, L1 BSET 'B' A, 'O' A, 'O' A, 'T' A,
PC ORG @ 1 + ! ( main )
( STACK OVERFLOW PROTECTION: See B76 )

16
blk/291
View File

@ -5,12 +5,12 @@ PC ORG @ 4 + ! ( find )
BC PUSHqq,
HL PUSHqq,
( First, figure out string len )
BC 0 LDddnn,
A XORr,
CPIR,
( C has our length, negative, -1 )
A C LDrr,
NEG,
A DECr,
HL DECss, A (HL) LDrr, A ORr,
( special case. zero len? we never find anything. )
IFNZ, ( fail-B296 ) ( cont. )
IFNZ, ( fail-B296 )
( Let's do something weird: We'll hold HL by the *tail*.
Because of our dict structure and because we know our
lengths, it's easier to compare starting from the end. )
C A LDrr, B 0 LDrn, ( C holds our length )
BC ADDHLss, HL INCss, ( HL points to after-last-char )
( cont . )

View File

@ -1,11 +1,3 @@
C A LDrr, ( C holds our length )
( Let's do something weird: We'll hold HL by the *tail*.
Because of our dict structure and because we know our
lengths, it's easier to compare starting from the end.
Currently, after CPIR, HL points to char after null. Let's
adjust. Because the compare loop pre-decrements, instead
of DECing HL twice, we DEC it once. )
HL DECss,
BEGIN, ( inner )
( DE is a wordref, first step, do our len correspond? )
HL PUSHqq, ( --> lvl 1 )

View File

@ -1,6 +1,6 @@
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
6 A, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A,
L2 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
HL PC 6 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 BCALL, ( find )
0x33 BJP, ( 33 == execute )

10
blk/366
View File

@ -1,13 +1,15 @@
( Read word from C<, copy to WORDBUF, null-terminate, and
return WORDBUF. )
: _wb 0x0e RAM+ ;
: _eot 4 _wb ! _wb ;
: WORD
0x0e RAM+ TOWORD ( a c )
DUP EOT? IF OVER ! EXIT THEN
_wb 1+ TOWORD ( a c )
DUP EOT? IF 2DROP _eot EXIT THEN
BEGIN
( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination )
OVER ! 1+ C< ( a c )
OVER 0x2d ( 2e-1 for NULL ) RAM+ = OVER WS? OR
UNTIL ( a c )
NIP 0x0e RAM+ ( ws a )
SWAP EOT? IF 4 OVER ! THEN ;
SWAP _wb - 1- ( ws len ) _wb C!
EOT? IF _eot ELSE _wb 1+ THEN ;

View File

@ -1,13 +1,7 @@
: EMIT
( 0x53==(emit) override )
0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null or 0xd )
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a )
AGAIN ;
: (print) 1- C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ;
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;

View File

@ -2,6 +2,9 @@
BEGIN
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
AGAIN ;
: LIT" 34 , ( litWord ) ," 0 C, ; IMMEDIATE
: LIT"
34 , ( litWord ) H@ 0 C, ,"
DUP H@ -^ 1- ( a len ) SWAP C! 0 C,
; IMMEDIATE
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

View File

@ -1,4 +1,4 @@
: LIT< WORD 34 , BEGIN C@+ DUP C, NOT UNTIL DROP ; IMMEDIATE
: LIT< WORD 34 , 1- DUP C@ 1+ MOVE, 0 C, ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE

Binary file not shown.