( 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 ) ( 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 ) : ( 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*+ ; : ( 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 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 >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 !