diff --git a/blk/283 b/blk/283 index bae9859..0368d13 100644 --- a/blk/283 +++ b/blk/283 @@ -6,7 +6,7 @@ NOP, NOP, ( 06, uflw ) NOP, NOP, ( 08, LATEST ) NOP, ( unused ) NOP, NOP, NOP, ( unused ) 0 JP, ( 1a, next ) NOP, NOP, NOP, ( unused ) 0 JP, ( RST 20 ) -NOP, NOP, NOP, NOP, NOP, ( unused ) +0 A, 0 JP, ( 23, (n) ) NOP, ( unused ) 0 JP, ( RST 28 ) 0 A, 0 JP, ( 2b, (s) ) NOP, ( unused ) 0 JP, ( RST 30 ) diff --git a/blk/285 b/blk/285 index 7296d8c..e6319c0 100644 --- a/blk/285 +++ b/blk/285 @@ -13,3 +13,4 @@ CODE (loop) ( 0x80 ) A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L2 BWR ( branch ) ( don't branch ) IX DECd, IX DECd, IX DECd, IX DECd, JR, L1 BWR +( END OF STABLE ABI ) diff --git a/blk/286 b/blk/286 deleted file mode 100644 index 1aa2046..0000000 --- a/blk/286 +++ /dev/null @@ -1,11 +0,0 @@ -ORG @ 0xb9 + HERE ! -CODE (n) ( 0xbf, number literal ) - ( Literal value to push to stack is next to (n) reference - in the atom list. That is where IP is currently pointing. - Read, push, then advance IP. ) - E 0 IY+ LDrIXY, - D 1 IY+ LDrIXY, - IY INCd, IY INCd, - DE PUSH, -;CODE -( END OF STABLE ABI ) diff --git a/blk/306 b/blk/306 index fddc699..ac1b21f 100644 --- a/blk/306 +++ b/blk/306 @@ -1,11 +1,11 @@ -CODE (s) ( string literal ) -PC ORG @ 0x2d + ! ( stable ABI JP ) -( Like (n) but instead of being followed by a 2 bytes - number, it's followed by a string. When called, puts the - string's address on PS ) - IY PUSH, HL POP, ( <-- IP ) - E (HL) LDrr, D 0 LDri, - DE INCd, - DE ADDIYd, - HL PUSH, +CODE (n) ( number literal ) +PC ORG @ 0x25 + ! ( stable ABI JP ) + ( Literal value to push to stack is next to (n) reference + in the atom list. That is where IP is currently pointing. + Read, push, then advance IP. ) + E 0 IY+ LDrIXY, + D 1 IY+ LDrIXY, + IY INCd, IY INCd, + DE PUSH, ;CODE +( END OF STABLE ABI ) diff --git a/blk/307 b/blk/307 index 59f5a16..fddc699 100644 --- a/blk/307 +++ b/blk/307 @@ -1,16 +1,11 @@ -CODE ROT ( a b c -- b c a ) - HL POP, ( C ) DE POP, ( B ) BC POP, ( A ) chkPS, - DE PUSH, ( B ) HL PUSH, ( C ) BC PUSH, ( A ) -;CODE -CODE DUP ( a -- a a ) - HL POP, chkPS, - HL PUSH, HL PUSH, -;CODE -CODE ?DUP - HL POP, chkPS, +CODE (s) ( string literal ) +PC ORG @ 0x2d + ! ( stable ABI JP ) +( Like (n) but instead of being followed by a 2 bytes + number, it's followed by a string. When called, puts the + string's address on PS ) + IY PUSH, HL POP, ( <-- IP ) + E (HL) LDrr, D 0 LDri, + DE INCd, + DE ADDIYd, HL PUSH, - HLZ, IFNZ, HL PUSH, THEN, -;CODE -CODE DROP ( a -- ) - HL POP, ;CODE diff --git a/blk/308 b/blk/308 index 8c0ece3..59f5a16 100644 --- a/blk/308 +++ b/blk/308 @@ -1,8 +1,16 @@ -( a b -- b a ) -CODE SWAP - HL POP, ( B ) - DE POP, ( A ) - chkPS, - HL PUSH, ( B ) - DE PUSH, ( A ) +CODE ROT ( a b c -- b c a ) + HL POP, ( C ) DE POP, ( B ) BC POP, ( A ) chkPS, + DE PUSH, ( B ) HL PUSH, ( C ) BC PUSH, ( A ) +;CODE +CODE DUP ( a -- a a ) + HL POP, chkPS, + HL PUSH, HL PUSH, +;CODE +CODE ?DUP + HL POP, chkPS, + HL PUSH, + HLZ, IFNZ, HL PUSH, THEN, +;CODE +CODE DROP ( a -- ) + HL POP, ;CODE diff --git a/blk/309 b/blk/309 index b365db8..ff456e1 100644 --- a/blk/309 +++ b/blk/309 @@ -1,9 +1,11 @@ -( a b -- a b a ) -CODE OVER - HL POP, ( B ) - DE POP, ( A ) +CODE SWAP ( a b -- b a ) + HL POP, ( B ) DE POP, ( A ) chkPS, - DE PUSH, ( A ) - HL PUSH, ( B ) - DE PUSH, ( A ) + HL PUSH, ( B ) DE PUSH, ( A ) +;CODE + +CODE OVER ( a b -- a b a ) + HL POP, ( B ) DE POP, ( A ) + chkPS, + DE PUSH, ( A ) HL PUSH, ( B ) DE PUSH, ( A ) ;CODE diff --git a/blk/397 b/blk/397 index d190732..785dd81 100644 --- a/blk/397 +++ b/blk/397 @@ -1,9 +1,9 @@ -( Now we have "as late as possible" stuff. See B70 and B270. ) +( Now we have "as late as possible" stuff. See B70 and B260. ) : _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ; : DO 0x33 ( 2>R ) , H@ ; IMMEDIATE : LOOP 0x80 ( loop ) , H@ - _bchk , ; IMMEDIATE ( LEAVE is implemented in low xcomp ) -: LITN 0xbf ( n ) , , ; +: LITN 0x23 ( n ) , , ; ( gets its name at the very end. can't comment afterwards ) : _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE : _ ( : will get its name almost at the very end ) diff --git a/blk/805 b/blk/805 index a0c8dd4..5ba4e42 100644 --- a/blk/805 +++ b/blk/805 @@ -6,10 +6,9 @@ JMPn, 0 A,, ( 00, main ) 0 A, ( 03, boot driveno ) 0 A, JMPn, 0 A,, ( unused ) 0 A,, ( unused ) JMPn, 0 A,, ( unused ) JMPn, 0 A,, ( unused ) 0 A, 0 A,, ( unused ) -JMPn, 0 A,, ( 1a, next ) 0 A, 0 A,, ( unused ) -0 A, 0 A, 0 A, 0 A, ( unused ) -0 A, 0 A, 0 A, 0 A, ( unused ) -0 A, 0 A,, ( unused ) +JMPn, 0 A,, ( 1a, next ) 0 A,, 0 A,, 0 A,, ( unused ) +0 A, JMPn, 0 A,, ( 23, (n) ) +0 A,, 0 A,, ( unused ) 0 A, JMPn, 0 A,, ( 2b, (s) ) 0 A, ( unused ) 0 A, 0 A,, ( unused ) 0 A, JMPn, 0 A,, ( 33, 2>R ) 0 A, 0 A, 0 A,, ( unused ) diff --git a/blk/807 b/blk/807 index d180dbf..9fcf6f2 100644 --- a/blk/807 +++ b/blk/807 @@ -5,9 +5,4 @@ CODE (loop) ( 0x80 ) JNZ, L2 @ RPCs, ( branch ) ( don't branch ) BP 4 SUBxi, JMPs, L1 @ RPCs, -ORG @ 0xb9 + HERE ! -CODE (n) ( 0xbf, number literal ) - DI DX MOVxx, DI [DI] MOVx[], DI PUSHx, - DX INCx, DX INCx, -;CODE ( END OF STABLE ABI ) diff --git a/blk/810 b/blk/810 index 7c36afe..a62bc11 100644 --- a/blk/810 +++ b/blk/810 @@ -3,3 +3,13 @@ lblchkPS BSET ( CX -> expected size ) AX CX CMPxx, IFNC, ( we're good ) RETn, THEN, ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs, + +PC 3 - ORG @ 1+ ! ( main ) + DX POPx, ( boot drive no ) 0x03 DL MOVmr, + SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, + DI 0x08 MOVxm, ( LATEST ) +( HERE begins at CURRENT ) + SYSVARS 0x4 ( HERE ) + DI MOVmx, + SYSVARS 0x2 ( CURRENT ) + DI MOVmx, + DI 0x04 ( BOOT ) MOVxm, + JMPn, lblexec @ RPCn, ( execute ) diff --git a/blk/811 b/blk/811 index 66789d6..cabbdca 100644 --- a/blk/811 +++ b/blk/811 @@ -1,9 +1,8 @@ -PC 3 - ORG @ 1+ ! ( main ) - DX POPx, ( boot drive no ) 0x03 DL MOVmr, - SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, - DI 0x08 MOVxm, ( LATEST ) -( HERE begins at CURRENT ) - SYSVARS 0x4 ( HERE ) + DI MOVmx, - SYSVARS 0x2 ( CURRENT ) + DI MOVmx, - DI 0x04 ( BOOT ) MOVxm, - JMPn, lblexec @ RPCn, ( execute ) +( native words ) +CODE EXECUTE 1 chkPS, + DI POPx, JMPn, lblexec @ RPCn, +CODE EXIT +PC 0x0f - ORG @ 0x0d + ! ( stable abi ) + DX [BP] 0 MOVx[]+, BP DECx, BP DECx, ( popRS ) +;CODE + diff --git a/blk/812 b/blk/812 index d0adf9e..2b01c01 100644 --- a/blk/812 +++ b/blk/812 @@ -1,9 +1,7 @@ -( native words ) -CODE EXECUTE 1 chkPS, - DI POPx, JMPn, lblexec @ RPCn, -CODE EXIT -PC 0x0f - ORG @ 0x0d + ! ( stable abi ) - DX [BP] 0 MOVx[]+, BP DECx, BP DECx, ( popRS ) +CODE (n) ( number literal ) +PC 0x27 - ORG @ 0x25 + ! ( stable abi ) + DI DX MOVxx, DI [DI] MOVx[], DI PUSHx, + DX INCx, DX INCx, ;CODE CODE (s) ( string literal, see B287 ) PC 0x2f - ORG @ 0x2d + ! ( stable abi ) diff --git a/cvm/forth.bin b/cvm/forth.bin index 7848cc6..1cd046e 100644 Binary files a/cvm/forth.bin and b/cvm/forth.bin differ diff --git a/cvm/xcomp.fs b/cvm/xcomp.fs index 5153b13..16247c1 100644 --- a/cvm/xcomp.fs +++ b/cvm/xcomp.fs @@ -12,6 +12,8 @@ CREATE BIN( 0 , H@ ORG ! ORG @ 0x0b + HERE ! 0 C, 0 C, ( EXIT ) +ORG @ 0x23 + HERE ! +0 C, 0x05 C, ( (n) ) ORG @ 0x2b + HERE ! 0 C, 0x06 C, ( (s) ) ORG @ 0x33 + HERE !