pcat: implement (loop)

8086 asm is a lot terser than z80... Those indirect memory operations
are very handy.

blk/754

@@ -4,3 +4,13 @@
 0x29 OPrr SUBxx,     0x08 OPrr ORrr,     0x09 OPrr ORxx,
 0x3a OPrr CMPrr,     0x3b OPrr CMPxx,    0x00 OPrr ADDrr,
 0x01 OPrr ADDxx,
+
+: OPm ( modrm op ) CREATE C, C, DOES> C@+ A, C@ OR A, ;
+0 0xff OPm INC[w], 0 0xfe OPm INC[b],
+0x8 0xff OPm DEC[w], 0x8 0xfe OPm DEC[b],
+0x30 0xff OPm PUSH[w], 0 0x8f OPm POP[w],
+: OPm+ ( modrm op ) CREATE C, C, DOES>
+    ( m off ) C@+ A, C@ ROT OR A, A, ;
+0x40 0xff OPm+ INC[w]+, 0x40 0xfe OPm+ INC[b]+,
+0x48 0xff OPm+ DEC[w]+, 0x48 0xfe OPm+ DEC[b]+,
+0x70 0xff OPm+ PUSH[w]+, 0x40 0x8f OPm+ POP[w]+,

blk/755

@@ -7,6 +7,7 @@
 : OPrm+ ( r m off ) CREATE C, DOES>
     C@ A, ROT 3 LSHIFT ROT OR 0x40 OR A, A, ;
 0x8a OPrm+ MOVr[]+,    0x8b OPrm+ MOVx[]+,
+0x3a OPrm+ CMPr[]+,    0x3b OPrm+ CMPx[]+,
 
 : OPm+r ( m off r ) CREATE C, DOES>
     C@ A, 3 LSHIFT ROT OR 0x40 OR A, A, ;

blk/756

@@ -5,5 +5,6 @@
 : INT, 0xcd A, A, ;
 : 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/813

@@ -12,5 +12,5 @@ CODE (br) ( 0x53 ) L2 BSET ( used in br? )
 CODE (br?) ( 0x67 )
     AX POPx, AX AX ORxx, JZ, L2 @ RPCs, ( False, branch )
     ( True, skip next 2 bytes and don't branch )
-    DX INCx, DX INCx,
+    L1 BSET ( loop will jump here ) DX INCx, DX INCx,
-;CODE
+;CODE NOP, NOP, NOP, NOP, NOP,

blk/814

@@ -1,5 +1,15 @@
-ORG @ 0xb9 + HERE !
+CODE (loop) ( 0x80 )
+    [BP] 0 INC[w]+, ( I++ )
+    ( Jump if I <> I' )
+    AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+,
+    JNZ, L2 @ RPCs, ( branch )
+    ( don't branch )
+    BP 4 SUBxi, JMPs, L1 @ RPCs,
+ORG @ 0xa3 + HERE !
+CODE 2>R ( 0xa9 )
+    [BP] 4 POP[w]+, [BP] 2 POP[w]+, BP 4 ADDxi,
+;CODE NOP, NOP, NOP, NOP, NOP,
 CODE (n) ( 0xbf, number literal )
     DI DX MOVxx, DI [DI] MOVx[], DI PUSHx,
     DX INCx, DX INCx,
-;CODE
+;CODE ( END OF STABLE ABI )

blk/815

@@ -1,14 +1,10 @@
-PC 0x1d - ORG @ 0x1b + ! ( next )
+CODE >R
-    DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx,
+    BP INCx, BP INCx, [BP] 0 POP[w]+,
-    DI [DI] MOVx[], ( wordref )
+;CODE NOP, NOP, NOP,
-    ( continue to execute )
+CODE R>
-L1 BSET PC 0x36 - ORG @ 0x34 + ! ( execute -- DI -> wordref )
+    [BP] 0 PUSH[w]+, BP DECx, BP DECx,
-    AL [DI] MOVr[], DI INCx, ( PFA )
+;CODE
-    AL AL ORrr, IFZ, DI JMPr, THEN, ( native )
+CODE 2R>
-    ( continue to compiled )
+    [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
-
+;CODE
-PC 0x11 - ORG @ 0x0f + ! ( compiled -- DI -> PFA )
+CODE I [BP] 0 PUSH[w]+, ;CODE
-    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/816

@@ -1,16 +1,14 @@
-L4 BSET PC 3 - ORG @ 4 + ! ( find )
+PC 0x1d - ORG @ 0x1b + ! ( next )
-( find word the same name as str in SI starting from tip in
+    DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx,
-  DI. Returns wordref in DI. Z if found, NZ if not. )
+    DI [DI] MOVx[], ( wordref )
-    CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
+    ( continue to execute )
-    SI INCx, ( first char ) AX AX XORxx, ( initial prev )
+L1 BSET PC 0x36 - ORG @ 0x34 + ! ( execute -- DI -> wordref )
-    BEGIN, ( loop )
+    AL [DI] MOVr[], DI INCx, ( PFA )
-        DI AX SUBxx, ( jump to prev wordref )
+    AL AL ORrr, IFZ, DI JMPr, THEN, ( native )
-        AL [DI] -1 MOVr[]+, ( strlen )
+    ( continue to compiled )
-        CL AL CMPrr, IFZ, ( same len )
+
-            SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
+PC 0x11 - ORG @ 0x0f + ! ( compiled -- DI -> PFA )
-            3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
+    BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
-            REPZ, CMPSB,
+    DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
-            CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
+    DI [DI] MOVx[],
-            IFZ, AL AL XORrr, ( Z ) RETn, THEN,
+    JMPs, L1 @ RPCs,
-        THEN,
-                                                      ( cont. )

blk/817

@@ -1,6 +1,16 @@
-( find cont. )
+L4 BSET PC 3 - ORG @ 4 + ! ( find )
-        DI 3 SUBxi, AX [DI] MOVx[], ( prev )
+( find word the same name as str in SI starting from tip in
-        AX AX ORxx,
+  DI. Returns wordref in DI. Z if found, NZ if not. )
-    JNZ, AGAIN, ( loop )
+    CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
-    AX INCx, ( NZ ) RETn,
+    SI INCx, ( first char ) AX AX XORxx, ( initial prev )
-
+    BEGIN, ( loop )
+        DI AX SUBxx, ( jump to prev wordref )
+        AL [DI] -1 MOVr[]+, ( strlen )
+        CL AL CMPrr, IFZ, ( same len )
+            SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
+            3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
+            REPZ, CMPSB,
+            CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
+            IFZ, AL AL XORrr, ( Z ) RETn, THEN,
+        THEN,
+                                                      ( cont. )

blk/818

@@ -1,15 +1,5 @@
-CODE BYE BEGIN, JMPs, AGAIN, ;CODE
+( find cont. )
-CODE EMIT
+        DI 3 SUBxi, AX [DI] MOVx[], ( prev )
-    AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
+        AX AX ORxx,
-;CODE CODE 0 AX AX XORxx, AX PUSHx, ;CODE
+    JNZ, AGAIN, ( loop )
-: FOO 'F' EMIT ; : BAR 0 IF FOO THEN FOO BYE ;
+    AX INCx, ( NZ ) RETn,
-L3 BSET 3 A, 'B' A, 'A' A, 'R' 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 )
-    IFZ, JMPn, L1 @ RPCn, ( execute ) THEN,
-    AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
-    BEGIN, JMPs, AGAIN,

blk/819

@@ -0,0 +1,15 @@
+CODE BYE BEGIN, JMPs, AGAIN, ;CODE
+CODE EMIT
+    AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
+;CODE CODE 0 AX AX XORxx, AX PUSHx, ;CODE
+: BAR '[' 'A' DO I EMIT LOOP BYE ;
+L3 BSET 3 A, 'B' A, 'A' A, 'R' 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 )
+    IFZ, JMPn, L1 @ RPCn, ( execute ) THEN,
+    AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
+    BEGIN, JMPs, AGAIN,

recipes/pcat/xcomp.fs

@@ -3,7 +3,7 @@
 750 LOAD  ( 8086 asm )
 262 LOAD  ( xcomp )
 270 LOAD  ( xcomp overrides )
-812 818 LOADR
+812 819 LOADR
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !