From a348ee91061a81425450827b04cf63ba9d989506 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Mon, 21 Sep 2020 14:40:53 -0400 Subject: [PATCH] Remove Extra words The few extra bytes they save in the core aren't worth the extra complexity. This was initially done in a context where I had troubles keeping the RC2014 binary with SDC inside the 8K limit. At this point, even with the few extra bytes we add here, we're at 7200 bytes, so I'd say we're fine. --- blk/001 | 3 +-- blk/105 | 1 - blk/125 | 1 - blk/131 | 1 + blk/150 | 14 -------------- blk/152 | 2 -- blk/155 | 5 ----- blk/157 | 8 -------- blk/158 | 2 -- blk/355 | 23 +++++++++-------------- blk/358 | 22 +++++++++++++--------- blk/{357 => 359} | 0 blk/360 | 24 +++++++++--------------- blk/361 | 16 ++++++++++++++++ blk/367 | 8 -------- blk/369 | 4 ++++ blk/378 | 10 +++++++--- cvm/forth.bin | Bin 5208 -> 5345 bytes cvm/xcomp.fs | 1 - 19 files changed, 60 insertions(+), 85 deletions(-) delete mode 100644 blk/150 delete mode 100644 blk/152 delete mode 100644 blk/155 delete mode 100644 blk/157 delete mode 100644 blk/158 rename blk/{357 => 359} (100%) create mode 100644 blk/361 delete mode 100644 blk/367 diff --git a/blk/001 b/blk/001 index 942518f..fe6cc65 100644 --- a/blk/001 +++ b/blk/001 @@ -1,8 +1,7 @@ MASTER INDEX 5-99 unused -100 Block editor -120 Visual Editor 150 Extra words +100 Block editor 120 Visual Editor 160-199 unused 200 Z80 assembler 260 Cross compilation 280 Z80 boot code 350 Core words diff --git a/blk/105 b/blk/105 index 8f090be..2bb238b 100644 --- a/blk/105 +++ b/blk/105 @@ -1,2 +1 @@ -'? FILL NOT [IF] 50 LOAD+ [THEN] DROP ( B155 ) 1 7 LOADR+ diff --git a/blk/125 b/blk/125 index fdddc02..cd8a25e 100644 --- a/blk/125 +++ b/blk/125 @@ -1,3 +1,2 @@ -'? UPPER NOT [IF] 33 LOAD+ [THEN] DROP ( B158 ) -20 LOAD+ ( B105, block editor ) 1 6 LOADR+ diff --git a/blk/131 b/blk/131 index 1dc09bd..346832e 100644 --- a/blk/131 +++ b/blk/131 @@ -1,3 +1,4 @@ +: UPPER DUP 'a' 'z' =><= IF 32 - THEN ; : handle ( c -- f ) DUP '0' '9' =><= IF num 0 EXIT THEN DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN diff --git a/blk/150 b/blk/150 deleted file mode 100644 index b1dd6cd..0000000 --- a/blk/150 +++ /dev/null @@ -1,14 +0,0 @@ -Extra words - -The Core words (B350) section contains the absolute minimum -needed to get a usable Forth interpreter with input buffer and -disk blocks access running. The goal here is to minimize the -binary size of a minimum Collapse OS install. - -Extra words are words you will most likely want because they -are generally useful. - -Some programs need them, so they will automatically LOAD them. -Because more than one program can use the same extra words, -conditional loaders are recommended. If you want to load all -words do "152 LOAD" which conditionally loads all extra words. diff --git a/blk/152 b/blk/152 deleted file mode 100644 index 4b648e9..0000000 --- a/blk/152 +++ /dev/null @@ -1,2 +0,0 @@ -'? FILL NOT [IF] 3 LOAD+ [THEN] DROP -'? WIPE NOT [IF] 5 LOAD+ [THEN] DROP diff --git a/blk/155 b/blk/155 deleted file mode 100644 index ee3369e..0000000 --- a/blk/155 +++ /dev/null @@ -1,5 +0,0 @@ -: FILL ( a n b -- ) - SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b ) - DUP I C! - LOOP DROP ; -: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ; diff --git a/blk/157 b/blk/157 deleted file mode 100644 index 972a8e5..0000000 --- a/blk/157 +++ /dev/null @@ -1,8 +0,0 @@ -: WIPE BLK( 1024 0 FILL BLK!! ; -: WIPED? ( -- f ) - 1 ( f ) BLK) BLK( DO - I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ; -: COPY ( src dst -- ) - FLUSH SWAP BLK@ BLK> ! BLK! ; -: FREEBLKS? ( b1 b2 -- ) - 1+ SWAP DO I BLK@ WIPED? IF I . SPC THEN LOOP ; diff --git a/blk/158 b/blk/158 deleted file mode 100644 index 921d50a..0000000 --- a/blk/158 +++ /dev/null @@ -1,2 +0,0 @@ -: LOWER DUP 'A' 'Z' =><= IF 32 + THEN ; -: UPPER DUP 'a' 'z' =><= IF 32 - THEN ; diff --git a/blk/355 b/blk/355 index 00037e1..de827db 100644 --- a/blk/355 +++ b/blk/355 @@ -1,14 +1,9 @@ -( r c -- r f ) -( Parse digit c and accumulate into result r. - Flag f is 0 when c was a valid digit, 1 when c was WS, - -1 when c was an invalid digit. ) -: _pdacc - DUP 0x21 < IF DROP 1 EXIT THEN - ( parse char ) - ( if bad, return "r -1" ) - '0' - - DUP 10 < NOT IF DROP -1 EXIT THEN - ( good, add to running result ) - SWAP 10 * + ( r*10+n ) - 0 ( good ) -; +: +! TUCK @ + SWAP ! ; +: / /MOD NIP ; +: MOD /MOD DROP ; +: ALLOT HERE +! ; +: FILL ( a n b -- ) + SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b ) + DUP I C! + LOOP DROP ; +: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ; diff --git a/blk/358 b/blk/358 index 0665b8b..00037e1 100644 --- a/blk/358 +++ b/blk/358 @@ -1,10 +1,14 @@ -( strings being sent to parse routines are always null - terminated ) - -: _pc ( a -- n f, parse character ) - ( apostrophe is ASCII 39 ) - DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f ) - NOT IF 0 EXIT THEN ( a 0 ) - ( surrounded by apos, good, return ) - 2+ C@ 1 ( n 1 ) +( r c -- r f ) +( Parse digit c and accumulate into result r. + Flag f is 0 when c was a valid digit, 1 when c was WS, + -1 when c was an invalid digit. ) +: _pdacc + DUP 0x21 < IF DROP 1 EXIT THEN + ( parse char ) + ( if bad, return "r -1" ) + '0' - + DUP 10 < NOT IF DROP -1 EXIT THEN + ( good, add to running result ) + SWAP 10 * + ( r*10+n ) + 0 ( good ) ; diff --git a/blk/357 b/blk/359 similarity index 100% rename from blk/357 rename to blk/359 diff --git a/blk/360 b/blk/360 index d56e25a..0665b8b 100644 --- a/blk/360 +++ b/blk/360 @@ -1,16 +1,10 @@ -( returns negative value on error ) -: _ ( c -- n ) - DUP '0' '9' =><= IF '0' - EXIT THEN - DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN - DROP -1 ( bad ) +( strings being sent to parse routines are always null + terminated ) + +: _pc ( a -- n f, parse character ) + ( apostrophe is ASCII 39 ) + DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f ) + NOT IF 0 EXIT THEN ( a 0 ) + ( surrounded by apos, good, return ) + 2+ C@ 1 ( n 1 ) ; -: _ph ( a -- n f, parse hex ) - ( '0': ASCII 0x30 'x': 0x78 0x7830 ) - DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 ) - ( We have "0x" prefix ) - DUP C@ ( a len ) - 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) - OVER I + C@ ( a r c ) _ ( a r n ) - DUP 0< IF 2DROP 0 UNLOOP EXIT THEN - SWAP 4 LSHIFT + ( a r*16+n ) LOOP - NIP 1 ; diff --git a/blk/361 b/blk/361 new file mode 100644 index 0000000..d56e25a --- /dev/null +++ b/blk/361 @@ -0,0 +1,16 @@ +( returns negative value on error ) +: _ ( c -- n ) + DUP '0' '9' =><= IF '0' - EXIT THEN + DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN + DROP -1 ( bad ) +; +: _ph ( a -- n f, parse hex ) + ( '0': ASCII 0x30 'x': 0x78 0x7830 ) + DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 ) + ( We have "0x" prefix ) + DUP C@ ( a len ) + 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) + OVER I + C@ ( a r c ) _ ( a r n ) + DUP 0< IF 2DROP 0 UNLOOP EXIT THEN + SWAP 4 LSHIFT + ( a r*16+n ) LOOP + NIP 1 ; diff --git a/blk/367 b/blk/367 deleted file mode 100644 index 7e21ebf..0000000 --- a/blk/367 +++ /dev/null @@ -1,8 +0,0 @@ -: IMMEDIATE - CURRENT @ 1- - DUP C@ 128 OR SWAP C! ; -: IMMED? 1- C@ 0x80 AND ; -: +! TUCK @ + SWAP ! ; -: / /MOD NIP ; -: MOD /MOD DROP ; -: ALLOT HERE +! ; diff --git a/blk/369 b/blk/369 index 579a5cb..4824824 100644 --- a/blk/369 +++ b/blk/369 @@ -1,3 +1,7 @@ +: IMMEDIATE + CURRENT @ 1- + DUP C@ 128 OR SWAP C! ; +: IMMED? 1- C@ 0x80 AND ; : '? WORD FIND ; : ' '? NOT IF (wnf) THEN ; : ROLL diff --git a/blk/378 b/blk/378 index 49e3cfa..9cd31f9 100644 --- a/blk/378 +++ b/blk/378 @@ -1,10 +1,14 @@ : BLK! ( -- ) BLK> @ BLK!* @ EXECUTE - 0 BLKDTY ! -; + 0 BLKDTY ! ; : FLUSH BLKDTY @ IF BLK! THEN ; : BLK@ ( n -- ) DUP BLK> @ = IF DROP EXIT THEN FLUSH DUP BLK> ! BLK@* @ EXECUTE ; - : BLK!! 1 BLKDTY ! ; +: WIPE BLK( 1024 0 FILL BLK!! ; +: WIPED? ( -- f ) + 1 ( f ) BLK) BLK( DO + I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ; +: COPY ( src dst -- ) + FLUSH SWAP BLK@ BLK> ! BLK! ; diff --git a/cvm/forth.bin b/cvm/forth.bin index 1062b4b576e7f711e326673ce25de1b7144586a1..88ecc99390a7ecbccadc1b090a908ba5c10628bc 100644 GIT binary patch delta 2023 zcmY*aYiv_x7=FLg)1F?=>2((fr@~ssx)EE)C5F1V^{i*3A75W&EoB?gIzCqGf%J!kr2$mCxMfsI9lY2a*7>_f+02lw{x*%RO!#eHmwe=dF}3|aZx*7w+R ze#hDq++vM^MTP0|BV;qBMbUg5<~waSf>n|V`OMBtF6qJ0oK3)8TMRnySGrr2HEG{TR}ez%1_$|tbJk$ z?r@tUlG*Ht3LzoP>`aiVBzg}r6(R$}g+rtDA&@ZKZifo3IX#ir6{K|1K_w-cI}*86 zLNoLL*x6_1X`jfCI@Y^J?M0Y#{L6wY#b+JcHVSCmnn`!%6X|@NX^bb%Fy`q=we@}z}A!Bs;7I4aGy6i3+x*I%DH+BgG!uTbOzZOb{2nC(2Q+0wdi#gV@%?=fbAna z_TA|2+PVU)D26F$wac__@uGDR$bM0XftC8d!9@o__OThD92BEk+2m5JovADm7PIV{ zQv(obLWVFL9VeSBu@aN)w)2`ZheOqfxugk1A&GH#L}asXuEvxbTqV$5l!bsq28Q+* z>MMED6-R1gt}W(oCBN=U@4Z3#gNODH7wTWaqF=UfmV?WdaXAi839Z&ufvwfR4&$;4 zMw`o&oTk*8D@)3fWV9h{wkR*4WmmS<2^Mr*1LOPyc@=xYPs>{aG?N;H;6*j6B>tED z`eq7V1lbY;mj*9myfe(rPAO!(1)eXLZd|T~-&JUiaJ7`X@`w?)xF#In(9h7ly0mhhZ3{Gk$w5dU9%iVDf@ z&TJpDT99d_?U<-UlRbqSmV=C&H@m~utFlG8%J;cnWk2zfdyP=x;g{WkRsXoL`v>;SrL1vcOk(YHW=nZqzt$_C%#V@tB~&3@>=rjaif# z1Y)GR@>K{##{zjx=e|lP5K94W+Man(M1mb49C&wD_9;B#-NerFUT=7jzycOOyC zWIa&Clel?eXOI1K)fuULx)Qst;qVC(-DeRQjXB5clA8pL9&JDvA1u zy4OhKnm`{Fy;Nwz8S@w6Eqe^cYz4s13V3;2&)M`qtvM5I%_f?dnR}Aa9}-=N0Yp@U zsPMJrvA=|TRnUztymkp^E!vXhw}Gf|9yN$GRBdW-QjilzID@#rV25# zkAMcVG673ynOr{PgA>eKp}{4A&NRI}mG;6%`1gng?TJ*{i9$JHR9G%dcRHUks!T;0 y^|GSJkM+T>JqWC57`5w|s$938)=XzMW$3+CaEguEDN|2fuM>`=pa*!gqTxS!^q;W+ delta 1816 zcmX|CZ)g)|7=PYNa(|M$TrRDxb(h&Dt<6=M?2lb(CbqdY)y8YCy`*!aR_(M5=f6x- zP&epw*{p1g;0r=N#X-0B!;lHvJ_+KNu6~e>!9Wl;HlZIxVShx}tYgo6u?yVY`@YY= z-|u;z_sOruo%ja8-(77<-qy%g?r%lDwxQW8>@OagK6p^0pL^dTJyh}C;+}Zv9p7p4 z2_5GrBj0(G;L+g~pZoc${wdWDMS6?>KC-~;P_Xyd&X5W`q2w|Y`7#h;4VFNo-w3gZ zaUnv+1s#}<23}k*l9z=tXhIT%Wtc|M5_FM8QskGwgaq6rtK1U0cmPRQt--h;lB;Od zMVJLYEp&iqoOX-bJzLvUn)JRDSwk0{{St6wR@lzrS_DFR#5J_{i1fT@33<^359H}j z;*8G_Yw!i_m*V!CnBbyZjEJPdFYs&~Av(loj+aiJF`^)#J44c8(8;6=83pO(BojDb zlwV6bBWcshG=NCKI2E;O4ke-kT3DF1A?xqSV58AnWA)PC9y2=&)o+!`%B~!{l&j|&Jf!KO3wQu-xU%h zpfKe=_;;P9BzM3=9r{yP_82kfU&^-eO<3^|G?RA}NoJ1@iPu|PkU*MARjDdE><^*= z^OZu+WvD7=WfQ!ZX9t7E5F}Hr;W?Ag)4_P0@xM2Z&W0vN$MzvBTdtwKh=FRX+ZOQ# zIIyhHm0--5me0y*`g^dKOwhR6`ohOS7R&FF6fWaZ!7#-jmMR-$G#Q3bY{v*zXOvqL z=xH?~e;G8v2Y(>d$2R>;ZR6Ki|4Vd5O$df~jx)iaPt`5PS=m5F)=0k4gs@~xSI8x@ z6ED`MDkC-kJ282es1<72#CZHUkFVQ0jN}R#XUxeIvLInk&V^c9`gn{{f&)CeLdYTu z+=(My^1Mv1g|?9*T@A(B<-jF>{kBFhQ@tUUg}W|x6L@#^NTuDHL1el|i|l1>$&twr zVzkpkP6&H&5p(7ss4^JJygV67!J}u=tvX(|x<$=xXbx4MqHTJhYopsfJ1_#SVfbYi zwFxhhUX5|;A_e?bakb88ubKt#{!?d88B!JkgC~w2oi3i5X|?k#H@7utLB9bFvHb<V%*1x6@N8JbWjIH&K#W=8UA*0o zbx5h$ra7rf7Wi45n<#sgNdl~ebhOf8JGMu-4EJ$9&haI{;#IJMzCQkXxWg^+aKDQt z>Bg=SL&TxIE0b$LL}f^DUwe*(YsgoJjFrck#&C9^F4OF3NN`tCf=Hvyt|aSvp$O+5 zb}X~LisfO}iRk9d7-*&elP5D^Y14KJQ4KyK7x3%`SK(=Qqdv!SvYvs7Tw%m&f)6od z9p1WNGK`6Mr0OumBmV=y#?GKUIyPcuf^dNhh}XmGIh%ZTKGg&lQNSWkc24=>16K<# VI{qQxJZ*37Y|RYk2k1&;%YVL{Y`p*g diff --git a/cvm/xcomp.fs b/cvm/xcomp.fs index 1ca494b..05eabea 100644 --- a/cvm/xcomp.fs +++ b/cvm/xcomp.fs @@ -6,7 +6,6 @@ RS_ADDR 0x80 - CONSTANT SYSVARS VARIABLE ORG CREATE BIN( 0 , : PC H@ ORG @ - ; -155 LOAD ( ALLOT0 ) 262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides )