From 56af516d075a3dc56de3964b0c4fbae719478820 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Wed, 13 May 2020 09:02:44 -0400 Subject: [PATCH] Move core's fmt to xcomp core (high) --- blk/420 | 2 +- blk/423 | 28 +++++++++++++++------------- blk/424 | 32 ++++++++++++++++---------------- blk/425 | 13 +++++++++++++ blk/426 | 14 ++++++++++++++ blk/427 | 16 ++++++++++++++++ blk/442 | 16 ---------------- blk/443 | 16 ---------------- blk/444 | 16 ---------------- blk/445 | 6 ------ emul/forth.bin | Bin 5899 -> 5899 bytes 11 files changed, 75 insertions(+), 84 deletions(-) create mode 100644 blk/425 create mode 100644 blk/426 create mode 100644 blk/427 delete mode 100644 blk/442 delete mode 100644 blk/443 delete mode 100644 blk/444 delete mode 100644 blk/445 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 dc6de170730378c9273de007cd5b45d5bf2e8172..fee6f766e6f66430f79fab5ee0ab7e866604431c 100644 GIT binary patch delta 206 zcmeCy>(<*K!p9UZGkL#22$KZgWKltRrf|N=W`ef5lldfhLD-2wFG7-miBExnfiaSK zFW+81Cx&=F21Y&>CItp721#BProDWV7YK^6faE6c5)9#e#n-^_=f4w!k7tOV@?=Rq zZ?O*kbOsKFCyc=iEDVyI!3=B+%Q;H;Cs*+W3JVB0F*y7C26+0o@-ejYJ>eD**nE%A zl#xkYaI&bt3Vu&Nr%<=xC}jqAZ3l)t!Of~dr&p_-p0Ovw6 A!2kdN delta 223 zcmeCy>(<*K!pG|48R92DxrpCeOrI~EfrH@*V=w~?gCu7#0~^C~4r#v0m-z#QxAQqM zIQ#nsc>1{VF|_kN;oi=-*<8Ssk?9=&J*~!4d z)XNM}st6QM6Pzr_A0j?kuz}&veLZ_HO_I(s-W^xyp NTqe2$#4`}P4FIJ9F^2#E