Aren/kolibrios
1
0
Fork 0
mirror of https://github.com/KolibriOS/kolibrios.git synced 2024-12-25 08:06:49 +03:00
Code Issues Packages Projects Releases Wiki Activity
ba50660e2b
kolibrios/programs/develop/SPForth/lib/asm/486asm.f
Kirill Lipatov (Leency) 09488af869 KolSPForth12 uploaded to SVN 
git-svn-id: svn://kolibrios.org@4867 a494cfbc-eb01-0410-851d-a64ba20cac60
2014-04-21 19:22:58 +00:00

2104 lines
84 KiB
Forth
Raw Blame History

( 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 !
Reference in New Issue View Git Blame Copy Permalink