diff --git a/blk/420 b/blk/420 index 1c01882..70ceb17 100644 --- a/blk/420 +++ b/blk/420 @@ -1 +1 @@ -1 4 LOADR+ ( xcomp core high ) +1 7 LOADR+ ( xcomp core high ) diff --git a/blk/423 b/blk/423 index 60f0030..f3850c0 100644 --- a/blk/423 +++ b/blk/423 @@ -1,14 +1,16 @@ -( LITN has to be defined after the last immediate usage of - it to avoid bootstrapping issues ) -: LITN 32 , , ( 32 == NUMBER ) ; - -: IMMED? 1- C@ 0x80 AND ; - -( ';' can't have its name right away because, when created, it - is not an IMMEDIATE yet and will not be treated properly by - xcomp. ) : _ - ['] EXIT , - R> DROP ( exit : ) -; IMMEDIATE - + 999 SWAP ( stop indicator ) + DUP 0 = IF '0' EXIT THEN ( 0 is a special case ) + BEGIN + DUP 0 = IF DROP EXIT THEN + 10 /MOD ( r q ) + SWAP '0' + SWAP ( d q ) + AGAIN ; +: . ( n -- ) + ( handle negative ) + DUP 0< IF '-' EMIT -1 * THEN + _ + BEGIN + DUP '9' > IF DROP EXIT THEN ( stop indicator ) + EMIT + AGAIN ; diff --git a/blk/424 b/blk/424 index e109431..e5f9b51 100644 --- a/blk/424 +++ b/blk/424 @@ -1,16 +1,16 @@ -XCURRENT @ ( to PSP ) -: : - (entry) - ( We cannot use LITN as IMMEDIATE because of bootstrapping - issues. Same thing for ",". - 32 == NUMBER 14 == compiledWord ) - [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C, - BEGIN - WORD - (find) - ( is word ) - IF DUP IMMED? IF EXECUTE ELSE , THEN - ( maybe number ) - ELSE (parse) LITN THEN - AGAIN ; -( from PSP ) ';' SWAP 4 - C! +: ? @ . ; +: _ + 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/425 b/blk/425 new file mode 100644 index 0000000..31b564d --- /dev/null +++ b/blk/425 @@ -0,0 +1,13 @@ +: _ ( a -- a+8 ) + DUP ( a a ) + ':' EMIT DUP .x SPC + 4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP + DROP ( a ) + 8 0 DO + C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT + LOOP NL ; +: DUMP ( n a -- ) + LF + SWAP 8 /MOD SWAP IF 1+ THEN + 0 DO _ LOOP +; diff --git a/blk/426 b/blk/426 new file mode 100644 index 0000000..60f0030 --- /dev/null +++ b/blk/426 @@ -0,0 +1,14 @@ +( LITN has to be defined after the last immediate usage of + it to avoid bootstrapping issues ) +: LITN 32 , , ( 32 == NUMBER ) ; + +: IMMED? 1- C@ 0x80 AND ; + +( ';' can't have its name right away because, when created, it + is not an IMMEDIATE yet and will not be treated properly by + xcomp. ) +: _ + ['] EXIT , + R> DROP ( exit : ) +; IMMEDIATE + diff --git a/blk/427 b/blk/427 new file mode 100644 index 0000000..e109431 --- /dev/null +++ b/blk/427 @@ -0,0 +1,16 @@ +XCURRENT @ ( to PSP ) +: : + (entry) + ( We cannot use LITN as IMMEDIATE because of bootstrapping + issues. Same thing for ",". + 32 == NUMBER 14 == compiledWord ) + [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C, + BEGIN + WORD + (find) + ( is word ) + IF DUP IMMED? IF EXECUTE ELSE , THEN + ( maybe number ) + ELSE (parse) LITN THEN + AGAIN ; +( from PSP ) ';' SWAP 4 - C! diff --git a/blk/442 b/blk/442 deleted file mode 100644 index f3850c0..0000000 --- a/blk/442 +++ /dev/null @@ -1,16 +0,0 @@ -: _ - 999 SWAP ( stop indicator ) - DUP 0 = IF '0' EXIT THEN ( 0 is a special case ) - BEGIN - DUP 0 = IF DROP EXIT THEN - 10 /MOD ( r q ) - SWAP '0' + SWAP ( d q ) - AGAIN ; -: . ( n -- ) - ( handle negative ) - DUP 0< IF '-' EMIT -1 * THEN - _ - BEGIN - DUP '9' > IF DROP EXIT THEN ( stop indicator ) - EMIT - AGAIN ; diff --git a/blk/443 b/blk/443 deleted file mode 100644 index e5f9b51..0000000 --- a/blk/443 +++ /dev/null @@ -1,16 +0,0 @@ -: ? @ . ; -: _ - 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/444 b/blk/444 deleted file mode 100644 index da6b73e..0000000 --- a/blk/444 +++ /dev/null @@ -1,16 +0,0 @@ -: _ ( 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 =><= NOT - IF DROP '.' THEN - EMIT - LOOP - NL -; diff --git a/blk/445 b/blk/445 deleted file mode 100644 index 8ad77b7..0000000 --- a/blk/445 +++ /dev/null @@ -1,6 +0,0 @@ -: DUMP ( n a -- ) - LF - SWAP 8 /MOD SWAP IF 1+ THEN - 0 DO _ LOOP -; - diff --git a/emul/forth.bin b/emul/forth.bin index dc6de17..fee6f76 100644 Binary files a/emul/forth.bin and b/emul/forth.bin differ