wip
This commit is contained in:
parent
6a507bcaac
commit
98d23bc59b
14
blk/288
14
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,
|
||||
|
2
blk/289
2
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 )
|
||||
|
16
blk/291
16
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 . )
|
||||
|
8
blk/292
8
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 )
|
||||
|
4
blk/298
4
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 )
|
||||
|
10
blk/366
10
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 ;
|
||||
|
8
blk/381
8
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 ;
|
||||
|
5
blk/382
5
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
|
||||
|
2
blk/399
2
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
|
||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user