From cd514e6cd64141738b93b6f5079bd5d92c51a068 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 21 Jun 2020 14:07:02 -0400
Subject: [PATCH] pcat: add PSP checks in all native words

Also, fix (roll) which wasn't properly implemented.
---
 blk/758               |  4 ++--
 blk/763               |  3 +++
 blk/810               | 11 ++++++++++-
 blk/812               |  4 ++--
 blk/817               |  6 ++++++
 blk/822               |  8 ++++----
 blk/823               | 14 +++++---------
 blk/824               | 20 +++++++++++---------
 blk/825               | 20 +++++++++++---------
 blk/826               | 15 ++++++++++-----
 blk/827               |  5 +++--
 blk/828               |  2 +-
 blk/829               | 12 ++++++------
 recipes/pcat/xcomp.fs |  2 +-
 14 files changed, 75 insertions(+), 51 deletions(-)

diff --git a/blk/758 b/blk/758
index 471e17a..a73c6b4 100644
--- a/blk/758
+++ b/blk/758
@@ -1,6 +1,6 @@
 : OPi CREATE C, DOES> C@ A, A, ;
-0x04 OPi ADDALi,     0x24 OPi ANDALi,
+0x04 OPi ADDALi,     0x24 OPi ANDALi,    0x2c OPi SUBALi,
 0xcd OPi INT,
 : OPI CREATE C, DOES> C@ A, A,, ;
-0x05 OPI ADDAXI,     0x25 OPI ANDAXI,
+0x05 OPI ADDAXI,     0x25 OPI ANDAXI,    0x2d OPI SUBAXI,
 
diff --git a/blk/763 b/blk/763
index bedee06..4db01db 100644
--- a/blk/763
+++ b/blk/763
@@ -2,3 +2,6 @@
 : 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, ;
diff --git a/blk/810 b/blk/810
index 4d4fd45..bf0cc9b 100644
--- a/blk/810
+++ b/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
diff --git a/blk/812 b/blk/812
index c776e95..6b95b08 100644
--- a/blk/812
+++ b/blk/812
@@ -1,7 +1,7 @@
 VARIABLE lblexec VARIABLE lblnext
 H@ ORG !
-JMPn, 0 A,,   ( 00, main )     0 A, 0 A,, ( unused )
-0 A,, ( unused ) 0 A,, ( 08, LATEST )
+JMPn, 0 A,, ( 00, main ) 0 A, ( unused ) 0 A,, ( 04, BOOT )
+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 )
diff --git a/blk/817 b/blk/817
index 12ddb8a..c2ee308 100644
--- a/blk/817
+++ b/blk/817
@@ -3,3 +3,9 @@
     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 SUBxx,
+    IFNC, ( we're good ) RETn, THEN,
+    ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs,
diff --git a/blk/822 b/blk/822
index 27b5252..4bda302 100644
--- a/blk/822
+++ b/blk/822
@@ -1,16 +1,16 @@
 ( native words )
-CODE EXECUTE
+CODE EXECUTE 1 chkPS,
     DI POPx, JMPn, lblexec @ RPCn,
-CODE >R
+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 2R>
+CODE 2R> 2 chkPS,
     [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
 ;CODE
-CODE ROT ( a b c -- b c a )
+CODE ROT ( a b c -- b c a ) 3 chkPS,
     CX POPx, BX POPx, AX POPx,
     BX PUSHx, CX PUSHx, AX PUSHx,
 ;CODE
diff --git a/blk/823 b/blk/823
index 8286d32..211ed6e 100644
--- a/blk/823
+++ b/blk/823
@@ -1,16 +1,12 @@
-CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;CODE
-CODE ?DUP AX POPx, AX AX ORxx, AX PUSHx,
+CODE DUP 1 chkPS, AX POPx, AX PUSHx, AX PUSHx, ;CODE
+CODE ?DUP 1 chkPS, AX POPx, AX AX ORxx, AX PUSHx,
     IFNZ, AX PUSHx, THEN, ;CODE
-CODE DROP AX POPx, ;CODE
+CODE DROP 1 chkPS, AX POPx, ;CODE
 CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
-CODE OVER ( a b -- a b a )
+CODE OVER ( a b -- a b a ) 2 chkPS,
     DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
 CODE PICK
     DI POPx, DI SHLx1, ( x2 )
+    CX DI MOVxx, CX 2 ADDxi, CALLn, lblchkPS @ RPCn,
     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
diff --git a/blk/824 b/blk/824
index bbc2688..aeb770f 100644
--- a/blk/824
+++ b/blk/824
@@ -1,14 +1,16 @@
-CODE 2DROP SP 4 ADDxi, ;CODE
-CODE 2DUP
+CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
+    CX POPx, CX 2 ADDxi, CALLn, lblchkPS @ RPCn, CX 2 SUBxi,
+    SI SP MOVxx, SI CX ADDxx,
+    DI SI MOVxx, DI 2 ADDxi, STD, REPZ, MOVSB,
+;CODE
+CODE 2DROP 2 chkPS, SP 4 ADDxi, ;CODE
+CODE 2DUP 2 chkPS,
     AX POPx, BX POPx,
     BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
 ;CODE
 CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
 CODE 'S SP PUSHx, ;CODE
-CODE AND AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
-CODE OR AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
-CODE XOR AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
-CODE NOT
-    AX POPx, AX AX ORxx,
-    IFNZ, AX -1 MOVxI, THEN, AX INCx, AX 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
diff --git a/blk/825 b/blk/825
index 7a043f0..6f7a0d6 100644
--- a/blk/825
+++ b/blk/825
@@ -1,13 +1,15 @@
-CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
-CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
-CODE *
+CODE XOR 2 chkPS,
+    AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
+CODE NOT 1 chkPS,
+    AX POPx, AX AX ORxx,
+    IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
+;CODE
+CODE + 2 chkPS,
+    AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
+CODE - 2 chkPS,
+    BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
+CODE * 2 chkPS,
     AX POPx, BX POPx,
     DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
     AX PUSHx,
 ;CODE
-CODE /MOD
-    BX POPx, AX POPx, DX PUSHx, ( protect )
-    DX DX XORxx, BX DIVx,
-    BX DX MOVxx, DX POPx, ( unprotect )
-    BX PUSHx, ( modulo ) AX PUSHx, ( division )
-;CODE
diff --git a/blk/826 b/blk/826
index f20a463..3ddea8b 100644
--- a/blk/826
+++ b/blk/826
@@ -1,11 +1,16 @@
-CODE ! DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE
-CODE @ DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE
-CODE C! DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE
-CODE C@
+CODE /MOD 2 chkPS,
+    BX POPx, AX POPx, DX PUSHx, ( protect )
+    DX DX XORxx, BX DIVx,
+    BX DX MOVxx, DX POPx, ( unprotect )
+    BX PUSHx, ( modulo ) AX PUSHx, ( division )
+;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
-CODE BYE BEGIN, JMPs, AGAIN, ;CODE
diff --git a/blk/827 b/blk/827
index d08a9cb..6fb5f55 100644
--- a/blk/827
+++ b/blk/827
@@ -1,4 +1,5 @@
-CODE S=
+CODE BYE BEGIN, JMPs, AGAIN, ;CODE
+CODE S= 2 chkPS,
     SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
     CL [DI] CMPr[],
     IFZ, ( same size? )
@@ -6,7 +7,7 @@ CODE S=
     THEN,
     PUSHZ,
 ;CODE
-CODE CMP
+CODE CMP 2 chkPS,
     BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
     IFNZ, ( < or > )
         CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
diff --git a/blk/828 b/blk/828
index fa89bf0..069e7a1 100644
--- a/blk/828
+++ b/blk/828
@@ -1,4 +1,4 @@
-CODE _find ( cur w -- a f )
+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 )
diff --git a/blk/829 b/blk/829
index 79f9251..f7ce66c 100644
--- a/blk/829
+++ b/blk/829
@@ -4,11 +4,11 @@
 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+ DI SP MOVxx, [DI] INC[w], ;CODE
-CODE 1- DI SP MOVxx, [DI] DEC[w], ;CODE
-CODE 2+ DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE
-CODE 2- DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE
-CODE RSHIFT ( n u -- n )
+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 )
+CODE LSHIFT ( n u -- n ) 2 chkPS,
     CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE
diff --git a/recipes/pcat/xcomp.fs b/recipes/pcat/xcomp.fs
index 855ed78..4a6bf9b 100644
--- a/recipes/pcat/xcomp.fs
+++ b/recipes/pcat/xcomp.fs
@@ -6,7 +6,7 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
 270 LOAD  ( xcomp overrides )
 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)