pcat: implement cell execution and shaping things up

I always keep it on myself. I can imagine it's especially useful to
newcomers.

blk/754

@@ -4,7 +4,7 @@
 1 0xd0 OPr0 RORr1,   1 0xd1 OPr0 RORx1,  4 0xf7 OPr0 MULx,
 4 0xd0 OPr0 SHLr1,   4 0xd1 OPr0 SHLx1,  6 0xf6 OPr0 DIVr,
 5 0xd0 OPr0 SHRr1,   5 0xd1 OPr0 SHRx1,  6 0xf7 OPr0 DIVx,
-0 0xd2 OPr0 ROLrCL,  0 0xd3 OPr0 ROLxCL,
+0 0xd2 OPr0 ROLrCL,  0 0xd3 OPr0 ROLxCL, 1 0xfe OPr0 DECr,
-1 0xd2 OPr0 RORrCL,  1 0xd3 OPr0 RORxCL,
+1 0xd2 OPr0 RORrCL,  1 0xd3 OPr0 RORxCL, 0 0xfe OPr0 INCr,
 4 0xd2 OPr0 SHLrCL,  4 0xd3 OPr0 SHLxCL,
 5 0xd2 OPr0 SHRrCL,  5 0xd3 OPr0 SHRxCL,

blk/760

@@ -4,7 +4,8 @@
 : BREAK?, DUP 0x8000 AND IF
         0x7fff AND 1 ALLOT THEN, -1 ALLOT
     THEN ; )
-: RPCs, PC - 1- A, ; : RPCn, PC - 2- A,, ;
+: 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/816

@@ -5,9 +5,10 @@ lblnext BSET PC 0x1d - ORG @ 0x1b + ! ( next )
 lblexec BSET PC 0x36 - ORG @ 0x34 + ! ( DI -> wordref )
     AL [DI] MOVr[], DI INCx, ( PFA )
     AL AL ORrr, IFZ, DI JMPr, THEN, ( native )
-    ( continue to compiled )
+    AL DECr, IFNZ, ( cell or does )
-
+        DI PUSHx, ( push PFA ) JMPs, lblnext @ RPCs,
-PC 0x11 - ORG @ 0x0f + ! ( compiled -- DI -> PFA )
+        ( 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[],

blk/820

@@ -1,6 +1,6 @@
 ( native words )
 CODE EXECUTE
-    DI POPx, JMPs, lblexec @ RPCs,
+    DI POPx, JMPn, lblexec @ RPCn,
 CODE >R
     BP INCx, BP INCx, [BP] 0 POP[w]+,
 ;CODE NOP, NOP, NOP,

blk/821

@@ -1,10 +1,10 @@
 CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;CODE
-CODE ?DUP AX POPx, AX AX ORxx, IFNZ, AX PUSHx, THEN, ;CODE
+CODE ?DUP AX POPx, AX AX ORxx, AX PUSHx,
+    IFNZ, AX PUSHx, THEN, ;CODE
 CODE DROP AX POPx, ;CODE
 CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
 CODE OVER ( a b -- a b a )
-    DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx,
+    DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
-;CODE
 CODE PICK
     DI POPx, DI SHLx1, ( x2 )
     DI SP ADDxx, DI [DI] MOVx[], DI PUSHx,

blk/828

@@ -1,5 +0,0 @@
-CODE EMIT
-    AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
-;CODE
-: FOO '0' 1 3 LSHIFT + EMIT ;
-: BOOT 0x08 @ LIT< FOO _find DROP EXECUTE BYE ;

emul/stage.c

@@ -42,8 +42,8 @@ static uint8_t iord_stdio()
 
 static void iowr_stdio(uint8_t val)
 {
-    // uncomment when you need to debug staging
+    // comment if you don't like verbose staging output 
-    // putc(val, stderr);
+    putc(val, stderr);
 }
 
 static void iowr_here(uint8_t val)

recipes/pcat/xcomp.fs

@@ -4,7 +4,14 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
 750 LOAD  ( 8086 asm )
 262 LOAD  ( xcomp )
 270 LOAD  ( xcomp overrides )
-812 828 LOADR
+812 827 LOADR
+353 LOAD  ( xcomp core low )
+CODE (emit)
+    AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
+;CODE
+CODE (key) AH AH XORrr, 0x16 INT, AX PUSHx, ;CODE
+: FOO (key) (emit) ;
+: BOOT 0x08 @ LIT< FOO _find DROP EXECUTE BYE ;
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !