2104 lines
84 KiB
Forth
2104 lines
84 KiB
Forth
( 486 AND PENTIUM ASSEMBLER FOR WINDOWS 32BIT FORTH, VERSION 1.26 )
|
|
( COPYRIGHT [C] 1994, 1995, BY JIM SCHNEIDER )
|
|
|
|
( THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY )
|
|
( IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS PUBLISHED BY )
|
|
( THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE LICENSE, OR )
|
|
( <AT YOUR OPTION> ANY LATER VERSION. )
|
|
( )
|
|
( THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, )
|
|
( BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF )
|
|
( MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE )
|
|
( GNU GENERAL PUBLIC LICENSE FOR MORE DETAILS. )
|
|
( )
|
|
( YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE )
|
|
( ALONG WITH THIS PROGRAM; IF NOT, WRITE TO THE FREE SOFTWARE )
|
|
( FOUNDATION, INC., 675 MASS AVE, CAMBRIDGE, MA 02139, USA. )
|
|
|
|
( DECLARE THE VOCABULARIES NEEDED )
|
|
ONLY FORTH DEFINITIONS ( VOCABULARY ASSEMBLER ) ALSO ASSEMBLER DEFINITIONS
|
|
VOCABULARY ASM-HIDDEN ALSO ASM-HIDDEN DEFINITIONS ALSO ASSEMBLER
|
|
( THE ALSO ASSEMBLER IS STRICTLY TO TURN OFF STACK WARNINGS )
|
|
|
|
( WORDS TO MANIPULATE THE VOCABULARY SEARCH ORDER )
|
|
: IN-ASM ( ALL LATER WORDS ARE DEFINED IN THE ASSEMBLER VOCABULARY )
|
|
ONLY FORTH ALSO ASM-HIDDEN ALSO ASSEMBLER DEFINITIONS ;
|
|
: IN-HIDDEN ( ALL LATER WORDS ARE DEFINED IN THE HIDDEN VOCABULARY )
|
|
ONLY FORTH ALSO ASM-HIDDEN DEFINITIONS ALSO ASSEMBLER ;
|
|
: IN-FORTH ( ALL LATER WORDS ARE DEFINED IN THE FORTH VOCABULARY )
|
|
ONLY FORTH DEFINITIONS ALSO ASM-HIDDEN ALSO ASSEMBLER ;
|
|
IN-HIDDEN
|
|
|
|
( MISCELLANEOUS HOUSEKEEPING )
|
|
BASE @ DECIMAL ( SAVE THE BASE BECAUSE I HATE GRATUITOUS BASE BASHING )
|
|
: CELL- [ 1 CELLS ] LITERAL - ;
|
|
: CELL/ [ 1 CELLS ] LITERAL / ;
|
|
: 8* 8 * ;
|
|
: 8/ 8 / ;
|
|
: 8+ 8 + ;
|
|
: 8- 8 - ;
|
|
: 4+ 4 + ;
|
|
: 2+ 2 + ;
|
|
: 2- 2 - ;
|
|
: 8*+ 8* + ;
|
|
: 16*+ 16 * + ;
|
|
: 16/MOD 16 /MOD ;
|
|
HEX
|
|
: C0-8* 0C0 - 8* ;
|
|
: C0+ 0C0 + ;
|
|
: C0- 0C0 - ;
|
|
|
|
( DEFER SOME WORDS FOR EASE IN PORTING TO A CROSS ASSEMBLER )
|
|
DEFER CODE-C, ' C, IS CODE-C, ( X -- )
|
|
DEFER CODE-W, ' W, IS CODE-W, ( X -- )
|
|
DEFER CODE-D, ' , IS CODE-D, ( X -- )
|
|
DEFER DATA-, ' , IS DATA-, ( X -- )
|
|
DEFER CODE-C! ' C! IS CODE-C! ( X \ A -- )
|
|
DEFER CODE-W! ' W! IS CODE-W! ( X \ A -- )
|
|
DEFER CODE-D! ' ! IS CODE-D! ( X \ A -- )
|
|
DEFER DATA-! ' ! IS DATA-! ( X \ A -- )
|
|
DEFER DATA-+! ' +! IS DATA-+! ( X \ A -- )
|
|
DEFER CODE-C@ ' C@ IS CODE-C@ ( A -- X )
|
|
DEFER CODE-W@ ' W@ IS CODE-W@ ( A -- X )
|
|
DEFER CODE-D@ ' @ IS CODE-D@ ( A -- X )
|
|
DEFER DATA-@ ' @ IS DATA-@ ( A -- X )
|
|
DEFER DATA-HERE ' HERE IS DATA-HERE ( -- A )
|
|
DEFER CODE-HERE ' HERE IS CODE-HERE ( -- A )
|
|
DEFER CODE-ALIGN ' ALIGN IS CODE-ALIGN ( -- )
|
|
DEFER CODE-HEADER ' HEADER IS CODE-HEADER ( -- )
|
|
|
|
( REGISTER OUT OF SCOPE FORWARD REFERENCES, FOR USE BY A CROSS-COMPILER )
|
|
DEFER REGISTER-REF ' DROP IS REGISTER-REF ( ADDRESS \ TYPE -- ADDRESS )
|
|
( REGISTER ACTUAL CODE CREATION, FOR USE IN OPTOMIZERS, DEBUGGERS, ETC. )
|
|
DEFER REGISTER-ASM ' NOOP IS REGISTER-ASM ( DATA \ XT -- DATA \ XT )
|
|
|
|
IN-FORTH
|
|
( SET UP THE REGISTRATION CALLBACK FUNCTIONS )
|
|
: SET-REGISTER-REF IS REGISTER-REF ;
|
|
: SET-REGISTER-ASM IS REGISTER-ASM ;
|
|
IN-HIDDEN
|
|
|
|
( CONSTANTS FOR THE TYPE ARGUMENT )
|
|
1 CONSTANT 8B-ABS ( 8 BIT ABSOLUTE ADDRESSING )
|
|
2 CONSTANT 16B-ABS ( 16 BIT ABSOLUTE ADDRESSING )
|
|
3 CONSTANT 32B-ABS ( 32 BIT ABSOLUTE ADDRESSING )
|
|
5 CONSTANT 8B-REL ( 8 BIT RELATIVE ADDRESSING )
|
|
6 CONSTANT 16B-REL ( 16 BIT RELATIVE ADDRESSING )
|
|
7 CONSTANT 32B-REL ( 32 BIT RELATIVE ADDRESSING )
|
|
|
|
( DEFER THE ERROR HANDLER WORDS SO THEY CAN BE INDIVIDUALLY TURNED OFF )
|
|
( DEFER THEM HERE SO THEY CAN BE USED BEFORE THEY ARE ACTUALLY DEFINED )
|
|
: DEF-ERR-HAND ( THE DEFAULT ERROR HANDLER FOR UNINITIALIZED ERROR HANDLERS )
|
|
( X*I -- X*J )
|
|
-1 ABORT" NO ERROR HANDLER INSTALLED" ;
|
|
' DEF-ERR-HAND CONSTANT DEH-XT
|
|
|
|
DEFER ?PARAMS DEH-XT IS ?PARAMS ( -- ) \ ARE THERE PARAMETERS?
|
|
DEFER ?SEG DEH-XT IS ?SEG ( -- ) \ IS THERE A SEG OVERRIDE?
|
|
DEFER ?LOCK DEH-XT IS ?LOCK ( -- ) \ IS THERE A LOCK PREFIX?
|
|
DEFER ?REP DEH-XT IS ?REP ( -- ) \ IS THERE A REP TYPE PREFIX?
|
|
DEFER ?INST-PRE DEH-XT IS ?INST-PRE ( -- ) \ IS THERE AN INST PREFIX?
|
|
DEFER ?OPERANDS DEH-XT IS ?OPERANDS ( -- ) \ ARE THERE OPERANDS?
|
|
DEFER ?OPSIZE DEH-XT IS ?OPSIZE ( N -- ) \ IS THE OPERAND SIZE MISMATCHED?
|
|
DEFER ?ADSIZE DEH-XT IS ?ADSIZE ( N -- ) \ IS THE ADDRESS SIZE MISMATCHED?
|
|
DEFER ?SHORT DEH-XT IS ?SHORT ( -- ) \ IS THERE AN ILLEGAL SHORT?
|
|
DEFER ?TOOFAR DEH-XT IS ?TOOFAR ( FLAG -- ) \ IS THE DEST OF A BRANCH TO BIG?
|
|
DEFER ?UNRES DEH-XT IS ?UNRES ( -- ) \ IS THERE AN UNRESOLVED FORWARD REFERENCE?
|
|
DEFER ?NOADSIZE DEH-XT IS ?NOADSIZE ( -- ) \ IS THE FWD REF ADDR SIZE UNKNOWN?
|
|
DEFER ?TOOMANYOPS DEH-XT IS ?TOOMANYOPS ( N -- ) \ ARE THERE TOO MANY OPERANDS?
|
|
DEFER ?NOFAR DEH-XT IS ?NOFAR ( -- ) \ IS THERE A FAR REFERENCE?
|
|
DEFER ?MATCH DEH-XT IS ?MATCH ( X1 \ X2 -- ) \ ERROR IF X1==X2
|
|
DEFER ?NOMATCH DEH-XT IS ?NOMATCH ( X1 \ X2 -- ) \ ERROR IF X1!=X2
|
|
DEFER ?FINISHED DEH-XT IS ?FINISHED ( -- ) \ ARE THERE OPERANDS LEFT OVER?
|
|
DEFER ?BADTYPE DEH-XT IS ?BADTYPE ( MAX TYPE VAL -- ) \ IS THE TYPE UNALLOWED?
|
|
DEFER ?BADCOMBINE DEH-XT IS ?BADCOMBINE ( FLAG -- ) \ CAN THE TYPES BE COMBINED?
|
|
DEFER ?NOTENOUGH DEH-XT IS ?NOTENOUGH ( N -- ) \ ARE THERE TOO FEW OPERANDS?
|
|
DEFER ?NOIMMED DEH-XT IS ?NOIMMED ( -- ) \ IS THERE AN ILLEGAL IMMEDIATE OP?
|
|
DEFER ?BADMODE DEH-XT IS ?BADMODE ( FLAG -- ) \ IS THE ADDRESS MODE ILLEGAL?
|
|
DEFER ?REG,R/M DEH-XT IS ?REG,R/M ( -- ) \ IS THE DEST A REG?
|
|
DEFER ?R/M,REG DEH-XT IS ?R/M,REG ( -- ) \ IS THE SOURCE A REG?
|
|
DEFER ?MEM DEH-XT IS ?MEM ( -- ) \ DO WE HAVE AN ILLEGAL REGISTER OPERAND?
|
|
DEFER ?REG DEH-XT IS ?REG ( -- ) \ DO WE HAVE AN ILLEGAL MEMORY OPERAND?
|
|
|
|
( DEFER THE WORD THAT CALLS THE WORDS THAT CREATE THE CODE )
|
|
( IT COMES IN TWO FLAVORS -- PREFIX AND POSTFIX )
|
|
( IT'S DEFERRED HERE SO I CAN USE IT NOW )
|
|
: NO-OPCODE-HANDLER -1 ABORT" NO OPCODE CREATOR INSTALLED" ;
|
|
DEFER DO-OPCODE ' NO-OPCODE-HANDLER IS DO-OPCODE ( X? \ X? \ 0|ADDR -- )
|
|
\ POSTFIX MODE: THIS ACTUALLY SAVES THE CURRENT INSTRUCTION AND
|
|
\ DOES THE PREVIOUS ONE.
|
|
|
|
IN-ASM
|
|
: A; ( FINISH THE ASSEMBLY OF THE PREVIOUS INSTRUCTION )
|
|
( -- )
|
|
0 DO-OPCODE ;
|
|
|
|
( ADDRESS AND DATA SIZES )
|
|
IN-HIDDEN
|
|
0 CONSTANT UNKNOWN ( ALSO, OPERAND TYPE AND NUMBER )
|
|
1 CONSTANT 8BIT
|
|
2 CONSTANT 16BIT
|
|
3 CONSTANT 32BIT
|
|
4 CONSTANT 64BIT
|
|
5 CONSTANT 80BIT
|
|
|
|
( DETERMINE WHAT SIZE CODE TO GENERATE )
|
|
32BIT VALUE DEFAULT-SIZE ( THE DEFAULT USE SIZE )
|
|
: !DEFAULT-SIZE ( NOT THE DEFAULT SIZE, EG. CHANGE 16BIT TO 32BIT )
|
|
( -- SIZE )
|
|
DEFAULT-SIZE 16BIT = IF 32BIT ELSE 16BIT THEN ;
|
|
IN-ASM
|
|
: USE16 ( GENERATE 16 BIT CODE BY DEFAULT )
|
|
16BIT TO DEFAULT-SIZE ;
|
|
: USE32 ( GENERATE 32 BIT CODE BY DEFAULT )
|
|
32BIT TO DEFAULT-SIZE ;
|
|
|
|
( CREATE A STACK FOR OPERANDS )
|
|
IN-HIDDEN
|
|
7 CONSTANT MAX-OPERANDS ( MAXIMUM NUMBER OF OPERANDS ON THE OPSTACK )
|
|
CREATE OPSTACK MAX-OPERANDS 1+ CELLS ALLOT HERE CONSTANT OPSTACK-END
|
|
: CLR-OPSTACK OPSTACK DUP CELL+ SWAP DATA-! ;
|
|
CLR-OPSTACK ( INITIALIZE THE OPSTACK )
|
|
: ?CLR-OPSTACK ( CLEAR THE OPERAND STACK WHEN THE FLAG IS NON-ZERO )
|
|
( F -- )
|
|
IF CLR-OPSTACK THEN ;
|
|
IN-ASM
|
|
: PUSH-OP ( MOVE A PARAMETER STACK ITEM TO THE OPSTACK )
|
|
( X -- )
|
|
OPSTACK DATA-@ OPSTACK-END = DUP ?CLR-OPSTACK
|
|
ABORT" OPSTACK OVERFLOW" OPSTACK DUP DATA-@ DUP CELL+ ROT DATA-!
|
|
DATA-! ;
|
|
: POP-OP ( MOVE AN ITEM FROM THE OPERAND STACK TO THE PARAMETER STACK )
|
|
( -- X )
|
|
OPSTACK DUP DATA-@ SWAP CELL+ = DUP ?CLR-OPSTACK
|
|
ABORT" OPSTACK UNDERFLOW" OPSTACK DUP DATA-@ CELL- DUP ROT
|
|
DATA-! DATA-@ ;
|
|
IN-HIDDEN
|
|
: OP-DEPTH ( CHECK THE DEPTH OF THE OPERAND STACK )
|
|
OPSTACK DUP DATA-@ SWAP - CELL- CELL/ ;
|
|
|
|
( WORDS TO SUPPORT FORWARD REFERENCED LOCAL LABELS )
|
|
100 CONSTANT FRMAX ( MAX NUMBER OF UNRESOLVED FORWARD REFERENCES )
|
|
140 CONSTANT LBMAX ( MAX NUMBER OF LOCAL LABELS )
|
|
CREATE FRTABLE FRMAX 2* CELLS ALLOT ( HOLDS UNRESOLVED FORWARD REFERENCES )
|
|
CREATE LBTABLE LBMAX CELLS ALLOT ( HOLDS LOCAL LABEL BINDINGS )
|
|
: ADDREF ( ADD A FORWARD REFERENCE AT CODE-HERE )
|
|
( REF# -- REF# )
|
|
FRTABLE [ FRMAX 1+ ] LITERAL 0 DO
|
|
FRMAX I = DUP ?CLR-OPSTACK
|
|
ABORT" TOO MANY UNRESOLVED FORWARD REFERENCES"
|
|
DUP DATA-@ IF
|
|
CELL+ CELL+ ELSE 2DUP DATA-! CODE-HERE OVER CELL+
|
|
DATA-! LEAVE
|
|
THEN
|
|
LOOP DROP ;
|
|
: BACKPATCH ( BACKPATCH A FORWARD REFERENCE TO HERE )
|
|
( ADDRESS \ SIZE -- )
|
|
CASE 8BIT OF
|
|
CODE-HERE OVER 1+ - DUP ABS 7F > ?TOOFAR SWAP CODE-C!
|
|
ENDOF 16BIT OF
|
|
CODE-HERE OVER 2+ - DUP ABS 7FFF > ?TOOFAR SWAP CODE-W!
|
|
ENDOF 32BIT OF
|
|
CODE-HERE OVER 4+ - SWAP CODE-D!
|
|
ENDOF ?NOADSIZE DROP ENDCASE ;
|
|
: REFSIZE ( DETERMINE THE SIZE OF A BOUND REFERENCE )
|
|
( ADDR OF INSTR -- ADDR OF OPERAND \ SIZE )
|
|
DUP CODE-C@ 67 ( ADDR SIZE OVERRIDE PREFIX ) = IF
|
|
1+ !DEFAULT-SIZE
|
|
ELSE
|
|
DEFAULT-SIZE
|
|
THEN
|
|
( STACK: ADDRESS OF ACTUAL INSTRUCTION \ PROVISIONAL SIZE )
|
|
>R DUP CODE-C@ CASE
|
|
0F OF ( A NEAR CONDITIONAL BRANCH )
|
|
1+ ( ADJUST FOR THE FIRST BYTE OF THE OPCODE )
|
|
ENDOF 0E9 OF ( A JMP NEAR, DON'T NEED TO DO ANYTHING )
|
|
ENDOF 0E8 OF ( A NEAR CALL, DON'T NEED TO DO ANYTHING )
|
|
ENDOF ( IF WE GET TO HERE, IT MUST BE 8 BIT )
|
|
R> DROP 8BIT >R
|
|
ENDCASE 1+ R> ;
|
|
: RESOLVE ( RESOLVE A FORWARD REFERENCE TO CODE-HERE )
|
|
( REF# -- REF# )
|
|
FRTABLE FRMAX 0 DO
|
|
2DUP DATA-@ = IF
|
|
DUP CELL+ DATA-@ REFSIZE BACKPATCH 0 OVER DATA-!
|
|
THEN
|
|
CELL+ CELL+
|
|
LOOP
|
|
DROP ;
|
|
: !LABEL ( BIND A LABEL TO CODE-HERE )
|
|
( REF# -- )
|
|
RESOLVE CODE-HERE SWAP CELLS LBTABLE + DATA-! ;
|
|
: @LABEL ( FETCH THE BINDING OF A LABEL, OR RETURN A PSEUDO ADDRESS IF NOT )
|
|
( YET BOUND TO AN ADDRESS )
|
|
( REF# -- ADDR )
|
|
DUP CELLS LBTABLE + DATA-@ ?DUP IF SWAP DROP ELSE ADDREF DROP
|
|
CODE-HERE THEN ;
|
|
: CREATE-REF ( CREATE WORDS TO REFERENCE LOCAL LABELS )
|
|
( C:: INDEX -- )
|
|
( R:: -- ADDR )
|
|
CREATE DATA-, DOES> DATA-@ @LABEL ;
|
|
: CREATE-BIND ( CREATE WORDS TO BIND LOCAL LABELS )
|
|
( C:: INDEX -- )
|
|
( R:: -- )
|
|
CREATE DATA-, DOES> >R A; R> DATA-@ !LABEL ;
|
|
|
|
( THESE REFERENCES AND BINDINGS ARE NAMED FOR GENERAL USE. DO NOT USE THEM )
|
|
( IN MACROS )
|
|
IN-ASM
|
|
1 CREATE-REF @@1 1 CREATE-BIND @@1:
|
|
2 CREATE-REF @@2 2 CREATE-BIND @@2:
|
|
3 CREATE-REF @@3 3 CREATE-BIND @@3:
|
|
4 CREATE-REF @@4 4 CREATE-BIND @@4:
|
|
5 CREATE-REF @@5 5 CREATE-BIND @@5:
|
|
6 CREATE-REF @@6 6 CREATE-BIND @@6:
|
|
7 CREATE-REF @@7 7 CREATE-BIND @@7:
|
|
8 CREATE-REF @@8 8 CREATE-BIND @@8:
|
|
9 CREATE-REF @@9 9 CREATE-BIND @@9:
|
|
|
|
IN-HIDDEN
|
|
0 VALUE IN-MACRO? ( A SEMAPHORE TO TELL IF WE'RE IN EXECUTION OF A MACRO )
|
|
0A VALUE MACRO-LABELS ( THE FIRST LABEL USED FOR MACROS )
|
|
VARIABLE MACRO-LABEL-LEVEL ( FOR LABELS TO USE IN MACROS )
|
|
: IN-MACRO ( FLAG THE FACT THAT WE ARE IN A MACRO )
|
|
( -- )
|
|
1 +TO IN-MACRO? ;
|
|
: !IN-MACRO ( FLAG THE FACT THAT WE'VE LEFT A MACRO )
|
|
( -- )
|
|
-1 +TO IN-MACRO? ;
|
|
: +MACRO ( GET AN INDEX INTO THE LABEL TABLE FROM AN OFFSET )
|
|
( OFFSET -- INDEX )
|
|
MACRO-LABEL-LEVEL DATA-@ + DUP LBMAX >
|
|
ABORT" TOO MANY LOCAL LABELS IN MACROS" ;
|
|
: +MACRO-REF ( REFERENCE A LABEL OFFSET FROM THE MACRO LEVEL )
|
|
( OFFSET -- ADDR )
|
|
+MACRO @LABEL ;
|
|
: +MACRO-BIND ( BIND A LABEL OFFSET FROM THE MACRO LEVEL )
|
|
( OFFSET -- )
|
|
+MACRO !LABEL ;
|
|
: ENTER-MACRO ( SET UP MACRO RELATIVE LOCAL LABELS )
|
|
( -- )
|
|
MACRO-LABELS MACRO-LABEL-LEVEL DUP DATA-@ ROT + DUP ROT DATA-! CELLS
|
|
LBTABLE + MACRO-LABELS CELLS ERASE IN-MACRO ;
|
|
: LEAVE-MACRO ( GO BACK TO THE OLD REGIME )
|
|
( OLD MACRO LABEL LEVEL -- )
|
|
MACRO-LABELS MACRO-LABEL-LEVEL DUP DATA-@ ROT - SWAP DATA-! !IN-MACRO ;
|
|
: CREATE-MACRO-REF ( CREATE MACRO-SAFE LOCAL LABEL REFERENCES )
|
|
( C:: LABEL OFFSET -- )
|
|
( R:: -- ADDR )
|
|
CREATE DATA-, DOES> DATA-@ +MACRO-REF ;
|
|
: CREATE-MACRO-BIND ( CREATE MACRO-SAFE LOCAL LABEL BINDINGS )
|
|
( C:: LABEL OFFSET -- )
|
|
( R:: -- )
|
|
CREATE DATA-, DOES> >R A; R> DATA-@ +MACRO-BIND ;
|
|
: LOC-INIT ( INITIALIZE THE TABLES AND VARIABLES )
|
|
( -- )
|
|
FRTABLE [ FRMAX 2* CELLS ] LITERAL ERASE LBTABLE [ LBMAX CELLS ]
|
|
LITERAL ERASE MACRO-LABELS MACRO-LABEL-LEVEL DATA-! ;
|
|
|
|
( MACRO SAFE LOCAL LABELS )
|
|
IN-ASM
|
|
0 CREATE-MACRO-REF @@M0 0 CREATE-MACRO-BIND @@M0:
|
|
1 CREATE-MACRO-REF @@M1 1 CREATE-MACRO-BIND @@M1:
|
|
2 CREATE-MACRO-REF @@M2 2 CREATE-MACRO-BIND @@M2:
|
|
3 CREATE-MACRO-REF @@M3 3 CREATE-MACRO-BIND @@M3:
|
|
4 CREATE-MACRO-REF @@M4 4 CREATE-MACRO-BIND @@M4:
|
|
5 CREATE-MACRO-REF @@M5 5 CREATE-MACRO-BIND @@M5:
|
|
6 CREATE-MACRO-REF @@M6 6 CREATE-MACRO-BIND @@M6:
|
|
7 CREATE-MACRO-REF @@M7 7 CREATE-MACRO-BIND @@M7:
|
|
8 CREATE-MACRO-REF @@M8 8 CREATE-MACRO-BIND @@M8:
|
|
9 CREATE-MACRO-REF @@M9 9 CREATE-MACRO-BIND @@M9:
|
|
( CREATE ALTERNATIVE LABEL REFERENCE AND BINDING NAMES FOR TOM )
|
|
0 CREATE-MACRO-REF L$0 0 CREATE-MACRO-BIND L$0:
|
|
1 CREATE-MACRO-REF L$1 1 CREATE-MACRO-BIND L$1:
|
|
2 CREATE-MACRO-REF L$2 2 CREATE-MACRO-BIND L$2:
|
|
3 CREATE-MACRO-REF L$3 3 CREATE-MACRO-BIND L$3:
|
|
4 CREATE-MACRO-REF L$4 4 CREATE-MACRO-BIND L$4:
|
|
5 CREATE-MACRO-REF L$5 5 CREATE-MACRO-BIND L$5:
|
|
6 CREATE-MACRO-REF L$6 6 CREATE-MACRO-BIND L$6:
|
|
7 CREATE-MACRO-REF L$7 7 CREATE-MACRO-BIND L$7:
|
|
8 CREATE-MACRO-REF L$8 8 CREATE-MACRO-BIND L$8:
|
|
9 CREATE-MACRO-REF L$9 9 CREATE-MACRO-BIND L$9:
|
|
|
|
( CONSTANTS FOR OPERAND TYPING )
|
|
( OPERAND TYPES )
|
|
IN-HIDDEN
|
|
1 CONSTANT INDIRECT ( 16 BIT REGISTER INDIRECT )
|
|
2 CONSTANT BASED ( 32 BIT REGISTER INDIRECT OR SCALED INDEX/BASE )
|
|
3 CONSTANT INDEX ( 32 BIT SCALED INDEX )
|
|
4 CONSTANT IMMEDIATE ( AN IMMEDIATE OPERAND )
|
|
5 CONSTANT REGISTER ( A GENERAL PURPOSE MACHINE REGISTER )
|
|
6 CONSTANT SREG ( A SEGMENT REGISTER )
|
|
7 CONSTANT CREG ( A CONTROL REGISTER )
|
|
8 CONSTANT DREG ( A DEBUG REGISTER )
|
|
9 CONSTANT TREG ( A TEST REGISTER )
|
|
0A CONSTANT FREG ( A FLOATING POINT REGISTER )
|
|
|
|
( ENCODE AND DECODE REGISTER REPRESENTATIONS )
|
|
( REGISTER ENCODING: )
|
|
( BITS USE )
|
|
( 0-3 DATA SIZE )
|
|
( 4-7 ADDRESS SIZE )
|
|
( 8-11 TYPE )
|
|
( 12-13 R/M OR S-I-B )
|
|
: <ENC-REG> ( ENCODE THE SINGLE CELL OPERAND REPRESENTATION FROM THE VALUES )
|
|
( ON THE STACK )
|
|
( DATA SIZE \ ADDR SIZE \ TYPE \ R/M OR S-I-B -- REG VAL )
|
|
16*+ 16*+ 16*+ ;
|
|
: <DEC-REG> ( DECODE THE SINGLE CELL OPERAND REPRESENTATION TO ITS )
|
|
( CONSTITUENT PARTS )
|
|
( REG VAL -- DATA SIZE \ ADDR SIZE \ TYPE \ R/M OR S-I-B )
|
|
16/MOD 16/MOD 16/MOD ;
|
|
: ASM-OP ( CREATE THE ASSEMBLER OPERANDS FROM OPERAND DESCRIPTIONS )
|
|
( C:: DATA SIZE \ ADDR SIZE \ TYPE \ R/M OR S-I-B -- )
|
|
( R:: -- )
|
|
( R::OS: -- X )
|
|
CREATE <ENC-REG> DATA-, DOES> DATA-@ PUSH-OP ;
|
|
|
|
( THE ASSEMBLER OPERANDS )
|
|
IN-ASM
|
|
8BIT UNKNOWN REGISTER 0 ASM-OP AL
|
|
8BIT UNKNOWN REGISTER 1 ASM-OP CL
|
|
8BIT UNKNOWN REGISTER 2 ASM-OP DL
|
|
8BIT UNKNOWN REGISTER 3 ASM-OP BL
|
|
8BIT UNKNOWN REGISTER 4 ASM-OP AH
|
|
8BIT UNKNOWN REGISTER 5 ASM-OP CH
|
|
8BIT UNKNOWN REGISTER 6 ASM-OP DH
|
|
8BIT UNKNOWN REGISTER 7 ASM-OP BH
|
|
16BIT UNKNOWN REGISTER 0 ASM-OP AX
|
|
16BIT UNKNOWN REGISTER 1 ASM-OP CX
|
|
16BIT UNKNOWN REGISTER 2 ASM-OP DX
|
|
16BIT UNKNOWN REGISTER 3 ASM-OP BX
|
|
16BIT UNKNOWN REGISTER 4 ASM-OP SP
|
|
16BIT UNKNOWN REGISTER 5 ASM-OP BP
|
|
16BIT UNKNOWN REGISTER 6 ASM-OP SI
|
|
16BIT UNKNOWN REGISTER 7 ASM-OP DI
|
|
32BIT UNKNOWN REGISTER 0 ASM-OP EAX
|
|
32BIT UNKNOWN REGISTER 1 ASM-OP ECX
|
|
32BIT UNKNOWN REGISTER 2 ASM-OP EDX
|
|
32BIT UNKNOWN REGISTER 3 ASM-OP EBX
|
|
32BIT UNKNOWN REGISTER 4 ASM-OP ESP
|
|
32BIT UNKNOWN REGISTER 5 ASM-OP EBP
|
|
32BIT UNKNOWN REGISTER 6 ASM-OP ESI
|
|
32BIT UNKNOWN REGISTER 7 ASM-OP EDI
|
|
UNKNOWN 16BIT INDIRECT 0 ASM-OP [BX+SI]
|
|
UNKNOWN 16BIT INDIRECT 1 ASM-OP [BX+DI]
|
|
UNKNOWN 16BIT INDIRECT 2 ASM-OP [BP+SI]
|
|
UNKNOWN 16BIT INDIRECT 3 ASM-OP [BP+DI]
|
|
UNKNOWN 16BIT INDIRECT 4 ASM-OP [SI]
|
|
UNKNOWN 16BIT INDIRECT 5 ASM-OP [DI]
|
|
UNKNOWN 16BIT INDIRECT 6 ASM-OP [BP]
|
|
UNKNOWN 16BIT INDIRECT 7 ASM-OP [BX]
|
|
UNKNOWN 32BIT BASED 0 ASM-OP [EAX]
|
|
UNKNOWN 32BIT BASED 1 ASM-OP [ECX]
|
|
UNKNOWN 32BIT BASED 2 ASM-OP [EDX]
|
|
UNKNOWN 32BIT BASED 3 ASM-OP [EBX]
|
|
UNKNOWN 32BIT BASED 4 ASM-OP [ESP]
|
|
UNKNOWN 32BIT BASED 5 ASM-OP [EBP]
|
|
UNKNOWN 32BIT BASED 6 ASM-OP [ESI]
|
|
UNKNOWN 32BIT BASED 7 ASM-OP [EDI]
|
|
UNKNOWN 32BIT INDEX 8 ASM-OP [EAX*2]
|
|
UNKNOWN 32BIT INDEX 9 ASM-OP [ECX*2]
|
|
UNKNOWN 32BIT INDEX 0A ASM-OP [EDX*2]
|
|
UNKNOWN 32BIT INDEX 0B ASM-OP [EBX*2]
|
|
UNKNOWN 32BIT INDEX 0D ASM-OP [EBP*2]
|
|
UNKNOWN 32BIT INDEX 0E ASM-OP [ESI*2]
|
|
UNKNOWN 32BIT INDEX 0F ASM-OP [EDI*2]
|
|
UNKNOWN 32BIT INDEX 10 ASM-OP [EAX*4]
|
|
UNKNOWN 32BIT INDEX 11 ASM-OP [ECX*4]
|
|
UNKNOWN 32BIT INDEX 12 ASM-OP [EDX*4]
|
|
UNKNOWN 32BIT INDEX 13 ASM-OP [EBX*4]
|
|
UNKNOWN 32BIT INDEX 15 ASM-OP [EBP*4]
|
|
UNKNOWN 32BIT INDEX 16 ASM-OP [ESI*4]
|
|
UNKNOWN 32BIT INDEX 17 ASM-OP [EDI*4]
|
|
UNKNOWN 32BIT INDEX 18 ASM-OP [EAX*8]
|
|
UNKNOWN 32BIT INDEX 19 ASM-OP [ECX*8]
|
|
UNKNOWN 32BIT INDEX 1A ASM-OP [EDX*8]
|
|
UNKNOWN 32BIT INDEX 1B ASM-OP [EBX*8]
|
|
UNKNOWN 32BIT INDEX 1D ASM-OP [EBP*8]
|
|
UNKNOWN 32BIT INDEX 1E ASM-OP [ESI*8]
|
|
UNKNOWN 32BIT INDEX 1F ASM-OP [EDI*8]
|
|
16BIT UNKNOWN SREG 0 ASM-OP ES
|
|
16BIT UNKNOWN SREG 1 ASM-OP CS
|
|
16BIT UNKNOWN SREG 2 ASM-OP SS
|
|
16BIT UNKNOWN SREG 3 ASM-OP DS
|
|
16BIT UNKNOWN SREG 4 ASM-OP FS
|
|
16BIT UNKNOWN SREG 5 ASM-OP GS
|
|
32BIT UNKNOWN CREG 0 ASM-OP CR0
|
|
32BIT UNKNOWN CREG 2 ASM-OP CR2
|
|
32BIT UNKNOWN CREG 3 ASM-OP CR3
|
|
32BIT UNKNOWN CREG 4 ASM-OP CR4
|
|
32BIT UNKNOWN DREG 0 ASM-OP DR0
|
|
32BIT UNKNOWN DREG 1 ASM-OP DR1
|
|
32BIT UNKNOWN DREG 2 ASM-OP DR2
|
|
32BIT UNKNOWN DREG 3 ASM-OP DR3
|
|
32BIT UNKNOWN DREG 6 ASM-OP DR6
|
|
32BIT UNKNOWN DREG 7 ASM-OP DR7
|
|
32BIT UNKNOWN TREG 3 ASM-OP TR3
|
|
32BIT UNKNOWN TREG 4 ASM-OP TR4
|
|
32BIT UNKNOWN TREG 5 ASM-OP TR5
|
|
32BIT UNKNOWN TREG 6 ASM-OP TR6
|
|
32BIT UNKNOWN TREG 7 ASM-OP TR7
|
|
UNKNOWN UNKNOWN FREG 0 ASM-OP ST
|
|
UNKNOWN UNKNOWN FREG 0 ASM-OP ST(0)
|
|
UNKNOWN UNKNOWN FREG 1 ASM-OP ST(1)
|
|
UNKNOWN UNKNOWN FREG 2 ASM-OP ST(2)
|
|
UNKNOWN UNKNOWN FREG 3 ASM-OP ST(3)
|
|
UNKNOWN UNKNOWN FREG 4 ASM-OP ST(4)
|
|
UNKNOWN UNKNOWN FREG 5 ASM-OP ST(5)
|
|
UNKNOWN UNKNOWN FREG 6 ASM-OP ST(6)
|
|
UNKNOWN UNKNOWN FREG 7 ASM-OP ST(7)
|
|
8BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP BYTE
|
|
16BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP WORD
|
|
32BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP DWORD
|
|
64BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP QWORD
|
|
32BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP FLOAT
|
|
64BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP DOUBLE
|
|
80BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP LONG
|
|
80BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP EXTENDED
|
|
80BIT UNKNOWN UNKNOWN UNKNOWN ASM-OP TBYTE
|
|
UNKNOWN 8BIT UNKNOWN UNKNOWN ASM-OP SHORT
|
|
UNKNOWN 16BIT UNKNOWN UNKNOWN ASM-OP NEAR
|
|
UNKNOWN 32BIT UNKNOWN UNKNOWN ASM-OP FAR
|
|
UNKNOWN UNKNOWN IMMEDIATE UNKNOWN ASM-OP #
|
|
UNKNOWN UNKNOWN UNKNOWN UNKNOWN ASM-OP ,
|
|
|
|
( VARIABLES USED FOR INSTRUCTION CODING )
|
|
IN-HIDDEN
|
|
VARIABLE INST-PREFIX ( INSTRUCTION PREFIXES )
|
|
VARIABLE ADDR-PREFIX ( ADDRESS SIZE PREFIX )
|
|
VARIABLE DATA-PREFIX ( DATA SIZE PREFIX )
|
|
VARIABLE SEG-PREFIX ( SEGMENT OVERRIDE PREFIX )
|
|
VARIABLE SV-INST-PREFIX ( THE SAVED INSTRUCTION PREFIX )
|
|
VARIABLE INST-SAVE ( THE PREVIOUSLY EXECUTED INSTRUCTION )
|
|
VARIABLE SP-SAVE ( THE STACK POINTER )
|
|
VARIABLE OFFSET-SV ( SAVE THE OFFSET PART )
|
|
VARIABLE IMMED-SV ( SAVE THE IMMEDIATE PART )
|
|
VARIABLE DT-SIZE ( DATA ITEM SIZE )
|
|
VARIABLE AD-SIZE ( ADDRESS SIZE )
|
|
VARIABLE RTYPE ( THE WORKING REGISTER TYPE )
|
|
VARIABLE MAXTYPE ( THE MAXIMUM NUMERICAL TYPE VALUE ENCOUNTERED )
|
|
VARIABLE MOD-R/M ( THE WORKING AREA FOR THE MOD-R/M BYTE )
|
|
VARIABLE S-I-B ( THE WORKING AREA FOR THE S-I-B BYTE )
|
|
VARIABLE ADDMODE ( ADDRESSING MODE FLAGS )
|
|
|
|
: RESET-VARS ( STORE 0 INTO ALL INSTRUCTION CODING VARIABLES )
|
|
0 INST-PREFIX DATA-! 0 ADDR-PREFIX DATA-! 0 DATA-PREFIX DATA-!
|
|
0 SEG-PREFIX DATA-! 0 SV-INST-PREFIX DATA-! 0 INST-SAVE DATA-!
|
|
0 SP-SAVE DATA-! 0 OFFSET-SV DATA-! 0 IMMED-SV DATA-! 0 DT-SIZE DATA-!
|
|
0 AD-SIZE DATA-! 0 RTYPE DATA-! 0 MAXTYPE DATA-! 0 MOD-R/M DATA-!
|
|
0 S-I-B DATA-! 0 ADDMODE DATA-! ;
|
|
|
|
: RESET-FOR-NEXT-INSTR ( STORE A 0 INTO INTERMEDIATE CODING VARIABLES )
|
|
0 OFFSET-SV DATA-! 0 IMMED-SV DATA-! 0 DT-SIZE DATA-!
|
|
0 AD-SIZE DATA-! 0 RTYPE DATA-! 0 MAXTYPE DATA-! 0 MOD-R/M DATA-!
|
|
0 S-I-B DATA-! 0 ADDMODE DATA-! ;
|
|
|
|
( SET/RESET MODE BITS )
|
|
1 CONSTANT IMMED-BIT ( FLAG AN IMMEDIATE OPERAND )
|
|
2 CONSTANT DIRECT-BIT ( FLAG THE DIRECTION )
|
|
4 CONSTANT MOD-R/M-BIT ( FLAG THAT WE'VE STARTED THE MOD-R/M )
|
|
8 CONSTANT S-I-B-BIT ( FLAG THE BEGINNING OF S-I-B CREATION )
|
|
10 CONSTANT FULL-OFF-BIT ( FLAG A FULL OFFSET )
|
|
20 CONSTANT BASED-BIT ( FLAG THAT WE'VE SEEN A BASE )
|
|
40 CONSTANT OFFSET-BIT ( FLAG AN OFFSET )
|
|
80 CONSTANT SHORT-BIT ( FLAG SHORT )
|
|
100 CONSTANT NEAR-BIT ( FLAG NEAR )
|
|
200 CONSTANT FAR-BIT ( FLAG FAR )
|
|
400 CONSTANT DO-1OP-BIT ( FLAG WE'VE BEEN THROUGH DO-1OP ONCE )
|
|
800 CONSTANT MAYBE-OFFSET-BIT ( FLAG THAT MAYBE WE'VE GOT AN OFFSET )
|
|
IMMED-BIT
|
|
DIRECT-BIT OR
|
|
MOD-R/M-BIT OR
|
|
S-I-B-BIT OR
|
|
FULL-OFF-BIT OR
|
|
BASED-BIT OR
|
|
OFFSET-BIT OR
|
|
SHORT-BIT OR
|
|
NEAR-BIT OR
|
|
FAR-BIT OR
|
|
DO-1OP-BIT OR
|
|
MAYBE-OFFSET-BIT OR
|
|
CONSTANT MODE-MASK ( ALL MODE BITS SET )
|
|
|
|
: 1MODE-BIT! ( SET A MODE BIT )
|
|
( BIT CONSTANT -- )
|
|
ADDMODE SWAP OVER DATA-@ OR SWAP DATA-! ;
|
|
: 0MODE-BIT! ( CLEAR A MODE BIT )
|
|
( BIT CONSTANT -- )
|
|
MODE-MASK XOR ADDMODE SWAP OVER DATA-@ AND SWAP DATA-! ;
|
|
: MODE-BIT@ ( FETCH A MODE BIT )
|
|
( BIT MASK -- FLAG )
|
|
ADDMODE DATA-@ AND 0<> ;
|
|
: HAS-IMMED ( FLAG AN IMMEDIATE OPERAND )
|
|
( -- )
|
|
IMMED-BIT 1MODE-BIT! ;
|
|
: HAS-IMMED? ( DO WE HAVE AN IMMEDIATE OPERAND? )
|
|
( -- FLAG )
|
|
IMMED-BIT MODE-BIT@ ;
|
|
: HAS-MOD-R/M ( WE'VE SEEN AT LEAST ONE OPERAND )
|
|
( -- )
|
|
MOD-R/M-BIT 1MODE-BIT! ;
|
|
: HAS-MOD-R/M? ( HAVE WE SEEN AN OPERAND? )
|
|
( -- FLAG )
|
|
MOD-R/M-BIT MODE-BIT@ ;
|
|
: HAS-S-I-B ( WE'VE STARTED WORK ON THE S-I-B )
|
|
( -- )
|
|
S-I-B-BIT 1MODE-BIT! ;
|
|
: HAS-S-I-B? ( HAVE WE STARTED WORK ON THE S-I-B )
|
|
( -- FLAG )
|
|
S-I-B-BIT MODE-BIT@ ;
|
|
: REG,R/M ( ADDRESSING MODE IS REGISTER, REGISTER/MEMORY )
|
|
( -- )
|
|
DIRECT-BIT 1MODE-BIT! ;
|
|
: R/M,REG ( ADDRESSING MODE IS REGISTER/MEMORY, REGISTER )
|
|
( -- )
|
|
DIRECT-BIT 0MODE-BIT! ;
|
|
: DIRECTION? ( IS THE DESTINATION A REGISTER? )
|
|
( -- FLAG )
|
|
DIRECT-BIT MODE-BIT@ ;
|
|
: HAS-FULL-OFF ( MUST GENERATE A FULL OFFSET )
|
|
( -- )
|
|
FULL-OFF-BIT 1MODE-BIT! ;
|
|
: HAS-FULL-OFF? ( DO WE NEED A FULL OFFSET? )
|
|
( -- FLAG )
|
|
FULL-OFF-BIT MODE-BIT@ ;
|
|
: HAS-BASE ( WE HAVE A BASE )
|
|
( -- )
|
|
BASED-BIT 1MODE-BIT! ;
|
|
: HAS-BASE? ( DO WE HAVE A BASE? )
|
|
( -- FLAG )
|
|
BASED-BIT MODE-BIT@ ;
|
|
: MAYBE-S-I-B? ( DO WE HAVE A POSSIBLE S-I-B? )
|
|
( -- FLAG )
|
|
BASED-BIT MODE-BIT@ S-I-B-BIT MODE-BIT@ OR ;
|
|
: HAS-OFFSET ( FLAG THAT WE DO HAVE AN OFFSET )
|
|
( -- )
|
|
OFFSET-BIT 1MODE-BIT! ;
|
|
: HAS-OFFSET? ( DO WE HAVE AN OFFSET? )
|
|
( -- FLAG )
|
|
OFFSET-BIT MODE-BIT@ FULL-OFF-BIT MODE-BIT@ OR ;
|
|
: IS-SHORT ( WE HAVE A SHORT DISPLACEMENT )
|
|
( -- )
|
|
SHORT-BIT 1MODE-BIT! ;
|
|
: IS-SHORT? ( IS THE DISPLACEMENT SHORT? )
|
|
( -- FLAG )
|
|
SHORT-BIT MODE-BIT@ ;
|
|
: IS-NEAR ( WE HAVE A NEAR DISPLACEMENT )
|
|
( -- )
|
|
NEAR-BIT 1MODE-BIT! ;
|
|
: IS-NEAR? ( DO WE HAVE A NEAR DISPLACEMENT? )
|
|
( -- FLAG )
|
|
NEAR-BIT MODE-BIT@ FAR-BIT MODE-BIT@ 0= OR ;
|
|
: IS-FAR ( WE HAVE A FAR POINTER )
|
|
( -- )
|
|
FAR-BIT 1MODE-BIT! ;
|
|
: IS-FAR? ( DO WE HAVE A FAR DISPLACEMENT? )
|
|
( -- FLAG )
|
|
FAR-BIT MODE-BIT@ ;
|
|
: DO-1OP-EXED ( WE'VE EXEC'D DO-1OP )
|
|
( -- )
|
|
DO-1OP-BIT 1MODE-BIT! ;
|
|
( NOTE: WHEN WE START TO ASSEMBLE AN OPCODE, ALL FLAGS ARE OFF )
|
|
: DO-1OP-EXED? ( HAVE WE EXEC'D DO-1OP? )
|
|
( -- FLAG )
|
|
DO-1OP-BIT MODE-BIT@ ;
|
|
: MAYBE-HAS-OFFSET ( FLAG THAT WE'VE PICKED SOMETHING UP FROM THE STACK )
|
|
( -- )
|
|
MAYBE-OFFSET-BIT 1MODE-BIT! ;
|
|
: MAYBE-HAS-OFFSET? ( HAVE WE PICKED UP SOMETHING FROM THE STACK? )
|
|
( -- FLAG )
|
|
MAYBE-OFFSET-BIT MODE-BIT@ ;
|
|
|
|
( TEST FOR ERROR CONDITIONS )
|
|
: _?PARAMS ( ARE THERE PARAMETERS ON THE STACK? )
|
|
SP@ SP-SAVE DATA-@ - DUP ?CLR-OPSTACK
|
|
ABORT" OFFSET OR IMMEDIATE OPERAND NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?PARAMS IS ?PARAMS
|
|
|
|
: _?SEG ( IS THERE A SEGMENT OVERRIDE? )
|
|
SEG-PREFIX DATA-@ DUP ?CLR-OPSTACK
|
|
ABORT" SEGMENT OVERRIDE NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?SEG IS ?SEG
|
|
|
|
: _?LOCK ( IS THERE A LOCK PREFIX? )
|
|
INST-PREFIX DATA-@ 0F0 = DUP ?CLR-OPSTACK
|
|
ABORT" LOCK PREFIX NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?LOCK IS ?LOCK
|
|
|
|
: _?REP ( IS THERE A REPEAT PREFIX? )
|
|
INST-PREFIX DATA-@ 0F3 OVER = 0F2 ROT = OR DUP ?CLR-OPSTACK
|
|
ABORT" REP, ETC. NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?REP IS ?REP
|
|
|
|
: _?INST-PRE ( IS THERE ANY INSTRUCTION PREFIX? )
|
|
INST-PREFIX DATA-@ DUP ?CLR-OPSTACK
|
|
ABORT" INSTRUCTION PREFIXES NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?INST-PRE IS ?INST-PRE
|
|
|
|
: _?OPERANDS ( ARE THERE ANY OPERANDS? )
|
|
OP-DEPTH DUP ?CLR-OPSTACK
|
|
ABORT" OPERANDS NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?OPERANDS IS ?OPERANDS
|
|
|
|
: _?OPSIZE1 ( IS THE OPERAND SIZE MISMATCHED? )
|
|
( N -- )
|
|
?DUP IF DT-SIZE DATA-@ ?DUP IF - DUP ?CLR-OPSTACK
|
|
ABORT" OPERAND SIZE MISMATCHED" ELSE DT-SIZE DATA-! THEN THEN ;
|
|
: _?OPSIZE2 ( JUST STORE THE OPERAND SIZE )
|
|
( N -- )
|
|
?DUP IF DT-SIZE DATA-! THEN ;
|
|
' _?OPSIZE1 IS ?OPSIZE
|
|
|
|
: _?ADSIZE1 ( IS THE ADDRESS SIZE MISMATCHED? )
|
|
( N -- )
|
|
?DUP IF AD-SIZE DATA-@ ?DUP IF - DUP ?CLR-OPSTACK
|
|
ABORT" ADDRESS SIZE MISMATCHED" ELSE AD-SIZE DATA-! THEN THEN ;
|
|
: _?ADSIZE2 ( JUST STORE THE ADDRESS SIZE )
|
|
( N -- )
|
|
?DUP IF AD-SIZE DATA-! THEN ;
|
|
' _?ADSIZE1 IS ?ADSIZE
|
|
|
|
: _?SHORT ( IS THE ADDRESS SHORT? )
|
|
( -- )
|
|
AD-SIZE DATA-@ 8BIT = DUP ?CLR-OPSTACK
|
|
ABORT" SHORT NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?SHORT IS ?SHORT
|
|
|
|
: ?NOSHORT ( DO WE HAVE AN ILLEGAL SHORT? )
|
|
( -- )
|
|
IS-SHORT? IF 8BIT AD-SIZE DATA-! ?SHORT THEN ;
|
|
|
|
: _?TOOFAR ( IS THE BRANCH OFFSET TO FAR? )
|
|
( FLAG -- )
|
|
DUP ?CLR-OPSTACK
|
|
ABORT" BRANCH OFFSET TOO BIG TO FIT SPECIFIED WIDTH" ;
|
|
' _?TOOFAR IS ?TOOFAR
|
|
|
|
: _?UNRES ( ARE THERE ANY UNRESOLVED FORWARD REFERENCE LABELS? )
|
|
( -- )
|
|
FRTABLE FRMAX 0 DO DUP DATA-@ DUP ?CLR-OPSTACK
|
|
ABORT" UNRESOLVED FORWARD REFERENCE" CELL+ CELL+ LOOP DROP ;
|
|
' _?UNRES IS ?UNRES
|
|
|
|
: _?NOADSIZE ( NO OR UNKNOWN ADDRESS SIZE )
|
|
( -- )
|
|
CLR-OPSTACK -1
|
|
ABORT" NO OR UNKNOWN ADDRESS SIZE" ;
|
|
' _?NOADSIZE IS ?NOADSIZE
|
|
|
|
: _?TOOMANYOPS ( ARE THERE TOO MANY OPERANDS? )
|
|
( MAX ALLOWED OPERANDS -- )
|
|
OP-DEPTH < DUP ?CLR-OPSTACK
|
|
ABORT" TOO MANY OPERANDS" ;
|
|
' _?TOOMANYOPS IS ?TOOMANYOPS
|
|
|
|
: _?NOFAR ( IS THERE AN UNALLOWED FAR REFERENCE? )
|
|
( -- )
|
|
AD-SIZE DATA-@ 32BIT = DUP ?CLR-OPSTACK
|
|
ABORT" FAR REFERENCES NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?NOFAR IS ?NOFAR
|
|
|
|
: <_?MATCH> ( THE ERROR ACTION FOR ?MATCH AND ?NOMATCH )
|
|
( FLAG -- )
|
|
DUP ?CLR-OPSTACK
|
|
ABORT" OPERAND MISMATCH" ;
|
|
|
|
: _?MATCH ( ERROR IF THE PARAMETERS MATCH )
|
|
( X1 \ X2 -- )
|
|
= <_?MATCH> ;
|
|
' _?MATCH IS ?MATCH
|
|
|
|
: _?NOMATCH ( ERROR IF THE PARAMETERS DON'T MATCH )
|
|
( X1 \ X2 -- )
|
|
- <_?MATCH> ;
|
|
' _?NOMATCH IS ?NOMATCH
|
|
|
|
: _?FINISHED ( ARE THERE OPERANDS LEFT? )
|
|
( -- )
|
|
OP-DEPTH DUP ?CLR-OPSTACK
|
|
ABORT" UNCONSUMED OPERANDS" ;
|
|
' _?FINISHED IS ?FINISHED
|
|
|
|
: _?BADTYPE ( IS THE OPERAND TYPE ALLOWED? )
|
|
( MAX TYPE ALLOWED -- )
|
|
MAXTYPE DATA-@ < DUP ?CLR-OPSTACK
|
|
ABORT" ADDRESSING MODE NOT ALLOWED" ;
|
|
' _?BADTYPE IS ?BADTYPE
|
|
|
|
: _?BADCOMBINE ( CAN THE OPERAND TYPES BE COMBINED? )
|
|
( FLAG -- )
|
|
DUP ?CLR-OPSTACK
|
|
ABORT" ILLEGAL OPERAND COMBINATION" ;
|
|
' _?BADCOMBINE IS ?BADCOMBINE
|
|
|
|
: _?NOTENOUGH ( ARE THERE NOT ENOUGH OPERANDS? )
|
|
( N -- )
|
|
OP-DEPTH > DUP ?CLR-OPSTACK
|
|
ABORT" NOT ENOUGH OPERANDS" ;
|
|
' _?NOTENOUGH IS ?NOTENOUGH
|
|
|
|
: _?NOIMMED ( IS THERE AN ILLEGAL IMMEDIATE OPERAND? )
|
|
( -- ) HAS-IMMED? DUP ?CLR-OPSTACK
|
|
ABORT" IMMEDIATE OPERANDS NOT ALLOWED WITH THIS INSTRUCTION" ;
|
|
' _?NOIMMED IS ?NOIMMED
|
|
|
|
: _?BADMODE ( IS THE ADDRESS MODE ILLEGAL? )
|
|
( FLAG -- )
|
|
DUP ?CLR-OPSTACK
|
|
ABORT" ILLEGAL ADDRESS MODE" ;
|
|
' _?BADMODE IS ?BADMODE
|
|
|
|
: _?REG,R/M ( IS THE DESTINATION A REGISTER? )
|
|
( -- )
|
|
DIRECTION? 0= MOD-R/M DATA-@ 0C0 < AND DUP ?CLR-OPSTACK
|
|
ABORT" DESTINATION MUST BE A REGISTER" ;
|
|
' _?REG,R/M IS ?REG,R/M
|
|
|
|
: _?R/M,REG ( IS THE SOURCE A REGISTER? )
|
|
( -- )
|
|
DIRECTION? MOD-R/M DATA-@ 0C0 < AND DUP ?CLR-OPSTACK
|
|
ABORT" SOURCE MUST BE A REGISTER" ;
|
|
' _?R/M,REG IS ?R/M,REG
|
|
|
|
: _?MEM ( IS ONE OF THE OPERANDS IN MEMORY? )
|
|
( -- )
|
|
MOD-R/M DATA-@ 0BF > MAYBE-HAS-OFFSET? 0= AND DUP ?CLR-OPSTACK
|
|
ABORT" INSTRUCTION REQUIRES A MEMORY OPERAND" ;
|
|
' _?MEM IS ?MEM
|
|
|
|
: _?REG ( ARE ALL OF THE OPERANDS REGISTER? )
|
|
( -- )
|
|
MOD-R/M DATA-@ 0C0 < HAS-OFFSET? OR DUP ?CLR-OPSTACK
|
|
ABORT" THIS INSTRUCTION MAY ONLY USE REGISTERS" ;
|
|
' _?REG IS ?REG
|
|
|
|
: ?MEM,REG ( IS THE INSTRUCTION CODED AS MEMORY,REGISTER? )
|
|
( -- )
|
|
?R/M,REG ?MEM ;
|
|
|
|
: ?REG,MEM ( IS THE INSTRUCTION CODED AS REGISTER,MEMORY? )
|
|
( -- )
|
|
?REG,R/M ?MEM ;
|
|
|
|
: ?REGEXCLUS ( IS THE ADDRESSING MODE EXCLUSIVE? )
|
|
( -- )
|
|
RTYPE DATA-@ 0 ?NOMATCH ;
|
|
|
|
IN-ASM
|
|
: REPORT-ERRORS ( TURN ON ERROR REPORTING )
|
|
['] _?PARAMS IS ?PARAMS
|
|
['] _?SEG IS ?SEG
|
|
['] _?LOCK IS ?LOCK
|
|
['] _?REP IS ?REP
|
|
['] _?INST-PRE IS ?INST-PRE
|
|
['] _?OPERANDS IS ?OPERANDS
|
|
['] _?OPSIZE1 IS ?OPSIZE
|
|
['] _?ADSIZE1 IS ?ADSIZE
|
|
['] _?SHORT IS ?SHORT
|
|
['] _?TOOFAR IS ?TOOFAR
|
|
['] _?UNRES IS ?UNRES
|
|
['] _?NOADSIZE IS ?NOADSIZE
|
|
['] _?TOOMANYOPS IS ?TOOMANYOPS
|
|
['] _?NOFAR IS ?NOFAR
|
|
['] _?MATCH IS ?MATCH
|
|
['] _?NOMATCH IS ?NOMATCH
|
|
['] _?FINISHED IS ?FINISHED
|
|
['] _?BADTYPE IS ?BADTYPE
|
|
['] _?BADCOMBINE IS ?BADCOMBINE
|
|
['] _?NOTENOUGH IS ?NOTENOUGH
|
|
['] _?NOIMMED IS ?NOIMMED
|
|
['] _?BADMODE IS ?BADMODE
|
|
['] _?REG,R/M IS ?REG,R/M
|
|
['] _?R/M,REG IS ?R/M,REG
|
|
['] _?MEM IS ?MEM
|
|
['] _?REG IS ?REG ;
|
|
|
|
: NO-ERRORS ( TURN OFF ERROR REPORTING )
|
|
['] NOOP IS ?PARAMS
|
|
['] NOOP IS ?SEG
|
|
['] NOOP IS ?LOCK
|
|
['] NOOP IS ?REP
|
|
['] NOOP IS ?INST-PRE
|
|
['] NOOP IS ?OPERANDS
|
|
['] _?OPSIZE2 IS ?OPSIZE
|
|
['] _?ADSIZE2 IS ?ADSIZE
|
|
['] NOOP IS ?SHORT
|
|
['] DROP IS ?TOOFAR
|
|
['] NOOP IS ?UNRES
|
|
['] NOOP IS ?NOADSIZE
|
|
['] DROP IS ?TOOMANYOPS
|
|
['] NOOP IS ?NOFAR
|
|
['] 2DROP IS ?MATCH
|
|
['] 2DROP IS ?NOMATCH
|
|
['] NOOP IS ?FINISHED
|
|
['] DROP IS ?BADTYPE
|
|
['] DROP IS ?BADCOMBINE
|
|
['] DROP IS ?NOTENOUGH
|
|
['] NOOP IS ?NOIMMED
|
|
['] DROP IS ?BADMODE
|
|
['] NOOP IS ?REG,R/M
|
|
['] NOOP IS ?R/M,REG
|
|
['] NOOP IS ?MEM
|
|
['] NOOP IS ?REG ;
|
|
|
|
( GENERATE PREFIX SEQUENCES )
|
|
IN-HIDDEN
|
|
: INST, ( GENERATE A NECESSARY INSTRUCTION PREFIX )
|
|
( -- )
|
|
INST-PREFIX DATA-@ ?DUP IF CODE-C, 0 INST-PREFIX DATA-! THEN ;
|
|
: ADDR, ( GENERATE A NECESSARY ADDRESS SIZE PREFIX )
|
|
( -- )
|
|
ADDR-PREFIX DATA-@ IF 67 CODE-C, 0 ADDR-PREFIX DATA-! THEN ;
|
|
: DATA, ( GENERATE A NECESSARY DATA SIZE PREFIX )
|
|
( -- )
|
|
DATA-PREFIX DATA-@ IF 66 CODE-C, 0 DATA-PREFIX DATA-! THEN ;
|
|
: SEG, ( GENERATE A NECESSARY SEGMENT OVERRIDE PREFIX )
|
|
( -- )
|
|
SEG-PREFIX DATA-@ ?DUP IF CODE-C, 0 SEG-PREFIX DATA-! THEN ;
|
|
|
|
: GENERATE-PREFIXES ( GENERATE NECESSARY PREFIXES )
|
|
( -- )
|
|
INST, ADDR, DATA, SEG, ;
|
|
|
|
( THE PREFIXES )
|
|
: SEG-PRE CREATE DATA-, DOES> DATA-@ SEG-PREFIX DATA-! ;
|
|
: INST-PRE CREATE DATA-, DOES> DATA-@ INST-PREFIX DATA-! ;
|
|
IN-ASM
|
|
2E SEG-PRE CS:
|
|
36 SEG-PRE SS:
|
|
3E SEG-PRE DS:
|
|
26 SEG-PRE ES:
|
|
64 SEG-PRE FS:
|
|
65 SEG-PRE GS:
|
|
0F3 INST-PRE REP
|
|
0F3 INST-PRE REPE
|
|
0F3 INST-PRE REPZ
|
|
0F2 INST-PRE REPNE
|
|
0F2 INST-PRE REPNZ
|
|
0F0 INST-PRE LOCK
|
|
|
|
( SAVE THE P-STACK DEPTH )
|
|
IN-HIDDEN
|
|
: SAVE-DEPTH ( -- )
|
|
SP@ SP-SAVE DATA-! ;
|
|
: DEPTH-CHANGE ( REPORT ON A CHANGE OF DEPTH )
|
|
SP@ SP-SAVE DATA-@ SWAP - CELL/ ;
|
|
|
|
( CREATE AN ASSEMBLY MNEMONIC )
|
|
: COMPILE-OPCODE ( COMPILE THE BYTES IN AN OPCODE )
|
|
( 0 -- | A -- | X \ A -- | X \ X' \ A -- )
|
|
( OS: X ... -- )
|
|
( A IS THE ADDRESS OF A TWO CELL DATA STRUCTURE: )
|
|
( OFFSET 0 -- XT OF THE ACTUAL ROUTINE TO COMPILE THE CODE )
|
|
( OFFSET 1 -- PARAMETER USED TO GENERATE THE CODE )
|
|
?DUP IF
|
|
DUP CELL+ DATA-@ SWAP DATA-@ REGISTER-ASM EXECUTE
|
|
THEN ;
|
|
|
|
DEFER SAVE-INST ( SAVE THE CURRENT INSTRUCTION -- USED IN POSTFIX MODE )
|
|
: _SAVE-INST ( SAVE THE CURRENT INSTRUCTION, AND FETCH THE PREVIOUS ONE )
|
|
( ALSO SWAPS INSTRUCTION PREFIXES )
|
|
( A -- A' )
|
|
INST-SAVE DUP DATA-@ >R DATA-! R> INST-PREFIX SV-INST-PREFIX
|
|
2DUP DATA-@ SWAP DATA-@ ROT DATA-! SWAP DATA-! ;
|
|
' _SAVE-INST IS SAVE-INST
|
|
|
|
IN-ASM
|
|
: POSTFIX ['] _SAVE-INST IS SAVE-INST ;
|
|
: PREFIX ['] NOOP IS SAVE-INST ;
|
|
|
|
IN-HIDDEN
|
|
: _DO-OPCODE ( CREATE THE ACTUAL OPCODE, OR AT LEAST CALL THE FUNCTIONS )
|
|
( THAT DO ... )
|
|
( X? \ X? \ 0|ADDR -- )
|
|
SAVE-INST COMPILE-OPCODE RESET-FOR-NEXT-INSTR SAVE-DEPTH ;
|
|
' _DO-OPCODE IS DO-OPCODE
|
|
|
|
: OPCODE ( C:: PARAMETER \ XT -- )
|
|
( R:: -- | X -- | X \ X' -- )
|
|
( R::OS: X ... -- )
|
|
CREATE DATA-, DATA-, DOES> DO-OPCODE ;
|
|
|
|
( SUPPORT ROUTINES FOR CREATING ASSEMBLY CODE )
|
|
: ALL-EXCEPT ( PROCESS ALL OPERANDS EXCEPT ONE IN PARTICULAR )
|
|
( X \ N -- TYPE \ MOD-R/M {X!=N} | -- 0 \ 0 )
|
|
OVER = IF DROP 0 0 ELSE <DEC-REG> >R >R ?ADSIZE ?OPSIZE R> R> THEN ;
|
|
|
|
: OFFSET8, ( CREATE AN 8 BIT CODE-HERE RELATIVE OFFSET )
|
|
( ADDR -- )
|
|
8B-REL REGISTER-REF CODE-HERE 1+ - DUP ABS 7F > ?TOOFAR CODE-C, ;
|
|
: OFFSET16, ( CREATE A 16 BIT CODE-HERE RELATIVE OFFSET )
|
|
( ADDR -- )
|
|
16B-REL REGISTER-REF CODE-HERE 2+ - DUP ABS 7FFF > ?TOOFAR CODE-W, ;
|
|
: OFFSET32, ( CREATE A 32 BIT CODE-HERE RELATIVE OFFSET )
|
|
( ADDR -- )
|
|
32B-REL REGISTER-REF CODE-HERE 4+ - CODE-D, ;
|
|
: OFFSET16/32, ( CREATE A 16 OR 32 BIT CODE-HERE RELATIVE OFFSET )
|
|
( ADDR \ 16BIT? -- )
|
|
IF OFFSET16, ELSE OFFSET32, THEN ;
|
|
|
|
: FLAG-FOR-SIZE-PREFIX ( DO WE NEED A SIZE PREFIX? )
|
|
( SIZE -- FLAG )
|
|
DUP IF DUP 8BIT - IF DEFAULT-SIZE - ELSE DROP 0 THEN THEN ;
|
|
: CHECK-AD-SIZE ( CHECK THE ADDRESS SIZE )
|
|
( -- )
|
|
AD-SIZE DATA-@ FLAG-FOR-SIZE-PREFIX ADDR-PREFIX DATA-! ;
|
|
: CHECK-DT-SIZE ( CHECK THE OPERAND SIZE )
|
|
( -- )
|
|
DT-SIZE DATA-@ FLAG-FOR-SIZE-PREFIX DATA-PREFIX DATA-! ;
|
|
: CHECK-SIZES ( CHECK THE ADDRESS AND OPERAND SIZES )
|
|
( -- )
|
|
CHECK-AD-SIZE CHECK-DT-SIZE ;
|
|
: RTYPE! ( STORE THE ADDRESSING MODE TYPE AND UPDATE MAXTYPE )
|
|
( TYPE -- )
|
|
DUP RTYPE DATA-! MAXTYPE DATA-@ OVER < IF MAXTYPE DATA-! ELSE
|
|
DROP THEN ;
|
|
: SPECIAL-PROCESS? ( DO WE NEED TO SPECIALLY PROCESS THIS REGISTER? )
|
|
( -- FLAG )
|
|
MAXTYPE DATA-@ DUP REGISTER > SWAP FREG < AND ;
|
|
: SPECIAL-REGISTER? ( IS THIS A SPECIAL REGISTER? )
|
|
( -- FLAG )
|
|
RTYPE DATA-@ DUP REGISTER > SWAP FREG < AND ;
|
|
: DO-REG ( DO ANY REGISTER ADDRESSING MODE TRANSLATION )
|
|
( REG \ TYPE -- )
|
|
?REGEXCLUS RTYPE! DO-1OP-EXED? IF
|
|
HAS-MOD-R/M? IF
|
|
MOD-R/M DATA-@ SWAP SPECIAL-PROCESS? IF
|
|
SPECIAL-REGISTER? IF
|
|
8*+ REG,R/M
|
|
ELSE
|
|
MAXTYPE DATA-@ SREG = IF
|
|
C0+ SWAP C0-8* +
|
|
ELSE
|
|
C0+ +
|
|
THEN R/M,REG
|
|
THEN
|
|
ELSE
|
|
8*+ REG,R/M
|
|
THEN
|
|
ELSE ( *MUST* BE REG,DISP OR REG,IMMED )
|
|
C0+ REG,R/M HAS-MOD-R/M HAS-IMMED? 0= IF
|
|
HAS-OFFSET
|
|
THEN
|
|
THEN
|
|
ELSE ( FIRST TIME THROUGH DO-1OP )
|
|
SPECIAL-REGISTER? RTYPE DATA-@ SREG <> AND IF
|
|
8*
|
|
ELSE ( EITHER A GENERAL OR SEGMENT REGISTER )
|
|
C0+
|
|
THEN HAS-MOD-R/M R/M,REG
|
|
THEN MOD-R/M DATA-! ;
|
|
: DO-IMMED ( DO AN IMMEDIATE ADDRESSING MODE OPERAND )
|
|
( X \ 0 -- )
|
|
DROP IMMED-SV DATA-! HAS-IMMED IMMEDIATE RTYPE! ;
|
|
: DO-INDIRE ( DO AN INDIRECT ADDRESSING MODE OPERAND )
|
|
( REG -- )
|
|
HAS-MOD-R/M? IF
|
|
MOD-R/M DATA-@ DUP 0BF > IF
|
|
C0-8* +
|
|
ELSE
|
|
+
|
|
THEN
|
|
ELSE
|
|
HAS-MOD-R/M
|
|
THEN MOD-R/M DATA-! HAS-BASE ;
|
|
: DO-INDEX ( DO A SCALED INDEX ADDRESSING MODE )
|
|
( REG -- )
|
|
HAS-S-I-B 8* S-I-B DATA-@ 8/ + S-I-B DATA-! HAS-MOD-R/M? IF
|
|
MOD-R/M DATA-@ DUP 0BF > IF
|
|
C0-8* 4+
|
|
ELSE
|
|
[ 7 -1 XOR ] LITERAL AND 4+
|
|
THEN
|
|
ELSE
|
|
4 HAS-MOD-R/M
|
|
THEN MOD-R/M DATA-! ;
|
|
: DO-BASED ( DO A BASE REGISTER ADDRESSING MODE )
|
|
( REG -- )
|
|
HAS-MOD-R/M? IF
|
|
MOD-R/M DATA-@ DUP 0BF > IF
|
|
C0-8* OVER 8* S-I-B DATA-! +
|
|
ELSE
|
|
MAYBE-S-I-B? IF
|
|
HAS-S-I-B S-I-B ROT OVER DATA-@ + SWAP
|
|
DATA-! [ 7 -1 XOR ] LITERAL AND 4+
|
|
ELSE
|
|
OVER 8* S-I-B DATA-! +
|
|
THEN
|
|
THEN
|
|
ELSE
|
|
DUP 8* S-I-B DATA-! HAS-MOD-R/M
|
|
THEN MOD-R/M DATA-! HAS-BASE ;
|
|
|
|
: OPERAND-CASES ( PROCESS AN OPERAND BASED ON ITS TYPE )
|
|
( REG \ TYPE -- | X \ REG \ TYPE -- )
|
|
CASE UNKNOWN OF
|
|
DROP
|
|
ENDOF IMMEDIATE OF
|
|
DO-IMMED
|
|
ENDOF INDIRECT OF
|
|
?REGEXCLUS INDIRECT RTYPE! DO-INDIRE
|
|
ENDOF INDEX OF
|
|
RTYPE DATA-@ ?DUP IF BASED ?NOMATCH THEN INDEX RTYPE! DO-INDEX
|
|
ENDOF BASED OF
|
|
RTYPE DATA-@ ?DUP IF BASED OVER = INDEX ROT = OR 0= ?BADCOMBINE
|
|
THEN BASED RTYPE! DO-BASED
|
|
ENDOF ( MUST BE A REGISTER TYPE ) DO-REG DUP ( SO ENDCASE HAS )
|
|
( SOMETHING TO DISCARD ) ENDCASE ;
|
|
: SAVE-OFFSET ( SAVE THE OFFSET, IF IT'S PRESENT )
|
|
( X -- | -- )
|
|
DEPTH-CHANGE IF MAYBE-HAS-OFFSET ?DUP IF OFFSET-SV DATA-! HAS-OFFSET
|
|
THEN THEN ;
|
|
: DO-1OP ( PROCESS A SINGLE OPERAND )
|
|
( -- | X -- | X \ X' -- )
|
|
0 RTYPE DATA-! BEGIN OP-DEPTH IF POP-OP ELSE FALSE THEN ?DUP WHILE
|
|
0 ALL-EXCEPT SWAP OPERAND-CASES REPEAT SAVE-OFFSET DO-1OP-EXED ;
|
|
: LIT-OP ( INSTERT THE LITERAL VALUE OF AN OPERAND INTO CODE )
|
|
( C:: -- )
|
|
( R:: -- X )
|
|
' >BODY DATA-@ POSTPONE LITERAL ; ALSO FORTH IMMEDIATE IN-HIDDEN
|
|
: PARSE-CALL/JMP-OPERANDS ( PARSE THE OPERANDS FOR CALLS AND JUMPS )
|
|
( -- | X -- )
|
|
0 RTYPE DATA-! BEGIN OP-DEPTH WHILE POP-OP DUP LIT-OP SHORT = OVER
|
|
LIT-OP NEAR = OR OVER LIT-OP FAR = OR IF CASE LIT-OP SHORT OF
|
|
IS-SHORT ENDOF LIT-OP NEAR OF IS-NEAR ENDOF IS-FAR ENDCASE ELSE
|
|
0 ALL-EXCEPT SWAP OPERAND-CASES THEN REPEAT ?NOIMMED SAVE-OFFSET ;
|
|
: DO-2OPS ( DO TWO OPERANDS AND SET SIZE PREFIXES )
|
|
( -- | X -- | X \ X -- )
|
|
DO-1OP DO-1OP CHECK-SIZES ;
|
|
: INSTALL-/R ( INSTALL THE /R FIELD IN A MOD-R/M BYTE )
|
|
( /R VALUE -- )
|
|
8* MOD-R/M DATA-@ [ 7 8* -1 XOR ] LITERAL AND OR MOD-R/M DATA-! ;
|
|
|
|
: DISP, ( COMPILE THE DISPLACEMENT )
|
|
( -- )
|
|
HAS-OFFSET? IF OFFSET-SV DATA-@ DUP ABS 7F > HAS-FULL-OFF? OR
|
|
IF AD-SIZE DATA-@ 16BIT = IF 16B-ABS REGISTER-REF CODE-W, ELSE 32B-ABS
|
|
REGISTER-REF CODE-D, THEN ELSE 8B-ABS REGISTER-REF CODE-C, THEN THEN ;
|
|
|
|
: DEFAULT-8BIT ( CHANGE A ZERO SIZE TO 8BIT )
|
|
( SIZE -- SIZE' )
|
|
?DUP 0= IF 8BIT THEN ;
|
|
: >DEFAULT-SIZE ( CHANGE A ZERO SIZE TO THE DEFAULT SIZE )
|
|
( SIZE -- SIZE' )
|
|
?DUP 0= IF DEFAULT-SIZE THEN ;
|
|
: GET-DT-SIZE ( GET THE CURRENT DATA SIZE, DEFAULT IS 8 BIT )
|
|
( -- DATA SIZE )
|
|
DT-SIZE DATA-@ DEFAULT-8BIT ;
|
|
: GET-AD-SIZE ( GET THE CURRENT ADDRESS SIZE, DEFAULT IS DEFAULT-SIZE )
|
|
( -- ADDRESS SIZE )
|
|
AD-SIZE DATA-@ >DEFAULT-SIZE ;
|
|
: GET-FP-SIZE ( GET THE SIZE OF FP OPERAND, DEFAULT IS DEFAULT-SIZE )
|
|
DT-SIZE DATA-@ >DEFAULT-SIZE ;
|
|
|
|
: IMMED, ( COMPILE THE IMMEDIATE OPERAND )
|
|
( -- )
|
|
HAS-IMMED? IF
|
|
IMMED-SV DATA-@ GET-DT-SIZE CASE
|
|
8BIT OF 8B-ABS REGISTER-REF CODE-C, ENDOF
|
|
16BIT OF 16B-ABS REGISTER-REF CODE-W, ENDOF
|
|
32BIT OF 32B-ABS REGISTER-REF CODE-D, ENDOF
|
|
?NOADSIZE DROP
|
|
ENDCASE
|
|
THEN ;
|
|
|
|
: 8BIT? ( IS THE OPERATION 8 BITS WIDE? )
|
|
( -- FLAG )
|
|
GET-DT-SIZE 8BIT = ;
|
|
: A16BIT? ( IS THE ADDRESS SIZE 16 BITS? )
|
|
( -- FLAG )
|
|
GET-AD-SIZE 16BIT = ;
|
|
: A32BIT? ( IS THE ADDRESS SIZE 32 BITS? )
|
|
( -- FLAG )
|
|
GET-AD-SIZE 32BIT = ;
|
|
|
|
: S-I-B, ( COMPILE THE S-I-B BYTE )
|
|
( -- )
|
|
HAS-S-I-B? A32BIT? AND IF S-I-B DATA-@ CODE-C, THEN ;
|
|
|
|
: +SIZE-BIT ( ADJUST AN OPCODE FOR THE SIZE OF THE OPERATION )
|
|
( OP-CODE -- OP-CODE' )
|
|
8BIT? 0= IF 1+ THEN ;
|
|
: +DIRECT-BIT ( ADJUST AN OPCODE FOR THE DIRECTION OF THE OPERANDS )
|
|
( OP-CODE -- OP-CODE' )
|
|
DIRECTION? IF 2+ THEN ;
|
|
|
|
: MATCH-R/M? ( DOES THE VALUE MATCH THE R/M FIELD OF THE MOD-R/M? )
|
|
( VALUE -- FLAG )
|
|
MOD-R/M DATA-@ 7 AND = ;
|
|
: PURE-REG? ( IS THE MOD FIELD OF THE MOD-R/M = 3? )
|
|
( -- FLAG )
|
|
MOD-R/M DATA-@ 0BF > ;
|
|
: DISPLACEMENT? ( DOES THE ADDRESS MODE HAVE A PURE DISPLACEMENT? )
|
|
( -- FLAG )
|
|
HAS-MOD-R/M? IF PURE-REG? MAYBE-HAS-OFFSET? AND ELSE TRUE THEN ;
|
|
: [(E)BP]? ( DOES THE ADDRESS MODE HAVE EITHER [BP] OR [EBP] ALONE? )
|
|
( -- FLAG )
|
|
A16BIT? 6 MATCH-R/M? AND A32BIT? 5 MATCH-R/M? AND OR MOD-R/M
|
|
DATA-@ 40 < AND ;
|
|
: [REG*N]? ( DOES IT HAVE ONLY AN INDEX REGISTER? )
|
|
( -- FLAG )
|
|
HAS-S-I-B? HAS-BASE? 0= AND ;
|
|
: [ESP][REG]? ( DOES IT HAVE ESP AS AN INDEX REGISTER? )
|
|
( -- FLAG )
|
|
S-I-B DATA-@ 8/ 4 = ;
|
|
: [ESP]? ( DOES IT HAVE ONLY A BASE OF ESP? )
|
|
( -- FLAG )
|
|
A32BIT? HAS-BASE? HAS-S-I-B? 0= 4 MATCH-R/M? AND AND AND ;
|
|
|
|
: DO-[(E)BP] ( DO A NAKED [BP] OR [EBP] )
|
|
( -- )
|
|
[(E)BP]? IF HAS-OFFSET THEN ;
|
|
: DO-DISP ( PROCESS A DISPLACEMENT )
|
|
( -- )
|
|
MOD-R/M DATA-@ DUP 0BF > IF C0-8* THEN 5 + A16BIT? IF 1+ THEN
|
|
CODE-C, HAS-FULL-OFF ;
|
|
: DO-[REG*N] ( PROCESS A NAKED INDEX )
|
|
( -- )
|
|
[REG*N]? IF HAS-FULL-OFF 5 S-I-B DATA-+! -80 MOD-R/M DATA-+! THEN ;
|
|
: DO-[ESP][REG] ( SWAP INDEX AND BASE REGISTERS IN S-I-B )
|
|
( -- )
|
|
[ESP][REG]? IF S-I-B DATA-@ 7 AND 8* 4+ S-I-B DATA-! THEN ;
|
|
: DO-[ESP] ( DO [ESP] ONLY )
|
|
( -- )
|
|
[ESP]? IF 24 S-I-B DATA-! HAS-S-I-B THEN ;
|
|
: MOD-R/M, ( COMPILE THE MOD-R/M FIELD )
|
|
( -- )
|
|
DISPLACEMENT? IF DO-DISP ELSE DO-[(E)BP] DO-[ESP][REG] DO-[REG*N]
|
|
DO-[ESP] MOD-R/M DATA-@ HAS-OFFSET? IF OFFSET-SV DATA-@ ABS
|
|
7F > HAS-FULL-OFF? OR IF 80 ELSE 40 THEN + THEN CODE-C, THEN ;
|
|
: COMPILE-FIELDS ( COMPILE THE MOD-R/M, S-I-B, DISPLACEMENT, AND IMMED FIELDS )
|
|
( -- )
|
|
MOD-R/M, S-I-B, DISP, IMMED, ;
|
|
: GENERIC-ENTRY2 ( GENERIC ENTRY SEQUENCE FOR TWO OPERAND INSTRUCTIONS )
|
|
( PARAM \ MAX TYPE -- )
|
|
( | X \ PARAM \ MAX TYPE -- )
|
|
( | X \ X' \ PARAM \ MAX TYPE -- )
|
|
2>R DO-2OPS ?FINISHED 2R> ?BADTYPE GENERATE-PREFIXES ;
|
|
: +FP-SIZE ( ADD 4 IF THE OPERATION SIZE IS 64BIT: IE., DEFAULT FLOAT )
|
|
( N -- N' )
|
|
DT-SIZE DATA-@ 64BIT = IF 4+ THEN ;
|
|
: /R&FREG>MOD-R/M ( TURN /R AND FP REG INTO THE RQD MOD-R/M )
|
|
( /R \ FREG -- MOD-R/M )
|
|
SWAP 8*+ C0+ ;
|
|
: SWAP-REGS ( SWAP THE ORDER OF REGISTERS IN THE MOD-R/M BYTE )
|
|
( -- )
|
|
MOD-R/M DATA-@ DUP 0BF > IF 3F AND 8 /MOD /R&FREG>MOD-R/M THEN MOD-R/M
|
|
DATA-! ;
|
|
: PARSE-FP-OPS ( PARSE FLOATING POINT INSTRUCTION OPERANDS )
|
|
( -- N | X -- N )
|
|
DEPTH-CHANGE 0<> OP-DEPTH 0<> OR IF DO-1OP OP-DEPTH IF DO-1OP 2 ELSE
|
|
1 THEN ELSE 0 THEN ?NOIMMED ?FINISHED CHECK-SIZES ;
|
|
: MOD-R/M>FREG ( CONVERT MOD-R/M BYTE INTO AN FP REGISTER NUMBER )
|
|
( -- N )
|
|
MOD-R/M DATA-@ C0- DUP 7 > IF 8/ THEN ;
|
|
: FP-DIRECTION? ( WHICH DIRECTION IS THE FLOATING POINT DATA GOING? )
|
|
( -- FLAG )
|
|
MOD-R/M DATA-@ 0C7 > ;
|
|
: +FP-DIRECT-BIT ( ADD 4, DEPENDING ON THE DIRECTION OF THE OPERANDS )
|
|
( X -- X' )
|
|
FP-DIRECTION? IF 4+ THEN ;
|
|
: FP-GENERIC-ASSEMBLE ( GENERIC ASSEMBLY OF FLOATING POINT INSTRUCTIONS )
|
|
( OPCODE \ /R FIELD -- )
|
|
INSTALL-/R ADDR, SEG, CODE-C, COMPILE-FIELDS ;
|
|
: SAVE-IMMED ( SAVE IMMEDIATE OPERANDS FOR DOUBLE-SHIFT )
|
|
( X \ PARAM -- PARAM )
|
|
SWAP IMMED-SV DATA-! HAS-IMMED ;
|
|
: NEXT-IS-, ( MAKE SURE THE NEXT OPERAND IS A COMMA )
|
|
( -- )
|
|
POP-OP LIT-OP , - ?BADMODE ;
|
|
|
|
( THE ASSEMBLY ENGINE WORDS -- ACTUALLY DO THE ASSEMBLY )
|
|
( SIMPLE ASSEMBLY INSTRUCTIONS -- NO-BRAINERS )
|
|
: 1BYTE ( COMPILE A SINGLE BYTE, NO OPERAND, NO OVERRIDE OPCODE )
|
|
( PARAM -- )
|
|
>R ?PARAMS R> ?SEG ?INST-PRE ?OPERANDS CODE-C, ;
|
|
: 2BYTE ( COMPILE A TWO BYTE, NO OPERAND, NO OVERRIDE OPCODE )
|
|
( PARAM -- )
|
|
>R ?PARAMS R> ?SEG ?INST-PRE ?OPERANDS CODE-W, ;
|
|
: 3BYTE ( COMPILE A THREE BYTE, NO OPERAND, NO OVERRIDE OPCODE )
|
|
( PARAM -- )
|
|
>R ?PARAMS R> ?SEG ?INST-PRE ?OPERANDS 10000 /MOD SWAP CODE-W,
|
|
CODE-C, ;
|
|
: SIZE-COND-COMP ( COMPILE A SIZE CONDITIONAL ASSEMBLY SEQUENCE )
|
|
( PARAM -- )
|
|
>R ?PARAMS R> ?SEG ?INST-PRE ?OPERANDS 100 /MOD DEFAULT-SIZE - IF
|
|
66 CODE-C, THEN CODE-C, ;
|
|
|
|
( STRING INSTRUCTIONS )
|
|
: STR-ENTRY ( CHECK FOR ENTRY ERROR CONDITIONS )
|
|
( PARAM -- PARAM )
|
|
>R ?PARAMS R> ?LOCK SEG-PREFIX DATA-@ ?DUP IF 3E OVER - 0<>
|
|
26 ROT - 0<> AND IF ?SEG THEN 0 SEG-PREFIX DATA-! THEN ;
|
|
: STR-OPERANDS ( PROCESS OPERANDS FOR STRING INSTRUCTIONS )
|
|
( -- )
|
|
BEGIN OP-DEPTH WHILE POP-OP LIT-OP DX ALL-EXCEPT 2DROP REPEAT ;
|
|
: STR-INST ( THE ENGINE TO CREATE STRING INSTRUCTIONS )
|
|
( PARAM -- )
|
|
STR-ENTRY STR-OPERANDS ?SHORT CHECK-SIZES
|
|
DT-SIZE DATA-@ DUP 0= 8BIT ROT = OR 0= IF 1+ THEN
|
|
GENERATE-PREFIXES CODE-C, ;
|
|
: BYTE-STR-INST ( BYTE STRING INSTRUCTIONS )
|
|
( PARAM -- )
|
|
BYTE STR-INST ;
|
|
: WORD-STR-INST ( WORD STRING INSTRUCTIONS )
|
|
( PARAM -- )
|
|
WORD STR-INST ;
|
|
: DWORD-STR-INST ( DWORD STRING INSTRUCTIONS )
|
|
( PARAM -- )
|
|
DWORD STR-INST ;
|
|
|
|
( CONDITIONAL BRANCH INSTRUCTIONS )
|
|
: JCC-ENTRY ( THE ENTRY SEQUENCE FOR CONDITIONAL BRANCH INSTRUCTIONS )
|
|
( -- )
|
|
?SEG ?INST-PRE 1 ?TOOMANYOPS OP-DEPTH IF POP-OP 0 ALL-EXCEPT
|
|
2DROP ?NOFAR AD-SIZE DATA-@ 16BIT = IF DEFAULT-SIZE AD-SIZE DATA-!
|
|
THEN DT-SIZE DATA-@ ?DUP IF AD-SIZE DATA-! THEN THEN ;
|
|
: JCC-8BIT ( COMPILE AN 8 BIT CONDITIONAL BRANCH )
|
|
( ADDR \ PARAM -- )
|
|
CODE-C, OFFSET8, ;
|
|
: JCC-16/32BIT ( COMPILE A 16 OR 32BIT CONDITIONAL BRANCH )
|
|
( ADDR \ PARAM \ SIZE -- )
|
|
DUP >R FLAG-FOR-SIZE-PREFIX IF 67 ( ADDRESS SIZE PREFIX ) CODE-C,
|
|
THEN 0F CODE-C, 10 + CODE-C, R> 16BIT = OFFSET16/32, ;
|
|
: JCC-UNKNOWN ( COMPILE A CONDITIONAL BRANCH WITH AN UNKNOWN SIZE )
|
|
( ADDR \ PARAM -- )
|
|
OVER CODE-HERE = IF ( UNRESOLVED FORWARD REFERENCE )
|
|
DEFAULT-SIZE JCC-16/32BIT
|
|
ELSE
|
|
OVER CODE-HERE 2+ SWAP - ABS 7F > IF ( CAN'T BE SHORT )
|
|
DEFAULT-SIZE JCC-16/32BIT
|
|
ELSE ( IT CAN BE SHORT )
|
|
JCC-8BIT
|
|
THEN
|
|
THEN ;
|
|
: JCC-COMPILE ( COMPILE A CONDITIONAL BRANCH )
|
|
( ADDR \ PARAM -- )
|
|
JCC-ENTRY AD-SIZE DATA-@ CASE
|
|
UNKNOWN OF JCC-UNKNOWN ENDOF
|
|
8BIT OF JCC-8BIT ENDOF
|
|
16BIT OF 16BIT JCC-16/32BIT ENDOF
|
|
32BIT OF 32BIT JCC-16/32BIT ENDOF
|
|
?NOADSIZE 2DROP ENDCASE ;
|
|
|
|
( LOOP INSTRUCTIONS )
|
|
: LOOP-ENTRY ( THE ENTRY SEQUENCE FOR LOOP INSTRUCTIONS )
|
|
( -- )
|
|
?SEG ?INST-PRE 2 ?TOOMANYOPS OP-DEPTH IF POP-OP ?DUP 0= IF POP-OP
|
|
THEN 0 ALL-EXCEPT OP-DEPTH IF POP-OP DROP THEN 1 ?NOMATCH
|
|
REGISTER ?NOMATCH DT-SIZE DATA-@ DUP 8BIT ?MATCH ELSE DEFAULT-SIZE
|
|
THEN AD-SIZE DATA-! ;
|
|
: LOOP-COMPILE ( COMPILE A LOOP INSTRUCTION )
|
|
( ADDRESS \ PARAM -- )
|
|
LOOP-ENTRY AD-SIZE DATA-@ FLAG-FOR-SIZE-PREFIX IF 67 CODE-C, THEN
|
|
JCC-8BIT ;
|
|
|
|
( JCXZ/JECXZ )
|
|
: JCXZ-COMPILE ( COMPILE JCXZ )
|
|
( ADDRESS \ PARAM -- )
|
|
CX LOOP-COMPILE ;
|
|
: JECXZ-COMPILE ( COMPILE JECXZ )
|
|
( ADDRESS \ PARAM -- )
|
|
ECX LOOP-COMPILE ;
|
|
|
|
( GROUP 1 INSTRUCTIONS -- ADD, ETC. )
|
|
: GROUP1-COMPILE ( COMPILE GROUP 1 INSTRUCTIONS )
|
|
( PARAM -- | X \ PARAM -- | X \ X \ PARAM -- )
|
|
?REP REGISTER GENERIC-ENTRY2 HAS-IMMED? IF 80 +SIZE-BIT IMMED-SV
|
|
DATA-@ 80 OVER > -81 ROT < AND GET-DT-SIZE 8BIT <> AND IF 2+ 8BIT
|
|
DT-SIZE DATA-! THEN SWAP INSTALL-/R ELSE 8* +SIZE-BIT +DIRECT-BIT
|
|
THEN GENERATE-PREFIXES CODE-C, COMPILE-FIELDS ;
|
|
|
|
( GROUP 2 INSTRUCTIONS -- RCL, ETC. )
|
|
: GROUP2-COMPILE ( COMPILE GROUP 2 INSTRUCTIONS )
|
|
( PARAM -- | X \ PARAM -- | X \ X \ PARAM -- )
|
|
?INST-PRE 1 ?NOTENOUGH >R POP-OP CASE
|
|
LIT-OP , OF 0 SAVE-IMMED DROP ENDOF
|
|
LIT-OP # OF 0 SAVE-IMMED DROP NEXT-IS-, ENDOF
|
|
LIT-OP CL OF NEXT-IS-, ENDOF
|
|
DUP PUSH-OP 1 0 SAVE-IMMED DROP
|
|
ENDCASE DO-1OP CHECK-SIZES REGISTER ?BADTYPE HAS-IMMED? IF 0C0
|
|
ELSE 0D2 THEN +SIZE-BIT GENERATE-PREFIXES CODE-C, R> INSTALL-/R
|
|
MOD-R/M, S-I-B, DISP, 8BIT DT-SIZE DATA-! IMMED, ;
|
|
|
|
( GROUP 3 INSTRUCTIONS -- DIV, ETC. )
|
|
: GROUP3-COMPILE ( COMPILE GROUP 3 INSTRUCTIONS )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?REP >R DO-1OP BEGIN OP-DEPTH WHILE POP-OP 0 ALL-EXCEPT 2DROP REPEAT
|
|
?NOIMMED REGISTER ?BADTYPE CHECK-SIZES GENERATE-PREFIXES R> INSTALL-/R
|
|
0F6 +SIZE-BIT CODE-C, COMPILE-FIELDS ;
|
|
: TEST-COMPILE ( COMPILE THE TEST INSTRUCTION, WHICH IS A SPECIAL GROUP3 INS )
|
|
( PARAM -- | X \ PARAM -- | X \ X' \ PARAM -- )
|
|
?INST-PRE REGISTER GENERIC-ENTRY2 DROP HAS-IMMED? IF 0F6 0 INSTALL-/R
|
|
ELSE 84 THEN +SIZE-BIT CODE-C, COMPILE-FIELDS ;
|
|
|
|
|
|
( INC AND DEC )
|
|
: INC-DEC-ENTRY ( PARAM -- | X \ PARAM -- )
|
|
?REP >R DO-1OP R>
|
|
CHECK-SIZES ?FINISHED REGISTER ?BADTYPE
|
|
GENERATE-PREFIXES
|
|
MAXTYPE @ REGISTER =
|
|
;
|
|
|
|
: INC-COMPILE ( COMPILE AN INC OR DEC )
|
|
( PARAM -- | X \ PARAM -- )
|
|
INC-DEC-ENTRY
|
|
IF MOD-R/M DATA-@ [ 40 C0 - ] LITERAL + CODE-C, DROP EXIT
|
|
ELSE 0FE +SIZE-BIT CODE-C,
|
|
THEN
|
|
INSTALL-/R COMPILE-FIELDS
|
|
;
|
|
|
|
: DEC-COMPILE ( COMPILE AN INC OR DEC )
|
|
( PARAM -- | X \ PARAM -- )
|
|
INC-DEC-ENTRY
|
|
IF MOD-R/M DATA-@ [ 48 C0 - ] LITERAL + CODE-C, DROP EXIT
|
|
ELSE 0FE +SIZE-BIT CODE-C,
|
|
THEN
|
|
INSTALL-/R COMPILE-FIELDS
|
|
;
|
|
|
|
( GROUP 6 AND 7 INSTRUCTIONS -- SLDT, SGDT, ETC. )
|
|
: GROUP6&7-COMPILE ( COMPILE A GROUP 6 OR 7 INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R DO-1OP R> ?FINISHED DUP 100 > OVER 0FF AND 4 <> AND
|
|
IF ?MEM THEN CHECK-SIZES ADDR, SEG, 0F CODE-C, 100 /MOD CODE-C,
|
|
INSTALL-/R COMPILE-FIELDS ;
|
|
|
|
( GROUP 8 INSTRUCTIONS -- BT, ETC. )
|
|
: GROUP8-COMPILE ( COMPILE A GROUP 8 INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- | X \ X' \ PARAM -- )
|
|
?REP REGISTER GENERIC-ENTRY2 0F CODE-C, HAS-IMMED? IF INSTALL-/R BA
|
|
ELSE 8* 83 + ?R/M,REG THEN CODE-C, MOD-R/M, S-I-B, DISP, 8BIT DT-SIZE
|
|
DATA-! IMMED, ;
|
|
|
|
( ENTER )
|
|
: ENTER-COMPILE ( COMPILE THE ENTER INSTRUCTION )
|
|
( X \ X' \ PARAM -- )
|
|
3 ?TOOMANYOPS ?INST-PRE ?SEG CLR-OPSTACK DROP 0C8 CODE-C, SWAP
|
|
CODE-W, CODE-C, ;
|
|
|
|
( ARPL )
|
|
: ARPL-COMPILE ( COMPILE THE ARPL INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE DROP DO-2OPS ?FINISHED REGISTER ?BADTYPE ?R/M,REG ?NOIMMED
|
|
ADDR, SEG, 63 CODE-C, SWAP-REGS COMPILE-FIELDS ;
|
|
|
|
( ECHANGE & ALU INSTRUCTIONS -- CMPXCHG, XADD )
|
|
: XCHG&ALU-COMPILE ( COMPILE CMPXCHG OR XADD )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?REP REGISTER GENERIC-ENTRY2 ?R/M,REG ?NOIMMED 0F CODE-C, +SIZE-BIT
|
|
CODE-C, SWAP-REGS COMPILE-FIELDS ;
|
|
|
|
( CMPXCHG8B -- PENTIUM INSTRUCTION SET )
|
|
: CMPXCHG8B-COMP ( ASSEMBLE CMPXCHG8B )
|
|
( PARAM -- )
|
|
?REP DROP ?PARAMS DO-1OP CHECK-AD-SIZE DT-SIZE DATA-@ ?DUP IF 64BIT <>
|
|
?BADMODE THEN ?MEM ?NOIMMED GENERATE-PREFIXES 0C70F CODE-W,
|
|
COMPILE-FIELDS ;
|
|
|
|
( BOUND CHECKING )
|
|
: BOUND-COMPILE ( COMPILE THE BOUND INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE REGISTER GENERIC-ENTRY2 ?REG,MEM ?NOIMMED DROP 62 CODE-C,
|
|
COMPILE-FIELDS ;
|
|
|
|
( BSWAP )
|
|
: BSWAP-COMPILE ( COMPILE BSWAP )
|
|
( PARAM -- )
|
|
?INST-PRE ?SEG DROP ?PARAMS 1 ?TOOMANYOPS POP-OP 0 ALL-EXCEPT SWAP
|
|
REGISTER ?NOMATCH 0F CODE-C, 0C8 + CODE-C, ;
|
|
|
|
( PUSH AND POP )
|
|
: PUSH/POP-ENTRY ( ENTRY SEQUENCE FOR PUSH AND POP COMPILERS )
|
|
( PARAM -- )
|
|
?INST-PRE DROP DO-1OP ?FINISHED SREG ?BADTYPE CHECK-SIZES
|
|
SREG MAXTYPE DATA-@ - IF GENERATE-PREFIXES THEN MAXTYPE DATA-@ ;
|
|
|
|
: PUSH-COMPILE ( COMPILE PUSH )
|
|
( PARAM -- | X \ PARAM -- )
|
|
PUSH/POP-ENTRY CASE
|
|
UNKNOWN OF A16BIT? IF 6 ELSE 5 THEN MOD-R/M DATA-! 6
|
|
INSTALL-/R 0FF CODE-C, MOD-R/M DATA-@ CODE-C,
|
|
HAS-FULL-OFF DISP,
|
|
ENDOF REGISTER OF MOD-R/M DATA-@ [ 50 C0- ] LITERAL +
|
|
CODE-C,
|
|
ENDOF SREG OF MOD-R/M DATA-@ C0-8* 6 + DUP 1E > IF 0F CODE-C,
|
|
[ 0A0 26 - ] LITERAL + THEN CODE-C,
|
|
ENDOF IMMEDIATE OF IMMED-SV DATA-@ ABS 7F > IF 68 GET-FP-SIZE
|
|
DT-SIZE DATA-! ELSE 6A 8BIT DT-SIZE DATA-! THEN
|
|
CODE-C, IMMED,
|
|
ENDOF 0FF CODE-C, 6 INSTALL-/R COMPILE-FIELDS
|
|
ENDCASE ;
|
|
|
|
: POP-COMPILE ( COMPILE POP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
PUSH/POP-ENTRY ?NOIMMED CASE
|
|
UNKNOWN OF A16BIT? IF 6 ELSE 5 THEN MOD-R/M DATA-! 0
|
|
INSTALL-/R 8F CODE-C, MOD-R/M DATA-@ CODE-C,
|
|
HAS-FULL-OFF DISP,
|
|
ENDOF REGISTER OF MOD-R/M DATA-@ [ 58 C0- ] LITERAL +
|
|
CODE-C,
|
|
ENDOF SREG OF MOD-R/M DATA-@ C0-8* 7 + DUP 1F > IF 0F CODE-C,
|
|
[ 0A1 27 - ] LITERAL + THEN CODE-C,
|
|
ENDOF 8F CODE-C, 0 INSTALL-/R COMPILE-FIELDS
|
|
ENDCASE ;
|
|
|
|
( CALL AND JMP )
|
|
: CALL/JMP-ENTRY ( ENTRY FOR CALL AND JUMP )
|
|
( PARAM -- )
|
|
DROP ?INST-PRE PARSE-CALL/JMP-OPERANDS REGISTER ?BADTYPE CHECK-SIZES ;
|
|
: CALL-COMPILE ( COMPILE CALL )
|
|
( PARAM -- | X \ PARAM -- )
|
|
CALL/JMP-ENTRY ?NOSHORT GENERATE-PREFIXES IS-NEAR? IF HAS-MOD-R/M?
|
|
IF 0FF CODE-C, 2 INSTALL-/R COMPILE-FIELDS ELSE 0E8 CODE-C, OFFSET-SV
|
|
DATA-@ A16BIT? OFFSET16/32, THEN ELSE HAS-MOD-R/M? IF 0FF CODE-C, 3
|
|
INSTALL-/R COMPILE-FIELDS ELSE 9A CODE-C, OFFSET-SV DATA-@ A16BIT?
|
|
IF CODE-W, ELSE CODE-D, THEN CODE-W, THEN THEN ;
|
|
: JMP-COMPILE ( COMPILE JMP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
CALL/JMP-ENTRY GENERATE-PREFIXES IS-SHORT? IF OFFSET-SV DATA-@ 0EB
|
|
CODE-C, OFFSET8, ELSE IS-NEAR? IF HAS-MOD-R/M? IF 0FF CODE-C, 4
|
|
INSTALL-/R COMPILE-FIELDS ELSE 0E9 CODE-C, OFFSET-SV DATA-@ A16BIT?
|
|
OFFSET16/32, THEN ELSE HAS-MOD-R/M? IF 0FF CODE-C, 5 INSTALL-/R
|
|
COMPILE-FIELDS ELSE 0EA CODE-C, OFFSET-SV DATA-@ A16BIT? IF CODE-W,
|
|
ELSE CODE-D, THEN CODE-W, THEN THEN THEN ;
|
|
|
|
( I/O INSTRUCTIONS )
|
|
: I/O-COMPILE ( COMPILE AN IN OR OUT )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE ?SEG 3 ?TOOMANYOPS >R DEPTH-CHANGE IF IMMED-SV DATA-!
|
|
HAS-IMMED THEN R> BEGIN OP-DEPTH WHILE POP-OP CASE
|
|
LIT-OP , OF ( DISCARD IT ) ENDOF
|
|
LIT-OP DX OF ( DISCARD IT ) ENDOF
|
|
LIT-OP # OF ( DISCARD IT ) ENDOF
|
|
LIT-OP AL OF 8BIT ?OPSIZE ENDOF
|
|
LIT-OP BYTE OF 8BIT ?OPSIZE ENDOF
|
|
LIT-OP AX OF 16BIT ?OPSIZE ENDOF
|
|
LIT-OP WORD OF 16BIT ?OPSIZE ENDOF
|
|
LIT-OP EAX OF 32BIT ?OPSIZE ENDOF
|
|
LIT-OP DWORD OF 32BIT ?OPSIZE ENDOF
|
|
-1 ?BADMODE
|
|
ENDCASE REPEAT CHECK-DT-SIZE DATA, +SIZE-BIT HAS-IMMED?
|
|
IF CODE-C, IMMED-SV DATA-@ CODE-C, ELSE 8+ CODE-C, THEN ;
|
|
|
|
( BIT SCAN INSTRUCTIONS )
|
|
: BS-COMPILE ( COMPILE A BIT SCAN INSTRUCTION, AND ALSO SELECTOR VALIDATION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE REGISTER GENERIC-ENTRY2 ?NOIMMED ?REG,R/M 0F CODE-C, CODE-C,
|
|
COMPILE-FIELDS ;
|
|
|
|
( MOV INSTRUCTION )
|
|
: MOV-COMPILE ( COMPILE A MOV INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- | X \ X' \ PARAM -- )
|
|
?REP TREG GENERIC-ENTRY2 DROP HAS-IMMED? IF 0C6 +SIZE-BIT ELSE
|
|
MAXTYPE DATA-@ CASE
|
|
REGISTER OF 88 +SIZE-BIT ENDOF
|
|
SREG OF 8C ENDOF
|
|
CREG OF ?REG 0F CODE-C, 20 ENDOF
|
|
DREG OF ?REG 0F CODE-C, 21 ENDOF
|
|
TREG OF ?REG 0F CODE-C, 24 ENDOF
|
|
-1 ?BADMODE 0
|
|
ENDCASE +DIRECT-BIT THEN CODE-C, COMPILE-FIELDS ;
|
|
|
|
( XCHG INSTRUCTION )
|
|
: XCHG-COMPILE ( COMPILE THE XCHG INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?REP REGISTER GENERIC-ENTRY2 ?NOIMMED +SIZE-BIT CODE-C,
|
|
COMPILE-FIELDS ;
|
|
|
|
( RET INSTRUCTION )
|
|
: RETF? ( ADJUST OPCODE FOR FAR RETURN )
|
|
( X -- X' )
|
|
IS-FAR? IF 8+ THEN ;
|
|
: RET-COMPILE ( COMPILE THE RET INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE 2 ?TOOMANYOPS DROP DEPTH-CHANGE IF IMMED-SV DATA-! HAS-IMMED
|
|
THEN BEGIN OP-DEPTH WHILE POP-OP CASE
|
|
LIT-OP NEAR OF IS-NEAR ENDOF
|
|
LIT-OP FAR OF IS-FAR ENDOF
|
|
LIT-OP # OF ENDOF
|
|
-1 ?BADMODE
|
|
ENDCASE REPEAT HAS-IMMED? IF 0C2 RETF? CODE-C, IMMED-SV DATA-@ CODE-W,
|
|
ELSE 0C3 RETF? CODE-C, THEN ;
|
|
|
|
: RETF-COMPILE ( COMPILE RETF )
|
|
( PARAM -- | X \ PARAM -- )
|
|
FAR RET-COMPILE ;
|
|
|
|
( INT INSTRUCTION )
|
|
: INT-COMPILE ( COMPILE THE INT INSTRUCTION )
|
|
( X \ PARAM -- )
|
|
?INST-PRE DROP 0 ?TOOMANYOPS DEPTH-CHANGE 0= IF 2 ?NOTENOUGH THEN
|
|
DUP 3 = IF DROP 0CC ELSE 0CD CODE-C, THEN CODE-C, ;
|
|
|
|
( SETCC INSTRUCTIONS )
|
|
: SETCC-COMPILE ( COMPILE SETCC INSTRUCTIONS )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R DO-1OP ?FINISHED ?NOIMMED REGISTER ?BADTYPE CHECK-SIZES
|
|
GENERATE-PREFIXES 0F CODE-C, R> CODE-C, COMPILE-FIELDS ;
|
|
|
|
( XLAT/XLATB )
|
|
: XLAT-COMPILE ( COMPILE XLAT )
|
|
( PARAM -- )
|
|
?INST-PRE DROP ?PARAMS 3 ?TOOMANYOPS BEGIN OP-DEPTH WHILE POP-OP CASE
|
|
LIT-OP AL OF ENDOF
|
|
LIT-OP [BX] OF 16BIT ?OPSIZE ENDOF
|
|
LIT-OP [EBX] OF 32BIT ?OPSIZE ENDOF
|
|
-1 ?BADMODE
|
|
ENDCASE REPEAT CHECK-SIZES GENERATE-PREFIXES 0D7 CODE-C, ;
|
|
|
|
: XLATB-COMPILE ( COMPILE XLATB )
|
|
( PARAM -- )
|
|
?SEG ?OPERANDS DEFAULT-SIZE 16BIT = IF [BX] ELSE [EBX] THEN
|
|
XLAT-COMPILE ;
|
|
|
|
( DOUBLE PRECISION SHIFT INSTRUCTIONS )
|
|
: DOUBLE-SHIFT ( COMPILE SHLD, SHRD )
|
|
( PARAM -- | X \ PARAM -- | X \ X' \ PARAM -- )
|
|
?INST-PRE POP-OP CASE LIT-OP , OF SAVE-IMMED ENDOF LIT-OP # OF
|
|
SAVE-IMMED NEXT-IS-, ENDOF LIT-OP CL OF 1+ NEXT-IS-, ENDOF -1
|
|
?BADMODE ENDCASE REGISTER GENERIC-ENTRY2 0F CODE-C, CODE-C, MOD-R/M,
|
|
S-I-B, DISP, 8BIT DT-SIZE DATA-! IMMED, ;
|
|
|
|
( POINTER LOADING INSTRUCTIONS )
|
|
: LOAD-PTR-COMP ( COMPILE A POINTER LOAD INSTRUCTION )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE REGISTER GENERIC-ENTRY2 ?NOIMMED ?REG,R/M ?MEM DUP 100 >
|
|
IF CODE-W, ELSE CODE-C, THEN COMPILE-FIELDS ;
|
|
|
|
( EXTENDED MOV INSTRUCTIONS )
|
|
: MOVX-COMPILE ( COMPILE MOVSX/MOVZX )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R DO-1OP R> +SIZE-BIT 0 DT-SIZE DATA-! >R DO-1OP R>
|
|
?FINISHED ?NOIMMED ?REG,R/M CHECK-SIZES GENERATE-PREFIXES 0F CODE-C,
|
|
CODE-C, COMPILE-FIELDS ;
|
|
|
|
( FADD & FMUL )
|
|
: FAD/FMUL-COMPILE ( COMPILE FADD AND FMUL )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R PARSE-FP-OPS R> SWAP CASE
|
|
0 OF 1 /R&FREG>MOD-R/M ?SEG 0DE CODE-C, CODE-C, ENDOF
|
|
1 OF 0D8 +FP-SIZE SWAP FP-GENERIC-ASSEMBLE ENDOF
|
|
2 OF ?SEG 0D8 +FP-DIRECT-BIT CODE-C, MOD-R/M>FREG
|
|
/R&FREG>MOD-R/M CODE-C, ENDOF
|
|
ENDCASE ;
|
|
|
|
( FST & FSTP )
|
|
: FST-COMPILE ( COMPILE FST AND FSTP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R DO-1OP R> ?FINISHED ?NOIMMED MAXTYPE DATA-@ FREG = IF
|
|
?SEG 0DD CODE-C, MOD-R/M>FREG /R&FREG>MOD-R/M CODE-C,
|
|
ELSE
|
|
REGISTER ?BADTYPE ?MEM CHECK-SIZES DT-SIZE DATA-@
|
|
CASE
|
|
UNKNOWN OF ( FLOAT BY DEFAULT ) 0D9 ENDOF
|
|
32BIT OF 0D9 ENDOF
|
|
64BIT OF 0DD ENDOF
|
|
80BIT OF 4+ 0DB ENDOF
|
|
-1 ?BADMODE 0
|
|
ENDCASE SWAP FP-GENERIC-ASSEMBLE
|
|
THEN ;
|
|
|
|
( INTEGER/FLOATING POINT OPERATIONS )
|
|
: FIX-COMPILE ( COMPILE FIX INSTRUCTIONS )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R DO-1OP ?FINISHED REGISTER ?BADTYPE ?NOIMMED ?MEM
|
|
CHECK-SIZES 0DA DT-SIZE DATA-@ 16BIT = IF 4+ THEN R>
|
|
FP-GENERIC-ASSEMBLE ;
|
|
|
|
( FLOAT OPS THAT POP THE STACK )
|
|
: FXP-COMPILE ( COMPILE FXP INSTRUCTIONS )
|
|
( PARAM -- )
|
|
?INST-PRE ?SEG >R PARSE-FP-OPS 2- ?BADMODE R> 0DE CODE-C,
|
|
MOD-R/M>FREG + CODE-C, ;
|
|
|
|
( FCOM )
|
|
: FCOM-COMPILE ( COMPILE FCOM AND FCOMP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R PARSE-FP-OPS R> SWAP CASE
|
|
0 OF 0D8 CODE-C, 1 /R&FREG>MOD-R/M CODE-C, ENDOF
|
|
1 OF MAXTYPE DATA-@ FREG = IF
|
|
0D8 CODE-C, MOD-R/M>FREG /R&FREG>MOD-R/M CODE-C,
|
|
ELSE
|
|
REGISTER ?BADTYPE ?MEM 0D8 +FP-SIZE SWAP
|
|
FP-GENERIC-ASSEMBLE
|
|
THEN ENDOF
|
|
-1 ?BADMODE DROP
|
|
ENDCASE ;
|
|
|
|
( MISCELLANEOUS FLOATING POINT INSTRUCTIONS )
|
|
: FMISC-COMPILE ( COMPILE MISCELLANEOUS FP INSTRUCTIONS )
|
|
( PARAM -- )
|
|
?INST-PRE ?SEG >R ?PARAMS PARSE-FP-OPS R> 100 /MOD ROT CASE
|
|
0 OF 1+ ENDOF
|
|
1 OF MAXTYPE DATA-@ FREG - ?BADMODE MOD-R/M>FREG + ENDOF
|
|
-1 ?BADMODE
|
|
ENDCASE SWAP CODE-C, CODE-C, ;
|
|
|
|
( FBLD & FBSTP, AND LOAD AND STORE CONTROL WORD, ENVIRONMENT, ETC. )
|
|
: GENERIC-FP-ENTRY1 ( GENERIC ENTRY SEQUENCE FOR FP INST THAT TAKE ONE MEMORY )
|
|
( OPERAND )
|
|
( PARAM -- PARAM | X \ PARAM -- PARAM )
|
|
?INST-PRE >R PARSE-FP-OPS 1- ?BADMODE R> REGISTER ?BADTYPE ?MEM ;
|
|
: FBLD/STP-COMPILE ( COMPILE FBLD & FBSTP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
GENERIC-FP-ENTRY1 100 /MOD DUP 7 > IF 8- 9B CODE-C, THEN
|
|
FP-GENERIC-ASSEMBLE ;
|
|
|
|
( FIST )
|
|
: FIST-COMPILE ( COMPILE FIST & FISTP )
|
|
( PARAM -- | X \ PARAM -- )
|
|
GENERIC-FP-ENTRY1 GET-FP-SIZE CASE
|
|
16BIT OF 0DF ENDOF
|
|
32BIT OF 0DB ENDOF
|
|
64BIT OF 4+ 0DF ENDOF
|
|
-1 ?BADMODE 0
|
|
ENDCASE SWAP FP-GENERIC-ASSEMBLE ;
|
|
|
|
( FSTSW )
|
|
: FSTSW-COMPILE ( COMPILE FSTSW & FNSTSW )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R PARSE-FP-OPS DUP 1 > ?BADMODE REGISTER ?BADTYPE R> IF
|
|
9B CODE-C, THEN CASE
|
|
0 OF ?SEG 0E0DF CODE-W, ENDOF
|
|
1 OF MAXTYPE DATA-@ REGISTER = IF
|
|
MOD-R/M DATA-@ C0- ?BADMODE ?SEG 0E0DF CODE-W,
|
|
ELSE
|
|
0DD 7 FP-GENERIC-ASSEMBLE
|
|
THEN ENDOF
|
|
ENDCASE ;
|
|
|
|
( FILD )
|
|
: FILD-COMPILE ( COMPILE FILD )
|
|
( PARAM -- | X \ PARAM -- )
|
|
GENERIC-FP-ENTRY1 DROP GET-FP-SIZE CASE
|
|
16BIT OF 0DF 0 ENDOF
|
|
32BIT OF 0DB 0 ENDOF
|
|
64BIT OF 0DF 5 ENDOF
|
|
-1 ?BADMODE 0 0
|
|
ENDCASE FP-GENERIC-ASSEMBLE ;
|
|
|
|
( FLD COMPILE )
|
|
: FLD-COMPILE ( COMPILE FLD )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE DROP PARSE-FP-OPS 1- ?BADMODE MAXTYPE DATA-@ FREG = IF
|
|
?SEG 0D9 CODE-C, MOD-R/M>FREG C0+ CODE-C,
|
|
ELSE
|
|
REGISTER ?BADTYPE ?MEM DT-SIZE DATA-@ CASE
|
|
UNKNOWN OF ( ASSUME FLOAT ) 0D9 0 ENDOF
|
|
32BIT OF 0D9 0 ENDOF
|
|
64BIT OF 0DD 0 ENDOF
|
|
80BIT OF 0DB 5 ENDOF
|
|
-1 ?BADMODE 0 0
|
|
ENDCASE FP-GENERIC-ASSEMBLE
|
|
THEN ;
|
|
|
|
( FDIV, FDIVR, FSUB, FSUBR )
|
|
: FDIV/SUB-COMPILE ( COMPILE FDIV, FDIVR, FSUB, & FSUBR )
|
|
( PARAM -- | X \ PARAM -- )
|
|
?INST-PRE >R PARSE-FP-OPS R> SWAP CASE
|
|
0 OF ?SEG 1 XOR 0DE CODE-C, 1 /R&FREG>MOD-R/M CODE-C, ENDOF
|
|
1 OF ?MEM 0D8 +FP-SIZE SWAP FP-GENERIC-ASSEMBLE ENDOF
|
|
2 OF ?SEG MAXTYPE DATA-@ FREG ?NOMATCH 0D8 +FP-DIRECT-BIT
|
|
CODE-C, FP-DIRECTION? IF 1 XOR THEN MOD-R/M>FREG
|
|
/R&FREG>MOD-R/M CODE-C, ENDOF
|
|
ENDCASE ;
|
|
|
|
( THE INSTRUCTIONS )
|
|
IN-ASM
|
|
37 ' 1BYTE OPCODE AAA
|
|
0AD5 ' 2BYTE OPCODE AAD
|
|
0AD4 ' 2BYTE OPCODE AAM
|
|
3F ' 1BYTE OPCODE AAS
|
|
02 ' GROUP1-COMPILE OPCODE ADC
|
|
00 ' GROUP1-COMPILE OPCODE ADD
|
|
04 ' GROUP1-COMPILE OPCODE AND
|
|
0 ' ARPL-COMPILE OPCODE ARPL
|
|
0 ' BOUND-COMPILE OPCODE BOUND
|
|
0BC ' BS-COMPILE OPCODE BSF
|
|
0BD ' BS-COMPILE OPCODE BSR
|
|
0 ' BSWAP-COMPILE OPCODE BSWAP
|
|
04 ' GROUP8-COMPILE OPCODE BT
|
|
07 ' GROUP8-COMPILE OPCODE BTC
|
|
06 ' GROUP8-COMPILE OPCODE BTR
|
|
05 ' GROUP8-COMPILE OPCODE BTS
|
|
0 ' CALL-COMPILE OPCODE CALL
|
|
298 ' SIZE-COND-COMP OPCODE CBW
|
|
399 ' SIZE-COND-COMP OPCODE CDQ
|
|
0F8 ' 1BYTE OPCODE CLC
|
|
0FC ' 1BYTE OPCODE CLD
|
|
0FA ' 1BYTE OPCODE CLI
|
|
060F ' 2BYTE OPCODE CLTS
|
|
0F5 ' 1BYTE OPCODE CMC
|
|
07 ' GROUP1-COMPILE OPCODE CMP
|
|
0A6 ' STR-INST OPCODE CMPS
|
|
0A6 ' BYTE-STR-INST OPCODE CMPSB
|
|
0A6 ' DWORD-STR-INST OPCODE CMPSD
|
|
0A6 ' WORD-STR-INST OPCODE CMPSW
|
|
0BC ' XCHG&ALU-COMPILE OPCODE CMPXCHG
|
|
0 ' CMPXCHG8B-COMP OPCODE CMPXCHG8B
|
|
0A20F ' 2BYTE OPCODE CPUID
|
|
299 ' SIZE-COND-COMP OPCODE CWD
|
|
398 ' SIZE-COND-COMP OPCODE CWDE
|
|
27 ' 1BYTE OPCODE DAA
|
|
2F ' 1BYTE OPCODE DAS
|
|
01 ' DEC-COMPILE OPCODE DEC
|
|
06 ' GROUP3-COMPILE OPCODE DIV
|
|
0 ' ENTER-COMPILE OPCODE ENTER
|
|
0F0D9 ' 2BYTE OPCODE F2XM1
|
|
0E1D9 ' 2BYTE OPCODE FABS
|
|
00 ' FAD/FMUL-COMPILE OPCODE FADD
|
|
0C0 ' FXP-COMPILE OPCODE FADDP
|
|
4DF ' FBLD/STP-COMPILE OPCODE FBLD
|
|
6DF ' FBLD/STP-COMPILE OPCODE FBSTP
|
|
0E0D9 ' 2BYTE OPCODE FCHS
|
|
0E2DB9B ' 3BYTE OPCODE FCLEX
|
|
02 ' FCOM-COMPILE OPCODE FCOM
|
|
03 ' FCOM-COMPILE OPCODE FCOMP
|
|
0D9DE ' 2BYTE OPCODE FCOMPP
|
|
0FFD9 ' 2BYTE OPCODE FCOS
|
|
0F6D9 ' 2BYTE OPCODE FDECSTP
|
|
06 ' FDIV/SUB-COMPILE OPCODE FDIV
|
|
0F8 ' FXP-COMPILE OPCODE FDIVP
|
|
07 ' FDIV/SUB-COMPILE OPCODE FDIVR
|
|
0F0 ' FXP-COMPILE OPCODE FDIVPR
|
|
0C0DD ' FMISC-COMPILE OPCODE FFREE
|
|
00 ' FIX-COMPILE OPCODE FIADD
|
|
02 ' FIX-COMPILE OPCODE FICOM
|
|
03 ' FIX-COMPILE OPCODE FICOMP
|
|
06 ' FIX-COMPILE OPCODE FIDIV
|
|
07 ' FIX-COMPILE OPCODE FIDIVR
|
|
0 ' FILD-COMPILE OPCODE FILD
|
|
01 ' FIX-COMPILE OPCODE FIMUL
|
|
0F7D9 ' 2BYTE OPCODE FINCSTP
|
|
0E3DB9B ' 3BYTE OPCODE FINIT
|
|
04 ' FIX-COMPILE OPCODE FISUB
|
|
05 ' FIX-COMPILE OPCODE FISUBR
|
|
02 ' FIST-COMPILE OPCODE FIST
|
|
03 ' FIST-COMPILE OPCODE FISTP
|
|
0 ' FLD-COMPILE OPCODE FLD
|
|
0E8D9 ' 2BYTE OPCODE FLD1
|
|
5D9 ' FBLD/STP-COMPILE OPCODE FLDCW
|
|
4D9 ' FBLD/STP-COMPILE OPCODE FLDENV
|
|
0E9D9 ' 2BYTE OPCODE FLDL2T
|
|
0EAD9 ' 2BYTE OPCODE FLDL2E
|
|
0EBD9 ' 2BYTE OPCODE FLDPI
|
|
0ECD9 ' 2BYTE OPCODE FLDLG2
|
|
0EDD9 ' 2BYTE OPCODE FLDLN2
|
|
0EED9 ' 2BYTE OPCODE FLDZ
|
|
01 ' FAD/FMUL-COMPILE OPCODE FMUL
|
|
0C8 ' FXP-COMPILE OPCODE FMULP
|
|
0E2DB ' 2BYTE OPCODE FNCLEX
|
|
0E3DB ' 2BYTE OPCODE FNINIT
|
|
0D0D9 ' 2BYTE OPCODE FNOP
|
|
6DD ' FBLD/STP-COMPILE OPCODE FNSAVE
|
|
7D9 ' FBLD/STP-COMPILE OPCODE FNSTCW
|
|
00 ' FSTSW-COMPILE OPCODE FNSTSW
|
|
6D9 ' FBLD/STP-COMPILE OPCODE FNSTENV
|
|
0F3D9 ' 2BYTE OPCODE FPATAN
|
|
0F8D9 ' 2BYTE OPCODE FPREM
|
|
0F5D9 ' 2BYTE OPCODE FPREM1
|
|
0F2D9 ' 2BYTE OPCODE FPTAN
|
|
0FCD9 ' 2BYTE OPCODE FRNDINT
|
|
4DD ' FBLD/STP-COMPILE OPCODE FRSTOR
|
|
0EDD ' FBLD/STP-COMPILE OPCODE FSAVE
|
|
0FDD9 ' 2BYTE OPCODE FSCALE
|
|
0FED9 ' 2BYTE OPCODE FSIN
|
|
0FBD9 ' 2BYTE OPCODE FSINCOS
|
|
0FAD9 ' 2BYTE OPCODE FSQRT
|
|
02 ' FST-COMPILE OPCODE FST
|
|
0FD9 ' FBLD/STP-COMPILE OPCODE FSTCW
|
|
0ED9 ' FBLD/STP-COMPILE OPCODE FSTENV
|
|
03 ' FST-COMPILE OPCODE FSTP
|
|
01 ' FSTSW-COMPILE OPCODE FSTSW
|
|
04 ' FDIV/SUB-COMPILE OPCODE FSUB
|
|
0E8 ' FXP-COMPILE OPCODE FSUBP
|
|
0E0 ' FXP-COMPILE OPCODE FSUBPR
|
|
05 ' FDIV/SUB-COMPILE OPCODE FSUBR
|
|
0E4D9 ' 2BYTE OPCODE FTST
|
|
0E0DD ' FMISC-COMPILE OPCODE FUCOM
|
|
0E8DD ' FMISC-COMPILE OPCODE FUCOMP
|
|
0E9DA ' 2BYTE OPCODE FUCOMPP
|
|
9B ' 1BYTE OPCODE FWAIT
|
|
0E5D9 ' 2BYTE OPCODE FXAM
|
|
0C8D9 ' FMISC-COMPILE OPCODE FXCH
|
|
0F4D9 ' 2BYTE OPCODE FXTRACT
|
|
0F1D9 ' 2BYTE OPCODE FYL2X
|
|
0F9D9 ' 2BYTE OPCODE FYL2XP1
|
|
0F4 ' 1BYTE OPCODE HLT
|
|
07 ' GROUP3-COMPILE OPCODE IDIV
|
|
05 ' GROUP3-COMPILE OPCODE IMUL
|
|
0E4 ' I/O-COMPILE OPCODE IN
|
|
00 ' INC-COMPILE OPCODE INC
|
|
6C ' STR-INST OPCODE INS
|
|
6C ' BYTE-STR-INST OPCODE INSB
|
|
6C ' DWORD-STR-INST OPCODE INSD
|
|
6C ' WORD-STR-INST OPCODE INSW
|
|
0 ' INT-COMPILE OPCODE INT
|
|
0C3 ' 1BYTE OPCODE INTO
|
|
080F ' 2BYTE OPCODE INVD
|
|
107 ' GROUP6&7-COMPILE OPCODE INVLPG
|
|
2CF ' SIZE-COND-COMP OPCODE IRET
|
|
3CF ' SIZE-COND-COMP OPCODE IRETD
|
|
77 ' JCC-COMPILE OPCODE JA
|
|
73 ' JCC-COMPILE OPCODE JAE
|
|
72 ' JCC-COMPILE OPCODE JB
|
|
76 ' JCC-COMPILE OPCODE JBE
|
|
72 ' JCC-COMPILE OPCODE JC
|
|
0E3 ' JCXZ-COMPILE OPCODE JCXZ
|
|
0E3 ' JECXZ-COMPILE OPCODE JECXZ
|
|
74 ' JCC-COMPILE OPCODE JE
|
|
7F ' JCC-COMPILE OPCODE JG
|
|
7D ' JCC-COMPILE OPCODE JGE
|
|
7C ' JCC-COMPILE OPCODE JL
|
|
7E ' JCC-COMPILE OPCODE JLE
|
|
0 ' JMP-COMPILE OPCODE JMP
|
|
76 ' JCC-COMPILE OPCODE JNA
|
|
72 ' JCC-COMPILE OPCODE JNAE
|
|
73 ' JCC-COMPILE OPCODE JNB
|
|
77 ' JCC-COMPILE OPCODE JNBE
|
|
73 ' JCC-COMPILE OPCODE JNC
|
|
75 ' JCC-COMPILE OPCODE JNE
|
|
7E ' JCC-COMPILE OPCODE JNG
|
|
7C ' JCC-COMPILE OPCODE JNGE
|
|
7D ' JCC-COMPILE OPCODE JNL
|
|
7F ' JCC-COMPILE OPCODE JNLE
|
|
71 ' JCC-COMPILE OPCODE JNO
|
|
7B ' JCC-COMPILE OPCODE JNP
|
|
79 ' JCC-COMPILE OPCODE JNS
|
|
75 ' JCC-COMPILE OPCODE JNZ
|
|
70 ' JCC-COMPILE OPCODE JO
|
|
7A ' JCC-COMPILE OPCODE JP
|
|
7A ' JCC-COMPILE OPCODE JPE
|
|
7B ' JCC-COMPILE OPCODE JPO
|
|
78 ' JCC-COMPILE OPCODE JS
|
|
74 ' JCC-COMPILE OPCODE JZ
|
|
9F ' 1BYTE OPCODE LAHF
|
|
02 ' BS-COMPILE OPCODE LAR
|
|
0C5 ' LOAD-PTR-COMP OPCODE LDS
|
|
8D ' LOAD-PTR-COMP OPCODE LEA
|
|
0C9 ' 1BYTE OPCODE LEAVE
|
|
0C4 ' LOAD-PTR-COMP OPCODE LES
|
|
0B40F ' LOAD-PTR-COMP OPCODE LFS
|
|
0B50F ' LOAD-PTR-COMP OPCODE LGS
|
|
03 ' BS-COMPILE OPCODE LSL
|
|
0B20F ' LOAD-PTR-COMP OPCODE LSS
|
|
102 ' GROUP6&7-COMPILE OPCODE LGDT
|
|
103 ' GROUP6&7-COMPILE OPCODE LIDT
|
|
02 ' GROUP6&7-COMPILE OPCODE LLDT
|
|
106 ' GROUP6&7-COMPILE OPCODE LMSW
|
|
0AC ' STR-INST OPCODE LODS
|
|
0AC ' BYTE-STR-INST OPCODE LODSB
|
|
0AC ' DWORD-STR-INST OPCODE LODSD
|
|
0AC ' WORD-STR-INST OPCODE LODSW
|
|
0E2 ' LOOP-COMPILE OPCODE LOOP
|
|
0E1 ' LOOP-COMPILE OPCODE LOOPE
|
|
0E0 ' LOOP-COMPILE OPCODE LOOPNE
|
|
0E0 ' LOOP-COMPILE OPCODE LOOPNZ
|
|
0E1 ' LOOP-COMPILE OPCODE LOOPZ
|
|
03 ' GROUP6&7-COMPILE OPCODE LTR
|
|
0 ' MOV-COMPILE OPCODE MOV
|
|
0A4 ' STR-INST OPCODE MOVS
|
|
0BE ' MOVX-COMPILE OPCODE MOVSX
|
|
0A4 ' BYTE-STR-INST OPCODE MOVSB
|
|
0A4 ' DWORD-STR-INST OPCODE MOVSD
|
|
0A4 ' WORD-STR-INST OPCODE MOVSW
|
|
0B6 ' MOVX-COMPILE OPCODE MOVZX
|
|
04 ' GROUP3-COMPILE OPCODE MUL
|
|
03 ' GROUP3-COMPILE OPCODE NEG
|
|
90 ' 1BYTE OPCODE NOP
|
|
02 ' GROUP3-COMPILE OPCODE NOT
|
|
01 ' GROUP1-COMPILE OPCODE OR
|
|
0E6 ' I/O-COMPILE OPCODE OUT
|
|
6E ' STR-INST OPCODE OUTS
|
|
6E ' BYTE-STR-INST OPCODE OUTSB
|
|
6E ' DWORD-STR-INST OPCODE OUTSD
|
|
6E ' WORD-STR-INST OPCODE OUTSW
|
|
0 ' POP-COMPILE OPCODE POP
|
|
261 ' SIZE-COND-COMP OPCODE POPA
|
|
361 ' SIZE-COND-COMP OPCODE POPAD
|
|
29D ' SIZE-COND-COMP OPCODE POPF
|
|
39D ' SIZE-COND-COMP OPCODE POPFD
|
|
0 ' PUSH-COMPILE OPCODE PUSH
|
|
260 ' SIZE-COND-COMP OPCODE PUSHA
|
|
360 ' SIZE-COND-COMP OPCODE PUSHAD
|
|
29C ' SIZE-COND-COMP OPCODE PUSHF
|
|
39C ' SIZE-COND-COMP OPCODE PUSHFD
|
|
02 ' GROUP2-COMPILE OPCODE RCL
|
|
03 ' GROUP2-COMPILE OPCODE RCR
|
|
320F ' 2BYTE OPCODE RDMSR
|
|
310F ' 2BYTE OPCODE RDTSC
|
|
0 ' RET-COMPILE OPCODE RET
|
|
0 ' RETF-COMPILE OPCODE RETF
|
|
00 ' GROUP2-COMPILE OPCODE ROL
|
|
01 ' GROUP2-COMPILE OPCODE ROR
|
|
0AA0F ' 2BYTE OPCODE RSM
|
|
9E ' 1BYTE OPCODE SAHF
|
|
04 ' GROUP2-COMPILE OPCODE SAL
|
|
07 ' GROUP2-COMPILE OPCODE SAR
|
|
03 ' GROUP1-COMPILE OPCODE SBB
|
|
0AE ' STR-INST OPCODE SCAS
|
|
0AE ' BYTE-STR-INST OPCODE SCASB
|
|
0AE ' DWORD-STR-INST OPCODE SCASD
|
|
0AE ' WORD-STR-INST OPCODE SCASW
|
|
97 ' SETCC-COMPILE OPCODE SETA
|
|
93 ' SETCC-COMPILE OPCODE SETAE
|
|
92 ' SETCC-COMPILE OPCODE SETB
|
|
96 ' SETCC-COMPILE OPCODE SETBE
|
|
92 ' SETCC-COMPILE OPCODE SETC
|
|
94 ' SETCC-COMPILE OPCODE SETE
|
|
9F ' SETCC-COMPILE OPCODE SETG
|
|
9D ' SETCC-COMPILE OPCODE SETGE
|
|
9C ' SETCC-COMPILE OPCODE SETL
|
|
9E ' SETCC-COMPILE OPCODE SETLE
|
|
96 ' SETCC-COMPILE OPCODE SETNA
|
|
92 ' SETCC-COMPILE OPCODE SETNAE
|
|
93 ' SETCC-COMPILE OPCODE SETNB
|
|
97 ' SETCC-COMPILE OPCODE SETNBE
|
|
93 ' SETCC-COMPILE OPCODE SETNC
|
|
95 ' SETCC-COMPILE OPCODE SETNE
|
|
9E ' SETCC-COMPILE OPCODE SETNG
|
|
9C ' SETCC-COMPILE OPCODE SETNGE
|
|
9D ' SETCC-COMPILE OPCODE SETNL
|
|
9F ' SETCC-COMPILE OPCODE SETNLE
|
|
91 ' SETCC-COMPILE OPCODE SETNO
|
|
9B ' SETCC-COMPILE OPCODE SETNP
|
|
99 ' SETCC-COMPILE OPCODE SETNS
|
|
95 ' SETCC-COMPILE OPCODE SETNZ
|
|
90 ' SETCC-COMPILE OPCODE SETO
|
|
9A ' SETCC-COMPILE OPCODE SETP
|
|
9A ' SETCC-COMPILE OPCODE SETPE
|
|
9B ' SETCC-COMPILE OPCODE SETPO
|
|
98 ' SETCC-COMPILE OPCODE SETS
|
|
94 ' SETCC-COMPILE OPCODE SETZ
|
|
100 ' GROUP6&7-COMPILE OPCODE SGDT
|
|
04 ' GROUP2-COMPILE OPCODE SHL
|
|
0A4 ' DOUBLE-SHIFT OPCODE SHLD
|
|
05 ' GROUP2-COMPILE OPCODE SHR
|
|
0AC ' DOUBLE-SHIFT OPCODE SHRD
|
|
101 ' GROUP6&7-COMPILE OPCODE SIDT
|
|
00 ' GROUP6&7-COMPILE OPCODE SLDT
|
|
104 ' GROUP6&7-COMPILE OPCODE SMSW
|
|
0F9 ' 1BYTE OPCODE STC
|
|
0FD ' 1BYTE OPCODE STD
|
|
0FB ' 1BYTE OPCODE STI
|
|
0AA ' STR-INST OPCODE STOS
|
|
0AA ' BYTE-STR-INST OPCODE STOSB
|
|
0AA ' DWORD-STR-INST OPCODE STOSD
|
|
0AA ' WORD-STR-INST OPCODE STOSW
|
|
01 ' GROUP6&7-COMPILE OPCODE STR
|
|
05 ' GROUP1-COMPILE OPCODE SUB
|
|
0 ' TEST-COMPILE OPCODE TEST
|
|
04 ' GROUP6&7-COMPILE OPCODE VERR
|
|
05 ' GROUP6&7-COMPILE OPCODE VERW
|
|
9B ' 1BYTE OPCODE WAIT
|
|
090F ' 2BYTE OPCODE WBINVD
|
|
300F ' 2BYTE OPCODE WRMSR
|
|
0C0 ' XCHG&ALU-COMPILE OPCODE XADD
|
|
86 ' XCHG-COMPILE OPCODE XCHG
|
|
0 ' XLAT-COMPILE OPCODE XLAT
|
|
0 ' XLATB-COMPILE OPCODE XLATB
|
|
06 ' GROUP1-COMPILE OPCODE XOR
|
|
|
|
( CREATE CODE DEFINITIONS )
|
|
IN-HIDDEN
|
|
VARIABLE CURRENT-SV ( NEEDED FOR STASHING THE CURRENT VOCABULARY )
|
|
: SAVE-CURRENT ( SAVE THE CURRENT VOCABULARY LINKAGE )
|
|
( -- )
|
|
CURRENT DATA-@ CURRENT-SV DATA-! ;
|
|
|
|
: UNSAVE-CURRENT ( RESET CURRENT-SV )
|
|
( -- )
|
|
0 CURRENT-SV DATA-! ;
|
|
|
|
: RESTORE-CURRENT ( RESTORE CURRENT TO ITS PREVIOUSLY SAVED VALUE )
|
|
( -- )
|
|
CURRENT-SV DATA-@ ?DUP IF CURRENT DATA-! UNSAVE-CURRENT THEN ;
|
|
|
|
( DEBUGGING )
|
|
: RESET-ASM RESET-VARS CLR-OPSTACK LOC-INIT SAVE-DEPTH ;
|
|
|
|
IN-ASM
|
|
: INIT-ASM ( INITALIZE ASSEMBLY )
|
|
( -- )
|
|
ALSO ASSEMBLER RESET-ASM ;
|
|
|
|
( FORTH HEADER CREATION WORDS )
|
|
IN-HIDDEN
|
|
: _CODE ( START A NATIVE CODE DEFINITION )
|
|
CODE-HEADER CODE-HERE CELL+ CODE-D, HIDE !CSP INIT-ASM ;
|
|
|
|
: _;CODE ( CREATE THE [;CODE] PART OF A LOW LEVEL DEFINING WORD )
|
|
?CSP !CSP COMPILE (;CODE) POSTPONE [ INIT-ASM ;
|
|
|
|
IN-FORTH
|
|
DEFER CODE ' _CODE IS CODE
|
|
DEFER ;CODE ' _;CODE IS ;CODE
|
|
ALSO FORTH IMMEDIATE PREVIOUS ( NECESSARY BECAUSE OF ASM-HIDDEN IMMEDIATE )
|
|
|
|
: SUBR: ( CREATE A SUBROUTINE IN THE ASSEMBLER VOCABULARY )
|
|
SAVE-CURRENT INIT-ASM DEFINITIONS !CSP CREATE HIDE DATA-HERE 0
|
|
DATA-, CODE-ALIGN CODE-HERE SWAP DATA-! DOES> DATA-@ ;
|
|
|
|
: MACRO: ( CREATE A MACRO IN THE ASSEMBLER VOCABULARY )
|
|
SAVE-CURRENT ALSO ASSEMBLER DEFINITIONS : POSTPONE ENTER-MACRO ;
|
|
|
|
( END CODE DEFINITIONS )
|
|
IN-ASM
|
|
: END-ASM A; PREVIOUS ;
|
|
|
|
IN-HIDDEN
|
|
: _END-CODE ( END A CODE DEFINITION )
|
|
END-ASM ?FINISHED ?UNRES ?CSP REVEAL RESTORE-CURRENT CODE-ALIGN
|
|
EXIT-ASSEMBLER ;
|
|
|
|
IN-ASM
|
|
DEFER END-CODE ' _END-CODE IS END-CODE
|
|
DEFER ;C ' _END-CODE IS ;C
|
|
|
|
: ENDM ( END A MACRO DEFINITION )
|
|
POSTPONE LEAVE-MACRO POSTPONE ; PREVIOUS RESTORE-CURRENT ;
|
|
|
|
|
|
ALSO FORTH IMMEDIATE PREVIOUS
|
|
|
|
: ;MACRO ( END A MACRO DEFINITION )
|
|
POSTPONE ENDM ; ALSO FORTH IMMEDIATE PREVIOUS
|
|
|
|
\ : EXIT ( REDEFINE EXIT TO TAKE CARE OF MACROS )
|
|
\ IN-MACRO? IF LEAVE-MACRO THEN R> DROP ;
|
|
( REDEFINE EXIT TO BE CLOSER TO STANDARD )
|
|
: ?LEAVE-MACRO ( CONDITIONALLY UNNEST A MACRO )
|
|
IN-MACRO? IF LEAVE-MACRO THEN ;
|
|
|
|
: EXIT ( REDEFINE EXIT TO TAKE CARE OF MACROS )
|
|
STATE @ IF POSTPONE ?LEAVE-MACRO POSTPONE EXIT ELSE
|
|
?LEAVE-MACRO EXIT THEN ; ALSO FORTH IMMEDIATE PREVIOUS
|
|
|
|
( UTILITY WORDS )
|
|
: PREFIX? ( ARE WE IN PREFIX MODE? )
|
|
( -- FLAG )
|
|
DEFER@ SAVE-INST ['] NOOP = ;
|
|
|
|
: POSTFIX? ( ARE WE IN POSTFIX MODE? )
|
|
( -- FLAG )
|
|
PREFIX? 0= ;
|
|
|
|
( SETTING AND RESTORING THE ASSEMBLER SYNTAX )
|
|
: SET-POSTFIX ( SET THE ASSEMBLER TO POSTFIX MODE, LEAVE A MODE FLAG )
|
|
( -- PREV. MODE==PREFIX )
|
|
PREFIX? DUP IF >R A; POSTFIX R> THEN ;
|
|
|
|
: SET-PREFIX ( SET THE ASSEMBLER TO PREFIX MODE, LEAVE A MODE FLAG )
|
|
( -- PREV. MODE==PREFIX )
|
|
PREFIX? DUP 0= IF >R A; PREFIX R> THEN ;
|
|
|
|
: RESET-SYNTAX ( RESET THE ASSEMBLER TO THE PREVIOUSLY FLAGGED SYNTAX )
|
|
( PREV. MODE==PREFIX -- )
|
|
IF A; PREFIX ELSE A; POSTFIX THEN ;
|
|
|
|
ONLY FORTH DEFINITIONS BASE !
|