From 6f896caf7a5678657b44b734cc8da5e681075123 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Sat, 25 Apr 2020 21:54:07 -0400 Subject: [PATCH] Copy core words to blkfs --- blk/001 | 2 +- blk/269 | 3 +++ blk/420 | 14 ++++++++++++++ blk/422 | 16 ++++++++++++++++ blk/423 | 5 +++++ blk/424 | 13 +++++++++++++ blk/425 | 15 +++++++++++++++ blk/426 | 8 ++++++++ blk/427 | 10 ++++++++++ blk/428 | 13 +++++++++++++ blk/429 | 7 +++++++ blk/430 | 14 ++++++++++++++ blk/431 | 13 +++++++++++++ blk/432 | 16 ++++++++++++++++ blk/433 | 14 ++++++++++++++ blk/434 | 16 ++++++++++++++++ blk/435 | 16 ++++++++++++++++ blk/436 | 12 ++++++++++++ blk/438 | 13 +++++++++++++ blk/439 | 15 +++++++++++++++ blk/440 | 15 +++++++++++++++ blk/442 | 11 +++++++++++ blk/443 | 15 +++++++++++++++ blk/444 | 9 +++++++++ blk/446 | 11 +++++++++++ blk/447 | 15 +++++++++++++++ blk/448 | 15 +++++++++++++++ blk/449 | 11 +++++++++++ blk/450 | 16 ++++++++++++++++ blk/451 | 10 ++++++++++ blk/453 | 13 +++++++++++++ blk/454 | 16 ++++++++++++++++ blk/455 | 16 ++++++++++++++++ blk/456 | 16 ++++++++++++++++ blk/457 | 12 ++++++++++++ blk/459 | 16 ++++++++++++++++ blk/460 | 16 ++++++++++++++++ blk/461 | 16 ++++++++++++++++ blk/462 | 9 +++++++++ blk/464 | 12 ++++++++++++ blk/465 | 12 ++++++++++++ blk/466 | 13 +++++++++++++ blk/467 | 11 +++++++++++ blk/468 | 16 ++++++++++++++++ blk/469 | 16 ++++++++++++++++ blk/470 | 2 ++ 46 files changed, 574 insertions(+), 1 deletion(-) create mode 100644 blk/269 create mode 100644 blk/420 create mode 100644 blk/422 create mode 100644 blk/423 create mode 100644 blk/424 create mode 100644 blk/425 create mode 100644 blk/426 create mode 100644 blk/427 create mode 100644 blk/428 create mode 100644 blk/429 create mode 100644 blk/430 create mode 100644 blk/431 create mode 100644 blk/432 create mode 100644 blk/433 create mode 100644 blk/434 create mode 100644 blk/435 create mode 100644 blk/436 create mode 100644 blk/438 create mode 100644 blk/439 create mode 100644 blk/440 create mode 100644 blk/442 create mode 100644 blk/443 create mode 100644 blk/444 create mode 100644 blk/446 create mode 100644 blk/447 create mode 100644 blk/448 create mode 100644 blk/449 create mode 100644 blk/450 create mode 100644 blk/451 create mode 100644 blk/453 create mode 100644 blk/454 create mode 100644 blk/455 create mode 100644 blk/456 create mode 100644 blk/457 create mode 100644 blk/459 create mode 100644 blk/460 create mode 100644 blk/461 create mode 100644 blk/462 create mode 100644 blk/464 create mode 100644 blk/465 create mode 100644 blk/466 create mode 100644 blk/467 create mode 100644 blk/468 create mode 100644 blk/469 create mode 100644 blk/470 diff --git a/blk/001 b/blk/001 index 3e4dd2b..36ec4a4 100644 --- a/blk/001 +++ b/blk/001 @@ -5,7 +5,7 @@ MASTER INDEX 200 Z80 assembler 260 Cross compilation 280 Z80 boot code 350 ACIA driver 370 SD Card driver 390 Inner core - +420 Core words diff --git a/blk/269 b/blk/269 new file mode 100644 index 0000000..73130e0 --- /dev/null +++ b/blk/269 @@ -0,0 +1,3 @@ +( b1 b2 -- ) +: XPACKR 1+ SWAP DO I DUP . CRLF XPACK LOOP ; + diff --git a/blk/420 b/blk/420 new file mode 100644 index 0000000..1c4f0ca --- /dev/null +++ b/blk/420 @@ -0,0 +1,14 @@ +Core words + +These words follow Inner core words, but unlike them, these are +self-bootstrapping and don't depend on the Cross Compiler. They +will typically be included in source form right after a stage1 +binary which will interpret it on boot and bootstrap itself to +a full intepreter, which can then be relinked with the +Relinker. There is no loader for these libraries because you +will typically XPACK (B267) them. + +422 core 438 cmp +442 print 446 parse +453 readln 459 fmt +464 blk diff --git a/blk/422 b/blk/422 new file mode 100644 index 0000000..9871af4 --- /dev/null +++ b/blk/422 @@ -0,0 +1,16 @@ +: H@ HERE @ ; +: IMMEDIATE + CURRENT @ 1- + DUP C@ 128 OR SWAP C! +; +: [ INTERPRET ; IMMEDIATE +: ] R> DROP ; +: LITS 34 , SCPY ; +: LIT< WORD LITS ; IMMEDIATE +: LITA 36 , , ; +: ' + WORD (find) (?br) [ 4 , ] EXIT + LIT< (wnf) (find) DROP EXECUTE +; +: ['] ' LITA ; IMMEDIATE + diff --git a/blk/423 b/blk/423 new file mode 100644 index 0000000..0f436d7 --- /dev/null +++ b/blk/423 @@ -0,0 +1,5 @@ +: COMPILE ' LITA ['] , , ; IMMEDIATE +: [COMPILE] ' , ; IMMEDIATE +: BEGIN H@ ; IMMEDIATE +: AGAIN COMPILE (br) H@ - , ; IMMEDIATE +: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE diff --git a/blk/424 b/blk/424 new file mode 100644 index 0000000..4bcb673 --- /dev/null +++ b/blk/424 @@ -0,0 +1,13 @@ +: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE +40 CURRENT @ 4 - C! +( Hello, hello, krkrkrkr... do you hear me? + Ah, voice at last! Some lines above need comments + BTW: Forth lines limited to 64 cols because of default + input buffer size in Collapse OS + + 40 is ASCII for '('. We do this to simplify XPACK's task of + not mistakenly consider '(' definition as a comment. + LITS: 34 == litWord + LITA: 36 == addrWord + COMPILE: Tough one. Get addr of caller word (example above + (br)) and then call LITA on it. ) diff --git a/blk/425 b/blk/425 new file mode 100644 index 0000000..c081f6e --- /dev/null +++ b/blk/425 @@ -0,0 +1,15 @@ +: +! SWAP OVER @ + SWAP ! ; +: -^ SWAP - ; +: ALLOT HERE +! ; + +: IF ( -- a | a: br cell addr ) + COMPILE (?br) + H@ ( push a ) + 2 ALLOT ( br cell allot ) +; IMMEDIATE + +: THEN ( a -- | a: br cell addr ) + DUP H@ -^ SWAP ( a-H a ) + ! +; IMMEDIATE + diff --git a/blk/426 b/blk/426 new file mode 100644 index 0000000..5d02510 --- /dev/null +++ b/blk/426 @@ -0,0 +1,8 @@ +: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) + COMPILE (br) + 2 ALLOT + DUP H@ -^ SWAP ( a-H a ) + ! + H@ 2- ( push a. -2 for allot offset ) +; IMMEDIATE + diff --git a/blk/427 b/blk/427 new file mode 100644 index 0000000..776e84e --- /dev/null +++ b/blk/427 @@ -0,0 +1,10 @@ +( During a CASE, the stack grows by 1 at each ENDOF so that + we can fill all those ENDOF branching addrs. So that we + know when to stop, we put a 0 on PSP. That's our stopgap. ) +: CASE 0 COMPILE >R ; IMMEDIATE +: OF + COMPILE I COMPILE = + [COMPILE] IF +; IMMEDIATE +: ENDOF [COMPILE] ELSE ; IMMEDIATE + diff --git a/blk/428 b/blk/428 new file mode 100644 index 0000000..cb1e5ad --- /dev/null +++ b/blk/428 @@ -0,0 +1,13 @@ +( At this point, we have something like "0 e1 e2 e3 val". We + want top drop val, and then call THEN as long as we don't + hit 0. ) +: ENDCASE + BEGIN + DUP NOT IF + DROP COMPILE R> COMPILE DROP EXIT + THEN + [COMPILE] THEN + AGAIN +; IMMEDIATE + + diff --git a/blk/429 b/blk/429 new file mode 100644 index 0000000..68efbdf --- /dev/null +++ b/blk/429 @@ -0,0 +1,7 @@ +: CREATE + (entry) ( empty header with name ) + 11 ( 11 == cellWord ) + C, ( write it ) +; + + diff --git a/blk/430 b/blk/430 new file mode 100644 index 0000000..4bd8e56 --- /dev/null +++ b/blk/430 @@ -0,0 +1,14 @@ +: DOES> + ( Overwrite cellWord in CURRENT ) + ( 43 == doesWord ) + 43 CURRENT @ C! + ( When we have a DOES>, we forcefully place HERE to 4 + bytes after CURRENT. This allows a DOES word to use "," + and "C," without messing everything up. ) + CURRENT @ 3 + HERE ! + ( HERE points to where we should write R> ) + R> , + ( We're done. Because we've popped RS, we'll exit parent + definition ) +; + diff --git a/blk/431 b/blk/431 new file mode 100644 index 0000000..1640707 --- /dev/null +++ b/blk/431 @@ -0,0 +1,13 @@ +: VARIABLE CREATE 2 ALLOT ; +: CONSTANT CREATE , DOES> @ ; +: / /MOD SWAP DROP ; +: MOD /MOD DROP ; + +( In addition to pushing H@ this compiles 2 >R so that loop + variables are sent to PS at runtime ) +: DO + COMPILE SWAP COMPILE >R COMPILE >R + H@ +; IMMEDIATE + + diff --git a/blk/432 b/blk/432 new file mode 100644 index 0000000..3a4cfe5 --- /dev/null +++ b/blk/432 @@ -0,0 +1,16 @@ +( Increase loop counter and returns whether we should loop. ) +: _ + R> ( IP, keep for later ) + R> 1+ ( ip i+1 ) + DUP >R ( ip i ) + I' = ( ip f ) + SWAP >R ( f ) +; +( One could think that we should have a sub word to avoid all + these COMPILE, but we can't because otherwise it messes with + the RS ) +: LOOP + COMPILE _ COMPILE (?br) + H@ - , + COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP +; IMMEDIATE diff --git a/blk/433 b/blk/433 new file mode 100644 index 0000000..27bbd0a --- /dev/null +++ b/blk/433 @@ -0,0 +1,14 @@ +: LEAVE R> R> DROP I 1- >R >R ; + +: ROLL + DUP NOT IF EXIT THEN + 1+ DUP PICK ( n val ) + SWAP 2 * (roll) ( val ) + SWAP DROP +; + +: 2DUP OVER OVER ; +: 2OVER 3 PICK 3 PICK ; +: 2SWAP 3 ROLL 3 ROLL ; + + diff --git a/blk/434 b/blk/434 new file mode 100644 index 0000000..1d3a449 --- /dev/null +++ b/blk/434 @@ -0,0 +1,16 @@ +( a1 a2 u -- ) +: MOVE + ( u ) 0 DO + SWAP DUP I + C@ ( a2 a1 x ) + ROT SWAP OVER I + ( a1 a2 x a2 ) + C! ( a1 a2 ) + LOOP + 2DROP +; + +: DELW 1- 0 SWAP C! ; + +: PREV + 3 - DUP @ ( a o ) + - ( a-o ) +; diff --git a/blk/435 b/blk/435 new file mode 100644 index 0000000..8a5bc52 --- /dev/null +++ b/blk/435 @@ -0,0 +1,16 @@ +: WORD( + DUP 1- C@ ( name len field ) + 127 AND ( 0x7f. remove IMMEDIATE flag ) + 3 + ( fixed header len ) + - +; +: FORGET + ' DUP ( w w ) + ( HERE must be at the end of prev's word, that is, at the + beginning of w. ) + WORD( HERE ! ( w ) + PREV CURRENT ! +; +: EMPTY + LIT< _sys (find) NOT IF ABORT THEN + DUP HERE ! CURRENT ! ; diff --git a/blk/436 b/blk/436 new file mode 100644 index 0000000..ae2d4ea --- /dev/null +++ b/blk/436 @@ -0,0 +1,12 @@ +( Drop RSP until I-2 == INTERPRET. ) +: EXIT! + ['] INTERPRET ( I ) + BEGIN ( I ) + DUP ( I I ) + R> DROP I 2- @ ( I I a ) + = UNTIL + DROP +; + +( a -- a+1 c ) +: C@+ DUP C@ SWAP 1+ SWAP ; diff --git a/blk/438 b/blk/438 new file mode 100644 index 0000000..85be626 --- /dev/null +++ b/blk/438 @@ -0,0 +1,13 @@ +( Words useful for complex comparison operations ) + +: >= < NOT ; +: <= > NOT ; +: 0>= 0< NOT ; + +( n1 -- n1 true ) +: <>{ 1 ; + +( n1 f -- f ) +: <>} SWAP DROP ; + + diff --git a/blk/439 b/blk/439 new file mode 100644 index 0000000..70f887c --- /dev/null +++ b/blk/439 @@ -0,0 +1,15 @@ + +: _|& + ( n1 n2 cell ) + >R >R DUP R> R> ( n1 n1 n2 cell ) + @ EXECUTE ( n1 f ) +; + +( n1 f n2 -- n1 f ) +: _| + CREATE , DOES> + ( n1 f n2 cell ) + ROT IF 2DROP 1 EXIT THEN ( n1 true ) + _|& +; + diff --git a/blk/440 b/blk/440 new file mode 100644 index 0000000..2c6113b --- /dev/null +++ b/blk/440 @@ -0,0 +1,15 @@ +: _& + CREATE , DOES> + ( n1 f n2 cell ) + ROT NOT IF 2DROP 0 EXIT THEN ( n1 true ) + _|& +; + +( All words below have this signature: + n1 f n2 -- n1 f ) +' = _| |= +' = _& &= +' > _| |> +' > _& &> +' < _| |< +' < _& &< diff --git a/blk/442 b/blk/442 new file mode 100644 index 0000000..5ec04b2 --- /dev/null +++ b/blk/442 @@ -0,0 +1,11 @@ +( EMIT is needed for this unit to compile ) + +: (print) + BEGIN + C@+ ( a+1 c ) + ( exit if null ) + DUP NOT IF 2DROP EXIT THEN + EMIT ( a ) + AGAIN +; + diff --git a/blk/443 b/blk/443 new file mode 100644 index 0000000..072164c --- /dev/null +++ b/blk/443 @@ -0,0 +1,15 @@ +: ." + 34 , ( 34 == litWord ) + BEGIN + C< + ( 34 is ASCII for " ) + DUP 34 = IF DROP 0 THEN + DUP C, + NOT UNTIL + COMPILE (print) +; IMMEDIATE + +: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE + +: (uflw) ABORT" stack underflow" ; + diff --git a/blk/444 b/blk/444 new file mode 100644 index 0000000..d4bad68 --- /dev/null +++ b/blk/444 @@ -0,0 +1,9 @@ +: BS 8 EMIT ; +: LF 10 EMIT ; +: CR 13 EMIT ; +: CRLF CR LF ; +: SPC 32 EMIT ; + +: (wnf) (print) SPC ABORT" word not found" ; +: (ok) SPC ." ok" CRLF ; + diff --git a/blk/446 b/blk/446 new file mode 100644 index 0000000..0babd58 --- /dev/null +++ b/blk/446 @@ -0,0 +1,11 @@ +( strings being sent to parse routines are always null + terminated ) + +: (parsec) ( a -- n f ) + ( apostrophe is ASCII 39 ) + DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) + DUP 2+ C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) + ( surrounded by apos, good, return ) + 1+ C@ 1 ( n 1 ) +; + diff --git a/blk/447 b/blk/447 new file mode 100644 index 0000000..1421743 --- /dev/null +++ b/blk/447 @@ -0,0 +1,15 @@ +( returns negative value on error ) +: _ ( c -- n ) + ( '0' is ASCII 48 ) + 48 - + DUP 0< IF EXIT THEN ( bad ) + DUP 10 < IF EXIT THEN ( good ) + ( 'a' is ASCII 97. 59 = 97 - 48 ) + 49 - + DUP 0< IF EXIT THEN ( bad ) + DUP 6 < IF 10 + EXIT THEN ( good ) + ( bad ) + 255 - +; + + diff --git a/blk/448 b/blk/448 new file mode 100644 index 0000000..e400a39 --- /dev/null +++ b/blk/448 @@ -0,0 +1,15 @@ +: (parseh) ( a -- n f ) + ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) + DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) + ( We have "0x" prefix ) + 2+ + 0 ( a r ) + BEGIN + SWAP C@+ ( r a+1 c ) + DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 ) + _ ( r a n ) + DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 ) + ROT 16 * + ( a r*16+n ) + AGAIN +; + diff --git a/blk/449 b/blk/449 new file mode 100644 index 0000000..1e5a236 --- /dev/null +++ b/blk/449 @@ -0,0 +1,11 @@ +( returns negative value on error ) +: _ ( c -- n ) + ( '0' is ASCII 48 ) + 48 - + DUP 0< IF EXIT THEN ( bad ) + DUP 2 < IF EXIT THEN ( good ) + ( bad ) + 255 - +; + + diff --git a/blk/450 b/blk/450 new file mode 100644 index 0000000..e8788f9 --- /dev/null +++ b/blk/450 @@ -0,0 +1,16 @@ +: (parseb) ( a -- n f ) + ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) + DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) + ( We have "0b" prefix ) + 2+ + 0 ( a r ) + BEGIN + SWAP C@+ ( r a+1 c ) + DUP NOT IF 2DROP 1 EXIT THEN ( r 1 ) + _ ( r a n ) + DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 ) + ROT 2 * + ( a r*2+n ) + AGAIN +; + + diff --git a/blk/451 b/blk/451 new file mode 100644 index 0000000..7f308d4 --- /dev/null +++ b/blk/451 @@ -0,0 +1,10 @@ +: (parse) ( a -- n ) + (parsec) IF EXIT THEN + (parseh) IF EXIT THEN + (parseb) IF EXIT THEN + (parsed) IF EXIT THEN + ( nothing works ) + LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN +; + +' (parse) (parse*) ! diff --git a/blk/453 b/blk/453 new file mode 100644 index 0000000..5443342 --- /dev/null +++ b/blk/453 @@ -0,0 +1,13 @@ +64 CONSTANT INBUFSZ +: RDLNMEM+ 0x53 RAM+ @ + ; +( current position in INBUF ) +: IN> 0 RDLNMEM+ ; +( points to INBUF ) +: IN( 2 RDLNMEM+ ; +( points to INBUF's end ) +: IN) INBUFSZ 2+ RDLNMEM+ ; + +( flush input buffer ) +( set IN> to IN( and set IN> @ to null ) +: (infl) 0 IN( DUP IN> ! ! ; + diff --git a/blk/454 b/blk/454 new file mode 100644 index 0000000..864385b --- /dev/null +++ b/blk/454 @@ -0,0 +1,16 @@ +( 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 +; + + + + + + +( cont.: read one char into input buffer and returns whether we + should continue, that is, whether CR was not met. ) diff --git a/blk/455 b/blk/455 new file mode 100644 index 0000000..2412b93 --- /dev/null +++ b/blk/455 @@ -0,0 +1,16 @@ +: (rdlnc) ( -- f ) + ( buffer overflow? same as if we typed a newline ) + IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) + DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace ) + DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) + ( echo back ) + DUP EMIT ( c ) + ( bacspace? handle and exit ) + DUP 0x8 = IF (inbs) EXIT THEN + ( write and advance ) + DUP ( keep as result ) ( c c ) +( We take advantage of the fact that c's MSB is always zero and + thus ! automatically null-terminates our string ) + IN> @ ! 1 IN> +! ( c ) + ( if newline, replace with zero to indicate EOL ) + DUP 0xd = IF DROP 0 THEN ; diff --git a/blk/456 b/blk/456 new file mode 100644 index 0000000..949c155 --- /dev/null +++ b/blk/456 @@ -0,0 +1,16 @@ +( Read one line in input buffer and make IN> point to it ) +: (rdln) + (infl) BEGIN (rdlnc) NOT UNTIL + LF IN( IN> ! ; + +( And finally, implement C<* ) +: RDLN< + IN> @ C@ + DUP IF ( not EOL? good, inc and return ) + 1 IN> +! + ELSE ( EOL ? readline. we still return null though ) + (rdln) + THEN + ( update C @ C@ 0 > 0x06 RAM+ ! ( 06 == C, plus 2 for extra bytes after buffer: 1 for + the last typed 0x0a and one for the following NULL. ) + INBUFSZ 4 + ALLOT + (infl) + ['] RDLN< 0x0c RAM+ ! + 1 0x06 RAM+ ! ( 06 == C IF DROP EXIT THEN ( stop indicator ) + EMIT + AGAIN ; diff --git a/blk/460 b/blk/460 new file mode 100644 index 0000000..e5f9b51 --- /dev/null +++ b/blk/460 @@ -0,0 +1,16 @@ +: ? @ . ; +: _ + DUP 9 > IF 10 - 'a' + + ELSE '0' + THEN +; +( For hex display, there are no negatives ) +: .x + 256 MOD ( ensure < 0x100 ) + 16 /MOD ( l h ) + _ EMIT ( l ) + _ EMIT +; +: .X + 256 /MOD ( l h ) + .x .x +; diff --git a/blk/461 b/blk/461 new file mode 100644 index 0000000..832ca57 --- /dev/null +++ b/blk/461 @@ -0,0 +1,16 @@ +: _ ( a -- a+8 ) + DUP ( save for 2nd loop ) + ':' EMIT DUP .x SPC + 4 0 DO + DUP @ 256 /MOD SWAP + .x .x SPC 2+ + LOOP + DROP + 8 0 DO + C@+ + DUP <>{ 0x20 &< 0x7e |> <>} + IF DROP '.' THEN + EMIT + LOOP + CRLF +; diff --git a/blk/462 b/blk/462 new file mode 100644 index 0000000..d98508c --- /dev/null +++ b/blk/462 @@ -0,0 +1,9 @@ +: DUMP ( n a -- ) + LF + BEGIN + OVER 1 < IF 2DROP EXIT THEN + _ + SWAP 8 - SWAP + AGAIN +; + diff --git a/blk/464 b/blk/464 new file mode 100644 index 0000000..8eb9c4e --- /dev/null +++ b/blk/464 @@ -0,0 +1,12 @@ +: BLKMEM+ 0x57 RAM+ @ + ; +( n -- Fetches block n and write it to BLK( ) +: BLK@* 0 BLKMEM+ ; +( n -- Write back BLK( to storage at block n ) +: BLK!* 2 BLKMEM+ ; +( Current blk pointer in ( ) +: BLK> 4 BLKMEM+ ; +( Whether buffer is dirty ) +: BLKDTY 6 BLKMEM+ ; +: BLK( 8 BLKMEM+ ; + + diff --git a/blk/465 b/blk/465 new file mode 100644 index 0000000..ca5cfa0 --- /dev/null +++ b/blk/465 @@ -0,0 +1,12 @@ +: BLK$ + H@ 0x57 RAM+ ! + ( 1024 for the block, 8 for variables ) + 1032 ALLOT + ( LOAD detects end of block with ASCII EOT. This is why + we write it there. EOT == 0x04 ) + 4 C, + 0 BLKDTY ! + -1 BLK> ! +; + + diff --git a/blk/466 b/blk/466 new file mode 100644 index 0000000..d7b688a --- /dev/null +++ b/blk/466 @@ -0,0 +1,13 @@ +: BLK! ( -- ) + BLK> @ BLK!* @ EXECUTE + 0 BLKDTY ! +; + +: BLK@ ( n -- ) + DUP BLK> @ = IF DROP EXIT THEN + BLKDTY @ IF BLK! THEN + DUP BLK> ! BLK@* @ EXECUTE +; + +: BLK!! 1 BLKDTY ! ; + diff --git a/blk/467 b/blk/467 new file mode 100644 index 0000000..5378b08 --- /dev/null +++ b/blk/467 @@ -0,0 +1,11 @@ +: .2 DUP 10 < IF SPC THEN . ; + +: LIST + BLK@ + 16 0 DO + I 1+ .2 SPC + 64 I * BLK( + (print) + CRLF + LOOP +; + diff --git a/blk/468 b/blk/468 new file mode 100644 index 0000000..e53efae --- /dev/null +++ b/blk/468 @@ -0,0 +1,16 @@ +: _ + (boot<) + DUP 4 = IF + ( We drop our char, but also "a" from WORD: it won't + have the opportunity to balance PSP because we're + EXIT!ing. ) + 2DROP + ( We're finished interpreting ) + EXIT! + THEN +; + +( pre-comment for tight LOAD: The 0x08==I check after INTERPRET + is to check whether we're restoring to "_", the word above. + if yes, then we're in a nested load. Also, the 1 in 0x06 is + to avoid tons of "ok" displays. ) diff --git a/blk/469 b/blk/469 new file mode 100644 index 0000000..f8cdec7 --- /dev/null +++ b/blk/469 @@ -0,0 +1,16 @@ +: LOAD + BLK> @ >R ( save restorable variables to RSP ) + 0x08 RAM+ @ >R + 0x06 RAM+ @ >R ( CR ( boot ptr ) + BLK@ + BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) + ['] _ 0x08 RAM+ ! ( 08 == C<* override ) + 1 0x06 RAM+ ! ( 06 == C 0x2e RAM+ ! R> 0x06 RAM+ ! + I 0x08 RAM+ @ = IF ( nested load ) + R> DROP ( C<* ) R> BLK@ + ELSE ( not nested ) + R> 0x08 RAM+ ! R> DROP ( BLK> ) + THEN ; diff --git a/blk/470 b/blk/470 new file mode 100644 index 0000000..29bb9b5 --- /dev/null +++ b/blk/470 @@ -0,0 +1,2 @@ +( b1 b2 -- ) +: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;