From d956386e9b55e4302c4dc1d935622d1e78a45e8f Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Wed, 13 May 2020 09:28:32 -0400 Subject: [PATCH] Move core's readln to xcomp core (high) --- blk/420 | 2 +- blk/426 | 22 ++++++++++------------ blk/427 | 32 ++++++++++++++++---------------- blk/{449 => 428} | 0 blk/{450 => 429} | 0 blk/{451 => 430} | 6 +++--- blk/431 | 14 ++++++++++++++ blk/432 | 16 ++++++++++++++++ blk/447 | 13 ------------- blk/448 | 16 ---------------- emul/forth.bin | Bin 5899 -> 5894 bytes 11 files changed, 60 insertions(+), 61 deletions(-) rename blk/{449 => 428} (100%) rename blk/{450 => 429} (100%) rename blk/{451 => 430} (64%) create mode 100644 blk/431 create mode 100644 blk/432 delete mode 100644 blk/447 delete mode 100644 blk/448 diff --git a/blk/420 b/blk/420 index 70ceb17..98a8627 100644 --- a/blk/420 +++ b/blk/420 @@ -1 +1 @@ -1 7 LOADR+ ( xcomp core high ) +1 12 LOADR+ ( xcomp core high ) diff --git a/blk/426 b/blk/426 index 60f0030..5e25854 100644 --- a/blk/426 +++ b/blk/426 @@ -1,14 +1,12 @@ -( LITN has to be defined after the last immediate usage of - it to avoid bootstrapping issues ) -: LITN 32 , , ( 32 == NUMBER ) ; +: RDLNMEM+ 0x57 RAM+ @ + ; +( current position in INBUF ) +: IN> 0 RDLNMEM+ ; +( points to INBUF ) +: IN( 2 RDLNMEM+ ; +( points to INBUF's end ) +: IN) 0x40 ( buffer size ) 2+ RDLNMEM+ ; -: 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 +( flush input buffer ) +( set IN> to IN( and set IN> @ to null ) +: (infl) 0 IN( DUP IN> ! ! ; diff --git a/blk/427 b/blk/427 index e109431..f3eb716 100644 --- a/blk/427 +++ b/blk/427 @@ -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! +( 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 +; + +: KEY + 85 RAM+ @ ( (key) override ) + DUP IF EXECUTE ELSE DROP (key) THEN ; + + +( cont.: read one char into input buffer and returns whether we + should continue, that is, whether CR was not met. ) diff --git a/blk/449 b/blk/428 similarity index 100% rename from blk/449 rename to blk/428 diff --git a/blk/450 b/blk/429 similarity index 100% rename from blk/450 rename to blk/429 diff --git a/blk/451 b/blk/430 similarity index 64% rename from blk/451 rename to blk/430 index 47ccec0..38c1c92 100644 --- a/blk/451 +++ b/blk/430 @@ -2,11 +2,11 @@ : RDLN$ ( 57 == rdln's memory ) H@ 0x57 RAM+ ! - ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for + ( plus 2 for extra bytes after buffer: 1 for the last typed 0x0a and one for the following NULL. ) - INBUFSZ 4 + ALLOT + IN) IN> - 2+ ALLOT (infl) - ['] RDLN< 0x0c RAM+ ! + LIT< RDLN< (find) DROP 0x0c RAM+ ! 1 0x06 RAM+ ! ( 06 == C DROP ( exit : ) +; IMMEDIATE + diff --git a/blk/432 b/blk/432 new file mode 100644 index 0000000..e109431 --- /dev/null +++ b/blk/432 @@ -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/447 b/blk/447 deleted file mode 100644 index f436650..0000000 --- a/blk/447 +++ /dev/null @@ -1,13 +0,0 @@ -64 CONSTANT INBUFSZ -: RDLNMEM+ 0x57 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/448 b/blk/448 deleted file mode 100644 index f3eb716..0000000 --- a/blk/448 +++ /dev/null @@ -1,16 +0,0 @@ -( 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 -; - -: KEY - 85 RAM+ @ ( (key) override ) - DUP IF EXECUTE ELSE DROP (key) THEN ; - - -( cont.: read one char into input buffer and returns whether we - should continue, that is, whether CR was not met. ) diff --git a/emul/forth.bin b/emul/forth.bin index fee6f766e6f66430f79fab5ee0ab7e866604431c..79cdcc5557b9e536a55bc4f01ccfcef3c1fce1ee 100644 GIT binary patch delta 829 zcmXw1O-NKx6h8CropFAgx$n*UQ6puh8Jii0rXLiEqU<$BgHKII2_sr$Gz8(I2tpW4 zf?5m{!X|&UepwwZe-+Xe;8| z%K88TtD$=$G+uN@h6ji98Ci(8-+n4=D2-&pz+wqdz=OF~7Y@Kar$F|>%>9Qs4Fa(S zUld%ai7KlyH-7hV&ct|4)Y+o=;jaJ(8wh>jH6fScy%vELHx-5igrSTje}w!Q?^Qpd zHmTK7ZJp{1dRPC3=v0AK;NRi<=%S!jHjw3u$H4FQdCRy`fmR^KbcEzytH^z>ck3%y zpJw}fDY79>cr1AsZfmi@DNT%AkdMTWbzZAL5O#e;>X)zRS_ zC1)@OFJrrrO>M1T?ei(0;&MiNGiN(PG`JMB;H;*=@zs17gaE@@sNC5C=kF*>zj?c9jRkp?bczT_3SmrnC z>_D%xU0;J!-iB+=WchkKdT7HGE#-;f`P8s{!Qcu}Xk7s?6%5bWwfP2gTI5XY=?g~enk^7fZu&AW0<%dLMBTpl&5VS$f9{BI)<}x zMz0h*$g!L^Q)1bm2NrOURhEW3a?QLvy=;_GdmDe1pc~(I4H7T^3N4Xulg*l*)VPYF z9qx7F%FWo{=&bn+ejhf|`A!_NM@hO*CRbf@(#rcXa^5 zL_fr=E-nLirIZkX&@ONt8A02MTvURqHqFM)c~3X@-tT*Mf~zq#g(o;W)Q1ZD#+1`fo4R$4b?zt*ok!_j2dM7s^r-`9H1E*M`7V0CEieMnRdn&km4 zalQ*8!Js#ct99rA>X?g@-I$5JAGKoz$8Zn|wh~`3GH}y$Q07O-+`$Ox<$>pqQ66XH zC$p>i)eH*hlO1SI>+cr^6TlJk16-QALi>};z9Jhcq6aufxFFA2xjWrfgKhE{o}qaT znV8jNEwjnCl{HSh2c!OU?b2Z!+l>?k2M?@3KCGjB+2Sg-P^4`jRLY4AcLIyhHhmnM zH+Z-FY+X3LYB`|68h;Nz*cSh8?Iau+#`gd#SONnhBv@J{o&s#iA<>su(LL}dE|xm! zhjLN4sa30hPQ5`^8JLsnVn|t)yP~H=-w|v{gdLL_4&UOTAy;RT{}M~$A^hFjr}IZJ suCOH?Y(m3bS+(;@K`z>-@O*8%R>jJ|ti5A4SO%8u7TzyR`O|j)0~w{LX8-^I