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 935068e..c13545b 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ 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