diff --git a/blk/750 b/blk/750 index 2bb238b..dcc3342 100644 --- a/blk/750 +++ b/blk/750 @@ -1 +1 @@ -1 7 LOADR+ +1 8 LOADR+ diff --git a/blk/753 b/blk/753 index a1f8dbb..94799f1 100644 --- a/blk/753 +++ b/blk/753 @@ -1,9 +1,13 @@ : OP1 CREATE C, DOES> C@ A, ; -0xac OP1 LODSB, 0xfa OP1 CLI, 0xfb OP1 STI, +0xc3 OP1 RETn, 0xfa OP1 CLI, 0xfb OP1 STI, 0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD, ( no argument, jumps with relative addrs are special ) 0xeb OP1 JMPs, 0xe9 OP1 JMPn, 0x74 OP1 JZ, - 0xe8 OP1 CALLn, +0x75 OP1 JNZ, 0xe8 OP1 CALLn, +0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB, +0xa6 OP1 CMPSB, 0xa4 OP1 MOVSB, 0xae OP1 SCASB, +0xaa OP1 STOSB, -: OPrr CREATE C, DOES> C@ A, 3 LSHIFT OR 0xc0 OR A, ; -0x31 OPrr XORxx, 0x30 OPrr XORrr, 0x08 OPrr ORrr, +: OP1r CREATE C, DOES> C@ + A, ; +0x40 OP1r INCx, 0x48 OP1r DECx, +0x58 OP1r POPx, 0x50 OP1r PUSHx, diff --git a/blk/754 b/blk/754 index 868b3d6..e9ab06f 100644 --- a/blk/754 +++ b/blk/754 @@ -1,9 +1,5 @@ -: 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,, ; +: OPrr CREATE C, DOES> C@ A, 3 LSHIFT OR 0xc0 OR A, ; +0x31 OPrr XORxx, 0x30 OPrr XORrr, +0x88 OPrr MOVrr, 0x89 OPrr MOVxx, 0x28 OPrr SUBrr, +0x29 OPrr SUBxx, 0x08 OPrr ORrr, 0x09 OPrr ORxx, +0x3a OPrr CMPrr, 0x3b OPrr CMPxx, diff --git a/blk/755 b/blk/755 index 2b55b99..ce9ea5a 100644 --- a/blk/755 +++ b/blk/755 @@ -1,16 +1,11 @@ -( 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! ; +: OPrm CREATE C, DOES> C@ A, SWAP 3 LSHIFT OR A, ; +0x8a OPrm MOVr[], 0x8b OPrm MOVx[], + +: 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, ; +: ADDAXi, 0x05 A, A,, ; : ADDALi, 0x04 A, A, ; +: JMPr, 0xff A, 7 AND 0xe0 OR A, ; +: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ; diff --git a/blk/756 b/blk/756 index ba1f378..3ff2e8b 100644 --- a/blk/756 +++ b/blk/756 @@ -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, JNZ, FJR, ; +: IFNZ, JZ, 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! ; diff --git a/blk/757 b/blk/757 index fbe8fcb..ba1f378 100644 --- a/blk/757 +++ b/blk/757 @@ -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, ) diff --git a/blk/758 b/blk/758 new file mode 100644 index 0000000..fbe8fcb --- /dev/null +++ b/blk/758 @@ -0,0 +1,4 @@ +: CODE ( same as CREATE, but with native word ) + (entry) + 23 C, ( 23 == nativeWord ) ; +: ;CODE ; diff --git a/blk/813 b/blk/813 index c129c79..eab0231 100644 --- a/blk/813 +++ b/blk/813 @@ -8,8 +8,6 @@ H@ XCURRENT ! ( set current tip of dict, 0x42 ) 0x17 A, ( nativeWord ) ;CODE CODE FOO -( Update LATEST, temporarily hackish ) -PC 1- ORG @ 8 + ! AH 0x0e MOVri, ( print char ) AL 'X' MOVri, 0x10 INT, L2 BSET JMPs, L2 @ RPCs, ;CODE diff --git a/blk/814 b/blk/814 index b8acee3..49b30b6 100644 --- a/blk/814 +++ b/blk/814 @@ -3,6 +3,3 @@ L1 BSET PC 3 - ORG @ 0x34 + ! ( execute -- BX -> wordref ) AL [BX] MOVr[], BX INCx, ( PFA ) AX JMPr, - -PC 3 - ORG @ 1+ ! ( main ) - BX 0x08 MOVxm, ( LATEST ) JMPs, L1 @ RPCs, ( execute ) diff --git a/blk/815 b/blk/815 new file mode 100644 index 0000000..6c0b7e7 --- /dev/null +++ b/blk/815 @@ -0,0 +1,14 @@ +L4 BSET PC 3 - ORG @ 4 + ! ( find ) +( find word the same name as str in SI starting from tip in + BX. Returns wordref in BX. Z if found, NZ if not. ) + CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen ) + SI INCx, + AX AX XORxx, ( initial prev ) + BEGIN, ( inner ) + BX AX SUBxx, ( jump to prev wordref ) + BX DECx, AL [BX] MOVr[], ( strlen ) + CL AL CMPrr, IFZ, BX INCx, RETn, THEN, + BX DECx, BX DECx, AX [BX] MOVx[], ( prev ) + AX AX ORxx, + JNZ, AGAIN, + BEGIN, JMPs, AGAIN, diff --git a/blk/816 b/blk/816 new file mode 100644 index 0000000..fd812e5 --- /dev/null +++ b/blk/816 @@ -0,0 +1,6 @@ +L3 BSET 3 A, 'F' A, 'O' A, 'O' A, +PC 3 - ORG @ 1+ ! ( main ) + BX 0x08 MOVxm, ( LATEST ) + SI L3 @ MOVxi, + CALLn, L4 @ RPCn, ( find ) + JMPs, L1 @ RPCs, ( execute ) diff --git a/recipes/pcat/xcomp.fs b/recipes/pcat/xcomp.fs index b83a675..0eb7708 100644 --- a/recipes/pcat/xcomp.fs +++ b/recipes/pcat/xcomp.fs @@ -1,6 +1,9 @@ 750 LOAD ( 8086 asm ) 262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides ) -812 814 LOADR +812 816 LOADR +(entry) _ +( Update LATEST ) +PC ORG @ 8 + ! ORG @ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!