From 179c66be8ad90ed007447ad452ab83fd901dfb8f Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Thu, 14 May 2020 08:50:43 -0400 Subject: [PATCH] Move a bunch of words from XPACKed core to xcomp core --- blk/409 | 16 ++++++++++++++++ blk/410 | 13 +++++++++++++ blk/{414 => 411} | 0 blk/412 | 29 +++++++++++++---------------- blk/413 | 26 ++++++++++++++------------ blk/415 | 13 ------------- blk/444 | 15 --------------- emul/forth.bin | Bin 5875 -> 5875 bytes 8 files changed, 56 insertions(+), 56 deletions(-) create mode 100644 blk/409 create mode 100644 blk/410 rename blk/{414 => 411} (100%) delete mode 100644 blk/415 delete mode 100644 blk/444 diff --git a/blk/409 b/blk/409 new file mode 100644 index 0000000..abb2c23 --- /dev/null +++ b/blk/409 @@ -0,0 +1,16 @@ +( Words here until the end of the low part, unlike words + preceeding them, aren't immediately needed for boot. But its + better to have as many words as possible in the xcomp part. ) +: H@ HERE @ ; +: IMMEDIATE + CURRENT @ 1- + DUP C@ 128 OR SWAP C! ; +: IMMED? 1- C@ 0x80 AND ; +: +! SWAP OVER @ + SWAP ! ; +: -^ SWAP - ; +: / /MOD SWAP DROP ; +: MOD /MOD DROP ; +: ALLOT HERE +! ; +: CREATE (entry) 11 ( 11 == cellWord ) C, ; +: VARIABLE CREATE 2 ALLOT ; +: LEAVE R> R> DROP I 1- >R >R ; diff --git a/blk/410 b/blk/410 new file mode 100644 index 0000000..6e8981c --- /dev/null +++ b/blk/410 @@ -0,0 +1,13 @@ +: '? WORD (find) ; +: ' + '? (?br) [ 4 , ] EXIT + LIT< (wnf) (find) DROP EXECUTE +; +: ROLL + DUP NOT IF EXIT THEN + 1+ DUP PICK ( n val ) + SWAP 2 * (roll) ( val ) + SWAP DROP +; +: 2OVER 3 PICK 3 PICK ; +: 2SWAP 3 ROLL 3 ROLL ; diff --git a/blk/414 b/blk/411 similarity index 100% rename from blk/414 rename to blk/411 diff --git a/blk/412 b/blk/412 index abb2c23..3cb48b4 100644 --- a/blk/412 +++ b/blk/412 @@ -1,16 +1,13 @@ -( Words here until the end of the low part, unlike words - preceeding them, aren't immediately needed for boot. But its - better to have as many words as possible in the xcomp part. ) -: H@ HERE @ ; -: IMMEDIATE - CURRENT @ 1- - DUP C@ 128 OR SWAP C! ; -: IMMED? 1- C@ 0x80 AND ; -: +! SWAP OVER @ + SWAP ! ; -: -^ SWAP - ; -: / /MOD SWAP DROP ; -: MOD /MOD DROP ; -: ALLOT HERE +! ; -: CREATE (entry) 11 ( 11 == cellWord ) C, ; -: VARIABLE CREATE 2 ALLOT ; -: LEAVE R> R> DROP I 1- >R >R ; +: 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 ! +; diff --git a/blk/413 b/blk/413 index 6e8981c..6bad060 100644 --- a/blk/413 +++ b/blk/413 @@ -1,13 +1,15 @@ -: '? WORD (find) ; -: ' - '? (?br) [ 4 , ] EXIT - LIT< (wnf) (find) DROP EXECUTE +: 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 ) ; -: ROLL - DUP NOT IF EXIT THEN - 1+ DUP PICK ( n val ) - SWAP 2 * (roll) ( val ) - SWAP DROP -; -: 2OVER 3 PICK 3 PICK ; -: 2SWAP 3 ROLL 3 ROLL ; +: CONSTANT CREATE , DOES> @ ; + diff --git a/blk/415 b/blk/415 deleted file mode 100644 index 3cb48b4..0000000 --- a/blk/415 +++ /dev/null @@ -1,13 +0,0 @@ -: 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 ! -; diff --git a/blk/444 b/blk/444 deleted file mode 100644 index 6bad060..0000000 --- a/blk/444 +++ /dev/null @@ -1,15 +0,0 @@ -: 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 ) -; -: CONSTANT CREATE , DOES> @ ; - diff --git a/emul/forth.bin b/emul/forth.bin index 15ab266737ee80e0845d60076caa947853177358..5c34ad74864896bc91556a3cc33c88fd82150ec8 100644 GIT binary patch delta 1239 zcmZWpPi)&{6o0nAWF@sf+evIXL>DK`vUp{IO{~(!R8lwTRyA$9rbC-Jl$FvlbxmLl z6{w;P4&#(c(Rbj)9aTc?REf(D-A>b>opzd#idyxsOt3>1?Hb;5+7k!M{=N5m@Av+E zpI@DNb?V--8q5{*rNJH%v`_O@wWfIB6~@N%3Gn~`N5fMcq#dBb2(>cFJ?=qiaySGE20G9X z13YGbg2r@Z(TyQxi6@}42%N8oMIK9Wz7s&_a(Ui8hJ|t8zg)RB=aehAo%zbwmTgv!wg8grmTs(`rxHUdPAcJ^IkpbHwe--rKPuY4`w(LDa(26lF2Q7$zSg}`yB^c zQyd^_9PQ{4s?mS4q1}PK_6oL}yD~m`9ozMI9OJuyc(kr6)}6wq-DR)2J$R5YRsRm207W)2Jz12JM`I2Za7+#9HF- zbMeB69sdiPOW&HiS^m^bz!9InF?V=Kp~S35GAZC8*Ed2 zX~xbsjcLF_NDYz6dX1^_G0G zn-pmD&)X}a9=;&`EdC4+NKFxl^!3%XDCW&TAy8G4@OFgSqwfty_maML#aN_Ys*B~w zu^inVOUXv?xEF_VQwBD)%{r1yUei~2HgX4Ac!qp;e=m-|6B73?9+kH*o<+ti5>o#s zbT0aB_?Ku2b}+-tdmw!*!S{SuJd6%SGL{F!#qr6}LY~8q{PXUNC3>vqf&54*dqjL= z_lg-iDC56k!Oqa@Cp!@x(2|g|pW+Qq!gux_z7t{bhyA9Gw+qkU%m*NiPK-`F{{eU^ B9HsyO delta 1275 zcmZWpUuaup6hHUg?`AQ%_q#WLX9u-OlcmYRVm6uJEHS-Js$sW(lfsG*)vY#;&IIbT zDuiu9)t5Nv2lH((*icH8y`*K}TOanc(meHHuraAHK__!V@u{A3(>(cb@BMz~{LcUL z-RH-jAHTDrxh?z5cyT;^MEtBBnZBx7fP&~T4OAWh84d(F9T;NP!-dM60WOrddXi+9 z;qKuS;ayD(>B-CYw1%?9+W78zPob)`=>`Cj4^cIZSv*mYQ#<=%TT*X*Nb%&n! zAw91%nM{6Ds~9sRTR^y>Tz6b_-9{5=ym8(|1D)gVQd>;Df;o3|BCOPx7b3O#rO0CaliC7w zbnyp28NbWd*@>4d$PD`6Oa6ezQPGEZ#G0I`pzJIDCl{l}*G%T3sNF*<(u|_6u8d>qG8B$4^ z6(uu$tfgOpU-olYUtxB9>V2$F>t8Br^TW_R;=g|FoD|hSlMBH{wyw29?z$gT`hzj35BqYq^Ah4`Ky?HNPgQ( z5vcV~_H$y}KP`Rjf4<9x