diff --git a/blk/091 b/blk/091 index 7cb7a46..0e9bde4 100644 --- a/blk/091 +++ b/blk/091 @@ -5,9 +5,9 @@ sets that don't change (well, not without some binary manipu- lation). Here's the complete list of these references: 04 BOOT addr 06 (uflw) addr 08 LATEST -33 2>R wordref 42 EXIT wordref 53 (br) wordref -67 (?br) wordref 80 (loop) wordref bf (n) wordref -d4 (s) wordref +2b (s) wordref 33 2>R wordref 42 EXIT wordref +53 (br) wordref 67 (?br) wordref 80 (loop) wordref +bf (n) wordref BOOT and (uflw) exist because they are referred to before those words are defined (in core words). LATEST is a critical part diff --git a/blk/283 b/blk/283 index 3a87ebf..7cd1035 100644 --- a/blk/283 +++ b/blk/283 @@ -8,7 +8,7 @@ NOP, NOP, NOP, ( unused ) NOP, NOP, NOP, NOP, ( unused ) NOP, NOP, NOP, NOP, ( unused ) 0 JP, ( RST 28 ) -NOP, NOP, NOP, NOP, NOP, ( unused ) +0 A, 0 JP, ( 2b, (s) ) NOP, ( unused ) 0 JP, ( RST 30 ) 0 A, 0 JP, ( 33, 2>R ) NOP, ( unused ) 0 JP, ( RST 38 ) diff --git a/blk/286 b/blk/286 index 9c11b0c..1aa2046 100644 --- a/blk/286 +++ b/blk/286 @@ -8,3 +8,4 @@ CODE (n) ( 0xbf, number literal ) IY INCd, IY INCd, DE PUSH, ;CODE +( END OF STABLE ABI ) diff --git a/blk/287 b/blk/287 index 91abdd5..e69de29 100644 --- a/blk/287 +++ b/blk/287 @@ -1,11 +0,0 @@ -CODE (s) ( 0xd4, string literal ) -( 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 -( END OF STABLE ABI ) diff --git a/blk/306 b/blk/306 index 35166fb..6d6ed6c 100644 --- a/blk/306 +++ b/blk/306 @@ -1,14 +1,16 @@ -( Core words ) -( KEY and EMIT are not defined here. There're - expected to be defined in platform-specific code. ) - +( Native words ) CODE EXECUTE DE POP, chkPS, JR, lblexec BWR ( execute-B301 ) - -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 (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 diff --git a/blk/307 b/blk/307 index 0c4f50a..59f5a16 100644 --- a/blk/307 +++ b/blk/307 @@ -1,14 +1,16 @@ +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/399 b/blk/399 index ce35bbc..98eb857 100644 --- a/blk/399 +++ b/blk/399 @@ -1,4 +1,4 @@ -: LIT< 0xd4 ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE +: LIT< 0x2b ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE : BEGIN H@ ; IMMEDIATE : AGAIN 0x53 ( br ) , H@ - _bchk , ; IMMEDIATE : UNTIL 0x67 ( ?br ) , H@ - _bchk , ; IMMEDIATE diff --git a/blk/805 b/blk/805 index dfa3049..b116fbf 100644 --- a/blk/805 +++ b/blk/805 @@ -10,6 +10,6 @@ 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 ) -0 A, 0 A,, 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 2822434..d180dbf 100644 --- a/blk/807 +++ b/blk/807 @@ -9,4 +9,5 @@ ORG @ 0xb9 + HERE ! CODE (n) ( 0xbf, number literal ) DI DX MOVxx, DI [DI] MOVx[], DI PUSHx, DX INCx, DX INCx, -;CODE NOP, NOP, NOP, NOP, +;CODE +( END OF STABLE ABI ) diff --git a/blk/808 b/blk/808 index 0c072b1..8cc605b 100644 --- a/blk/808 +++ b/blk/808 @@ -1,6 +1,9 @@ -CODE (s) ( 0xd4, string literal, see B287 ) - DI DX MOVxx, ( IP ) - AH AH XORrr, AL [DI] MOVr[], ( slen ) - DX PUSHx, DX INCx, DX AX ADDxx, -;CODE -( END OF STABLE ABI ) +lblnext BSET PC 0x1d - ORG @ 0x1b + ! ( next ) + ( RSP check ) + AX RS_ADDR MOVxI, BP AX CMPxx, + IFC, ( BP < RS_ADDR ) + DI 0x06 MOVxm, JMPs, L1 FWRs ( execute ) + THEN, + DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx, + DI [DI] MOVx[], ( wordref ) + ( continue to execute ) L1 FSET diff --git a/blk/809 b/blk/809 index 8cc605b..2077e0b 100644 --- a/blk/809 +++ b/blk/809 @@ -1,9 +1,14 @@ -lblnext BSET PC 0x1d - ORG @ 0x1b + ! ( next ) - ( RSP check ) - AX RS_ADDR MOVxI, BP AX CMPxx, - IFC, ( BP < RS_ADDR ) - DI 0x06 MOVxm, JMPs, L1 FWRs ( execute ) - THEN, - DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx, - DI [DI] MOVx[], ( wordref ) - ( continue to execute ) L1 FSET +lblexec BSET ( DI -> wordref ) + AL [DI] MOVr[], DI INCx, ( PFA ) + AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) + AL DECr, IFNZ, ( cell or does ) + DI PUSHx, ( push PFA ) + AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN, + ( does, see B302 ) + DI INCx, DI INCx, DI [DI] MOVx[], + THEN, ( continue to compiled ) + ( compiled ) + BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) + DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) + DI [DI] MOVx[], + JMPs, lblexec @ RPCs, diff --git a/blk/810 b/blk/810 index 2077e0b..7c36afe 100644 --- a/blk/810 +++ b/blk/810 @@ -1,14 +1,5 @@ -lblexec BSET ( DI -> wordref ) - AL [DI] MOVr[], DI INCx, ( PFA ) - AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) - AL DECr, IFNZ, ( cell or does ) - DI PUSHx, ( push PFA ) - AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN, - ( does, see B302 ) - DI INCx, DI INCx, DI [DI] MOVx[], - THEN, ( continue to compiled ) - ( compiled ) - BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) - DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) - DI [DI] MOVx[], - JMPs, lblexec @ RPCs, +lblchkPS BSET ( CX -> expected size ) + AX PS_ADDR MOVxI, AX SP SUBxx, 2 SUBAXI, ( CALL adjust ) + AX CX CMPxx, + IFNC, ( we're good ) RETn, THEN, + ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs, diff --git a/blk/811 b/blk/811 index 7c36afe..66789d6 100644 --- a/blk/811 +++ b/blk/811 @@ -1,5 +1,9 @@ -lblchkPS BSET ( CX -> expected size ) - AX PS_ADDR MOVxI, AX SP SUBxx, 2 SUBAXI, ( CALL adjust ) - 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/812 b/blk/812 index 66789d6..fef1638 100644 --- a/blk/812 +++ b/blk/812 @@ -1,9 +1,10 @@ -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 (s) ( string literal, see B287 ) +PC 0x2f - ORG @ 0x2d + ! ( stable abi ) + DI DX MOVxx, ( IP ) + AH AH XORrr, AL [DI] MOVr[], ( slen ) + DX PUSHx, DX INCx, DX AX ADDxx, +;CODE diff --git a/blk/813 b/blk/813 index 590e9e1..b79dff3 100644 --- a/blk/813 +++ b/blk/813 @@ -1,6 +1,3 @@ -( native words ) -CODE EXECUTE 1 chkPS, - DI POPx, JMPn, lblexec @ RPCn, CODE >R 1 chkPS, BP INCx, BP INCx, [BP] 0 POP[w]+, ;CODE NOP, NOP, NOP, diff --git a/cvm/forth.bin b/cvm/forth.bin index 8ab411f..2991657 100644 Binary files a/cvm/forth.bin and b/cvm/forth.bin differ diff --git a/cvm/xcomp.fs b/cvm/xcomp.fs index d8f58c1..5fb610a 100644 --- a/cvm/xcomp.fs +++ b/cvm/xcomp.fs @@ -10,6 +10,8 @@ CREATE BIN( 0 , 270 LOAD ( xcomp overrides ) H@ ORG ! +ORG @ 0x2b + HERE ! +0 C, 0x06 C, ( (s) ) ORG @ 0x33 + HERE ! 0 C, 0x04 C, ( 2>R ) ORG @ 0x3b + HERE ! @@ -25,9 +27,8 @@ ORG @ 0x77 + HERE ! 0x03 CODE (loop) ( 0x80 ) ORG @ 0xb9 + HERE ! 0x05 CODE (n) ( 0xbf ) -ORG @ 0xce + HERE ! -0x06 CODE (s) ( 0xd4 ) ( END OF STABLE ABI ) +0x06 CODE (s) 0x04 CODE 2>R 0x07 CODE >R 0x08 CODE R>