izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-23 17:08:04 +11:00
Code Issues Releases Wiki Activity

Add words 1+ 2+ 1- 2- and consts 0 1 -1

Browse Source 
Saves quite a few bytes in the final binary.
This commit is contained in:
Virgil Dupras 2020-04-15 21:29:39 -04:00
parent e1e634c815
commit 5d4155aa32
12 changed files with 88 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
blk/054
View File

@ -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-

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

2
forth/blk.fs
View File

@ -29,7 +29,7 @@
: LIST
BLK@
16 0 DO
I 1 + .2 SPC
I 1+ .2 SPC
64 I * BLK( + (print)
CRLF
LOOP

12
forth/core.fs
View File

@ -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
;

4
forth/fmt.fs
View File

@ -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
;

22
forth/icore.fs
View File

@ -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

20
forth/link.fs
View File

@ -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 )

12
forth/parse.fs
View File

@ -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
;

4
forth/readln.fs
View File

@ -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
;

2
forth/str.fs
View File

@ -2,6 +2,6 @@
DUP ( astart aend )
BEGIN
DUP C@ 0 = IF -^ EXIT THEN
1 +
1+
AGAIN
;

5
forth/z80a.fs
View File

@ -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, ;

45
forth/z80c.fs
View File

@ -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