pcat: add RSP checks in next

Also, fix (roll) which wasn't properly implemented.

blk/089

@@ -6,9 +6,9 @@ very few things.
 1. Set SP to PS_ADDR and IX to RS_ADDR
 2. Sets HERE to RAMEND (RAMSTART+0x80).
 3. Sets CURRENT to value of LATEST field in stable ABI.
-4. Look for the word "BOOT" and calls it.
+4. Execute the word referred to by 0x04 (BOOT) in stable ABI.
 
-In a normal system, BOOT is in xcomp core (B411) and does a
+In a normal system, BOOT is in core words at B396 and does a
 few things:
 
 1. Initialize all overrides to 0.

blk/283

@@ -1,6 +1,6 @@
 H@ ORG !
-0 JPnn, ( 00, main ) NOP, NOP, NOP, ( unused )
+0 JPnn, ( 00, main ) NOP, ( unused ) NOP, NOP, ( 04, BOOT )
-NOP, NOP, ( unused ) NOP, NOP, ( 08, LATEST )
+NOP, NOP, ( 06, uflw ) NOP, NOP, ( 08, LATEST )
 NOP, NOP, NOP, NOP, NOP, NOP, NOP, ( 0a, unused )
 0 JPnn, ( 11, pushRS ) 0 JPnn, ( 14, popRS )
 NOP, NOP, NOP, ( unused )

blk/298

@@ -1,8 +1,5 @@
-6 A, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A,
 lblofl BSET ( abortUnderflow )
-    HL PC 7 - LDddnn,
+    DE BIN( @ 0x06 ( uflw ) + LDdd(nn),
-    DE RAMSTART 0x02 + LDdd(nn),   ( RAM+02 == CURRENT )
-    lblfind @ CALLnn,
     JR, L2 FWR ( execute, B301 )
 
 

blk/299

@@ -1,4 +1,3 @@
-L1 BSET 4 A, 'B' A, 'O' A, 'O' A, 'T' A,
 PC ORG @ 1 + ! ( main )
 ( STACK OVERFLOW PROTECTION: See B76 )
     SP PS_ADDR LDddnn, IX RS_ADDR LDddnn,
@@ -10,7 +9,5 @@ PC ORG @ 1 + ! ( main )
   Forth. )
     BIN( @ 0x08 + LDHL(nn),
     RAMSTART 0x02 ( CURRENT ) + LD(nn)HL,
-    EXDEHL,
+    DE BIN( @ 0x04 ( BOOT ) + LDdd(nn),
-    HL L1 @ LDddnn,
-    lblfind @ CALLnn,
     JR, L1 FWR ( execute, B301 )

blk/381

@@ -6,6 +6,7 @@
 : CRLF CR LF ; : SPC 32 EMIT ;
 : NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;
 : (uflw) LIT" stack underflow" ERR ;
+XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + !
 : (wnf) (print) SPC LIT" word not found" ERR ;
 
 
@@ -13,4 +14,3 @@
 
 
 
-

blk/396

@@ -13,4 +13,4 @@
     1 0x06 RAM+ ! INTERPRET
     RDLN$ LIT< _sys [entry]
     LIT< CollapseOS (print) NL (main) ;
-
+XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !

blk/750

@@ -1 +1 @@
-1 11 LOADR+
+1 13 LOADR+

blk/755

@@ -2,6 +2,6 @@
 0x31 OPrr XORxx,     0x30 OPrr XORrr,
 0x88 OPrr MOVrr,     0x89 OPrr MOVxx,    0x28 OPrr SUBrr,
 0x29 OPrr SUBxx,     0x08 OPrr ORrr,     0x09 OPrr ORxx,
-0x3a OPrr CMPrr,     0x3b OPrr CMPxx,    0x00 OPrr ADDrr,
+0x38 OPrr CMPrr,     0x39 OPrr CMPxx,    0x00 OPrr ADDrr,
 0x01 OPrr ADDxx,     0x20 OPrr ANDrr,    0x21 OPrr ANDxx,
 

blk/758

@@ -1,10 +1,6 @@
-: MOVri, SWAP 0xb0 OR A, A, ;
+: OPi CREATE C, DOES> C@ A, A, ;
-: MOVxI, SWAP 0xb8 OR A, A,, ;
+0x04 OPi ADDALi,     0x24 OPi ANDALi,    0x2c OPi SUBALi,
-: MOVsx, 0x8e A, SWAP 3 LSHIFT OR 0xc0 OR A, ;
+0xcd OPi INT,
-: MOVxm, 0x8b A, SWAP 3 LSHIFT 0x6 OR A, A,, ;
+: OPI CREATE C, DOES> C@ A, A,, ;
-: INT, 0xcd A, A, ;
+0x05 OPI ADDAXI,     0x25 OPI ANDAXI,    0x2d OPI SUBAXI,
-: ADDAXI, 0x05 A, A,, ; : ADDALi, 0x04 A, A, ;
+
-: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ;
-: ADDxi, 0x83 A, SWAP 0xc0 OR A, A, ;
-: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
-: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;

blk/759

@@ -1,16 +0,0 @@
-( Place BEGIN, where you want to jump back and AGAIN after
-  a relative jump operator. Just like BSET and BWR. )
-: BEGIN, PC ;
-: BSET PC SWAP ! ;
-( same as BSET, but we need to write a placeholder )
-: FJR, PC 0 A, ;
-: IFZ, JNZ, FJR, ;
-: IFNZ, JZ, FJR, ;
-: IFC, JNC, FJR, ;
-: IFNC, JC, FJR, ;
-: THEN,
-    DUP PC          ( l l pc )
-    -^ 1-           ( l off )
-    ( warning: l is a PC offset, not a mem addr! )
-    SWAP ORG @ + BIN( @ - ( off addr )
-    C! ;

blk/760

@@ -1,11 +1,8 @@
-: FWRs BSET 0 A, ;
+: MOVri, SWAP 0xb0 OR A, A, ;
-: FSET @ THEN, ;
+: MOVxI, SWAP 0xb8 OR A, A,, ;
-( : BREAK, FJR, 0x8000 OR ;
+: MOVsx, 0x8e A, SWAP 3 LSHIFT OR 0xc0 OR A, ;
-: BREAK?, DUP 0x8000 AND IF
+: MOVxm, 0x8b A, SWAP 3 LSHIFT 0x6 OR A, A,, ;
-        0x7fff AND 1 ALLOT THEN, -1 ALLOT
+: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ;
-    THEN ; )
+: ADDxi, 0x83 A, SWAP 0xc0 OR A, A, ;
-: RPCs, PC - 1- DUP 128 + 0xff > IF ABORT" PC ovfl" THEN A, ;
+: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
-: RPCn, PC - 2- A,, ;
+: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;
-: AGAIN, ( BREAK?, ) RPCs, ;
-( Use RPCx with appropriate JMP/CALL op. Example:
-  JMPs, 0x42 RPCs, or CALLn, 0x1234 RPCn, )

blk/761

@@ -1,4 +1,16 @@
-: PUSHZ, CX 0 MOVxI, IFZ, CX INCx, THEN, CX PUSHx, ;
+( Place BEGIN, where you want to jump back and AGAIN after
-: CODE ( same as CREATE, but with native word )
+  a relative jump operator. Just like BSET and BWR. )
-    (entry) 0 ( native ) C, ;
+: BEGIN, PC ;
-: ;CODE JMPn, 0x1a ( next ) RPCn, ;
+: BSET PC SWAP ! ;
+( same as BSET, but we need to write a placeholder )
+: FJR, PC 0 A, ;
+: IFZ, JNZ, FJR, ;
+: IFNZ, JZ, FJR, ;
+: IFC, JNC, FJR, ;
+: IFNC, JC, FJR, ;
+: THEN,
+    DUP PC          ( l l pc )
+    -^ 1-           ( l off )
+    ( warning: l is a PC offset, not a mem addr! )
+    SWAP ORG @ + BIN( @ - ( off addr )
+    C! ;

blk/762

@@ -0,0 +1,11 @@
+: FWRs BSET 0 A, ;
+: FSET @ THEN, ;
+( : BREAK, FJR, 0x8000 OR ;
+: BREAK?, DUP 0x8000 AND IF
+        0x7fff AND 1 ALLOT THEN, -1 ALLOT
+    THEN ; )
+: RPCs, PC - 1- DUP 128 + 0xff > IF ABORT" PC ovfl" THEN A, ;
+: RPCn, PC - 2- A,, ;
+: AGAIN, ( BREAK?, ) RPCs, ;
+( Use RPCx with appropriate JMP/CALL op. Example:
+  JMPs, 0x42 RPCs, or CALLn, 0x1234 RPCn, )

blk/763

@@ -0,0 +1,7 @@
+: PUSHZ, CX 0 MOVxI, IFZ, CX INCx, THEN, CX PUSHx, ;
+: CODE ( same as CREATE, but with native word )
+    (entry) 0 ( native ) C, ;
+: ;CODE JMPn, 0x1a ( next ) RPCn, ;
+VARIABLE lblchkPS
+: chkPS, ( sz -- )
+    CX SWAP 2 * MOVxI, CALLn, lblchkPS @ RPCn, ;

blk/810

@@ -4,4 +4,13 @@ Work in progress.
 
 Register usage: SP is PSP, BP is RSP, DX is IP
 
-811 Hello World boot
+Unlike z80 boot code, we don't check PS at each next call (we
+do check RS though). It is the responsibility of every native
+PSP-modifying word to call chkPS, . Also, chkPS, is a bit
+different than in z80: it is parametrizable. The idea is that
+we always call chkPS, before popping, telling the expected size
+of stack. This allows for some interesting optimization. For
+example, in SWAP, no need to pop, chkPS, then push, we can
+chkPS and then proceed to optimized swapping in PS.
+
+811 MBR bootloader             812-829 Boot code

blk/812

@@ -1,7 +1,7 @@
-VARIABLE lblexec VARIABLE lblfind VARIABLE lblnext
+VARIABLE lblexec VARIABLE lblnext
 H@ ORG !
-JMPn, 0 A,,   ( 00, main )     0 A, 0 A,, ( unused )
+JMPn, 0 A,, ( 00, main ) 0 A, ( unused ) 0 A,, ( 04, BOOT )
-0 A,, ( unused ) 0 A,, ( 08, LATEST )
+0 A,, ( 06, uflw ) 0 A,, ( 08, LATEST )
 0 A, 0 A, 0 A,,    ( unused )
 0 A, 0 A,, ( unused ) JMPn, 0 A,,  ( 11, pushRS )
 JMPn, 0 A,,   ( 14, popRS )

blk/816

@@ -1,15 +1,9 @@
 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 )
+    ( continue to execute ) L1 FSET
-lblexec BSET PC 0x36 - ORG @ 0x34 + ! ( 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 ) JMPs, lblnext @ RPCs,
-        ( TODO: implement does )
-    THEN, ( 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,

blk/817

@@ -1,15 +1,15 @@
-lblfind BSET
+lblexec BSET PC 0x36 - ORG @ 0x34 + ! ( DI -> wordref )
-( find word the same name as str in SI starting from tip in
+    AL [DI] MOVr[], DI INCx, ( PFA )
-  DI. Returns wordref in DI. Z if found, NZ if not. )
+    AL AL ORrr, IFZ, DI JMPr, THEN, ( native )
-    CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
+    AL DECr, IFNZ, ( cell or does )
-    SI INCx, ( first char ) AX AX XORxx, ( initial prev )
+        DI PUSHx, ( push PFA )
-    BEGIN, ( loop )
+        AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN,
-        DI AX SUBxx, ( jump to prev wordref )
+        ( does, see B302 )
-        AL [DI] -1 MOVr[]+, ( strlen )
+        DI INCx, DI INCx, DI [DI] MOVx[],
-        CL AL CMPrr, IFZ, ( same len )
+    THEN, ( continue to compiled )
-            SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
+    ( compiled )
-            3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
+    BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
-            CLD, REPZ, CMPSB,
+    DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
-            CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
+    DI [DI] MOVx[],
-            IFZ, RETn, THEN,
+    JMPs, lblexec @ RPCs,
-        THEN,
+

blk/818

@@ -1,5 +1,5 @@
-( find cont. )
+lblchkPS BSET ( CX -> expected size )
-        DI 3 SUBxi, AX [DI] MOVx[], ( prev )
+    AX PS_ADDR MOVxI, AX SP SUBxx, 2 SUBAXI, ( CALL adjust )
-        AX AX ORxx,
+    AX CX CMPxx,
-    JNZ, AGAIN, ( loop )
+    IFNC, ( we're good ) RETn, THEN,
-    SI DECx, ( start of string, and NZ ) RETn,
+    ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs,

blk/819

@@ -1,13 +0,0 @@
-L3 BSET 4 A, 'B' A, 'O' A, 'O' A, 'T' A,
-PC 3 - ORG @ 1+ ! ( main )
-    SP PS_ADDR MOVxI, BP RS_ADDR MOVxI,
-    DI 0x08 MOVxm, ( LATEST )
-( HERE begins at CURRENT )
-    BX RAMSTART MOVxI,
-    [BX] 0x04 ( HERE ) DI MOV[]+x,
-    [BX] 0x02 ( CURRENT ) DI MOV[]+x,
-    SI L3 @ MOVxI,
-    CALLn, lblfind @ RPCn, ( find )
-    IFZ, JMPn, lblexec @ RPCn, ( execute ) THEN,
-    AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
-    BEGIN, JMPs, AGAIN,

blk/820

@@ -1,16 +0,0 @@
-( native words )
-CODE EXECUTE
-    DI POPx, JMPn, lblexec @ RPCn,
-CODE >R
-    BP INCx, BP INCx, [BP] 0 POP[w]+,
-;CODE NOP, NOP, NOP,
-CODE R>
-    [BP] 0 PUSH[w]+, BP DECx, BP DECx,
-;CODE
-CODE 2R>
-    [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
-;CODE
-CODE ROT ( a b c -- b c a )
-    CX POPx, BX POPx, AX POPx,
-    BX PUSHx, CX PUSHx, AX PUSHx,
-;CODE

blk/821

@@ -1,16 +1,9 @@
-CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;CODE
+PC 3 - ORG @ 1+ ! ( main )
-CODE ?DUP AX POPx, AX AX ORxx, AX PUSHx,
+    SP PS_ADDR MOVxI, BP RS_ADDR MOVxI,
-    IFNZ, AX PUSHx, THEN, ;CODE
+    DI 0x08 MOVxm, ( LATEST )
-CODE DROP AX POPx, ;CODE
+( HERE begins at CURRENT )
-CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
+    BX RAMSTART MOVxI,
-CODE OVER ( a b -- a b a )
+    [BX] 0x04 ( HERE ) DI MOV[]+x,
-    DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
+    [BX] 0x02 ( CURRENT ) DI MOV[]+x,
-CODE PICK
+    DI 0x04 ( BOOT ) MOVxm,
-    DI POPx, DI SHLx1, ( x2 )
+    JMPn, lblexec @ RPCn, ( execute )
-    DI SP ADDxx, DI [DI] MOVx[], DI PUSHx,
-;CODE
-CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
-    CX POPx, SI SP MOVxx, SI CX ADDxx,
-    DI SI MOVxx, SI DECx, SI DECx,
-    STD, REPZ, MOVSB,
-;CODE

blk/822

@@ -1,14 +1,16 @@
-CODE 2DROP SP 4 ADDxi, ;CODE
+( native words )
-CODE 2DUP
+CODE EXECUTE 1 chkPS,
-    AX POPx, BX POPx,
+    DI POPx, JMPn, lblexec @ RPCn,
-    BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
+CODE >R 1 chkPS,
+    BP INCx, BP INCx, [BP] 0 POP[w]+,
+;CODE NOP, NOP, NOP,
+CODE R>
+    [BP] 0 PUSH[w]+, BP DECx, BP DECx,
 ;CODE
-CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
+CODE 2R> 2 chkPS,
-CODE 'S SP PUSHx, ;CODE
+    [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
-CODE AND AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
+;CODE
-CODE OR AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
+CODE ROT ( a b c -- b c a ) 3 chkPS,
-CODE XOR AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
+    CX POPx, BX POPx, AX POPx,
-CODE NOT
+    BX PUSHx, CX PUSHx, AX PUSHx,
-    AX POPx, AX AX ORxx,
-    IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
 ;CODE

blk/823

@@ -1,13 +1,12 @@
-CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
+CODE DUP 1 chkPS, AX POPx, AX PUSHx, AX PUSHx, ;CODE
-CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
+CODE ?DUP 1 chkPS, AX POPx, AX AX ORxx, AX PUSHx,
-CODE *
+    IFNZ, AX PUSHx, THEN, ;CODE
-    AX POPx, BX POPx,
+CODE DROP 1 chkPS, AX POPx, ;CODE
-    DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
+CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
-    AX PUSHx,
+CODE OVER ( a b -- a b a ) 2 chkPS,
-;CODE
+    DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
-CODE /MOD
+CODE PICK
-    BX POPx, AX POPx, DX PUSHx, ( protect )
+    DI POPx, DI SHLx1, ( x2 )
-    DX DX XORxx, BX DIVx,
+    CX DI MOVxx, CX 2 ADDxi, CALLn, lblchkPS @ RPCn,
-    BX DX MOVxx, DX POPx, ( unprotect )
+    DI SP ADDxx, DI [DI] MOVx[], DI PUSHx,
-    BX PUSHx, ( modulo ) AX PUSHx, ( division )
 ;CODE

blk/824

@@ -1,11 +1,16 @@
-CODE ! DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE
+CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
-CODE @ DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE
+    CX POPx, CX 2 ADDxi, CALLn, lblchkPS @ RPCn, CX 2 SUBxi,
-CODE C! DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE
+    SI SP MOVxx, SI CX ADDxx,
-CODE C@
+    DI SI MOVxx, DI 2 ADDxi, STD, REPZ, MOVSB,
-    DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE
+;CODE
-CODE I [BP] 0 PUSH[w]+, ;CODE
+CODE 2DROP 2 chkPS, SP 4 ADDxi, ;CODE
-CODE I' [BP] -2 PUSH[w]+, ;CODE
+CODE 2DUP 2 chkPS,
-CODE J [BP] -4 PUSH[w]+, ;CODE
+    AX POPx, BX POPx,
-CODE (resSP) SP PS_ADDR MOVxI, ;CODE
+    BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
-CODE (resRS) BP RS_ADDR MOVxI, ;CODE
+;CODE
-CODE BYE BEGIN, JMPs, AGAIN, ;CODE
+CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
+CODE 'S SP PUSHx, ;CODE
+CODE AND 2 chkPS,
+    AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
+CODE OR 2 chkPS,
+    AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE

blk/825

@@ -1,15 +1,15 @@
-CODE S=
+CODE XOR 2 chkPS,
-    SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
+    AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
-    CL [DI] CMPr[],
+CODE NOT 1 chkPS,
-    IFZ, ( same size? )
+    AX POPx, AX AX ORxx,
-        SI INCx, DI INCx, CLD, REPZ, CMPSB,
+    IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
-    THEN,
-    PUSHZ,
 ;CODE
-CODE CMP
+CODE + 2 chkPS,
-    BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
+    AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
-    IFNZ, ( < or > )
+CODE - 2 chkPS,
-        CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
+    BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
-    THEN,
+CODE * 2 chkPS,
-    CX PUSHx,
+    AX POPx, BX POPx,
+    DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
+    AX PUSHx,
 ;CODE

blk/826

@@ -1,9 +1,16 @@
-CODE _find ( cur w -- a f )
+CODE /MOD 2 chkPS,
-    SI POPx, ( w ) DI POPx, ( cur )
+    BX POPx, AX POPx, DX PUSHx, ( protect )
-    CALLn, lblfind @ RPCn,
+    DX DX XORxx, BX DIVx,
-    IFNZ, ( not found )
+    BX DX MOVxx, DX POPx, ( unprotect )
-        SI PUSHx, AX AX XORxx, AX PUSHx,
+    BX PUSHx, ( modulo ) AX PUSHx, ( division )
-        JMPn, lblnext @ RPCn,
-    THEN, ( found )
-    DI PUSHx, AX 1 MOVxI, AX PUSHx,
 ;CODE
+CODE ! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE
+CODE @ 1 chkPS, DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE
+CODE C! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE
+CODE C@ 1 chkPS,
+    DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE
+CODE I [BP] 0 PUSH[w]+, ;CODE
+CODE I' [BP] -2 PUSH[w]+, ;CODE
+CODE J [BP] -4 PUSH[w]+, ;CODE
+CODE (resSP) SP PS_ADDR MOVxI, ;CODE
+CODE (resRS) BP RS_ADDR MOVxI, ;CODE

blk/827

@@ -1,11 +1,16 @@
-CODE 0 AX AX XORxx, AX PUSHx, ;CODE
+CODE BYE BEGIN, JMPs, AGAIN, ;CODE
-CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE
+CODE S= 2 chkPS,
-CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE
+    SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
-CODE 1+ DI SP MOVxx, [DI] INC[w], ;CODE
+    CL [DI] CMPr[],
-CODE 1- DI SP MOVxx, [DI] DEC[w], ;CODE
+    IFZ, ( same size? )
-CODE 2+ DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE
+        SI INCx, DI INCx, CLD, REPZ, CMPSB,
-CODE 2- DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE
+    THEN,
-CODE RSHIFT ( n u -- n )
+    PUSHZ,
-    CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
+;CODE
-CODE LSHIFT ( n u -- n )
+CODE CMP 2 chkPS,
-    CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE
+    BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
+    IFNZ, ( < or > )
+        CX INCx, IFC, ( < ) CX DECx, CX DECx, THEN,
+    THEN,
+    CX PUSHx,
+;CODE

blk/828

@@ -0,0 +1,16 @@
+CODE _find ( cur w -- a f ) 2 chkPS,
+    SI POPx, ( w ) DI POPx, ( cur )
+    CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
+    SI INCx, ( first char ) AX AX XORxx, ( initial prev )
+    BEGIN, ( loop )
+        DI AX SUBxx, ( jump to prev wordref )
+        AL [DI] -1 MOVr[]+, 0x7f ANDALi, ( strlen )
+        CL AL CMPrr, IFZ, ( same len )
+            SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
+            3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
+            CLD, REPZ, CMPSB,
+            CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
+            IFZ, DI PUSHx, AX 1 MOVxI, AX PUSHx,
+                JMPn, lblnext @ RPCn, THEN,
+        THEN,
+    DI 3 SUBxi, AX [DI] MOVx[], ( prev ) AX AX ORxx,  ( cont. )

blk/829

@@ -0,0 +1,14 @@
+( cont. find ) JNZ, AGAIN, ( loop )
+    SI DECx, SI PUSHx, AX AX XORrr, AX PUSHx,
+;CODE
+CODE 0 AX AX XORxx, AX PUSHx, ;CODE
+CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE
+CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE
+CODE 1+ 1 chkPS, DI SP MOVxx, [DI] INC[w], ;CODE
+CODE 1- 1 chkPS, DI SP MOVxx, [DI] DEC[w], ;CODE
+CODE 2+ 1 chkPS, DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE
+CODE 2- 1 chkPS, DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE
+CODE RSHIFT ( n u -- n ) 2 chkPS,
+    CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
+CODE LSHIFT ( n u -- n ) 2 chkPS,
+    CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE

recipes/pcat/xcomp.fs

@@ -4,9 +4,9 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
 750 LOAD  ( 8086 asm )
 262 LOAD  ( xcomp )
 270 LOAD  ( xcomp overrides )
-812 827 LOADR
+812 829 LOADR
 353 LOAD  ( xcomp core low )
-CODE (emit)
+CODE (emit) 1 chkPS,
     AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
 ;CODE
 CODE (key)