pcat: implement does
This commit is contained in:
Virgil Dupras
parent
d83d12899b
commit
dcaa515929
12
blk/816
12
blk/816
@ -6,10 +6,8 @@ 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,
|
||||
DI PUSHx, ( push PFA )
|
||||
AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN,
|
||||
( does, see B302 )
|
||||
DI INCx, DI INCx, DI [DI] MOVx[],
|
||||
THEN, ( continue to compiled cont. )
|
||||
|
||||
20
blk/817
20
blk/817
@ -1,15 +1,5 @@
|
||||
lblfind BSET
|
||||
( find word the same name as str in SI starting from tip in
|
||||
DI. Returns wordref in DI. Z if found, NZ if not. )
|
||||
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[]+, ( 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, RETn, THEN,
|
||||
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,
|
||||
|
||||
5
blk/818
5
blk/818
@ -1,5 +0,0 @@
|
||||
( find cont. )
|
||||
DI 3 SUBxi, AX [DI] MOVx[], ( prev )
|
||||
AX AX ORxx,
|
||||
JNZ, AGAIN, ( loop )
|
||||
SI DECx, ( start of string, and NZ ) RETn,
|
||||
28
blk/819
28
blk/819
@ -1,13 +1,15 @@
|
||||
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,
|
||||
lblfind BSET
|
||||
( find word the same name as str in SI starting from tip in
|
||||
DI. Returns wordref in DI. Z if found, NZ if not. )
|
||||
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[]+, ( 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, RETn, THEN,
|
||||
THEN,
|
||||
|
||||
21
blk/820
21
blk/820
@ -1,16 +1,5 @@
|
||||
( 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
|
||||
( find cont. )
|
||||
DI 3 SUBxi, AX [DI] MOVx[], ( prev )
|
||||
AX AX ORxx,
|
||||
JNZ, AGAIN, ( loop )
|
||||
SI DECx, ( start of string, and NZ ) RETn,
|
||||
|
||||
29
blk/821
29
blk/821
@ -1,16 +1,13 @@
|
||||
CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;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, ;CODE
|
||||
CODE PICK
|
||||
DI POPx, DI SHLx1, ( x2 )
|
||||
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
|
||||
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,
|
||||
|
||||
26
blk/822
26
blk/822
@ -1,14 +1,16 @@
|
||||
CODE 2DROP SP 4 ADDxi, ;CODE
|
||||
CODE 2DUP
|
||||
AX POPx, BX POPx,
|
||||
BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
|
||||
( 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 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 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
|
||||
|
||||
25
blk/823
25
blk/823
@ -1,13 +1,16 @@
|
||||
CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
|
||||
CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
|
||||
CODE *
|
||||
AX POPx, BX POPx,
|
||||
DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
|
||||
AX PUSHx,
|
||||
CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;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, ;CODE
|
||||
CODE PICK
|
||||
DI POPx, DI SHLx1, ( x2 )
|
||||
DI SP ADDxx, DI [DI] MOVx[], DI 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 (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
|
||||
|
||||
25
blk/824
25
blk/824
@ -1,11 +1,14 @@
|
||||
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@
|
||||
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
|
||||
CODE 2DROP SP 4 ADDxi, ;CODE
|
||||
CODE 2DUP
|
||||
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
|
||||
|
||||
24
blk/825
24
blk/825
@ -1,15 +1,13 @@
|
||||
CODE S=
|
||||
SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
|
||||
CL [DI] CMPr[],
|
||||
IFZ, ( same size? )
|
||||
SI INCx, DI INCx, CLD, REPZ, CMPSB,
|
||||
THEN,
|
||||
PUSHZ,
|
||||
CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
|
||||
CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
|
||||
CODE *
|
||||
AX POPx, BX POPx,
|
||||
DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
|
||||
AX PUSHx,
|
||||
;CODE
|
||||
CODE CMP
|
||||
BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
|
||||
IFNZ, ( < or > )
|
||||
CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
|
||||
THEN,
|
||||
CX PUSHx,
|
||||
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
|
||||
|
||||
20
blk/826
20
blk/826
@ -1,9 +1,11 @@
|
||||
CODE _find ( cur w -- a f )
|
||||
SI POPx, ( w ) DI POPx, ( cur )
|
||||
CALLn, lblfind @ RPCn,
|
||||
IFNZ, ( not found )
|
||||
SI PUSHx, AX AX XORxx, AX PUSHx,
|
||||
JMPn, lblnext @ RPCn,
|
||||
THEN, ( found )
|
||||
DI PUSHx, AX 1 MOVxI, AX PUSHx,
|
||||
;CODE
|
||||
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@
|
||||
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
|
||||
|
||||
26
blk/827
26
blk/827
@ -1,11 +1,15 @@
|
||||
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 )
|
||||
CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
|
||||
CODE LSHIFT ( n u -- n )
|
||||
CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE
|
||||
CODE S=
|
||||
SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
|
||||
CL [DI] CMPr[],
|
||||
IFZ, ( same size? )
|
||||
SI INCx, DI INCx, CLD, REPZ, CMPSB,
|
||||
THEN,
|
||||
PUSHZ,
|
||||
;CODE
|
||||
CODE CMP
|
||||
BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
|
||||
IFNZ, ( < or > )
|
||||
CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
|
||||
THEN,
|
||||
CX PUSHx,
|
||||
;CODE
|
||||
|
||||
9
blk/828
Normal file
9
blk/828
Normal file
@ -0,0 +1,9 @@
|
||||
CODE _find ( cur w -- a f )
|
||||
SI POPx, ( w ) DI POPx, ( cur )
|
||||
CALLn, lblfind @ RPCn,
|
||||
IFNZ, ( not found )
|
||||
SI PUSHx, AX AX XORxx, AX PUSHx,
|
||||
JMPn, lblnext @ RPCn,
|
||||
THEN, ( found )
|
||||
DI PUSHx, AX 1 MOVxI, AX PUSHx,
|
||||
;CODE
|
||||
11
blk/829
Normal file
11
blk/829
Normal file
@ -0,0 +1,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 )
|
||||
CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
|
||||
CODE LSHIFT ( n u -- n )
|
||||
CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE
|
||||
@ -4,7 +4,7 @@ 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)
|
||||
AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user