diff --git a/blk/288 b/blk/288 index af8d5b6..88c23cb 100644 --- a/blk/288 +++ b/blk/288 @@ -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, diff --git a/blk/289 b/blk/289 index 465de47..ef40f08 100644 --- a/blk/289 +++ b/blk/289 @@ -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 ) diff --git a/blk/291 b/blk/291 index d4e025f..2fb6dbe 100644 --- a/blk/291 +++ b/blk/291 @@ -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 . ) diff --git a/blk/292 b/blk/292 index 51e1b0c..a86812e 100644 --- a/blk/292 +++ b/blk/292 @@ -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 ) diff --git a/blk/298 b/blk/298 index 07762c6..edf2de4 100644 --- a/blk/298 +++ b/blk/298 @@ -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 ) diff --git a/blk/366 b/blk/366 index 784528c..d7214ad 100644 --- a/blk/366 +++ b/blk/366 @@ -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 ; diff --git a/blk/381 b/blk/381 index 51224e5..a3c3f12 100644 --- a/blk/381 +++ b/blk/381 @@ -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 ; diff --git a/blk/382 b/blk/382 index b397eee..d9a7282 100644 --- a/blk/382 +++ b/blk/382 @@ -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 diff --git a/blk/399 b/blk/399 index f299bbe..91bafce 100644 --- a/blk/399 +++ b/blk/399 @@ -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 diff --git a/emul/forth.bin b/emul/forth.bin index b8e4277..e9f80d4 100644 Binary files a/emul/forth.bin and b/emul/forth.bin differ