From 5d4155aa324201076f0653cb27e0cf10accaf134 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Wed, 15 Apr 2020 21:29:39 -0400 Subject: [PATCH] Add words 1+ 2+ 1- 2- and consts 0 1 -1 Saves quite a few bytes in the final binary. --- blk/054 | 2 ++ emul/forth/z80c.bin | Bin 2139 -> 2172 bytes forth/blk.fs | 2 +- forth/core.fs | 12 ++++++------ forth/fmt.fs | 4 ++-- forth/icore.fs | 22 +++++++++++----------- forth/link.fs | 20 ++++++++++---------- forth/parse.fs | 12 ++++++------ forth/readln.fs | 4 ++-- forth/str.fs | 2 +- forth/z80a.fs | 5 ++--- forth/z80c.fs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 12 files changed, 88 insertions(+), 42 deletions(-) diff --git a/blk/054 b/blk/054 index 70c17ec..a04f8bf 100644 --- a/blk/054 +++ b/blk/054 @@ -10,3 +10,5 @@ MOD a b -- c a % b -> c AND a b -- c a & b -> c OR a b -- c a | b -> c XOR a b -- c a ^ b -> c + +Shortcuts: 1+ 2+ 1- 2- diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index 935068e6ccde038aae556da78880434e30533a52..c13545b3e130ec6bee961d10b9cfea535772d9eb 100644 GIT binary patch delta 1058 zcmYjPO-K}B7=FK*Z^m6&XEjSP5Oy_aw^dQ;5M_#^+q$5x&aB90q2?bQ*8htjtR1=( zc+q<;o`sN(F_+Foc(Wi#2qZdn5RrxLdB1U~%gpya@89!2@B6K`RQql~7CHkY8lyx% zKi;ISAisrrw|7;O))+09l_SB%k5A3is?7G#m6>3(J5e!PmAkvWrs7t9r+*|7CTT^8 z&h|B%9u4=WT#F0<0gVp#W@UZhP}($P#6ONM{&EBb_07A$A$7-p{I+r2c zrr6^1<@tCGnO4vU>7Hmp;`l^5%MDY~lO^r5-a_foY|L|zso%~x*%pxa zpeGEwKo6mVb*UG?ug8DR$SK37-fD%r%9viApPicvqghczC`yaQ5(Vf;xM&)oPCC$v zA|)&63{Z{>(#BOBBOZ`ydavzkDOj=9+4YTu`9gdgLl#Aw&I#=_g@kJ;oR=p?O74mS z%>!r5BVHOs!A&pF$VP;R7|z?p%lG{*Gud5ngbcrY{4wM@F$&reNgBgY13h8VplJx2 zhIGi`P@9E0Phpib{=Sx{kPeY;HxS84v(DfA6+Y?qHIR-HQMv@kvSl-q8E3E_;tZKZ z@oI0yY{pvOnqNdo%S(lsOZ2CFfe9_OOm|=`cN=^1=Uy|Jpoy7m%1f7im2H|@Sl(RU zdfEd1+}#srCjYlFGV}8w4BNc=11)E+DR0nV<}sue*0RrbFlsHGsFCTM(} zTy-NmP?K-Pg|f#exFcNpj{dP{D=V8l@eb68P=`{B$$HrMzUCv`%g$u7QFXbvXL*i7 zElT>r#zI_O+%X^~SxJH0udKZOA~-2Mn&uPb1v3Q}V+zcN)7jA{s(yrWX3oScBO}Sd zzB-7#E!$9bhkC)|fkiK@TVx~XjSd}q=svG?sEQR|GyRzxaFnfqN(+ft7YFH29S*qk K6?0GDCGi)tPVI02 delta 1064 zcmYjPOH30{6us}wr+{TB##GUe3`$G~sv*RcRtQt7)<6r>A;h2|2-x6)5@h3Q>IQdg z=-xCy>&HKSl=e*6rXj!Sf0 zlRn*lp?wdZPcGh;EZH{?^)Pq=`irvcvxqj7Ts&{rN2y%sROxG-)jwLAO z9GY+;#MOFAT;}?T) z6r|o8AJBEXhlF!tM4+3|zbG;I4UOM-$oMSD-`sl5!Nv`i2v*E44n7T+C+;a_M%XH!Ih??BDxb{Fa zWD7F*za>&uT`-Mb0`CYwO~KHDYM_!f4)D??#~rQXKs3>;_uxH+pZiuM%Vg3|NX%vi zNMbQ@m>xISth56UB0SoXzb;82NAMQK=^+$zblA|jh{x*Wa%uV^8Gst06LhHrdcxvz zF_=9M4=uYcinbojtV{F*ws7{6+MojpTlOc>hC$q|>&vKOshstxlwEi*j%sb#q#ZGw z4KQ|xn@aQzpevi(d%MpcU4>ZY*%I$;%~udFj0v}3D#!Sk8Zv1EOTAcUO0|0#w7;~! z+W!BON>DFCM`}qtFyf=Df*z^!E8*xXfT=>|fm`R>ag!X((5iI`7w`LOU%;k%Ty zlPqa|J~unfx6L{lG7ao1O@Yg;v-H9l#bG7wR|Y$KlP_X8#ygm_wfZDZ{CBKOt{!8e RwuGD1+P}xN`qdjG{s87G*?9l} diff --git a/forth/blk.fs b/forth/blk.fs index 3287f52..f72bcba 100644 --- a/forth/blk.fs +++ b/forth/blk.fs @@ -29,7 +29,7 @@ : LIST BLK@ 16 0 DO - I 1 + .2 SPC + I 1+ .2 SPC 64 I * BLK( + (print) CRLF LOOP diff --git a/forth/core.fs b/forth/core.fs index b8cdab3..9feab9c 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -1,6 +1,6 @@ : H@ HERE @ ; : IMMEDIATE - CURRENT @ 1 - + CURRENT @ 1- DUP C@ 128 OR SWAP C! ; : [ INTERPRET 1 FLAGS ! ; IMMEDIATE @@ -52,7 +52,7 @@ 2 ALLOT DUP H@ -^ SWAP ( a-H a ) ! - H@ 2 - ( push a. -2 for allot offset ) + H@ 2- ( push a. -2 for allot offset ) ; IMMEDIATE : CREATE @@ -97,7 +97,7 @@ ( Increase loop counter and returns whether we should loop. ) : _ R> ( IP, keep for later ) - R> 1 + ( ip i+1 ) + R> 1+ ( ip i+1 ) DUP >R ( ip i ) I' = ( ip f ) SWAP >R ( f ) @@ -123,7 +123,7 @@ ; : DELW - 1 - 0 SWAP C! + 1- 0 SWAP C! ; : PREV @@ -132,7 +132,7 @@ ; : WHLEN - 1 - C@ ( name len field ) + 1- C@ ( name len field ) 127 AND ( 0x7f. remove IMMEDIATE flag ) 3 + ( fixed header len ) ; @@ -155,6 +155,6 @@ ['] INTERPRET ( I ) BEGIN ( I ) DUP ( I I ) - R> DROP I 2 - @ ( I I a ) + R> DROP I 2- @ ( I I a ) = UNTIL ; diff --git a/forth/fmt.fs b/forth/fmt.fs index e974a8f..8d9dcd0 100644 --- a/forth/fmt.fs +++ b/forth/fmt.fs @@ -50,7 +50,7 @@ 256 /MOD SWAP .x .x SPC - 2 + + 2+ LOOP DROP 8 0 DO @@ -58,7 +58,7 @@ DUP <>{ 0x20 &< 0x7e |> <>} IF DROP '.' THEN EMIT - 1 + + 1+ LOOP CRLF ; diff --git a/forth/icore.fs b/forth/icore.fs index 1f8757f..9cb00bc 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -75,7 +75,7 @@ ( special case: do we have a negative? ) DUP '-' = IF ( Oh, a negative, let's recurse and reverse ) - DROP 1 + ( a+1 ) + DROP 1+ ( a+1 ) (parsed) ( n f ) 0 ROT ( f 0 n ) - SWAP EXIT ( 0-n f ) @@ -88,7 +88,7 @@ 2DROP 0 EXIT ( a 0 ) THEN BEGIN ( a r 0 ) - DROP SWAP 1 + ( r a+1 ) + DROP SWAP 1+ ( r a+1 ) DUP C@ ( r a c ) ROT SWAP ( a r c ) _pdacc ( a r f ) @@ -113,18 +113,18 @@ : , HERE @ ! - HERE @ 2 + HERE ! + HERE @ 2+ HERE ! ; : C, HERE @ C! - HERE @ 1 + HERE ! + HERE @ 1+ HERE ! ; ( The NOT is to normalize the negative/positive numbers to 1 or 0. Hadn't we wanted to normalize, we'd have written: 32 CMP 1 - ) -: WS? 33 CMP 1 + NOT ; +: WS? 33 CMP 1+ NOT ; : TOWORD BEGIN @@ -141,8 +141,8 @@ BEGIN ( We take advantage of the fact that char MSB is always zero to pre-write our null-termination ) - OVER ! ( a ) - 1 + ( a+1 ) + OVER ! ( a ) + 1+ ( a+1 ) C< ( a c ) DUP WS? UNTIL @@ -157,7 +157,7 @@ DUP C@ ( a c ) DUP C, ( a c ) NOT IF DROP EXIT THEN - 1 + ( a+1 ) + 1+ ( a+1 ) AGAIN ; @@ -165,8 +165,8 @@ HERE @ ( w h ) SWAP SCPY ( h ) ( Adjust HERE -1 because SCPY copies the null ) - HERE @ 1 - ( h h' ) - DUP HERE ! ( h h' ) + HERE @ 1- ( h h' ) + DUP HERE ! ( h h' ) SWAP - ( sz ) ( write prev value ) HERE @ CURRENT @ - , @@ -220,7 +220,7 @@ 32 , , ; -: IMMED? 1 - C@ 0x80 AND ; +: 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 diff --git a/forth/link.fs b/forth/link.fs index f869fb3..68074ba 100644 --- a/forth/link.fs +++ b/forth/link.fs @@ -30,13 +30,13 @@ DUP <>{ 0x70 &= 0x58 |= 0x20 |= 0x24 |= <>} IF DROP 4 + EXIT THEN ( regular word ) - 0x22 = NOT IF 2 + EXIT THEN + 0x22 = NOT IF 2+ EXIT THEN ( it's a lit, skip to null char ) ( a ) - 1 + ( we skip by 2, but the loop below is pre-inc... ) - BEGIN 1 + DUP C@ NOT UNTIL + 1+ ( we skip by 2, but the loop below is pre-inc... ) + BEGIN 1+ DUP C@ NOT UNTIL ( skip null char ) - 1 + + 1+ ; ( Get word addr, starting at name's address ) @@ -57,7 +57,7 @@ our number will be treated like a regular wordref. ) DROP - 2 + ( o ol a+2 ) + 2+ ( o ol a+2 ) ROT ROT 2DROP ( a ) EXIT THEN @@ -93,9 +93,9 @@ ( doesWord is processed exactly like a compiledWord, but starts 2 bytes further. ) ( ol o a2 a1 n ) - 0x2b = IF 2 + THEN + 0x2b = IF 2+ THEN ( ol o a2 a1 ) - 1 + ( ol o a2 a1+1 ) + 1+ ( ol o a2 a1+1 ) BEGIN ( ol o a2 a1 ) 2OVER ( ol o a2 a1 ol o ) SWAP ( ol o a2 a1 o ol ) @@ -136,11 +136,11 @@ prev word is a "hook word", that is, an empty word. ) ( H@ == target ) DUP H@ ! - DUP 1 - C@ 0x7f AND ( t namelen ) + DUP 1- C@ 0x7f AND ( t namelen ) SWAP 3 - @ ( namelen po ) -^ ( o ) ( H@+2 == offset ) - H@ 2 + ! ( ) + H@ 2+ ! ( ) ( We have our offset, now let's copy our memory chunk ) H@ @ DUP WHLEN - ( src ) DUP H@ -^ ( src u ) @@ -162,7 +162,7 @@ DUP ROT ( wr wr we ) ( call RLWORD. we need a sig: ol o wr we ) H@ @ ( wr wr we ol ) - H@ 2 + @ ( wr wr we ol o ) + H@ 2+ @ ( wr wr we ol o ) 2SWAP ( wr ol o wr we ) RLWORD ( wr ) ( wr becomes wr's prev and we is wr-header ) diff --git a/forth/parse.fs b/forth/parse.fs index 9844a9a..fa1af00 100644 --- a/forth/parse.fs +++ b/forth/parse.fs @@ -5,9 +5,9 @@ : (parsec) ( a -- n f ) ( apostrophe is ASCII 39 ) DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) - DUP 2 + C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) + DUP 2+ C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) ( surrounded by apos, good, return ) - 1 + C@ 1 ( n 1 ) + 1+ C@ 1 ( n 1 ) ; ( returns negative value on error ) @@ -28,7 +28,7 @@ ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) ( We have "0x" prefix ) - 2 + + 2+ ( validate slen ) DUP SLEN ( a l ) DUP 0 = IF DROP 0 EXIT THEN ( a 0 ) @@ -40,7 +40,7 @@ hexdig ( a r n ) DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) SWAP 16 * + ( a r*16+n ) - SWAP 1 + SWAP ( a+1 r ) + SWAP 1+ SWAP ( a+1 r ) AGAIN ; @@ -58,7 +58,7 @@ ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) ( We have "0b" prefix ) - 2 + + 2+ ( validate slen ) DUP SLEN ( a l ) DUP 0 = IF DROP 0 EXIT THEN ( a 0 ) @@ -70,7 +70,7 @@ bindig ( a r n ) DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) SWAP 2 * + ( a r*2+n ) - SWAP 1 + SWAP ( a+1 r ) + SWAP 1+ SWAP ( a+1 r ) AGAIN ; diff --git a/forth/readln.fs b/forth/readln.fs index 730de9b..8566a62 100644 --- a/forth/readln.fs +++ b/forth/readln.fs @@ -14,7 +14,7 @@ ( points to INBUF ) : IN( 2 RDLNMEM+ ; ( points to INBUF's end ) -: IN) INBUFSZ 2 + RDLNMEM+ ; +: IN) INBUFSZ 2+ RDLNMEM+ ; ( flush input buffer ) ( set IN> to IN( and set IN> @ to null ) @@ -25,7 +25,7 @@ : (inbs) ( already at IN( ? ) IN> @ IN( = IF EXIT THEN - IN> @ 1 - IN> ! + IN> @ 1- IN> ! SPC BS ; diff --git a/forth/str.fs b/forth/str.fs index b877be0..dcc80c9 100644 --- a/forth/str.fs +++ b/forth/str.fs @@ -2,6 +2,6 @@ DUP ( astart aend ) BEGIN DUP C@ 0 = IF -^ EXIT THEN - 1 + + 1+ AGAIN ; diff --git a/forth/z80a.fs b/forth/z80a.fs index 38a7fca..f84eebf 100644 --- a/forth/z80a.fs +++ b/forth/z80a.fs @@ -371,7 +371,7 @@ ( Place BEGIN, where you want to jump back and AGAIN after a relative jump operator. Just like BSET and BWR. ) : BEGIN, PC ; -: AGAIN, PC - 1 - A, ; +: AGAIN, PC - 1- A, ; : BSET PC SWAP ! ; : BWR @ AGAIN, ; @@ -383,11 +383,10 @@ : IFNC, JRC, FJR, ; : THEN, DUP PC ( l l pc ) - -^ 1 - ( l off ) + -^ 1- ( l off ) ( warning: l is a PC offset, not a mem addr! ) SWAP ORG @ + ( off addr ) C! ; : FWR BSET 0 A, ; : FSET @ THEN, ; - diff --git a/forth/z80c.fs b/forth/z80c.fs index e96ffe0..4da5d45 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -381,3 +381,48 @@ CODE (im1) IM1, EI, ;CODE + +CODE 0 + HL 0 LDddnn, + HL PUSHqq, +;CODE + +CODE 1 + HL 1 LDddnn, + HL PUSHqq, +;CODE + +CODE -1 + HL -1 LDddnn, + HL PUSHqq, +;CODE + +CODE 1+ + HL POPqq, + chkPS, + HL INCss, + HL PUSHqq, +;CODE + +CODE 1- + HL POPqq, + chkPS, + HL DECss, + HL PUSHqq, +;CODE + +CODE 2+ + HL POPqq, + chkPS, + HL INCss, + HL INCss, + HL PUSHqq, +;CODE + +CODE 2- + HL POPqq, + chkPS, + HL DECss, + HL DECss, + HL PUSHqq, +;CODE