pcat: implement RSP mechanism in execution model

blk/750

@@ -1 +1 @@
-1 8 LOADR+
+1 9 LOADR+

blk/753

@@ -1,6 +1,7 @@
 : OP1 CREATE C, DOES> C@ A, ;
 0xc3 OP1 RETn,       0xfa OP1 CLI,       0xfb OP1 STI,
 0xf4 OP1 HLT,        0xfc OP1 CLD,       0xfd OP1 STD,
+0x90 OP1 NOP,
 ( no argument, jumps with relative addrs are special )
 0xeb OP1 JMPs,       0xe9 OP1 JMPn,      0x74 OP1 JZ,
 0x75 OP1 JNZ,        0xe8 OP1 CALLn,

blk/755

@@ -1,16 +1,13 @@
 : OPrm CREATE C, DOES> C@ A, SWAP 3 LSHIFT OR A, ;
 0x8a OPrm MOVr[],    0x8b OPrm MOVx[],
 
+: OPmr CREATE C, DOES> C@ A, 3 LSHIFT OR A, ;
+0x88 OPmr MOV[]r,    0x89 OPmr MOV[]x,
+
 : OPrm+ ( r m off ) CREATE C, DOES>
     C@ A, ROT 3 LSHIFT ROT OR 0x40 OR A, A, ;
 0x8a OPrm+ MOVr[]+,    0x8b OPrm+ MOVx[]+,
 
-: MOVri, SWAP 0xb0 OR A, A, ;
-: MOVxI, SWAP 0xb8 OR A, A,, ;
-: MOVsx, 0x8e A, SWAP 3 LSHIFT OR 0xc0 OR A, ;
-: MOVxm, 0x8b A, SWAP 3 LSHIFT 0x6 OR A, A,, ;
-: INT, 0xcd A, A, ;
-: ADDAXI, 0x05 A, A,, ; : ADDALi, 0x04 A, A, ;
-: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ;
-: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
-: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;
+: OPm+r ( m off r ) CREATE C, DOES>
+    C@ A, 3 LSHIFT ROT OR 0x40 OR A, A, ;
+0x88 OPm+r MOV[]+r,    0x89 OPm+r MOV[]+x,

blk/756

@@ -1,16 +1,9 @@
-( 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, JRNC, FJR, ;
-: IFNC, JRC, 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! ;
+: MOVri, SWAP 0xb0 OR A, A, ;
+: MOVxI, SWAP 0xb8 OR A, A,, ;
+: MOVsx, 0x8e A, SWAP 3 LSHIFT OR 0xc0 OR A, ;
+: MOVxm, 0x8b A, SWAP 3 LSHIFT 0x6 OR A, A,, ;
+: INT, 0xcd A, A, ;
+: ADDAXI, 0x05 A, A,, ; : ADDALi, 0x04 A, A, ;
+: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ;
+: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
+: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;

blk/757

@@ -1,10 +1,16 @@
-: 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- A, ; : RPCn, PC - 2- A,, ;
-: AGAIN, ( BREAK?, ) RPCs, ;
-( Use RPCx with appropriate JMP/CALL op. Example:
-  JMPs, 0x42 RPCs, or CALLn, 0x1234 RPCn, )
+( 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, JRNC, FJR, ;
+: IFNC, JRC, 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/758

@@ -1,4 +1,10 @@
-: CODE ( same as CREATE, but with native word )
-    (entry)
-    23 C, ( 23 == nativeWord ) ;
-: ;CODE JMPn, 0x1a ( next ) RPCn, ;
+: 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- A, ; : RPCn, PC - 2- A,, ;
+: AGAIN, ( BREAK?, ) RPCs, ;
+( Use RPCx with appropriate JMP/CALL op. Example:
+  JMPs, 0x42 RPCs, or CALLn, 0x1234 RPCn, )

blk/759

@@ -0,0 +1,4 @@
+: CODE ( same as CREATE, but with native word )
+    (entry)
+    23 C, ( 23 == nativeWord ) ;
+: ;CODE JMPn, 0x1a ( next ) RPCn, ;

blk/811

@@ -3,7 +3,7 @@ JMPs, L1 FWRs ( start )
 ORG @ 0x25 + HERE ! ( bypass BPB )
 L1 FSET ( start )
 CLI, CLD, AX 0x800 MOVxI, DS AX MOVsx, ES AX MOVsx,
-SS AX MOVsx, SP 0xffff MOVxI, STI,
+SS AX MOVsx, STI,
 AH 2 MOVri, DX 0 MOVxI, CH 0 MOVri, CL 2 MOVri, AL 1 MOVri,
 BX 0 MOVxI, 0x13 INT, ( read 2nd sector of boot floppy )
 0x800 0 JMPf,

blk/813

@@ -6,9 +6,10 @@
 4 A,
 H@ XCURRENT !        ( set current tip of dict, 0x42 )
     0x17 A,          ( nativeWord )
+    DX [BP] 0 MOVx[]+, BP DECx, BP DECx, ( popRS )
 ;CODE
 CODE BYE BEGIN, JMPs, AGAIN, ;CODE
 CODE FOO
     AH 0x0e MOVri, ( print char ) AL 'X' MOVri, 0x10 INT,
 ;CODE
-: BAR FOO FOO BYE ;
+: BAR FOO FOO ; : BAZ BAR FOO BYE ;

blk/814

@@ -8,6 +8,7 @@ L1 BSET PC 0x36 - ORG @ 0x34 + ! ( execute -- DI -> wordref )
     AX JMPr,
 
 PC 0x11 - ORG @ 0x0f + ! ( compiledWord -- DI -> PFA )
+    BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
     DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
     DI [DI] MOVx[],
     JMPs, L1 @ RPCs,

blk/817

@@ -1,5 +1,7 @@
-L3 BSET 3 A, 'B' A, 'A' A, 'R' A,
+L3 BSET 3 A, 'B' A, 'A' A, 'Z' A,
 PC 3 - ORG @ 1+ ! ( main )
+    SP PS_ADDR MOVxI,
+    BP RS_ADDR MOVxI,
     DI 0x08 MOVxm, ( LATEST )
     SI L3 @ MOVxI,
     CALLn, L4 @ RPCn, ( find )

recipes/pcat/xcomp.fs

@@ -1,3 +1,5 @@
+0xff00 CONSTANT RS_ADDR
+0xfffa CONSTANT PS_ADDR
 750 LOAD  ( 8086 asm )
 262 LOAD  ( xcomp )
 270 LOAD  ( xcomp overrides )