( 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 !
