1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-25 04:48:06 +11:00

pcat: implement execute and nativeWord

This commit is contained in:
Virgil Dupras 2020-06-14 15:27:26 -04:00
parent bf0e999f8e
commit 3be30e24bb
10 changed files with 53 additions and 43 deletions

View File

@ -1 +1 @@
1 6 LOADR+
1 7 LOADR+

View File

@ -6,3 +6,5 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
: AX 0 ; : CX 1 ; : DX 2 ; : BX 3 ;
: SP 4 ; : BP 5 ; : SI 6 ; : DI 7 ;
: ES 0 ; : CS 1 ; : SS 2 ; : DS 3 ;
: [BX+SI] 0 ; : [BX+DI] 1 ; : [BP+SI] 2 ; : [BP+DI] 3 ;
: [SI] 4 ; : [DI] 5 ; : [BP] 6 ; : [BX] 7 ;

10
blk/753
View File

@ -4,12 +4,6 @@
( no argument, jumps with relative addrs are special )
0xeb OP1 JMPs, 0xe9 OP1 JMPn, 0x74 OP1 JZ,
0xe8 OP1 CALLn,
: 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, ;
: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;
: OPrr CREATE C, DOES> C@ A, 3 LSHIFT OR 0xc0 OR A, ;
0x31 OPrr XORxx, 0x08 OPrr ORrr,
0x31 OPrr XORxx, 0x30 OPrr XORrr, 0x08 OPrr ORrr,

25
blk/754
View File

@ -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, JRNZ, FJR, ;
: IFNZ, JRZ, 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,, ;
: MOVr[], 0x8a A, SWAP 3 LSHIFT OR A, ;
: INCx, 0x40 OR A, ;
: INT, 0xcd A, A, ;
: JMPr, 0xff A, 7 AND 0xe0 OR A, ;
: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ;

26
blk/755
View File

@ -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, JRNZ, FJR, ;
: IFNZ, JRZ, 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! ;

14
blk/756
View File

@ -1,4 +1,10 @@
: CODE ( same as CREATE, but with native word )
(entry)
23 C, ( 23 == nativeWord ) ;
: ;CODE ;
: 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, )

4
blk/757 Normal file
View File

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

View File

@ -5,7 +5,7 @@ JMPn, 0 A,, ( 00, main ) JMPn, 0 A,, ( 03, find )
0 A, ( 0a, unused ) JMPn, 0 A,, ( 0b, cellWord )
JMPn, 0 A,, ( 0e compiledWord ) JMPn, 0 A,, ( 11, pushRS )
JMPn, 0 A,, ( 14, popRS )
JMPn, 0 A,, ( 17, nativeWord )
BX JMPr, ( 17, nativeWord ) 0 A,
JMPn, 0 A,, ( 1a, next ) JMPn, 0 A,, ( 1d, unused )
0 A, 0 A, ( 20, numberWord ) 0 A, 0 A, ( 22, litWord )
0 A, 0 A, ( 24, addrWord ) 0 A, 0 A, ( 26, unused )

View File

@ -6,7 +6,7 @@
4 A,
H@ XCURRENT ! ( set current tip of dict, 0x42 )
0x17 A, ( nativeWord )
HLT,
;CODE
CODE FOO
( Update LATEST, temporarily hackish )
PC 1- ORG @ 8 + !

View File

@ -1,3 +1,8 @@
PC 3 - ORG @ 1+ ! ( main )
AX 0x08 MOVxm, ( LATEST )
L1 BSET PC 3 - ORG @ 0x34 + ! ( execute -- BX -> wordref )
AH AH XORrr,
AL [BX] MOVr[],
BX INCx, ( PFA )
AX JMPr,
PC 3 - ORG @ 1+ ! ( main )
BX 0x08 MOVxm, ( LATEST ) JMPs, L1 @ RPCs, ( execute )