BlueGreycalmElegant

Català-Valencià – Catalan中文 – Chinese (Simplified)中文 – Chinese (Traditional)Česky – CzechDansk – DanishNederlands – DutchEnglish – EnglishSuomi – FinnishFrançais – FrenchDeutsch – Germanעברית – Hebrewहिंदी – HindiMagyar – HungarianBahasa Indonesia – IndonesianItaliano – Italian日本語 – Japanese한국어 – KoreanМакедонски – Macedonianमराठी – MarathiNorsk – NorwegianPolski – PolishPortuguês – PortuguesePortuguês – Portuguese (Brazil)Русский – RussianSlovenčina – SlovakSlovenščina – SlovenianEspañol – SpanishSvenska – SwedishTürkçe – TurkishУкраїнська – UkrainianOëzbekcha – Uzbek

Compare Revisions

• This comparison shows the changes necessary to convert path

  → /programs/develop/SPForth/lib/ @ 4866

  → /programs/develop/SPForth/lib/ @ 4867

  ↔ Reverse comparison

• Compare Path:	Rev

  With Path:	Rev

No changes between revisions

Regard whitespace Rev 4866 → Rev 4867

/programs/develop/SPForth/lib/asm/486asm.f
0,0 → 1,2103
( 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 !

/programs/develop/SPForth/lib/asm/asmmac.f
0,0 → 1,111
( Miscellaneous macros for Win32FORTH 486ASM version 1.24 )
( copyright [c] 1994 by Jim Schneider )
( This file version 1.2 )
( 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. )
MACRO: ;M POSTPONE ;MACRO ENDM IMMEDIATE
MACRO: AL, AL , ;M
MACRO: CL, CL , ;M
MACRO: DL, DL , ;M
MACRO: BL, BL , ;M
MACRO: AH, AH , ;M
MACRO: CH, CH , ;M
MACRO: DH, DH , ;M
MACRO: BH, BH , ;M
MACRO: AX, AX , ;M
MACRO: CX, CX , ;M
MACRO: DX, DX , ;M
MACRO: BX, BX , ;M
MACRO: SP, SP , ;M
MACRO: BP, BP , ;M
MACRO: SI, SI , ;M
MACRO: DI, DI , ;M
MACRO: EAX, EAX , ;M
MACRO: ECX, ECX , ;M
MACRO: EDX, EDX , ;M
MACRO: EBX, EBX , ;M
MACRO: ESP, ESP , ;M
MACRO: EBP, EBP , ;M
MACRO: ESI, ESI , ;M
MACRO: EDI, EDI , ;M
MACRO: [BX+SI], [BX+SI] , ;M
MACRO: [BX+DI], [BX+DI] , ;M
MACRO: [BP+SI], [BP+SI] , ;M
MACRO: [BP+DI], [BP+DI] , ;M
MACRO: [SI], [SI] , ;M
MACRO: [DI], [DI] , ;M
MACRO: [BP], [BP] , ;M
MACRO: [BX], [BX] , ;M
MACRO: [EAX], [EAX] , ;M
MACRO: [ECX], [ECX] , ;M
MACRO: [EDX], [EDX] , ;M
MACRO: [EBX], [EBX] , ;M
MACRO: [ESP], [ESP] , ;M
MACRO: [EBP], [EBP] , ;M
MACRO: [ESI], [ESI] , ;M
MACRO: [EDI], [EDI] , ;M
MACRO: [EAX*2], [EAX*2] , ;M
MACRO: [ECX*2], [ECX*2] , ;M
MACRO: [EDX*2], [EDX*2] , ;M
MACRO: [EBX*2], [EBX*2] , ;M
\ MACRO: [ESP*2], [ESP*2] , ;M
MACRO: [EBP*2], [EBP*2] , ;M
MACRO: [ESI*2], [ESI*2] , ;M
MACRO: [EDI*2], [EDI*2] , ;M
MACRO: [EAX*4], [EAX*4] , ;M
MACRO: [ECX*4], [ECX*4] , ;M
MACRO: [EDX*4], [EDX*4] , ;M
MACRO: [EBX*4], [EBX*4] , ;M
MACRO: [EBP*4], [EBP*4] , ;M
MACRO: [ESI*4], [ESI*4] , ;M
MACRO: [EDI*4], [EDI*4] , ;M
MACRO: [EAX*8], [EAX*8] , ;M
MACRO: [ECX*8], [ECX*8] , ;M
MACRO: [EDX*8], [EDX*8] , ;M
MACRO: [EBX*8], [EBX*8] , ;M
MACRO: [EBP*8], [EBP*8] , ;M
MACRO: [ESI*8], [ESI*8] , ;M
MACRO: [EDI*8], [EDI*8] , ;M
MACRO: ES, ES , ;M
MACRO: CS, CS , ;M
MACRO: SS, SS , ;M
MACRO: DS, DS , ;M
MACRO: FS, FS , ;M
MACRO: GS, GS , ;M
MACRO: CR0, CR0 , ;M
MACRO: CR2, CR2 , ;M
MACRO: CR3, CR3 , ;M
MACRO: CR4, CR4 , ;M
MACRO: DR0, DR0 , ;M
MACRO: DR1, DR1 , ;M
MACRO: DR2, DR2 , ;M
MACRO: DR3, DR3 , ;M
MACRO: DR6, DR6 , ;M
MACRO: DR7, DR7 , ;M
MACRO: TR3, TR3 , ;M
MACRO: TR4, TR4 , ;M
MACRO: TR5, TR5 , ;M
MACRO: TR6, TR6 , ;M
MACRO: TR7, TR7 , ;M
MACRO: ST, ST , ;M
MACRO: ST(0), ST(0) , ;M
MACRO: ST(1), ST(1) , ;M
MACRO: ST(2), ST(2) , ;M
MACRO: ST(3), ST(3) , ;M
MACRO: ST(4), ST(4) , ;M
MACRO: ST(5), ST(5) , ;M
MACRO: ST(6), ST(6) , ;M
MACRO: ST(7), ST(7) , ;M

/programs/develop/SPForth/lib/asm
Property changes:
Added: tsvn:logminsize
+5
\ No newline at end of property

/programs/develop/SPForth/lib/ext/case.f
0,0 → 1,42
\ Êîíñòðóêöèÿ âûáîðà CASE
\ ñ ó÷åòîì âîçìîæíîé âëîæåííîñòè îïåðàòîðîâ CASE
DECIMAL
VARIABLE CSP \ Óêàçàòåëü ñòåêà êîíòðîëÿ
6 CONSTANT L-CAS# \ Äîïóñòèìûé óðîâåíü âëîæåííîñòè
CREATE S-CSP L-CAS# CELLS ALLOT \ Ñòåê êîíòðîëÿ
S-CSP CSP !
: +CSP ( -> P) \ Äîáàâèòü óðîâåíü
CSP @ DUP CELL+ CSP !
;
: -CSP ( -> ) \ Óáðàòü óðîâåíü
CSP @ 1 CELLS - CSP !
;
: !CSP ( -> ) \ Èíèöèàëèçèðîâàòü óðîâåíü
SP@ +CSP !
;
: CSP@ ( -> A)
CSP @ 1 CELLS - @
;
: ?CSP ( -> ) \ Ïðîâåðèòü âûäåðæàííîñòü ñòåêà
\ SP@ CSP@ <> 37 ?ERROR ( ABORT" Ñáîé ñòåêà ïî CSP !")
-CSP
;
: CASE ( -> )
!CSP
; IMMEDIATE
: OF
POSTPONE OVER POSTPONE =
[COMPILE] IF POSTPONE DROP
; IMMEDIATE
: ENDOF
[COMPILE] ELSE
; IMMEDIATE
: ENDCASE
POSTPONE DROP BEGIN SP@ CSP@ =
0= WHILE [COMPILE] THEN REPEAT -CSP
; IMMEDIATE

/programs/develop/SPForth/lib/ext/disasm.f
0,0 → 1,1555
\ 80386 DISASSEMBLER
\ ANDREW MCKEWAN, APRIL 1994
\ TOM ZIMMER, 05/18/94 PORT TO WIN32F
\ MODIFIED TO WORD IN DECIMAL 08/03/94 10:04 TJZ
\ 06-??-95 SMUB NEXT SEQUENCE DEFINED IN FKERNEL
\ 06-21-95 SMUB REMOVED REDUNDANT COUNT CALLS FROM TXB, LXS.
\ 04-??-97 EXTENDED BY C.L. TO INCLUDE P6 AND MMX INSTRUCTIONS
\ 14-11-2000 Adapted from SPFOPT (Michael Maximov) by Dmitry Yakimov
\ ??-11-2000 Fixed FE. FF. (Bandaletov) and H.R (Yakimov)
\ 15-11-2000 Fixed MV2 (Yakimov)
\ 25-12-2000 Added float literals recognition (Yakimov)
\ 26-07-2001 Fixed MVX (Maksimov)
\ 11-05-2004 Fixed FDA and CMV (Serguei Jidkov)
CR .( Loading Intel Pentium MMX disassembler...)
WARNING @
BASE @
GET-CURRENT
( warn base wid )
WARNING 0!
DECIMAL
REQUIRE [DEFINED] lib/include/tools.f
\ REQUIRE [IF] ~mak\CompIF.f
REQUIRE CASE lib/ext/case.f
\ REQUIRE WITHIN lib\include\core-ext.f
REQUIRE NextNFA lib/ext/vocs.f
: DEFER VECT ;
: DUP>R R> OVER >R >R ;
: UMAX ( D1 D2 -- FLAG )
2DUP U< IF NIP ELSE DROP THEN ;
80 CONSTANT MAXSTRING
255 CONSTANT MAXCOUNTED \ maximum length of contents of a counted string
: 0X BASE @ HEX >R BL WORD ?LITERAL
R> BASE ! ; IMMEDIATE
: "CLIP" ( a1 n1 -- a1 n1' ) \ clip a string to between 0 and MAXCOUNTED
MAXCOUNTED MIN 0 MAX ;
: PLACE ( addr len dest -- )
SWAP "CLIP" SWAP
2DUP 2>R
CHAR+ SWAP MOVE
2R> C! ;
: +PLACE ( addr len dest -- ) \ append string addr,len to counted
\ string dest
>R "CLIP" MAXCOUNTED R@ C@ - MIN R>
\ clip total to MAXCOUNTED string
2DUP 2>R
COUNT CHARS + SWAP MOVE
2R> +! ;
: C+PLACE ( c1 a1 -- ) \ append char c1 to the counted string at a1
DUP 1+! COUNT + 1- C! ;
: OFF 0! ;
: BLANK ( addr len -- ) \ fill addr for len with spaces (blanks)
BL FILL ;
128 CONSTANT SPCS-MAX ( optimization for SPACES )
CREATE SPCS SPCS-MAX ALLOT
SPCS SPCS-MAX BLANK
C" UPC" FIND NIP 0=
[IF]
: UPC ( c -- c' )
DUP [CHAR] Z U>
IF 0xDF AND
THEN ;
[THEN]
: (D.) ( d -- addr len ) TUCK DABS <# #S ROT SIGN #> ;
80 VALUE COLS
: H.R ( n1 n2 -- ) \ display n1 as a hex number right
\ justified in a field of n2 characters
BASE @ >R HEX >R
0 <# #S #> R> OVER - 0 MAX SPACES TYPE
R> BASE ! ;
: H.N ( n1 n2 -- ) \ display n1 as a HEX number of n2 digits
BASE @ >R HEX >R
0 <# R> 0 ?DO # LOOP #> TYPE
R> BASE ! ;
0 VALUE DEFAULT-16BIT?
: DEFAULT-16BIT ( -- )
TRUE TO DEFAULT-16BIT? ;
: DEFAULT-32BIT ( -- )
FALSE TO DEFAULT-16BIT? ;
DEFER SHOW-NAME ( CFA -- ) \ DISPLAY NEAREST SYMBOL
0 VALUE BASE-ADDR
VOCABULARY DISASSEMBLER
ALSO DISASSEMBLER DEFINITIONS
CREATE S-BUF MAXSTRING ALLOT
: >S ( A1 N1 -- )
S-BUF +PLACE ;
: 0>S ( -- ) \ RESET S-BUF
S-BUF OFF ;
: SSPACES ( N1 -- )
SPCS SWAP S-BUF +PLACE ;
: SSPACE ( -- )
1 SSPACES ;
: EMIT>S ( C1 -- )
S-BUF C+PLACE ;
: S> ( -- A1 N1 )
S-BUF COUNT ;
: (.S") ( addr len -- )
S-BUF +PLACE ;
: .S" ( 'TEXT' -- )
[CHAR] " PARSE
POSTPONE SLITERAL
POSTPONE (.S") ; IMMEDIATE
: D.R>S ( D W -- )
>R (D.) R> OVER - SSPACES >S ;
: .R>S ( N W -- )
>R S>D R> D.R>S ;
: U.R>S ( U W -- )
0 SWAP D.R>S ;
: H.>S ( U -- )
BASE @ SWAP HEX 0 (D.) >S SSPACE BASE ! ;
: H.R>S ( N1 N2 -- )
BASE @ >R HEX >R
0 <# #S #> R> OVER - SSPACES >S
R> BASE ! ;
: ?.NAME>S ( CFA -- )
\ ELIMINATE " 0X"
DUP 1 H.R>S SSPACE
NEAR_NFA
>R DUP
IF .S" ( " DUP COUNT >S
NAME> R> - DUP
IF DUP .S" +" NEGATE H.>S
THEN DROP .S" ) "
ELSE RDROP DROP
THEN
;
' ?.NAME>S TO SHOW-NAME
\ 32 CONSTANT COMMENT-COL
0 VALUE SIZE
0 VALUE 16-BIT-DATA
0 VALUE 16-BIT-ADDR
0 VALUE PREFIX-OP
0 VALUE MMX-REG
: @+ ( ADDR -- ADDR N ) DUP CELL+ SWAP @ ;
: W@+ ( ADDR -- ADDR N ) DUP 2 + SWAP W@ ;
: SEXT ( BYTE -- N ) DUP 128 AND IF 0xFFFFFF00 OR THEN ;
: MOD/SIB ( MOD-R-R/M -- R/M R MOD ) \ R INCLUDING GENERAL, SPECIAL, SEGMENT, MMX
( MOD-OP-R/M -- R/M OP MOD )
( S-I-B -- B I S )
255 AND 8 /MOD 8 /MOD ;
: ??? ( N1 -- )
.S" ??? " DROP ;
: SS. ( N ADR LEN W ) >R DROP SWAP R@ * + R> >S SSPACE ;
: TTTN ( CODE -- ) 15 AND S" O NOB AEE NEBEA S NSP NPL GELEG " 2 SS. ;
: SREG ( SREG -- ) 3 RSHIFT 7 AND S" ESCSSSDSFSGSXXXX" 2 SS. ;
: CREG ( EEE -- ) 3 RSHIFT 7 AND S" CR0???CR2CR3CR4?????????" 3 SS. ;
: DREG ( EEE -- ) 3 RSHIFT 7 AND S" DR0DR1DR2DR3??????DR6DR7" 3 SS. ;
: TREG ( EEE -- ) 3 RSHIFT 7 AND S" ?????????TR3TR4TR5TR6TR7" 3 SS. ; \ OBSOLETE
: MREG ( N -- ) 7 AND S" MM0MM1MM2MM3MM4MM5MM6MM7" 3 SS. ;
: REG8 ( N -- ) 7 AND S" ALCLDLBLAHCHDHBH" 2 SS. ;
: REG16 ( N -- ) 7 AND S" AXCXDXBXSPBPSIDI" 2 SS. ;
: REG32 ( N -- ) 7 AND S" EAXECXEDXEBXESPEBPESIEDI" 3 SS. ;
: REG16/32 ( N -- )
16-BIT-DATA
IF REG16
ELSE REG32
THEN ;
: REG ( A N -- A )
MMX-REG
IF MREG
ELSE SIZE
IF REG16/32
ELSE REG8
THEN
THEN
;
: [BASE16] ( R/M -- ) 4 - S" [SI][DI][BP][BX]" 4 SS. ;
\ R/M = 4 , 5 , 6 , 7
: [IND16] ( R/M -- ) S" [BX+SI][BX+DI][BP+SI][BP+DI]" 7 SS. ;
\ R/M = 0 , 1 , 2 , 3
: [REG16] ( R/M -- ) DUP 4 <
IF [IND16]
ELSE [BASE16]
THEN ;
: [REG32] ( N -- ) 7 AND S" [EAX][ECX][EDX][EBX][ESP][EBP][ESI][EDI]" 5 SS. ;
: [REG*2] ( I -- ) S" [EAX*2][ECX*2][EDX*2][EBX*2][XXX*2][EBP*2][ESI*2][EDI*2]" 7 SS. ;
: [REG*4] ( I -- ) S" [EAX*4][ECX*4][EDX*4][EBX*4][XXX*4][EBP*4][ESI*4][EDI*4]" 7 SS. ;
: [REG*8] ( I -- ) S" [EAX*8][ECX*8][EDX*8][EBX*8][XXX*8][EBP*8][ESI*8][EDI*8]" 7 SS. ;
: [INDEX] ( SIB -- ) MOD/SIB OVER 4 =
IF 2DROP \ NO ESP SCALED INDEX
ELSE CASE ( S )
0 OF [REG32] ENDOF
1 OF [REG*2] ENDOF
2 OF [REG*4] ENDOF
3 OF [REG*8] ENDOF
ENDCASE
THEN DROP ;
: DISP8 ( ADR -- ADR' ) COUNT H.>S ;
: DISP16 ( ADR -- ADR' ) W@+ SHOW-NAME ;
: DISP32 ( ADR -- ADR' ) @+ ( BODY> ) SHOW-NAME ;
: DISP16/32 ( ADR -- ADR' )
16-BIT-ADDR
IF DISP16
ELSE DISP32
THEN ;
: ., ( -- ) .S" , " ;
: .# ., .S" # " ;
: IMM8 ( ADR -- ADR' ) .# COUNT H.>S ;
\ : IMM16 ( ADR -- ADR' ) .# W@+ H.>S ;
: IMM16/32 ( ADR -- ADR' )
.# 16-BIT-DATA
IF W@+
ELSE @+
THEN H.>S ;
: SIB ( ADR MOD -- ADR )
>R COUNT TUCK 7 AND 5 = R@ 0= AND
IF DISP32 SWAP [INDEX] R> DROP \ EBP BASE AND MOD = 00
ELSE R> CASE ( MOD )
1 OF DISP8 ENDOF
2 OF DISP32 ENDOF
ENDCASE
SWAP DUP [REG32] [INDEX]
THEN ;
: MOD-R/M32 ( ADR R/M MOD -- ADR' )
DUP 3 =
IF DROP REG \ MOD = 3, REGISTER CASE
ELSE OVER 4 =
IF NIP SIB \ R/M = 4, SIB CASE
ELSE 2DUP 0= SWAP 5 = AND \ MOD = 0, R/M = 5,
IF 2DROP DISP32 \ DISP32 CASE
ELSE ROT SWAP
CASE ( MOD )
1 OF DISP8 ENDOF
2 OF DISP32 ENDOF
ENDCASE
SWAP [REG32]
THEN
THEN
THEN ;
: MOD-R/M16 ( ADR R/M MOD -- ADR' )
2DUP 0= SWAP 6 = AND
IF 2DROP DISP16 \ DISP16 CASE
ELSE CASE ( MOD )
0 OF [REG16] ENDOF
1 OF SWAP DISP8 SWAP [REG16] ENDOF
2 OF SWAP DISP16 SWAP [REG16] ENDOF
3 OF REG ENDOF
ENDCASE
THEN ;
: MOD-R/M ( ADR MODR/M -- ADR' )
MOD/SIB NIP 16-BIT-ADDR
IF MOD-R/M16
ELSE MOD-R/M32
THEN ;
: R/M8 0 TO SIZE MOD-R/M ;
: R/M16/32 1 TO SIZE MOD-R/M ;
: R/M16 TRUE TO 16-BIT-DATA R/M16/32 ;
: R,R/M ( ADR -- ADR' )
COUNT DUP 3 RSHIFT REG ., MOD-R/M ;
: R/M,R ( ADR -- ADR' )
COUNT DUP>R MOD-R/M ., R> 3 RSHIFT REG ;
: R/M ( ADR OP -- ADR' )
2 AND
IF R,R/M
ELSE R/M,R
THEN ;
\ -------------------- SIMPLE OPCODES --------------------
: INH ( -<NAME>- )
CREATE
BL WORD COUNT HERE PLACE
HERE C@ 1+ ALLOT
DOES> COUNT >S SSPACE DROP ;
INH CLC CLC
INH STC STC
INH CLD CLD
INH STD STD
\ INH RPNZ REPNZ
\ INH REPZ REPZ
INH CBW CBW
INH CDQ CDQ
INH DAA DAA
INH DAS DAS
INH AAA AAA
INH AAS AAS
\ INH LOCK LOCK
INH INB INSB
INH OSB OUTSB
INH SAH SAHF
INH LAH LAHF
\ INH AAM AAM
\ INH AAD AAD
INH HLT HLT
INH CMC CMC
INH XLT XLAT
INH CLI CLI
INH STI STI
INH CLT CLTS
INH INV INVD
INH WIV WBINVD
INH UD2 UD2
INH WMR WRMSR
INH RTC RDTSC
INH RMR RDMSR
INH RPC RDPMC
INH EMS EMMS
INH RSM RSM
INH CPU CPUID
INH UD1 UD1
\ INH LSS LSS
\ INH LFS LFS
\ INH LGS LGS
\ INH D16: D16:
\ INH A16: A16:
\ INH ES: ES:
\ INH CS: CS:
\ INH DS: DS:
\ INH FS: FS:
\ INH GS: GS:
: AAM ( ADR CODE -- ADR' )
.S" AAM" DROP COUNT DROP ;
: AAD ( ADR CODE -- ADR' )
.S" AAD" DROP COUNT DROP ;
: D16 ( ADR CODE -- ADR' )
DROP .S" D16:"
TRUE TO 16-BIT-DATA
TRUE TO PREFIX-OP
;
: A16 ( ADR CODE -- ADR' )
DROP .S" A16:"
TRUE TO 16-BIT-ADDR
TRUE TO PREFIX-OP
;
: RPZ ( ADR CODE -- ADR' )
DROP .S" REPNZ"
TRUE TO PREFIX-OP
;
: REP ( ADR CODE -- ADR' )
DROP .S" REPZ"
TRUE TO PREFIX-OP
;
: LOK ( ADR CODE -- ADR' ) \ THIS SHOULD HAVE ERROR CHECKING ADDED
DROP .S" LOCK"
TRUE TO PREFIX-OP
;
: CS: ( ADR CODE -- ADR' )
DROP .S" CS:"
TRUE TO PREFIX-OP
;
: DS: ( ADR CODE -- ADR' )
DROP .S" DS:"
TRUE TO PREFIX-OP
;
: SS: ( ADR CODE -- ADR' )
DROP .S" SS:"
TRUE TO PREFIX-OP
;
: ES: ( ADR CODE -- ADR' )
DROP .S" ES:"
TRUE TO PREFIX-OP
;
: GS: ( ADR CODE -- ADR' )
DROP .S" GS:"
TRUE TO PREFIX-OP
;
: FS: ( ADR CODE -- ADR' )
DROP .S" FS:"
TRUE TO PREFIX-OP
;
: ISD ( ADR CODE -- ADR' )
DROP 16-BIT-DATA
IF .S" INSW "
ELSE .S" INSD "
THEN ;
: OSD ( ADR CODE -- ADR' )
DROP 16-BIT-DATA
IF .S" OUTSW "
ELSE .S" OUTSD "
THEN ;
: INP ( ADDR CODE -- ADDR' )
.S" IN " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
ELSE .S" AL , "
THEN
COUNT H.>S ;
: OTP ( ADDR CODE -- ADDR' )
.S" OUT " 1 AND
IF COUNT H.>S 16-BIT-DATA
IF .S" , AX"
ELSE .S" , EAX"
THEN
ELSE COUNT H.>S .S" , AL"
THEN
;
: IND ( ADDR CODE -- ADDR' )
.S" IN " 1 AND
IF 16-BIT-DATA
IF .S" AX , DX"
ELSE .S" EAX , DX"
THEN
ELSE .S" AL , DX"
THEN
;
: OTD ( ADDR CODE -- ADDR' )
.S" OUT " 1 AND
IF 16-BIT-DATA
IF .S" DX , AX"
ELSE .S" DX , EAX"
THEN
ELSE .S" DX , AL"
THEN
;
\ -------------------- ALU OPCODES --------------------
: .ALU ( N -- )
7 AND S" ADDOR ADCSBBANDSUBXORCMP" 3 SS. 4 SSPACES
;
: ALU ( ADR OP -- ADR' )
DUP 3 RSHIFT .ALU R/M ;
: ALI ( ADR OP -- ADR' )
>R COUNT
DUP 3 RSHIFT .ALU
MOD-R/M
R> 3 AND ?DUP
IF 1 =
IF IMM16/32
ELSE .# COUNT SEXT 0 .R>S SSPACE
THEN
ELSE IMM8
THEN ;
: ALA ( ADR OP -- ADR' )
DUP 3 RSHIFT .ALU
1 AND IF 0 REG IMM16/32 ELSE 0 REG8 IMM8 THEN ;
\ -------------------- TEST/XCHG --------------------
: TXB ( ADDR OP -- ADDR' )
DUP 3 AND S" TESTTESTXCHGXCHG" 4 SS. 3 SSPACES
1 AND
IF 1 TO SIZE R,R/M \ SMUB REMOVED COUNT
ELSE 0 TO SIZE R,R/M \ SMUB REMOVED COUNT
THEN
;
: TST ( ADDR OP -- ADDR' )
.S" TEST " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
IMM16/32
ELSE .S" AL , " IMM8
THEN
;
\ -------------------- INC/DEC ----------------------
: INC ( ADDR OP -- ADDR' )
.S" INC " REG16/32 ;
: DEC ( ADDR OP -- ADDR' )
.S" DEC " REG16/32 ;
\ -------------------- PUSH/POP --------------------
: PSH ( ADDR OP -- ADDR' )
.S" PUSH " REG16/32 ;
: POP ( ADDR OP -- ADDR' )
.S" POP " REG16/32 ;
: PSS ( ADDR OP -- ADDR' )
.S" PUSH " SREG ;
: PPS ( ADDR OP -- ADDR' )
.S" POP " SREG ;
: PSA ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" PUSHA "
ELSE .S" PUSHAD "
THEN ;
: PPA ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" POPA "
ELSE .S" POPAD "
THEN ;
: PSI ( ADDR OP -- ADDR' )
.S" PUSH " 2 AND
IF IMM8
ELSE IMM16/32
THEN ;
: PSF ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" PUSHF "
ELSE .S" PUSHFD "
THEN ;
: PPF ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" POPF "
ELSE .S" POPFD "
THEN ;
: 8F. ( ADDR OP -- ADDR' )
DROP COUNT .S" POP " R/M16/32 ;
\ -------------------- MOVE --------------------
: MOV ( ADDR OP -- ADDR' )
.S" MOV " R/M ;
: MRI ( ADDR OP -- ADDR' ) ( MOV REGISTER, IMM )
.S" MOV " DUP 8 AND
IF REG16/32 IMM16/32
ELSE REG8 IMM8
THEN ;
: MVI ( ADR OP -- ADR' ) ( MOV MEM, IMM )
.S" MOV " DROP COUNT MOD-R/M
SIZE
IF IMM16/32
ELSE IMM8
THEN
;
: MRS ( ADDR OP -- ADDR' )
\ ? REMOVE REDUNDANT >R , R>
16-BIT-DATA
IF .S" MOV " DROP
1 TO SIZE
COUNT DUP MOD-R/M .,
SREG
ELSE ???
THEN ;
: MSR ( ADDR OP -- ADDR' )
16-BIT-DATA
IF .S" MOV " DROP
1 TO SIZE
COUNT DUP SREG .,
MOD-R/M
ELSE ???
THEN ;
: MRC ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP REG32 .S" , "
CREG ;
: MCR ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP CREG .S" , "
REG32 ;
: MRD ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP REG32 .S" , "
DREG ;
: MDR ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP DREG .S" , "
REG32 ;
: MRT ( ADDR OP -- ADDR' )
\ OBSOLETE
.S" MOV "
DROP COUNT DUP REG32 .S" , "
TREG ;
: MTR ( ADDR OP -- ADDR' )
\ OBSOLETE
.S" MOV "
DROP COUNT DUP TREG .S" , "
REG32 ;
: MV1 ( ADDR OP -- ADDR' )
.S" MOV " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
ELSE .S" AL , "
THEN
DISP16/32 ;
: MV2 ( ADDR OP -- ADDR' )
.S" MOV " SWAP DISP16/32 .,
SWAP 1 AND
IF 16-BIT-DATA
IF .S" AX"
ELSE .S" EAX"
THEN
ELSE .S" AL"
THEN
;
: LEA ( ADDR OP -- ADDR' )
.S" LEA " DROP 1 TO SIZE R,R/M ;
: LXS ( ADDR OP -- ADDR' )
1 AND
IF .S" LDS "
ELSE .S" LES "
THEN
R,R/M \ SMUB REMOVED COUNT
;
: BND ( ADDR OP -- ADDR' )
.S" BOUND " DROP 1 TO SIZE R,R/M ;
: ARP ( ADDR OP -- ADDR' )
.S" ARPL " DROP
1 TO SIZE
TRUE TO 16-BIT-DATA
R,R/M
;
: MLI ( ADDR OP -- ADDR' )
1 TO SIZE
.S" IMUL " 0x69 =
IF R,R/M IMM16/32
ELSE R,R/M IMM8
THEN ;
\ -------------------- JUMPS AND CALLS --------------------
0 VALUE MAX_REFERENCE
: >MAX_R DUP MAX_REFERENCE UMAX TO MAX_REFERENCE ;
: REL8 ( ADDR OP -- ADDR' )
COUNT SEXT OVER + BASE-ADDR - >MAX_R H.>S ;
: REL16/32 ( ADDR OP -- ADDR' )
16-BIT-ADDR
IF W@+
ELSE @+
THEN OVER + BASE-ADDR - >MAX_R SHOW-NAME ;
: JSR ( ADDR OP -- ADDR' )
.S" CALL " DROP REL16/32 ;
: JMP ( ADDR OP -- ADDR' )
.S" JMP " 2 AND IF REL8 ELSE REL16/32 THEN ;
: .JXX ( ADDR OP -- ADDR' )
.S" J" TTTN 4 SSPACES ;
: BRA ( ADDR OP -- ADDR' )
.JXX REL8 ;
: LUP ( ADDR OP -- ADDR' )
3 AND S" LOOPNZLOOPZ LOOP JECXZ " 6 SS. 1 SSPACES REL8 ;
: LBR ( ADDR OP -- ADDR' )
.JXX REL16/32 ;
: RTN ( ADDR OP -- ADDR' )
.S" RET NEAR " 1 AND 0=
IF W@+ H.>S
THEN ;
: RTF ( ADDR OP -- ADDR' )
.S" RET FAR " 1 AND 0=
IF W@+ H.>S
THEN ;
: ENT ( ADDR OP -- ADDR' )
DROP
.S" ENTER " W@+ H.>S ., COUNT H.>S ;
: CIS ( ADDR OP -- ADDR' )
0x9A =
IF .S" CALL "
ELSE .S" JMP "
THEN
16-BIT-DATA
IF .S" PTR16:16 "
ELSE .S" PTR16:32 "
THEN
COUNT MOD-R/M ;
: NT3 ( ADDR OP -- ADDR' )
DROP .S" INT 3 "
;
: INT ( ADDR OP -- ADDR' )
DROP .S" INT "
COUNT H.>S ;
INH LEV LEAVE
INH IRT IRET
INH NTO INTO
\ -------------------- STRING OPS --------------------
: STR INH DOES> COUNT >S 1 AND IF .S" D" ELSE .S" B" THEN ;
STR MVS MOVS
STR CPS CMPS
STR STS STOS
STR LDS LODS
STR SCS SCAS
\ -------------------- EXCHANGE --------------------
: XGA ( ADDR OP -- ADDR' )
.S" XCHG EAX, " REG16/32 ;
\ : XCH ( ADDR OP -- ADDR' )
\ .S" XCHG " DROP R,R/M ;
\ -------------------- SHIFTS & ROTATES --------------------
: .SHIFT ( N -- )
7 AND S" ROLRORRCLRCRSHLSHRXXXSAR" 3 SS. 4 SSPACES ;
: SHF ( ADDR OP -- ADDR' )
>R COUNT
DUP 3 RSHIFT .SHIFT
MOD-R/M .,
R> 0xD2 AND
CASE
0xC0 OF COUNT H.>S ENDOF
0xD0 OF 1 H.>S ENDOF
0xD2 OF 1 REG8 ENDOF
ENDCASE ;
\ -------------------- EXTENDED OPCODES --------------------
: WF1 ( ADDR -- ADDR' )
1+ COUNT DUP
0x0C0 <
IF DUP
3 RSHIFT 7 AND
CASE 6 OF .S" FSTENV " MOD-R/M ENDOF
7 OF .S" FSTCW WORD " MOD-R/M ENDOF
2DROP 2 - DUP .S" FWAIT "
ENDCASE
ELSE DROP 2 - .S" FWAIT "
THEN ;
: WF2 ( ADDR -- ADDR' )
1+ COUNT
CASE 0xE2 OF .S" FCLEX " ENDOF
0xE3 OF .S" FINIT " ENDOF
SWAP 2 - SWAP .S" FWAIT "
ENDCASE ;
: WF3 ( ADDR -- ADDR' )
1+ COUNT DUP 3 RSHIFT 7 AND
CASE 6 OF .S" FSAVE " MOD-R/M ENDOF
7 OF .S" FSTSW WORD " MOD-R/M ENDOF
2DROP 2 - DUP .S" FWAIT "
ENDCASE ;
: WF4 ( ADDR -- ADDR' )
1+ COUNT 0xE0 =
IF .S" FSTSW AX "
ELSE 2 - .S" FWAIT "
THEN ;
: FWAITOPS ( ADDR OP -- ADDR' )
CASE 0xD9 OF WF1 ENDOF
0xDB OF WF2 ENDOF
0xDD OF WF3 ENDOF
0xDF OF WF4 ENDOF
.S" FWAIT "
ENDCASE ;
: W8F ( ADDR OP -- ADDR' )
DROP DUP C@ DUP 0xF8 AND 0xD8 =
IF FWAITOPS
ELSE DROP .S" WAIT "
THEN ;
: FALU1 ( XOPCODE -- )
3 RSHIFT 7 AND
S" FADD FMUL FCOM FCOMPFSUB FSUBRFDIV FDIVR"
5 SS. 2 SSPACES ;
: FALU5 ( XOPCODE -- )
3 RSHIFT 7 AND
S" FADD FMUL ???? ???? FSUBRFSUB FDIVRFDIV "
5 SS. 2 SSPACES ;
: STI. ( OP -- )
7 AND .S" ST(" 1 .R>S .S" )";
\ : STI.ST ( OP -- )
\ 7 AND
\ .S" ST(" 1 .R>S .S" )" .S" ST " ;
: FD8 ( ADDR OPCODE -- ADDR' )
DROP COUNT DUP FALU1
DUP 0xC0 <
IF .S" FLOAT " MOD-R/M
ELSE DUP 0xF0 AND 0xD0 =
IF STI.
ELSE .S" ST , " STI.
THEN
THEN ;
: FDC ( ADDR OPCODE -- ADDR' )
DROP COUNT
DUP DUP 0xC0 <
IF FALU1 .S" DOUBLE " MOD-R/M
ELSE FALU5 STI. .S" , ST"
THEN ;
: FNULLARY-F ( OP -- )
0x0F AND DUP 8 <
IF
S" F2XM1 FYL2X FPTAN FPATAN FXTRACTFPREM1 FDECSTPFINCSTP"
ELSE 8 -
S" FPREM FYL2XP1FSQRT FSINCOSFRNDINTFSCALE FSIN FCOS "
THEN
7 SS. ;
: FNULLARY-E ( OP -- )
0x0F AND DUP 8 <
IF
S" FCHS FABS ??? ??? FTST FXAM ??? ??? "
ELSE 8 -
S" FLD1 FLDL2T FLDL2E FLDPI FLDLG2 FLDLN2 FLDZ ??? "
THEN
7 SS. ;
: FNULLARY ( OP -- )
DUP 0xEF >
IF FNULLARY-F EXIT
THEN
DUP 0xE0 <
IF 0xD0 =
IF .S" FNOP"
ELSE DUP ???
THEN
EXIT
THEN
FNULLARY-E ;
\ : FALU2 ( OP -- )
\ 3 RSHIFT 7 AND
\ S" FLD ??? FST FSTP FLDENV FLDCW FNSTENVFNSTCW "
\ 7 SS. ;
: FD9 ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE
0x00 OF .S" FLD FLOAT " ENDOF
0x10 OF .S" FST FLOAT " ENDOF
0x18 OF .S" FSTP FLOAT " ENDOF
0x20 OF .S" FLDENV " ENDOF
0x28 OF .S" FLDCW WORD " ENDOF
0x30 OF .S" FNSTENV " ENDOF
0x38 OF .S" FNSTCW WORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE
DUP 0xD0 <
IF DUP 0xC8 <
IF .S" FLD "
ELSE .S" FXCH "
THEN
STI.
ELSE FNULLARY
THEN
THEN ;
: FALU3 ( OP -- )
3 RSHIFT 7 AND
S" FIADD FIMUL FICOM FICOMPFISUB FISUBRFIDIV FIDIVR"
6 SS. 1 SSPACES ;
: FCMOVA ( OP -- )
3 RSHIFT 7 AND
S" FCMOVB FCMOVE FCMOVBEFCMOVU ??? ??? ??? ??? "
7 SS. ;
: FDA ( ADDR OP -- )
DROP COUNT DUP 0xC0 <
IF DUP FALU3 .S" DWORD " MOD-R/M
ELSE DUP 0xE9 =
IF .S" FUCOMPP" DROP
ELSE DUP FCMOVA STI.
THEN
THEN ;
: FALU7 ( OP -- )
3 RSHIFT 7 AND
S" FADDP FMULP ??? ??? FSUBRPFSUBP FDIVRPFDIVP "
6 SS. SSPACE ;
: FDE ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP FALU3 .S" WORD " MOD-R/M
ELSE DUP 0xD9 =
IF .S" FCOMPP" DROP
ELSE DUP FALU7 STI.
THEN
THEN ;
: FCMOVB ( OP -- )
3 RSHIFT 7 AND
S" FCMOVNB FCMOVNE FCMOVNBEFCMOVNU ??? FUCOMI FCOMI ??? "
8 SS. ;
: FDB ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FILD DWORD " ENDOF
0x10 OF .S" FIST DWORD " ENDOF
0x18 OF .S" FISTP DWORD " ENDOF
0x28 OF .S" FLD EXTENDED " ENDOF
0x38 OF .S" FSTP EXTENDED " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE
CASE 0xE2 OF .S" FNCLEX" ENDOF
0xE3 OF .S" FNINIT" ENDOF
DUP DUP FCMOVB STI.
ENDCASE
THEN ;
: FALU6 ( OP -- )
3 RSHIFT 7 AND
S" FFREE ??? FST FSTP FUCOM FUCOMP??? ??? "
6 SS. SSPACE ;
: FDD ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FLD DOUBLE " ENDOF
0x10 OF .S" FST DOUBLE " ENDOF
0x18 OF .S" FSTP DOUBLE " ENDOF
0x20 OF .S" FRSTOR " ENDOF
0x30 OF .S" FNSAVE " ENDOF
0x38 OF .S" FNSTSW WORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE DUP FALU6 STI.
THEN ;
: FDF ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FILD WORD " ENDOF
0x10 OF .S" FIST WORD " ENDOF
0x18 OF .S" FISTP WORD " ENDOF
0x20 OF .S" FBLD TBYTE " ENDOF
0x28 OF .S" FILD QWORD " ENDOF
0x30 OF .S" FBSTP TBYTE " ENDOF
0x38 OF .S" FISTP QWORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE DUP 0xE0 =
IF .S" FNSTSW AX " DROP
ELSE DUP 0x38 AND
CASE 0x28 OF .S" FUCOMIP " STI. ENDOF
0x30 OF .S" FCOMIP " STI. ENDOF
???
ENDCASE
THEN
THEN ;
: GP6 ( ADDR OP -- ADDR' )
DROP COUNT DUP 3 RSHIFT
7 AND S" SLDTSTR LLDTLTR VERRVERW??? ???" 4 SS. 3 SSPACES
R/M16 ;
: GP7 ( ADDR OP -- ADDR' )
DROP COUNT DUP 3 RSHIFT
7 AND DUP S" SGDT SIDT LGDT LIDT SMSW ??? LMSW INVLPG" 6 SS. 1 SSPACES
4 AND 4 =
IF R/M16
ELSE R/M16/32
THEN ;
: BTX. ( N -- )
3 RSHIFT
3 AND S" BT BTSBTRBTC" 3 SS. 4 SSPACES ;
: GP8 ( ADDR OP -- ADDR' )
DROP COUNT DUP BTX.
R/M16/32 IMM8 ;
: LAR ( ADDR OP -- ADDR' )
.S" LAR " DROP R,R/M ;
: LSL ( ADDR OP -- ADDR' )
.S" LSL " DROP R,R/M ;
: LSS ( ADDR OP -- ADDR' )
.S" LSS " DROP R,R/M ;
: LFS ( ADDR OP -- ADDR' )
.S" LFS " DROP R,R/M ;
: LGS ( ADDR OP -- ADDR' )
.S" LGS " DROP R,R/M ;
: BTX ( ADDR OP -- ADDR' )
BTX. R/M,R ;
: SLI ( ADDR OP -- ADDR' )
.S" SHLD " DROP R/M,R IMM8 ;
: SRI ( ADDR OP -- ADDR' )
.S" SHRD " DROP R/M,R IMM8 ;
: SLC ( ADDR OP -- ADDR' )
.S" SHLD " DROP R/M,R .S" , CL" ;
: SRC ( ADDR OP -- ADDR' )
.S" SHRD " DROP R/M,R .S" , CL" ;
: IML ( ADDR OP -- ADDR' )
.S" IMUL " DROP R,R/M ;
: CXC ( ADDR OP -- ADDR' )
.S" CMPXCHG " 1 AND TO SIZE R/M,R ;
: MVX ( ADDR OP -- ADDR' )
DUP 8 AND
IF .S" MOVSX "
ELSE .S" MOVZX "
THEN
1 AND >R
COUNT MOD/SIB R> \ SIZE BIT
IF SWAP REG32 ., \ WORD TO DWORD CASE
3 =
IF REG16
ELSE .S" WORD PTR " DROP DUP 1- C@ MOD-R/M
THEN
ELSE SWAP REG16/32 ., \ BYTE CASE
3 =
IF REG8
ELSE .S" BYTE PTR " DROP DUP 1- C@ MOD-R/M
THEN
THEN ;
: XAD ( ADDR OP -- ADDR' )
.S" XADD " 1 AND TO SIZE R/M,R ;
: BSF ( ADDR OP -- ADDR' )
.S" BSF " DROP R,R/M ;
: BSR ( ADDR OP -- ADDR' )
.S" BSR " DROP R,R/M ;
: CX8 ( ADDR OP -- ADDR' )
.S" CMPXCHG8B " DROP COUNT R/M16/32 ;
: BSP ( ADDR OP -- ADDR' )
.S" BSWAP " REG32 ;
: F6. ( ADDR OP -- ADDR' )
\ ??
>R COUNT
DUP 3 RSHIFT 7 AND DUP>R S" TESTXXXXNOT NEG MUL IMULDIV IDIV" 4 SS. 3 SSPACES
MOD-R/M
R> 0= IF
R@ 1 AND IF IMM16/32
ELSE IMM8
THEN
THEN
R> DROP ;
: FE. ( ADDR OP -- ADDR' )
DROP COUNT
DUP 3 RSHIFT 7 AND
CASE
0 OF .S" INC " ENDOF
1 OF .S" DEC " ENDOF
.S" ??? "
ENDCASE R/M8 ;
: FF. ( ADDR OP -- ADDR' )
DROP COUNT
DUP 3 RSHIFT 7 AND
CASE
0 OF .S" INC " ENDOF
1 OF .S" DEC " ENDOF
2 OF .S" CALL " ENDOF
3 OF .S" CALL FAR " ENDOF
4 OF .S" JMP " ENDOF
5 OF .S" JMP FAR " ENDOF
6 OF .S" PUSH " ENDOF
.S" ??? "
ENDCASE R/M16/32 ;
\ --------------------- CONDITIONAL MOVE ---------------
: SET ( ADR OP -- )
.S" SET"
TTTN 2 SSPACES
COUNT R/M8 ;
: CMV ( ADR OP -- )
.S" CMOV"
TTTN 1 SSPACES
R,R/M ;
\ --------------------- MMX OPERATIONS -----------------
: MMX-SIZE ( OP -- )
3 AND S" BWDQ" 1 SS. ;
: UPL ( ADR OP -- ADR' )
3 AND S" PUNPCKLBWPUNPCKLWDPUNPCKLDQ" 9 SS. R,R/M ;
: UPH ( ADR OP -- ADR' )
3 AND S" PUNPCKHBWPUNPCKHWDPUNPCKHDQ" 9 SS. R,R/M ;
: CGT ( ADR OP -- ADR' )
.S" PCMPGT" MMX-SIZE R,R/M ;
: CEQ ( ADR OP -- ADR' )
.S" PCMPEQ" MMX-SIZE R,R/M ;
: PSH. ( OP -- )
0x30 AND
CASE
0x10 OF .S" PSRL" ENDOF
0x20 OF .S" PSRA" ENDOF
0x30 OF .S" PSLL" ENDOF
ENDCASE ;
: GPA ( ADR OP -- ADR' )
>R COUNT DUP PSH. R> MMX-SIZE 2 SSPACES MREG IMM8 ;
: PUW ( ADR OP -- ADR' )
.S" PACKUSDW " DROP R,R/M ;
: PSB ( ADR OP -- ADR' )
.S" PACKSSWB " DROP R,R/M ;
: PSW ( ADR OP -- ADR' )
.S" PACKSSDW " DROP R,R/M ;
: MPD ( ADR OP -- ADR' )
.S" MOVD " DROP COUNT MOD/SIB
SWAP MREG ., 3 =
IF REG32
ELSE MOD-R/M
THEN ;
: MDP ( ADR OP -- ADR' )
.S" MOVD " DROP COUNT MOD/SIB
3 =
IF SWAP REG32
ELSE SWAP MOD-R/M
THEN ., MREG ;
: MPQ ( ADR OP -- ADR' )
.S" MOVQ " DROP R,R/M ;
: MQP ( ADR OP -- ADR' )
.S" MOVQ " DROP R/M,R ;
: SHX ( ADR OP -- ADR' )
DUP PSH. MMX-SIZE 2 SSPACES R,R/M ;
: MLL ( ADR OP -- ADR' )
.S" PMULLW " DROP R,R/M ;
: MLH ( ADR OP -- ADR' )
.S" PMULHW " DROP R,R/M ;
: MAD ( ADR OP -- ADR' )
.S" PMADDWD " DROP R,R/M ;
: SUS ( ADR OP -- ADR' )
.S" PSUBUS" MMX-SIZE R,R/M ;
: SBS ( ADR OP -- ADR' )
.S" PSUBS" MMX-SIZE SSPACE R,R/M ;
: SUB ( ADR OP -- ADR' )
.S" PSUB" MMX-SIZE 2 SSPACES R,R/M ;
: AUS ( ADR OP -- ADR' )
.S" PADDUS" MMX-SIZE R,R/M ;
: ADS ( ADR OP -- ADR' )
.S" PADDS" MMX-SIZE SSPACE R,R/M ;
: ADD ( ADR OP -- ADR' )
.S" PADD" MMX-SIZE 2 SSPACES R,R/M ;
: PAD ( ADR OP -- ADR' )
.S" PAND " DROP R,R/M ;
: POR ( ADR OP -- ADR' )
.S" POR " DROP R,R/M ;
: PAN ( ADR OP -- ADR' )
.S" PANDN " DROP R,R/M ;
: PXR ( ADR OP -- ADR' )
.S" PXOR " DROP R,R/M ;
\ -------------------- OPCODE TABLE --------------------
: OPS 0x10 0 DO ' , LOOP ;
CREATE OP-TABLE2
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
OPS GP6 GP7 LAR LSL ??? ??? CLT ??? INV WIV ??? UD2 ??? ??? ??? ??? \ 0
OPS ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 1
OPS MRC MRD MCR MDR MRT ??? MTR ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 2
OPS WMR RTC RMR RPC ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 3
OPS CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV \ 4
OPS ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 5
OPS UPL UPL UPL PUW CGT CGT CGT PSB UPH UPH UPH PSW ??? ??? MPD MPQ \ 6
OPS ??? GPA GPA GPA CEQ CEQ CEQ EMS ??? ??? ??? ??? ??? ??? MDP MQP \ 7
OPS LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR \ 8
OPS SET SET SET SET SET SET SET SET SET SET SET SET SET SET SET SET \ 9
OPS PSS PPS CPU BTX SLI SLC ??? ??? PSS PPS RSM BTX SRI SRC ??? IML \ A
OPS CXC CXC LSS BTX LFS LGS MVX MVX ??? UD1 GP8 BTX BSF BSR MVX MVX \ B
OPS XAD XAD ??? ??? ??? ??? ??? CX8 BSP BSP BSP BSP BSP BSP BSP BSP \ C
OPS ??? SHX SHX SHX ??? MLL ??? ??? SUS SUS ??? PAD AUS AUS ??? PAN \ D
OPS ??? SHX SHX ??? ??? MLH ??? ??? SBS SBS ??? POR ADS ADS ??? PXR \ E
OPS ??? ??? SHX SHX ??? MAD ??? ??? SUB SUB SUB ??? ADD ADD ADD ??? \ F
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
: 0F. ( ADR CODE -- )
DROP COUNT DUP
DUP 0x70 AND 0x50 0x80 WITHIN TO MMX-REG
CELLS OP-TABLE2 + @ EXECUTE
0 TO MMX-REG ;
CREATE OP-TABLE
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
OPS ALU ALU ALU ALU ALA ALA PSS PPS ALU ALU ALU ALU ALA ALA PSS 0F. \ 0
OPS ALU ALU ALU ALU ALA ALA PSS PPS ALU ALU ALU ALU ALA ALA PSS PPS \ 1
OPS ALU ALU ALU ALU ALA ALA ES: DAA ALU ALU ALU ALU ALA ALA CS: DAS \ 2
OPS ALU ALU ALU ALU ALA ALA SS: AAA ALU ALU ALU ALU ALA ALA DS: AAS \ 3
OPS INC INC INC INC INC INC INC INC DEC DEC DEC DEC DEC DEC DEC DEC \ 4
OPS PSH PSH PSH PSH PSH PSH PSH PSH POP POP POP POP POP POP POP POP \ 5
OPS PSA PPA BND ARP FS: GS: D16 A16 PSI MLI PSI MLI INB ISD OSB OSD \ 6
OPS BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA \ 7
OPS ALI ALI ??? ALI TXB TXB TXB TXB MOV MOV MOV MOV MRS LEA MSR 8F. \ 8
OPS XGA XGA XGA XGA XGA XGA XGA XGA CBW CDQ CIS W8F PSF PPF SAH LAH \ 9
OPS MV1 MV1 MV2 MV2 MVS MVS CPS CPS TST TST STS STS LDS LDS SCS SCS \ A
OPS MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI \ B
OPS SHF SHF RTN RTN LXS LXS MVI MVI ENT LEV RTF RTF NT3 INT NTO IRT \ C
OPS SHF SHF SHF SHF AAM AAD ??? XLT FD8 FD9 FDA FDB FDC FDD FDE FDF \ D
OPS LUP LUP LUP LUP INP INP OTP OTP JSR JMP CIS JMP IND IND OTD OTD \ E
OPS LOK ??? RPZ REP HLT CMC F6. F6. CLC STC CLI STI CLD STD FE. FF. \ F
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
: DIS-OP ( ADR -- ADR' )
0>S
FALSE TO PREFIX-OP \ SMUB
COUNT
DUP 1 AND TO SIZE
DUP CELLS OP-TABLE + @ EXECUTE
PREFIX-OP 0=
IF DEFAULT-16BIT? 0=
IF FALSE TO 16-BIT-DATA
FALSE TO 16-BIT-ADDR
ELSE TRUE TO 16-BIT-DATA
TRUE TO 16-BIT-ADDR
THEN
THEN ;
0 VALUE NEXT-INST
: X". ( ADDR -- ADDR' )
\ CR DUP BASE-ADDR - 6 H.R SPACE
DUP C@ 2DUP DUMP
+ 2+
\ ." C, " 1+ OVER + SWAP
\ DO I C@ 2 H.R ." C, " LOOP
\ COUNT + 1+
;
[DEFINED] G. [IF]
: FLIT8. ( ADDR -- ADDR' )
." FLITERAL: "
DUP DF@ G. 8 +
;
: FLIT10. ( ADDR -- ADDR' )
." FLITERAL: "
DUP F@ G. 10 +
;
[ELSE]
: FLIT8.
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP 8 OVER + SWAP
DO I C@ 3 H.R ." C," LOOP
8 +
;
: FLIT10. ( ADDR -- ADDR' )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP 10 OVER + SWAP
DO I C@ 3 H.R ." C," LOOP
10 +
;
[THEN]
: VECT. ( ADDR -- ADDR' )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP @ 8 H.R DUP CELL+ SWAP @ ." , \ " WordByAddr TYPE
;
: CONS. ( ADDR -- )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " @ 8 H.R ." ,"
;
: USER. ( ADDR -- )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " @ 8 H.R ." , \ Relative in heap [hex]" \ CELL+
;
: UVAL. ( ADDR -- ADDR' )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP @ 8 H.R ." , \ Relative in heap [hex]" CELL+
;
: CODE. ( ADDR -- )
DUP NextNFA
?DUP
IF OVER - 5 -
ELSE
DUP DP @ SWAP - ABS DUP 512 > IF DROP 40 THEN \ no applicable end found
THEN
." Size of data: ~" DUP .
DUMP
;
: DIS-DB CR .S" DB " COUNT H.>S ;
: DIS-DW CR .S" DW " W@+ H.>S ;
: DIS-DD CR .S" DD " @+ H.>S ;
: DIS-DS CR .S" STRING " 0x22 EMIT>S COUNT 2DUP >S + 0x22 EMIT>S ;
: FIND-REST-END ( xt -- addr | 0)
DUP NextNFA DUP
IF
NIP
NAME>C 1- \ Skip CFA field
ELSE
DROP
DP @ - ABS 100 > IF 0 EXIT THEN \ no applicable end found
DP @ 1-
THEN
BEGIN \ Skip alignment
DUP C@ 0= WHILE 1-
REPEAT ;
( wid ) SET-CURRENT
: INST ( ADR -- ADR' )
DUP TO NEXT-INST
COLS 0x29 <
IF DIS-OP
S-BUF COUNT TYPE
ELSE DUP DIS-OP
OVER BASE-ADDR - 6 H.R SPACE
DUP ROT
2DUP - DUP>R 0x10 U> ABORT" DECOMPILER ERROR"
DO I C@ 2 H.N LOOP
R> 5 < IF 9 EMIT THEN
9 EMIT S-BUF COUNT TYPE
THEN NEXT-INST C@ 0xE8 =
IF NEXT-INST 1+ @+ SWAP +
CASE
['] _CLITERAL-CODE OF X". ENDOF
['] _SLITERAL-CODE OF X". ENDOF
['] _VECT-CODE OF VECT. 2DROP RDROP ENDOF
['] _CONSTANT-CODE OF CONS. DROP RDROP ENDOF
['] _USER-CODE OF USER. DROP RDROP ENDOF
['] _CREATE-CODE OF CODE. DROP RDROP ENDOF
['] _USER-VALUE-CODE OF UVAL. ENDOF
['] _FLIT-CODE10 OF FLIT10. ENDOF
['] _FLIT-CODE8 OF FLIT8. ENDOF
ENDCASE
THEN ;
: (REST-AREA) ( addr1 addr2 -- )
\ if addr2 = 0 continue till RET instruction
SWAP DUP TO NEXT-INST
BEGIN
\ We do not look for JMP's because there may be
\ a jump in a forth word
CR
OVER 0= IF NEXT-INST C@ 0xC3 <>
ELSE 2DUP < INVERT
THEN
WHILE INST
REPEAT 2DROP ." END-CODE "
;
VECT REST-AREA
' (REST-AREA) TO REST-AREA
: REST ( addr -- )
DUP HERE U> 0= HERE 1- AND REST-AREA
;
: SEE ( "name" -- )
' DUP FIND-REST-END ['] REST-AREA CATCH DROP
;
PREVIOUS
( warn base )
BASE !
WARNING !
.( Ok) CR

/programs/develop/SPForth/lib/ext/disasm2.f
0,0 → 1,1955
\ 80386 DISASSEMBLER
\ ANDREW MCKEWAN, APRIL 1994
\ TOM ZIMMER, 05/18/94 PORT TO WIN32F
\ MODIFIED TO WORD IN DECIMAL 08/03/94 10:04 TJZ
\ 06-??-95 SMUB NEXT SEQUENCE DEFINED IN FKERNEL
\ 06-21-95 SMUB REMOVED REDUNDANT COUNT CALLS FROM TXB, LXS.
\ 04-??-97 EXTENDED BY C.L. TO INCLUDE P6 AND MMX INSTRUCTIONS
\ 14-11-2000 Adapted from SPFOPT (Michael Maximov) by Dmitry Yakimov
\ ??-11-2000 Fixed FE. FF. (Bandaletov) and H.R (Yakimov)
\ 15-11-2000 Fixed MV2 (Yakimov)
\ 25-12-2000 Added float literals recognition (Yakimov)
\ 26-07-2001 Fixed MVX (Maksimov)
CR .( Loading Intel Pentium MMX disassembler...)
WARNING 0!
DECIMAL
\ REQUIRE [IF] ~mak/CompIF.f
\ REQUIRE CASE lib/ext/case.f
\ REQUIRE WITHIN lib/include/core-ext.f
REQUIRE [DEFINED] lib/include/tools.f
\ REQUIRE [IF] ~mak\CompIF.f
REQUIRE CASE lib/ext/case.f
\ REQUIRE WITHIN lib\include\core-ext.f
REQUIRE NextNFA lib/ext/vocs.f
VARIABLE END-WORD
VARIABLE START-WORD
\ VARIABLE START-LAB
\ VARIABLE FINISH-LAB
\ VARIABLE START-LIST
\ VARIABLE FINISH-LIST
\ VARIABLE IMAGE-END
VARIABLE START-LAB
VARIABLE FINISH-LAB
VARIABLE START-LIST
VARIABLE FINISH-LIST
VARIABLE START-LIST2
VARIABLE FINISH-LIST2
VARIABLE FINISH-LIST3
VARIABLE START-VAR
VARIABLE FINISH-VAR
VARIABLE START-ARRAY
VARIABLE FINISH-ARRAY
0 VALUE IMAGE-END
VARIABLE CALL-TYPE?
VARIABLE TRIGER
VARIABLE TRIGER3
VARIABLE DISP8?
: ADD-CALL
>R START-LIST @
BEGIN DUP @ R@ =
IF DROP RDROP 0 CALL-TYPE? ! EXIT
ELSE DUP FINISH-LIST @ = 0= THEN
WHILE CELL+ REPEAT CELL+ DUP FINISH-LIST ! R> OVER !
BEGIN DUP CELL- 2DUP 2>R @ SWAP @ < IF 2R@ @ SWAP 2R@ SWAP @ SWAP ! ! THEN
2R> NIP DUP START-LIST @ = UNTIL
DROP 1 CALL-TYPE? !
;
: ADD-CALL2
>R START-LIST2 @
BEGIN DUP @ R@ =
IF DROP RDROP 0 CALL-TYPE? ! EXIT
ELSE DUP FINISH-LIST2 @ = 0= THEN
WHILE CELL+ REPEAT CELL+ DUP FINISH-LIST2 ! R> OVER !
BEGIN DUP CELL- 2DUP 2>R @ SWAP @ < IF 2R@ @ SWAP 2R@ SWAP @ SWAP ! ! THEN
2R> NIP DUP START-LIST2 @ = UNTIL
DROP 1 CALL-TYPE? !
;
: ADD-LAB
>R START-LAB @
BEGIN DUP @ R@ =
IF DROP RDROP EXIT
ELSE DUP FINISH-LAB @ = 0= THEN
WHILE CELL+ REPEAT CELL+ DUP FINISH-LAB ! R> OVER !
BEGIN DUP CELL- 2DUP 2>R @ SWAP @ < IF 2R@ @ SWAP 2R@ SWAP @ SWAP ! ! THEN
2R> NIP DUP START-LAB @ = UNTIL DROP ;
: ADD-VAR
>R START-VAR @
BEGIN DUP @ R@ =
IF DROP RDROP EXIT
ELSE DUP FINISH-VAR @ = 0= THEN
WHILE CELL+ REPEAT CELL+ DUP FINISH-VAR ! R> OVER !
BEGIN DUP CELL- 2DUP 2>R @ SWAP @ < IF 2R@ @ SWAP 2R@ SWAP @ SWAP ! ! THEN
2R> NIP DUP START-VAR @ = UNTIL DROP ;
: LAB
>R START-LIST @
BEGIN DUP @ R@ =
IF DROP RDROP 1 EXIT
ELSE DUP FINISH-LIST @ = 0= THEN
WHILE CELL+ REPEAT DROP RDROP 0 ;
: TYPE-LAB
>R START-LAB @
BEGIN DUP @ R@ =
IF DROP RDROP 0 EXIT
ELSE DUP FINISH-LAB @ = 0= THEN
WHILE CELL+ REPEAT DROP RDROP 1
;
\ : TYPE-ARRAY START-ARRAY @ DUP FINISH-ARRAY @ = IF DROP EXIT THEN
\ BEGIN DUP 2@ HEX . . DECIMAL CR 2 CELLS + DUP FINISH-ARRAY @ =
\ UNTIL DROP
\ ;
VARIABLE TRIGER4
VARIABLE ALLOTN
: ARRAY? 0 ALLOTN !
>R START-ARRAY @ DUP FINISH-ARRAY @ = IF RDROP 0 TRIGER4 ! EXIT THEN
BEGIN DUP @ R@ =
IF ." ALLOT" ALLOTN @ . ." :" ." array[0.." 2@ DROP
BASE @ >R DECIMAL . R> BASE !
." ] of byte;" CR RDROP 1 TRIGER3 ! 1 TRIGER4 ! EXIT THEN \ 1 EXIT THEN
ALLOTN 1+! 2 CELLS + DUP FINISH-ARRAY @ =
UNTIL DROP RDROP 0 TRIGER4 !
;
: ARRAY2? 0 ALLOTN !
>R START-ARRAY @ DUP FINISH-ARRAY @ = IF RDROP 0 EXIT THEN
BEGIN DUP @ R@ =
IF ." ALLOT" ALLOTN @
BASE @ >R DECIMAL . R> BASE ! ." ;" CR
DROP RDROP 1 EXIT THEN
ALLOTN 1+! 2 CELLS + DUP FINISH-ARRAY @ =
UNTIL DROP RDROP 0
;
: DEFER VECT ;
: DUP>R R> OVER >R >R ;
: UMAX ( D1 D2 -- FLAG )
2DUP U< IF NIP ELSE DROP THEN ;
80 CONSTANT MAXSTRING
255 CONSTANT MAXCOUNTED \ maximum length of contents of a counted string
: 0X BASE @ HEX >R BL WORD ?LITERAL
R> BASE ! ; IMMEDIATE
: "CLIP" ( a1 n1 -- a1 n1' ) \ clip a string to between 0 and MAXCOUNTED
MAXCOUNTED MIN 0 MAX ;
: PLACE ( addr len dest -- )
SWAP "CLIP" SWAP
2DUP 2>R
CHAR+ SWAP MOVE
2R> C! ;
: +PLACE ( addr len dest -- ) \ append string addr,len to counted
\ string dest
>R "CLIP" MAXCOUNTED R@ C@ - MIN R>
\ clip total to MAXCOUNTED string
2DUP 2>R
COUNT CHARS + SWAP MOVE
2R> +! ;
: C+PLACE ( c1 a1 -- ) \ append char c1 to the counted string at a1
DUP 1+! COUNT + 1- C! ;
: OFF 0! ;
: BLANK ( addr len -- ) \ fill addr for len with spaces (blanks)
BL FILL ;
128 CONSTANT SPCS-MAX ( optimization for SPACES )
CREATE SPCS SPCS-MAX ALLOT
SPCS SPCS-MAX BLANK
C" UPC" FIND NIP 0=
[IF]
: UPC ( c -- c' )
DUP [CHAR] Z U>
IF 0xDF AND
THEN ;
[THEN]
: (D.) ( d -- addr len ) TUCK DABS <# #S ROT SIGN #> ;
80 VALUE COLS
: H.R ( n1 n2 -- ) \ display n1 as a hex number right
\ justified in a field of n2 characters
BASE @ >R HEX >R
0 <# #S #> R> OVER - 0 MAX SPACES TYPE
R> BASE ! ;
: H.N ( n1 n2 -- ) \ display n1 as a HEX number of n2 digits
BASE @ >R HEX >R
0 <# R> 0 ?DO # LOOP #> TYPE
R> BASE ! ;
ONLY FORTH ALSO DEFINITIONS
0 VALUE DEFAULT-16BIT?
: DEFAULT-16BIT ( -- )
TRUE TO DEFAULT-16BIT? ;
: DEFAULT-32BIT ( -- )
FALSE TO DEFAULT-16BIT? ;
DEFER SHOW-NAME ( CFA -- ) \ DISPLAY NEAREST SYMBOL
0 VALUE BASE-ADDR
VOCABULARY DISASSEMBLER
DISASSEMBLER ALSO DEFINITIONS
DECIMAL
CREATE S-BUF MAXSTRING ALLOT
: >S ( A1 N1 -- )
S-BUF +PLACE ;
: 0>S ( -- ) \ RESET S-BUF
S-BUF OFF ;
: SSPACES ( N1 -- )
SPCS SWAP S-BUF +PLACE ;
: SSPACE ( -- )
1 SSPACES ;
: EMIT>S ( C1 -- )
S-BUF C+PLACE ;
: S> ( -- A1 N1 )
S-BUF COUNT ;
: (.S") ( addr len -- )
S-BUF +PLACE ;
: .S" ( 'TEXT' -- )
[CHAR] " PARSE
POSTPONE SLITERAL
POSTPONE (.S") ; IMMEDIATE
VARIABLE ADR@
: D.>S BASE @ SWAP DECIMAL DUP 0= IF DROP ELSE DUP 128 > IF .S" -" 256 SWAP - ELSE .S" +" THEN
0 (D.) >S THEN BASE ! 0 DISP8? ! ;
: D.R>S ( D W -- )
\ >R (D.) R> OVER - SSPACES >S ;
>R (D.) R> OVER - SSPACES >S ;
: .R>S ( N W -- )
>R S>D R> D.R>S ;
: U.R>S ( U W -- )
0 SWAP D.R>S ;
: H.>S ( U -- )
BASE @ SWAP
DUP DUP IMAGE-BEGIN > SWAP IMAGE-END < AND IF DUP ADD-LAB \ .S" [OFFSET @" HEX 0 (D.) >S .S" ]" ELSE
.S" OFFSET [" SHOW-NAME .S" ]" ELSE \ .S" [OFFSET @" SHOW-NAME .S" ]" ELSE
.S" $" HEX 0 (D.) >S THEN
( SSPACE ) BASE ! ;
: H.>Sn ( U -- )
BASE @ SWAP HEX 0 (D.) >S ( SSPACE ) BASE ! ;
: H.R>S ( N1 N2 -- )
BASE @ >R HEX >R
0 <# #S #> R> OVER - SSPACES >S
R> BASE ! ;
VARIABLE NAME
\ [THEN]
: ?.NAME>S ( CFA -- )
\ ELIMINATE " 0X"
\ DUP 1 H.R>S SSPACE \ ïå÷àòü àäðåñà ïåðåõîäà
NEAR_NFA
>R DUP
IF \ .S" @"
\ IF ñþäà ïðîâåðêó ELSE
R@ DUP START-WORD @ < >R END-WORD @ > R> OR R@ START-WORD @ = OR 0= IF R> DUP ADD-LAB .S" @" 1 H.R>S ELSE
\ .S" @"
ADR@ @ R@ = IF 0 ADR@ ! ELSE R@ ADD-LAB THEN \ .S" 2@" <--
DUP NAME ! \ COUNT >S \ ïå÷àòü ñêîáîê. Çíàê ìåòêè
NAME> DUP ADD-CALL2 \ áåç ADD-CALL íå ðàáîòàþò ññûëêè íà ïåðåìåííûå ADD-LAB CR WordByAddr TYPE CR
( DUP H.>Sn ) R@ -
DUP IF .S" [OFFSET " \ .S" [OFFSET @@"
\ DUP .S" +" NEGATE H.>S
\ R> H.>Sn .S" ]" NAME @ COUNT >S
RDROP NAME @ COUNT >S .S" ]"
ELSE
.S" @@" RDROP NAME @ COUNT >S THEN \ êîíåö ïðîâåðêè
THEN
DROP \ .S" ) "
ELSE R> .S" [" H.>S .S" ]" DROP \ òóò
THEN
;
' ?.NAME>S TO SHOW-NAME
\ 32 CONSTANT COMMENT-COL
0 VALUE SIZE
0 VALUE 16-BIT-DATA
0 VALUE 16-BIT-ADDR
0 VALUE PREFIX-OP
0 VALUE MMX-REG
: @+ ( ADDR -- ADDR N ) DUP CELL+ SWAP @ ;
: W@+ ( ADDR -- ADDR N ) DUP 2 + SWAP W@ ;
: SEXT ( BYTE -- N ) DUP 128 AND IF 0xFFFFFF00 OR THEN ;
: MOD/SIB ( MOD-R-R/M -- R/M R MOD ) \ R INCLUDING GENERAL, SPECIAL, SEGMENT, MMX
( MOD-OP-R/M -- R/M OP MOD )
( S-I-B -- B I S )
255 AND 8 /MOD 8 /MOD ;
: ??? ( N1 -- )
.S" ??? " DROP ;
: SS. ( N ADR LEN W ) >R DROP SWAP R@ * + R> >S SSPACE ;
: TTTN ( CODE -- ) 15 AND S" O NOB AEE NEBEA S NSP NPL GELEG " 2 SS. ;
: SREG ( SREG -- ) 3 RSHIFT 7 AND S" ESCSSSDSFSGSXXXX" 2 SS. ;
: CREG ( EEE -- ) 3 RSHIFT 7 AND S" CR0???CR2CR3CR4?????????" 3 SS. ;
: DREG ( EEE -- ) 3 RSHIFT 7 AND S" DR0DR1DR2DR3??????DR6DR7" 3 SS. ;
: TREG ( EEE -- ) 3 RSHIFT 7 AND S" ?????????TR3TR4TR5TR6TR7" 3 SS. ; \ OBSOLETE
: MREG ( N -- ) 7 AND S" MM0MM1MM2MM3MM4MM5MM6MM7" 3 SS. ;
: REG8 ( N -- ) 7 AND S" ALCLDLBLAHCHDHBH" 2 SS. ;
: REG16 ( N -- ) 7 AND S" AXCXDXBXSPBPSIDI" 2 SS. ;
: REG32 ( N -- ) 7 AND S" EAXECXEDXEBXESPEBPESIEDI" 3 SS. ;
: REG16/32 ( N -- )
16-BIT-DATA
IF REG16
ELSE REG32
THEN ;
: REG ( A N -- A )
MMX-REG
IF MREG
ELSE SIZE
IF REG16/32
ELSE REG8
THEN
THEN
;
: [BASE16] ( R/M -- ) 4 - S" [SI][DI][BP][BX]" 4 SS. ;
\ R/M = 4 , 5 , 6 , 7
: [IND16] ( R/M -- ) S" [BX+SI][BX+DI][BP+SI][BP+DI]" 7 SS. ;
\ R/M = 0 , 1 , 2 , 3
: [REG16] ( R/M -- ) DUP 4 <
IF [IND16]
ELSE [BASE16]
THEN ;
: [REG32] ( N -- ) 7 AND \ TRIGER3 @ IF
\ S" [EAX][ECX][EDX][EBX][ESP][EBP][ESI][EDI]" 5 SS.
\ ELSE
S" [EAX[ECX[EDX[EBX[ESP[EBP[ESI[EDI" 4 SS. DISP8? @ D.>S .S" ]"
\ THEN
;
: [REG*2] ( I -- ) S" [EAX*2][ECX*2][EDX*2][EBX*2][XXX*2][EBP*2][ESI*2][EDI*2]" 7 SS. ;
: [REG*4] ( I -- ) S" [EAX*4][ECX*4][EDX*4][EBX*4][XXX*4][EBP*4][ESI*4][EDI*4]" 7 SS. ;
: [REG*8] ( I -- ) S" [EAX*8][ECX*8][EDX*8][EBX*8][XXX*8][EBP*8][ESI*8][EDI*8]" 7 SS. ;
: [INDEX] ( SIB -- ) MOD/SIB OVER 4 =
IF 2DROP \ NO ESP SCALED INDEX
ELSE CASE ( S )
0 OF [REG32] ENDOF
1 OF [REG*2] ENDOF
2 OF [REG*4] ENDOF
3 OF [REG*8] ENDOF
ENDCASE
THEN DROP ;
: DISP8 ( ADR -- ADR' )
\ COUNT DUP DISP8? ! D.>S ;
COUNT DISP8? ! ;
: DISP16 ( ADR -- ADR' ) W@+ SHOW-NAME ;
: DISP32 ( ADR -- ADR' ) @+ ( BODY> ) SHOW-NAME ;
: DISP16/32 ( ADR -- ADR' )
16-BIT-ADDR
IF DISP16
ELSE DISP32
THEN ;
: ., ( -- ) TRIGER @ IF .S" , " THEN 1 TRIGER ! ;
: .# ., .S" $" ;
\ : .# ., ;
\ : .# ., .S" # " ;
: IMM8 ( ADR -- ADR' ) .# COUNT H.>Sn ;
\ : IMM16 ( ADR -- ADR' ) .# W@+ H.>S ;
: IMM16/32 ( ADR -- ADR' )
\ .#
.,
16-BIT-DATA
IF W@+
ELSE @+
THEN H.>S ; \ \\\\\\\
: SIB ( ADR MOD -- ADR )
>R COUNT TUCK 7 AND 5 = R@ 0= AND
IF DISP32 SWAP [INDEX] R> DROP \ EBP BASE AND MOD = 00
ELSE R> CASE ( MOD )
1 OF DISP8 ENDOF
2 OF DISP32 ENDOF
ENDCASE
SWAP DUP [REG32] [INDEX]
THEN ;
: MOD-R/M32 ( ADR R/M MOD -- ADR' )
DUP 3 =
IF DROP REG \ MOD = 3, REGISTER CASE
ELSE OVER 4 =
IF NIP SIB \ R/M = 4, SIB CASE
ELSE 2DUP 0= SWAP 5 = AND \ MOD = 0, R/M = 5,
IF 2DROP DISP32 \ DISP32 CASE
ELSE ROT SWAP
CASE ( MOD )
1 OF DISP8 ENDOF
2 OF DISP32 ENDOF
ENDCASE
SWAP [REG32]
THEN
THEN
THEN ;
: MOD-R/M16 ( ADR R/M MOD -- ADR' )
2DUP 0= SWAP 6 = AND
IF 2DROP DISP16 \ DISP16 CASE
ELSE CASE ( MOD )
0 OF [REG16] ENDOF
1 OF SWAP DISP8 SWAP [REG16] ENDOF
2 OF SWAP DISP16 SWAP [REG16] ENDOF
3 OF REG ENDOF
ENDCASE
THEN ;
: MOD-R/M ( ADR MODR/M -- ADR' )
MOD/SIB NIP 16-BIT-ADDR
IF MOD-R/M16
ELSE MOD-R/M32
THEN ;
: R/M8 0 TO SIZE MOD-R/M ;
: R/M16/32 1 TO SIZE MOD-R/M ;
: R/M16 TRUE TO 16-BIT-DATA R/M16/32 ;
: R,R/M ( ADR -- ADR' )
COUNT DUP 3 RSHIFT REG ., MOD-R/M ;
: R/M,R ( ADR -- ADR' )
COUNT DUP>R MOD-R/M ., R> 3 RSHIFT REG ;
: R/M ( ADR OP -- ADR' )
2 AND
IF R,R/M
ELSE R/M,R
THEN ;
\ -------------------- SIMPLE OPCODES --------------------
: INH ( -<NAME>- )
CREATE
BL WORD COUNT HERE PLACE
HERE C@ 1+ ALLOT
DOES> COUNT >S SSPACE DROP ;
INH CLC CLC
INH STC STC
INH CLD CLD
INH STD STD
\ INH RPNZ REPNZ
\ INH REPZ REPZ
INH CBW CBW
INH CDQ CDQ
INH DAA DAA
INH DAS DAS
INH AAA AAA
INH AAS AAS
\ INH LOCK LOCK
INH INB INSB
INH OSB OUTSB
INH SAH SAHF
INH LAH LAHF
\ INH AAM AAM
\ INH AAD AAD
INH HLT HLT
INH CMC CMC
INH XLT XLAT
INH CLI CLI
INH STI STI
INH CLT CLTS
INH INV INVD
INH WIV WBINVD
INH UD2 UD2
INH WMR WRMSR
INH RTC RDTSC
INH RMR RDMSR
INH RPC RDPMC
INH EMS EMMS
INH RSM RSM
INH CPU CPUID
INH UD1 UD1
\ INH LSS LSS
\ INH LFS LFS
\ INH LGS LGS
\ INH D16: D16:
\ INH A16: A16:
\ INH ES: ES:
\ INH CS: CS:
\ INH DS: DS:
\ INH FS: FS:
\ INH GS: GS:
: AAM ( ADR CODE -- ADR' )
.S" AAM" DROP COUNT DROP ;
: AAD ( ADR CODE -- ADR' )
.S" AAD" DROP COUNT DROP ;
: D16 ( ADR CODE -- ADR' )
DROP .S" D16:"
TRUE TO 16-BIT-DATA
TRUE TO PREFIX-OP
;
: A16 ( ADR CODE -- ADR' )
DROP .S" A16:"
TRUE TO 16-BIT-ADDR
TRUE TO PREFIX-OP
;
: RPZ ( ADR CODE -- ADR' )
DROP .S" REPNZ"
TRUE TO PREFIX-OP
;
: REP ( ADR CODE -- ADR' )
DROP .S" REPZ"
TRUE TO PREFIX-OP
;
: LOK ( ADR CODE -- ADR' ) \ THIS SHOULD HAVE ERROR CHECKING ADDED
DROP .S" LOCK"
TRUE TO PREFIX-OP
;
: CS: ( ADR CODE -- ADR' )
DROP .S" CS:"
TRUE TO PREFIX-OP
;
: DS: ( ADR CODE -- ADR' )
DROP .S" DS:"
TRUE TO PREFIX-OP
;
: SS: ( ADR CODE -- ADR' )
DROP .S" SS:"
TRUE TO PREFIX-OP
;
: ES: ( ADR CODE -- ADR' )
DROP .S" ES:"
TRUE TO PREFIX-OP
;
: GS: ( ADR CODE -- ADR' )
DROP .S" GS:"
TRUE TO PREFIX-OP
;
: FS: ( ADR CODE -- ADR' )
DROP .S" FS:"
TRUE TO PREFIX-OP
;
: ISD ( ADR CODE -- ADR' )
DROP 16-BIT-DATA
IF .S" INSW "
ELSE .S" INSD "
THEN ;
: OSD ( ADR CODE -- ADR' )
DROP 16-BIT-DATA
IF .S" OUTSW "
ELSE .S" OUTSD "
THEN ;
: INP ( ADDR CODE -- ADDR' )
.S" IN " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
ELSE .S" AL , "
THEN
COUNT H.>S ;
: OTP ( ADDR CODE -- ADDR' )
.S" OUT " 1 AND
IF COUNT H.>S 16-BIT-DATA
IF .S" , AX"
ELSE .S" , EAX"
THEN
ELSE COUNT H.>S .S" , AL"
THEN
;
: IND ( ADDR CODE -- ADDR' )
.S" IN " 1 AND
IF 16-BIT-DATA
IF .S" AX , DX"
ELSE .S" EAX , DX"
THEN
ELSE .S" AL , DX"
THEN
;
: OTD ( ADDR CODE -- ADDR' )
.S" OUT " 1 AND
IF 16-BIT-DATA
IF .S" DX , AX"
ELSE .S" DX , EAX"
THEN
ELSE .S" DX , AL"
THEN
;
\ -------------------- ALU OPCODES --------------------
: .ALU ( N -- )
7 AND S" ADDOR ADCSBBANDSUBXORCMP" 3 SS. 4 SSPACES
;
: ALU ( ADR OP -- ADR' )
DUP 3 RSHIFT .ALU R/M ;
: ALI ( ADR OP -- ADR' )
>R COUNT
DUP 3 RSHIFT .ALU
MOD-R/M
R> 3 AND ?DUP
IF 1 =
IF IMM16/32
ELSE .# COUNT SEXT 0 .R>S SSPACE
THEN
ELSE IMM8
THEN ;
: ALA ( ADR OP -- ADR' )
DUP 3 RSHIFT .ALU
1 AND IF 0 REG IMM16/32 ELSE 0 REG8 IMM8 THEN ;
\ -------------------- TEST/XCHG --------------------
: TXB ( ADDR OP -- ADDR' )
DUP 3 AND S" TESTTESTXCHGXCHG" 4 SS. 3 SSPACES
1 AND
IF 1 TO SIZE R,R/M \ SMUB REMOVED COUNT
ELSE 0 TO SIZE R,R/M \ SMUB REMOVED COUNT
THEN
;
: TST ( ADDR OP -- ADDR' )
.S" TEST " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
IMM16/32
ELSE .S" AL , " IMM8
THEN
;
\ -------------------- INC/DEC ----------------------
: INC ( ADDR OP -- ADDR' )
.S" INC " REG16/32 ;
: DEC ( ADDR OP -- ADDR' )
.S" DEC " REG16/32 ;
\ -------------------- PUSH/POP --------------------
: PSH ( ADDR OP -- ADDR' )
.S" PUSH " REG16/32
0 TRIGER !
;
: POP ( ADDR OP -- ADDR' )
.S" POP " REG16/32
0 TRIGER !
;
: PSS ( ADDR OP -- ADDR' )
.S" PUSH " SREG ;
: PPS ( ADDR OP -- ADDR' )
.S" POP " SREG
0 TRIGER !
;
: PSA ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" PUSHA "
ELSE .S" PUSHAD "
THEN
0 TRIGER !
;
: PPA ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" POPA "
ELSE .S" POPAD "
THEN
0 TRIGER !
;
: PSI ( ADDR OP -- ADDR' )
.S" PUSH " 2 AND
IF IMM8
ELSE IMM16/32
THEN
0 TRIGER !
;
: PSF ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" PUSHF "
ELSE .S" PUSHFD "
THEN
0 TRIGER !
;
: PPF ( ADDR OP -- ADDR' )
DROP 16-BIT-DATA
IF .S" POPF "
ELSE .S" POPFD "
THEN
0 TRIGER !
;
: 8F. ( ADDR OP -- ADDR' )
DROP COUNT .S" POP " R/M16/32
0 TRIGER !
;
\ -------------------- MOVE --------------------
: MOV ( ADDR OP -- ADDR' )
.S" MOV " R/M ;
: MRI ( ADDR OP -- ADDR' ) ( MOV REGISTER, IMM )
.S" MOV " DUP 8 AND
IF REG16/32 IMM16/32
ELSE REG8 IMM8
THEN ;
: MVI ( ADR OP -- ADR' ) ( MOV MEM, IMM )
.S" MOV " DROP COUNT MOD-R/M
SIZE
IF IMM16/32
ELSE IMM8
THEN
;
: MRS ( ADDR OP -- ADDR' )
\ ? REMOVE REDUNDANT >R , R>
16-BIT-DATA
IF .S" MOV " DROP
1 TO SIZE
COUNT DUP MOD-R/M .,
SREG
ELSE ???
THEN ;
: MSR ( ADDR OP -- ADDR' )
16-BIT-DATA
IF .S" MOV " DROP
1 TO SIZE
COUNT DUP SREG .,
MOD-R/M
ELSE ???
THEN ;
: MRC ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP REG32 .S" , "
CREG ;
: MCR ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP CREG .S" , "
REG32 ;
: MRD ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP REG32 .S" , "
DREG ;
: MDR ( ADDR OP -- ADDR' )
.S" MOV "
DROP COUNT DUP DREG .S" , "
REG32 ;
: MRT ( ADDR OP -- ADDR' )
\ OBSOLETE
.S" MOV "
DROP COUNT DUP REG32 .S" , "
TREG ;
: MTR ( ADDR OP -- ADDR' )
\ OBSOLETE
.S" MOV "
DROP COUNT DUP TREG .S" , "
REG32 ;
: MV1 ( ADDR OP -- ADDR' )
.S" MOV " 1 AND
IF 16-BIT-DATA
IF .S" AX , "
ELSE .S" EAX , "
THEN
ELSE .S" AL , "
THEN
DISP16/32 ;
: MV2 ( ADDR OP -- ADDR' )
.S" MOV " SWAP DISP16/32 .,
SWAP 1 AND
IF 16-BIT-DATA
IF .S" AX"
ELSE .S" EAX"
THEN
ELSE .S" AL"
THEN
;
: LEA ( ADDR OP -- ADDR' )
.S" LEA " DROP 1 TO SIZE R,R/M ;
: LXS ( ADDR OP -- ADDR' )
1 AND
IF .S" LDS "
ELSE .S" LES "
THEN
R,R/M \ SMUB REMOVED COUNT
;
: BND ( ADDR OP -- ADDR' )
.S" BOUND " DROP 1 TO SIZE R,R/M ;
: ARP ( ADDR OP -- ADDR' )
.S" ARPL " DROP
1 TO SIZE
TRUE TO 16-BIT-DATA
R,R/M
;
: MLI ( ADDR OP -- ADDR' )
1 TO SIZE
.S" IMUL " 0x69 =
IF R,R/M IMM16/32
ELSE R,R/M IMM8
THEN ;
\ -------------------- JUMPS AND CALLS --------------------
0 VALUE MAX_REFERENCE
: >MAX_R DUP MAX_REFERENCE UMAX TO MAX_REFERENCE ;
: REL8 ( ADDR OP -- ADDR' )
\ .S" @" \
COUNT SEXT OVER + BASE-ADDR - >MAX_R DUP ADD-LAB
SHOW-NAME ; \ H.>Sn ;
: REL16/32 ( ADDR OP -- ADDR' )
\ .S" @"
16-BIT-ADDR
IF W@+
ELSE @+
THEN OVER + BASE-ADDR - >MAX_R DUP ADR@ ! DUP ADD-LAB SHOW-NAME ;
: JSR ( ADDR OP -- ADDR' )
.S" CALL " DROP REL16/32 \ DUP @ >R REL16/32 DUP R> + DROP
;
: JMP ( ADDR OP -- ADDR' )
.S" JMP " 2 AND IF REL8 ELSE REL16/32 THEN
;
: .JXX ( ADDR OP -- ADDR' )
.S" J" TTTN 4 SSPACES
;
: BRA ( ADDR OP -- ADDR' )
.JXX REL8 ;
: LUP ( ADDR OP -- ADDR' )
3 AND S" LOOPNZLOOPZ LOOP JECXZ " 6 SS. 1 SSPACES REL8 ;
: LBR ( ADDR OP -- ADDR' )
.JXX REL16/32 ;
: RTN ( ADDR OP -- ADDR' )
.S" RET" 1 AND 0= \ .S" RET NEAR " 1 AND 0=
IF W@+ H.>S
THEN ;
: RTF ( ADDR OP -- ADDR' )
.S" RET FAR " 1 AND 0=
IF W@+ H.>S
THEN ;
: ENT ( ADDR OP -- ADDR' )
DROP
.S" ENTER " W@+ H.>S ., COUNT H.>S ;
: CIS ( ADDR OP -- ADDR' )
0x9A =
IF .S" CALL "
ELSE .S" JMP "
THEN
16-BIT-DATA
IF .S" PTR16:16 "
ELSE .S" PTR16:32 "
THEN
COUNT MOD-R/M
;
: NT3 ( ADDR OP -- ADDR' )
DROP .S" INT 3 "
;
: INT ( ADDR OP -- ADDR' )
DROP .S" INT "
COUNT H.>S ;
INH LEV LEAVE
INH IRT IRET
INH NTO INTO
\ -------------------- STRING OPS --------------------
: STR INH DOES> COUNT >S 1 AND IF .S" D" ELSE .S" B" THEN ;
STR MVS MOVS
STR CPS CMPS
STR STS STOS
STR LDS LODS
STR SCS SCAS
\ -------------------- EXCHANGE --------------------
: XGA ( ADDR OP -- ADDR' )
.S" XCHG EAX, " REG16/32 ;
\ : XCH ( ADDR OP -- ADDR' )
\ .S" XCHG " DROP R,R/M ;
\ -------------------- SHIFTS & ROTATES --------------------
: .SHIFT ( N -- )
7 AND S" ROLRORRCLRCRSHLSHRXXXSAR" 3 SS. 4 SSPACES ;
: SHF ( ADDR OP -- ADDR' )
>R COUNT
DUP 3 RSHIFT .SHIFT
MOD-R/M .,
R> 0xD2 AND
CASE
0xC0 OF COUNT H.>S ENDOF
0xD0 OF 1 H.>S ENDOF
0xD2 OF 1 REG8 ENDOF
ENDCASE ;
\ -------------------- EXTENDED OPCODES --------------------
: WF1 ( ADDR -- ADDR' )
1+ COUNT DUP
0x0C0 <
IF DUP
3 RSHIFT 7 AND
CASE 6 OF .S" FSTENV " MOD-R/M ENDOF
7 OF .S" FSTCW WORD " MOD-R/M ENDOF
2DROP 2 - DUP .S" FWAIT "
ENDCASE
ELSE DROP 2 - .S" FWAIT "
THEN ;
: WF2 ( ADDR -- ADDR' )
1+ COUNT
CASE 0xE2 OF .S" FCLEX " ENDOF
0xE3 OF .S" FINIT " ENDOF
SWAP 2 - SWAP .S" FWAIT "
ENDCASE ;
: WF3 ( ADDR -- ADDR' )
1+ COUNT DUP 3 RSHIFT 7 AND
CASE 6 OF .S" FSAVE " MOD-R/M ENDOF
7 OF .S" FSTSW WORD " MOD-R/M ENDOF
2DROP 2 - DUP .S" FWAIT "
ENDCASE ;
: WF4 ( ADDR -- ADDR' )
1+ COUNT 0xE0 =
IF .S" FSTSW AX "
ELSE 2 - .S" FWAIT "
THEN ;
: FWAITOPS ( ADDR OP -- ADDR' )
CASE 0xD9 OF WF1 ENDOF
0xDB OF WF2 ENDOF
0xDD OF WF3 ENDOF
0xDF OF WF4 ENDOF
.S" FWAIT "
ENDCASE ;
: W8F ( ADDR OP -- ADDR' )
DROP DUP C@ DUP 0xF8 AND 0xD8 =
IF FWAITOPS
ELSE DROP .S" WAIT "
THEN ;
: FALU1 ( XOPCODE -- )
3 RSHIFT 7 AND
S" FADD FMUL FCOM FCOMPFSUB FSUBRFDIV FDIVR"
5 SS. 2 SSPACES ;
: FALU5 ( XOPCODE -- )
3 RSHIFT 7 AND
S" FADD FMUL ???? ???? FSUBRFSUB FDIVRFDIV "
5 SS. 2 SSPACES ;
: STI. ( OP -- )
7 AND .S" ST(" 1 .R>S .S" )";
\ : STI.ST ( OP -- )
\ 7 AND
\ .S" ST(" 1 .R>S .S" )" .S" ST " ;
: FD8 ( ADDR OPCODE -- ADDR' )
DROP COUNT DUP FALU1
DUP 0xC0 <
IF .S" FLOAT " MOD-R/M
ELSE DUP 0xF0 AND 0xD0 =
IF STI.
ELSE .S" ST , " STI.
THEN
THEN ;
: FDC ( ADDR OPCODE -- ADDR' )
DROP COUNT
DUP DUP 0xC0 <
IF FALU1 .S" DOUBLE " MOD-R/M
ELSE FALU5 STI. .S" , ST"
THEN ;
: FNULLARY-F ( OP -- )
0x0F AND DUP 8 <
IF
S" F2XM1 FYL2X FPTAN FPATAN FXTRACTFPREM1 FDECSTPFINCSTP"
ELSE 8 -
S" FPREM FYL2XP1FSQRT FSINCOSFRNDINTFSCALE FSIN FCOS "
THEN
7 SS. ;
: FNULLARY-E ( OP -- )
0x0F AND DUP 8 <
IF
S" FCHS FABS ??? ??? FTST FXAM ??? ??? "
ELSE 8 -
S" FLD1 FLDL2T FLDL2E FLDPI FLDLG2 FLDLN2 FLDZ ??? "
THEN
7 SS. ;
: FNULLARY ( OP -- )
DUP 0xEF >
IF FNULLARY-F EXIT
THEN
DUP 0xE0 <
IF 0xD0 =
IF .S" FNOP"
ELSE DUP ???
THEN
EXIT
THEN
FNULLARY-E ;
\ : FALU2 ( OP -- )
\ 3 RSHIFT 7 AND
\ S" FLD ??? FST FSTP FLDENV FLDCW FNSTENVFNSTCW "
\ 7 SS. ;
: FD9 ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE
0x00 OF .S" FLD FLOAT " ENDOF
0x10 OF .S" FST FLOAT " ENDOF
0x18 OF .S" FSTP FLOAT " ENDOF
0x20 OF .S" FLDENV " ENDOF
0x28 OF .S" FLDCW WORD " ENDOF
0x30 OF .S" FNSTENV " ENDOF
0x38 OF .S" FNSTCW WORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE
DUP 0xD0 <
IF DUP 0xC8 <
IF .S" FLD "
ELSE .S" FXCH "
THEN
STI.
ELSE FNULLARY
THEN
THEN ;
: FALU3 ( OP -- )
3 RSHIFT 7 AND
S" FIADD FIMUL FICOM FICOMPFISUB FISUBRFIDIV FIDIVR"
6 SS. 1 SSPACES ;
: FCMOVA ( OP -- )
3 RSHIFT 7 AND
S" FCMOVB FCMOVE FCMOVBEFCMOVU ??? ??? ??? ??? "
7 SS. ;
: FDA ( ADDR OP -- )
DROP COUNT DUP 0xC0 <
IF DUP FALU3 .S" DWORD " MOD-R/M
ELSE DUP 0xE9 =
IF .S" FUCOMPP" DROP
ELSE DUP FCMOVA STI.
THEN
THEN ;
: FALU7 ( OP -- )
3 RSHIFT 7 AND
S" FADDP FMULP ??? ??? FSUBRPFSUBP FDIVRPFDIVP "
6 SS. SSPACE ;
: FDE ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP FALU3 .S" WORD " MOD-R/M
ELSE DUP 0xD9 =
IF .S" FCOMPP" DROP
ELSE DUP FALU7 STI.
THEN
THEN ;
: FCMOVB ( OP -- )
3 RSHIFT 7 AND
S" FCMOVNB FCMOVNE FCMOVNBEFCMOVNU ??? FUCOMI FCOMI ??? "
8 SS. ;
: FDB ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FILD DWORD " ENDOF
0x10 OF .S" FIST DWORD " ENDOF
0x18 OF .S" FISTP DWORD " ENDOF
0x28 OF .S" FLD EXTENDED " ENDOF
0x38 OF .S" FSTP EXTENDED " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE
CASE 0xE2 OF .S" FNCLEX" ENDOF
0xE3 OF .S" FNINIT" ENDOF
DUP DUP FCMOVB STI.
ENDCASE
THEN ;
: FALU6 ( OP -- )
3 RSHIFT 7 AND
S" FFREE ??? FST FSTP FUCOM FUCOMP??? ??? "
6 SS. SSPACE ;
: FDD ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FLD DOUBLE " ENDOF
0x10 OF .S" FST DOUBLE " ENDOF
0x18 OF .S" FSTP DOUBLE " ENDOF
0x20 OF .S" FRSTOR " ENDOF
0x30 OF .S" FNSAVE " ENDOF
0x38 OF .S" FNSTSW WORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE DUP FALU6 STI.
THEN ;
: FDF ( ADDR OP -- ADDR' )
DROP COUNT DUP 0xC0 <
IF DUP 0x38 AND
CASE 0x00 OF .S" FILD WORD " ENDOF
0x10 OF .S" FIST WORD " ENDOF
0x18 OF .S" FISTP WORD " ENDOF
0x20 OF .S" FBLD TBYTE " ENDOF
0x28 OF .S" FILD QWORD " ENDOF
0x30 OF .S" FBSTP TBYTE " ENDOF
0x38 OF .S" FISTP QWORD " ENDOF
DUP ???
ENDCASE
MOD-R/M
ELSE DUP 0xE0 =
IF .S" FNSTSW AX " DROP
ELSE DUP 0x38 AND
CASE 0x28 OF .S" FUCOMIP " STI. ENDOF
0x30 OF .S" FCOMIP " STI. ENDOF
???
ENDCASE
THEN
THEN ;
: GP6 ( ADDR OP -- ADDR' )
DROP COUNT DUP 3 RSHIFT
7 AND S" SLDTSTR LLDTLTR VERRVERW??? ???" 4 SS. 3 SSPACES
R/M16 ;
: GP7 ( ADDR OP -- ADDR' )
DROP COUNT DUP 3 RSHIFT
7 AND DUP S" SGDT SIDT LGDT LIDT SMSW ??? LMSW INVLPG" 6 SS. 1 SSPACES
4 AND 4 =
IF R/M16
ELSE R/M16/32
THEN ;
: BTX. ( N -- )
3 RSHIFT
3 AND S" BT BTSBTRBTC" 3 SS. 4 SSPACES ;
: GP8 ( ADDR OP -- ADDR' )
DROP COUNT DUP BTX.
R/M16/32 IMM8 ;
: LAR ( ADDR OP -- ADDR' )
.S" LAR " DROP R,R/M ;
: LSL ( ADDR OP -- ADDR' )
.S" LSL " DROP R,R/M ;
: LSS ( ADDR OP -- ADDR' )
.S" LSS " DROP R,R/M ;
: LFS ( ADDR OP -- ADDR' )
.S" LFS " DROP R,R/M ;
: LGS ( ADDR OP -- ADDR' )
.S" LGS " DROP R,R/M ;
: BTX ( ADDR OP -- ADDR' )
BTX. R/M,R ;
: SLI ( ADDR OP -- ADDR' )
.S" SHLD " DROP R/M,R IMM8 ;
: SRI ( ADDR OP -- ADDR' )
.S" SHRD " DROP R/M,R IMM8 ;
: SLC ( ADDR OP -- ADDR' )
.S" SHLD " DROP R/M,R .S" , CL" ;
: SRC ( ADDR OP -- ADDR' )
.S" SHRD " DROP R/M,R .S" , CL" ;
: IML ( ADDR OP -- ADDR' )
.S" IMUL " DROP R,R/M ;
: CXC ( ADDR OP -- ADDR' )
.S" CMPXCHG " 1 AND TO SIZE R/M,R ;
: MVX ( ADDR OP -- ADDR' )
DUP 8 AND
IF .S" MOVSX "
ELSE .S" MOVZX "
THEN
1 AND >R
COUNT MOD/SIB R> \ SIZE BIT
IF SWAP REG32 ., \ WORD TO DWORD CASE
3 =
IF REG16
ELSE .S" WORD PTR " DROP DUP 1- C@ MOD-R/M
THEN
ELSE SWAP REG16/32 ., \ BYTE CASE
3 =
IF REG8
ELSE .S" BYTE PTR " DROP DUP 1- C@ MOD-R/M
THEN
THEN ;
: XAD ( ADDR OP -- ADDR' )
.S" XADD " 1 AND TO SIZE R/M,R ;
: BSF ( ADDR OP -- ADDR' )
.S" BSF " DROP R,R/M ;
: BSR ( ADDR OP -- ADDR' )
.S" BSR " DROP R,R/M ;
: CX8 ( ADDR OP -- ADDR' )
.S" CMPXCHG8B " DROP COUNT R/M16/32 ;
: BSP ( ADDR OP -- ADDR' )
.S" BSWAP " REG32 ;
: F6. ( ADDR OP -- ADDR' )
\ ??
>R COUNT
DUP 3 RSHIFT 7 AND DUP>R S" TESTXXXXNOT NEG MUL IMULDIV IDIV" 4 SS. 3 SSPACES
MOD-R/M
R> 0= IF
R@ 1 AND IF IMM16/32
ELSE IMM8
THEN
THEN
R> DROP ;
: FE. ( ADDR OP -- ADDR' )
DROP COUNT
DUP 3 RSHIFT 7 AND
CASE
0 OF .S" INC " ENDOF
1 OF .S" DEC " ENDOF
.S" ??? "
ENDCASE R/M8 ;
: FF. ( ADDR OP -- ADDR' )
DROP COUNT
DUP 3 RSHIFT 7 AND
CASE
0 OF .S" INC " ENDOF
1 OF .S" DEC " ENDOF
2 OF .S" CALL " ENDOF
3 OF .S" CALL FAR " ENDOF
4 OF .S" JMP " ENDOF
5 OF .S" JMP FAR " ENDOF
6 OF .S" PUSH " ENDOF
.S" ??? "
ENDCASE R/M16/32 ;
\ --------------------- CONDITIONAL MOVE ---------------
: SET ( ADR OP -- )
.S" SET"
TTTN 2 SSPACES
COUNT R/M8 ;
: CMV ( ADR OP -- )
.S" CMOV"
TTTN 1 SSPACES
R,R/M ;
\ --------------------- MMX OPERATIONS -----------------
: MMX-SIZE ( OP -- )
3 AND S" BWDQ" 1 SS. ;
: UPL ( ADR OP -- ADR' )
3 AND S" PUNPCKLBWPUNPCKLWDPUNPCKLDQ" 9 SS. R,R/M ;
: UPH ( ADR OP -- ADR' )
3 AND S" PUNPCKHBWPUNPCKHWDPUNPCKHDQ" 9 SS. R,R/M ;
: CGT ( ADR OP -- ADR' )
.S" PCMPGT" MMX-SIZE R,R/M ;
: CEQ ( ADR OP -- ADR' )
.S" PCMPEQ" MMX-SIZE R,R/M ;
: PSH. ( OP -- )
0x30 AND
CASE
0x10 OF .S" PSRL" ENDOF
0x20 OF .S" PSRA" ENDOF
0x30 OF .S" PSLL" ENDOF
ENDCASE ;
: GPA ( ADR OP -- ADR' )
>R COUNT DUP PSH. R> MMX-SIZE 2 SSPACES MREG IMM8 ;
: PUW ( ADR OP -- ADR' )
.S" PACKUSDW " DROP R,R/M ;
: PSB ( ADR OP -- ADR' )
.S" PACKSSWB " DROP R,R/M ;
: PSW ( ADR OP -- ADR' )
.S" PACKSSDW " DROP R,R/M ;
: MPD ( ADR OP -- ADR' )
.S" MOVD " DROP COUNT MOD/SIB
SWAP MREG ., 3 =
IF REG32
ELSE MOD-R/M
THEN ;
: MDP ( ADR OP -- ADR' )
.S" MOVD " DROP COUNT MOD/SIB
3 =
IF SWAP REG32
ELSE SWAP MOD-R/M
THEN ., MREG ;
: MPQ ( ADR OP -- ADR' )
.S" MOVQ " DROP R,R/M ;
: MQP ( ADR OP -- ADR' )
.S" MOVQ " DROP R/M,R ;
: SHX ( ADR OP -- ADR' )
DUP PSH. MMX-SIZE 2 SSPACES R,R/M ;
: MLL ( ADR OP -- ADR' )
.S" PMULLW " DROP R,R/M ;
: MLH ( ADR OP -- ADR' )
.S" PMULHW " DROP R,R/M ;
: MAD ( ADR OP -- ADR' )
.S" PMADDWD " DROP R,R/M ;
: SUS ( ADR OP -- ADR' )
.S" PSUBUS" MMX-SIZE R,R/M ;
: SBS ( ADR OP -- ADR' )
.S" PSUBS" MMX-SIZE SSPACE R,R/M ;
: SUB ( ADR OP -- ADR' )
.S" PSUB" MMX-SIZE 2 SSPACES R,R/M ;
: AUS ( ADR OP -- ADR' )
.S" PADDUS" MMX-SIZE R,R/M ;
: ADS ( ADR OP -- ADR' )
.S" PADDS" MMX-SIZE SSPACE R,R/M ;
: ADD ( ADR OP -- ADR' )
.S" PADD" MMX-SIZE 2 SSPACES R,R/M ;
: PAD ( ADR OP -- ADR' )
.S" PAND " DROP R,R/M ;
: POR ( ADR OP -- ADR' )
.S" POR " DROP R,R/M ;
: PAN ( ADR OP -- ADR' )
.S" PANDN " DROP R,R/M ;
: PXR ( ADR OP -- ADR' )
.S" PXOR " DROP R,R/M ;
\ -------------------- OPCODE TABLE --------------------
: OPS 0x10 0 DO ' , LOOP ;
CREATE OP-TABLE2
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
OPS GP6 GP7 LAR LSL ??? ??? CLT ??? INV WIV ??? UD2 ??? ??? ??? ??? \ 0
OPS ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 1
OPS MRC MRD MCR MDR MRT ??? MTR ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 2
OPS WMR RTC RMR RPC ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 3
OPS CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV CMV \ 4
OPS ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 5
OPS UPL UPL UPL PUW CGT CGT CGT PSB UPH UPH UPH PSW ??? ??? MPD MPQ \ 6
OPS ??? GPA GPA GPA CEQ CEQ CEQ EMS ??? ??? ??? ??? ??? ??? MDP MQP \ 7
OPS LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR LBR \ 8
OPS SET SET SET SET SET SET SET SET SET SET SET SET SET SET SET SET \ 9
OPS PSS PPS CPU BTX SLI SLC ??? ??? PSS PPS RSM BTX SRI SRC ??? IML \ A
OPS CXC CXC LSS BTX LFS LGS MVX MVX ??? UD1 GP8 BTX BSF BSR MVX MVX \ B
OPS XAD XAD ??? ??? ??? ??? ??? CX8 BSP BSP BSP BSP BSP BSP BSP BSP \ C
OPS ??? SHX SHX SHX ??? MLL ??? ??? SUS SUS ??? PAD AUS AUS ??? PAN \ D
OPS ??? SHX SHX ??? ??? MLH ??? ??? SBS SBS ??? POR ADS ADS ??? PXR \ E
OPS ??? ??? SHX SHX ??? MAD ??? ??? SUB SUB SUB ??? ADD ADD ADD ??? \ F
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
: 0F. ( ADR CODE -- )
DROP COUNT DUP
DUP 0x70 AND 0x50 0x80 WITHIN TO MMX-REG
CELLS OP-TABLE2 + @ EXECUTE
0 TO MMX-REG ;
CREATE OP-TABLE
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
OPS ALU ALU ALU ALU ALA ALA PSS PPS ALU ALU ALU ALU ALA ALA PSS 0F. \ 0
OPS ALU ALU ALU ALU ALA ALA PSS PPS ALU ALU ALU ALU ALA ALA PSS PPS \ 1
OPS ALU ALU ALU ALU ALA ALA ES: DAA ALU ALU ALU ALU ALA ALA CS: DAS \ 2
OPS ALU ALU ALU ALU ALA ALA SS: AAA ALU ALU ALU ALU ALA ALA DS: AAS \ 3
OPS INC INC INC INC INC INC INC INC DEC DEC DEC DEC DEC DEC DEC DEC \ 4
OPS PSH PSH PSH PSH PSH PSH PSH PSH POP POP POP POP POP POP POP POP \ 5
OPS PSA PPA BND ARP FS: GS: D16 A16 PSI MLI PSI MLI INB ISD OSB OSD \ 6
OPS BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA BRA \ 7
OPS ALI ALI ??? ALI TXB TXB TXB TXB MOV MOV MOV MOV MRS LEA MSR 8F. \ 8
OPS XGA XGA XGA XGA XGA XGA XGA XGA CBW CDQ CIS W8F PSF PPF SAH LAH \ 9
OPS MV1 MV1 MV2 MV2 MVS MVS CPS CPS TST TST STS STS LDS LDS SCS SCS \ A
OPS MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI MRI \ B
OPS SHF SHF RTN RTN LXS LXS MVI MVI ENT LEV RTF RTF NT3 INT NTO IRT \ C
OPS SHF SHF SHF SHF AAM AAD ??? XLT FD8 FD9 FDA FDB FDC FDD FDE FDF \ D
OPS LUP LUP LUP LUP INP INP OTP OTP JSR JMP CIS JMP IND IND OTD OTD \ E
OPS LOK ??? RPZ REP HLT CMC F6. F6. CLC STC CLI STI CLD STD FE. FF. \ F
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F
: DIS-OP ( ADR -- ADR' )
0>S
FALSE TO PREFIX-OP \ SMUB
COUNT
DUP 1 AND TO SIZE
DUP CELLS OP-TABLE + @ EXECUTE
PREFIX-OP 0=
IF DEFAULT-16BIT? 0=
IF FALSE TO 16-BIT-DATA
FALSE TO 16-BIT-ADDR
ELSE TRUE TO 16-BIT-DATA
TRUE TO 16-BIT-ADDR
THEN
THEN ;
0 VALUE NEXT-INST
: X". ( ADDR -- ADDR' )
\ CR DUP BASE-ADDR - 6 H.R SPACE
DUP C@ 2DUP SWAP 1+ SWAP ." '" TYPE ." '"
+ 2+
\ ." C, " 1+ OVER + SWAP
\ DO I C@ 2 H.R ." C, " LOOP
\ COUNT + 1+
;
[DEFINED] G. [IF]
: FLIT8. ( ADDR -- ADDR' ) CR
." FLITERAL: "
DUP DF@ G. 8 +
;
: FLIT10. ( ADDR -- ADDR' ) CR
." FLITERAL: "
DUP F@ G. 10 +
;
[ELSE]
: FLIT8.
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP 8 OVER + SWAP
DO I C@ 3 H.R ." C," LOOP
8 +
;
: FLIT10. ( ADDR -- ADDR' )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP 10 OVER + SWAP
DO I C@ 3 H.R ." C," LOOP
10 +
;
[THEN]
: VECT. ( ADDR -- ADDR' ) CR
\ ." @" DUP BASE-ADDR - 6 H.R ." :" SPACE
." A; " DUP @ 8 H.R DUP CELL+ SWAP @ ." , \ " WordByAddr TYPE CR
;
\ : CONS. ( ADDR -- ) \ CR
\ \ ." @" DUP BASE-ADDR - 6 H.R ." :" SPACE
\ SPACE ." CONSTANT " @ 8 SPACES DUP LAB IF ." @" WordByAddr TYPE ELSE DUP ARRAY2? IF DROP ELSE ." $" 1 H.R CR THEN THEN
\ ;
: CONS. ( ADDR -- )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " @ 8 H.R ." ,"
;
: USER. ( ADDR -- ) CR
\ ." @" DUP BASE-ADDR - 6 H.R ." :" SPACE
." A; " @ 8 H.R ." \ Relative in heap [hex]" \ CELL+
CR
;
\ : UVAL. ( ADDR -- ADDR' ) CR
\ ." @" DUP BASE-ADDR - 6 H.R ." :" SPACE
\ ." A; " DUP @ 8 H.R ." \ Relative in heap [hex]" CELL+
\ CR
\ ;
: UVAL. ( ADDR -- ADDR' )
CR DUP BASE-ADDR - 6 H.R SPACE
." A; " DUP @ 8 H.R ." , \ Relative in heap [hex]" CELL+
;
VARIABLE ENDDB
VARIABLE ENDDD
VARIABLE FLAGDB
: TLABEL TRIGER3 @ IF 0 TRIGER3 ! ELSE OVER . ." :" 6 SPACES THEN ;
: DDADR? OVER @ DUP IMAGE-BEGIN > SWAP IMAGE-END < AND ;
: CODE. ( ADDR -- ) 4 SPACES
DUP NextNFA
?DUP
IF OVER - 5 -
ELSE
DUP DP @ SWAP - ABS DUP 512 > IF DROP 124 THEN \ no applicable end found
THEN
BEGIN DUP WHILE OVER LAB 0= IF OVER ARRAY? TLABEL ELSE 24 SPACES THEN
DDADR? IF OVER @ ARRAY2? 0=
IF ." dd @" OVER @ DUP @ ADD-LAB . CR THEN 4 - SWAP 4 + SWAP ELSE
DUP 4 < IF ." db "
\ FLAGDB @ IF ." , " ELSE ." db " THEN OVER C@ . 1- SWAP 1+ SWAP
2DUP OVER + DUP ENDDB ! SWAP DO I DUP ." $" C@ . ENDDB @ 1- <> IF ." , " THEN LOOP CR DROP 0
ELSE OVER @ 0= IF \ OVER @ . 4 - SWAP 4 + SWAP CR
0 FLAGDB ! TRIGER4 @ IF 2DROP EXIT ELSE ." dd $" BEGIN OVER @ 0= OVER 0 > AND
WHILE 4 - SWAP 4 + SWAP FLAGDB 1+! REPEAT FLAGDB @ . ." DUP (?)" THEN CR
ELSE
." db " 4 - OVER DUP 4 + DUP ENDDB ! SWAP DO I DUP
." $" C@ . ENDDB @ 1- <> IF ." , " THEN LOOP SWAP 4 + SWAP CR THEN
THEN
THEN
REPEAT 2DROP
;
\ IMAGE-BEGIN - ïîïðîáîâàòü âìåìåñòî ìåòêè OVER @ IMAGE-BEGIN > IF ." DD" OVER @ . HERE . THEN
: DIS-DB CR .S" DB " COUNT H.>S ;
: DIS-DW CR .S" DW " W@+ H.>S ;
: DIS-DD CR .S" DD " @+ H.>S ;
: DIS-DS CR .S" STRING " 0x22 EMIT>S COUNT 2DUP >S + 0x22 EMIT>S ;
: FIND-REST-END ( xt -- addr | 0)
DUP NextNFA DUP
IF
NIP
NAME>C 1- \ Skip CFA field
ELSE
DROP
DP @ - ABS 100 > IF 0 EXIT THEN \ no applicable end found
DP @ 1-
THEN
BEGIN \ Skip alignment
DUP C@ 0= WHILE 1-
REPEAT ;
: INST ( ADR -- ADR' )
DUP TO NEXT-INST
COLS 0x29 <
IF DIS-OP
S-BUF COUNT TYPE
ELSE DUP DIS-OP
OVER BASE-ADDR - 6
\ H.R SPACE \ ïå÷àòü àäðåñà ìåòêè ïî óñëîâèþ, 2DROP óáðàòü
\ 2DROP \ H.R SPACE àäðåñà
OVER TYPE-LAB
IF 2DROP ELSE
OVER LAB IF 0 TRIGER3 ! 2DROP ELSE S" @" TYPE H.R S" :" TYPE SSPACE THEN
THEN
DUP ROT
2DUP - DUP>R 0x10 U> ABORT" DECOMPILER ERROR"
2DROP \ DO I C@ 2 SPACES DROP ( H.N ) LOOP \ 2DROP ( H.N ) LOOP \ äàìï êîìàíäû
R> 12 < IF 9 EMIT THEN
\ NEXT-INST C@ 0xE8 =
\ IF NEXT-INST 1+ @+ SWAP +
\ CASE
\ ['] _CLITERAL-CODE OF 0 ENDOF
\ ['] _SLITERAL-CODE OF 0 ENDOF
\ ['] _VECT-CODE OF 0 ENDOF
\ ['] _CONSTANT-CODE OF 0 ENDOF
\ ['] _USER-CODE OF 0 ENDOF
\ ['] _CREATE-CODE OF 0 ." // Îôîðìèò êàê var èëè label: array[0..10] of Byte/Integer;" ENDOF
\ ['] _USER-VALUE-CODE OF 0 ." // Îôîðìèò êàê" ENDOF
\ ['] _FLIT-CODE10 OF 0 ENDOF
\ ['] _FLIT-CODE8 OF 0 ENDOF
\ ENDCASE
\ THEN
?DUP IF 9 EMIT S-BUF COUNT TYPE THEN
THEN NEXT-INST C@ 0xE8 =
IF NEXT-INST 1+ @+ SWAP +
CASE
['] _CLITERAL-CODE OF CR X". ENDOF
['] _SLITERAL-CODE OF CR X". ENDOF
['] _VECT-CODE OF VECT. 2DROP RDROP ENDOF
['] _CONSTANT-CODE OF CONS. DROP RDROP ENDOF
['] _USER-CODE OF USER. DROP RDROP ENDOF
['] _CREATE-CODE OF CODE. DROP RDROP ENDOF
['] _USER-VALUE-CODE OF UVAL. DROP RDROP ENDOF
['] _FLIT-CODE10 OF FLIT10. ENDOF
['] _FLIT-CODE8 OF FLIT8. ENDOF
ENDCASE
THEN
;
: INST1 ( ADR -- ADR' )
DUP TO NEXT-INST
COLS 0x29 <
IF DIS-OP
\ S-BUF COUNT TYPE
ELSE DUP DIS-OP
DUP ROT
2DUP - DUP>R 0x10 U> ABORT" DECOMPILER ERROR"
2DROP RDROP
THEN
;
: (REST-AREA) ( addr1 addr2 -- )
\ if addr2 = 0 continue till RET instruction
SWAP DUP TO NEXT-INST
BEGIN
\ We do not look for JMP's because there may be
\ a jump in a forth word
CR
OVER 0= IF NEXT-INST C@ 0xC3 <>
ELSE 2DUP < INVERT
THEN
WHILE INST \ CR
REPEAT 2DROP
;
\ : ALLOT DUP HERE FINISH-ARRAY @ 2! FINISH-ARRAY @ 2 CELLS + FINISH-ARRAY ! ALLOT ;
FORTH DEFINITIONS
VECT REST-AREA
\ ' (REST-AREA) TO REST-AREA
\ : REST ( addr -- )
\ DUP HERE U> 0= HERE 1- AND REST-AREA
\ ;
\ : SEE ( "name" -- )
\ ' DUP FIND-REST-END ['] REST-AREA CATCH DROP
\ ;
: CALL-TYPE
\ WordByAddr TYPE
\ DUP ADD-CALL DUP ADD-LAB \ ! ! ! ! !
1 TRIGER3 ! S" @@" TYPE NEAR_NFA >R COUNT TYPE S" :" TYPE DROP R>
\ DUP SEE2
;
: CALL-FIND \ DUP SEE2
HEX
DUP FIND-REST-END
SWAP DUP TO NEXT-INST
BEGIN
\ We do not look for JMP's because there may be
\ a jump in a forth word
OVER 0= IF NEXT-INST C@ 0xC3 <>
ELSE 2DUP < INVERT
THEN
WHILE DUP INST1 DROP DUP TO NEXT-INST
DUP C@ 0xE8 = IF NEXT-INST 1+ DUP @ + 4 + DUP ADD-CALL
CALL-TYPE? @ IF RECURSE ELSE DROP 5 + THEN
ELSE DIS-OP THEN \ CR
REPEAT 2DROP
;
: SEE2 ( "addr" -- )
DUP FIND-REST-END 2DUP END-WORD ! START-WORD !
['] REST-AREA CATCH DROP
;
: VAR-VECT
1+ @+ SWAP +
CASE
['] _CLITERAL-CODE OF 5 + X". ENDOF
['] _SLITERAL-CODE OF 5 + X". ENDOF
['] _VECT-CODE OF 5 + VECT. DROP ENDOF
['] _CONSTANT-CODE OF 5 + CONS. ENDOF
['] _USER-CODE OF 5 + USER. ENDOF
['] _CREATE-CODE OF 5 + CODE. ENDOF
['] _USER-VALUE-CODE OF 5 + UVAL. ENDOF
['] _FLIT-CODE10 OF 5 + FLIT10. ENDOF
['] _FLIT-CODE8 OF 5 + FLIT8. ENDOF
ENDCASE
;
: TYPE-VAR
FINISH-VAR @ START-VAR @ = IF EXIT THEN
FINISH-VAR @ 4 -
BEGIN DUP @
\ DUP 5 + @ ARRAY? .
DUP WordByAddr TYPE 1 TRIGER3 ! DUP VAR-VECT \ SEE2
DUP START-VAR @ = 0= WHILE CELL- REPEAT DROP CR CR
;
: TYPE-ALL
START-LIST2 @ FINISH-LIST2 @ 4 - FINISH-LIST3 !
BEGIN DUP @
DUP 1+ @+ SWAP +
CASE
\ ['] _CLITERAL-CODE OF 0 ENDOF
\ ['] _SLITERAL-CODE OF 0 ENDOF
['] _VECT-CODE OF 0 ENDOF
['] _CONSTANT-CODE OF 0 ENDOF
['] _USER-CODE OF 0 ENDOF
['] _CREATE-CODE OF 0 ENDOF
['] _USER-VALUE-CODE OF 0 ENDOF
['] _FLIT-CODE10 OF 0 ENDOF
['] _FLIT-CODE8 OF 0 ENDOF
ENDCASE
?DUP IF ADD-CALL ELSE ADD-VAR THEN DUP FINISH-LIST3 @ = 0= \ ADD-CALL CR WordByAddr TYPE CR
WHILE CELL+ REPEAT DROP
TYPE-VAR
FINISH-LIST @ BEGIN DUP @ DUP CALL-TYPE
SEE2 DUP START-LIST @ = 0= WHILE CELL- REPEAT DROP
;
: DISASM-LIST
['] (REST-AREA) TO REST-AREA
DUP START-LIST @ ! CALL-FIND
;
: DIS ( ADR -- )
BEGIN
DUP
CR INST
KEY UPC DUP 0x1B = OVER [CHAR] Q = OR 0=
WHILE
CASE
[CHAR] Q OF DROP DIS-DB ENDOF
[CHAR] W OF DROP DIS-DW ENDOF
[CHAR] D OF DROP DIS-DD ENDOF
[CHAR] S OF DROP DIS-DS ENDOF
ROT DROP
ENDCASE
REPEAT 2DROP DROP ;
0 VALUE SHOW-NEXT? \ DEFAULT TO NOT SHOWING NEXT INSTRUCTIONS
DECIMAL
TRUE VALUE SEE-KET-FL
VARIABLE COUNT-LINE
: REST ( ADR -- )
20 COUNT-LINE !
0 TO MAX_REFERENCE
DUP TO NEXT-INST
BEGIN
CR
NEXT-INST C@
DUP 0xC3 <>
SWAP 0xE9 <> AND \ NEXT, BEHIND US?
NEXT-INST MAX_REFERENCE U< OR
OVER HERE - 0x100 U> AND
WHILE INST
COUNT-LINE @ 1- DUP 0= SEE-KET-FL AND
IF 9 EMIT ." \ Press <enter> | q | any" KEY UPC
DUP 0xD = IF 2DROP 1 ELSE
DUP [CHAR] Q = SWAP 0x1B =
OR IF 2DROP CR EXIT THEN
DROP 20 THEN
THEN
COUNT-LINE !
REPEAT DROP ." END-CODE "
;
: SEE ( -- )
' REST ;
ONLY FORTH DEFINITIONS
.( Ok) CR
TRUE WARNING !

/programs/develop/SPForth/lib/ext/locals.f
0,0 → 1,324
( 28.Mar.2000 Andrey Cherezov Copyright [C] RU FIG
Èñïîëüçîâàíû èäåè ñëåäóþùèõ àâòîðîâ:
Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
Konstantin Tarasov; Michail Maximov.
!! Ðàáîòàåò òîëüêî â SPF4.
)
( Ïðîñòîå ðàñøèðåíèå ÑÏ-Ôîðòà ëîêàëüíûìè ïåðåìåííûìè.
Ðåàëèçîâàíî áåç èñïîëüçîâàíèÿ LOCALS ñòàíäàðòà 94.
Îáúÿâëåíèå âðåìåííûõ ïåðåìåííûõ, âèäèìûõ òîëüêî âíóòðè
òåêóùåãî ñëîâà è îãðàíè÷åííûõ âðåìåíåì âûçîâà äàííîãî
ñëîâà âûïîëíÿåòñÿ ñ ïîìîùüþ ñëîâà "{". Âíóòðè îïðåäåëåíèÿ
ñëîâà èñïîëüçóåòñÿ êîíñòðóêöèÿ, ïîäîáíàÿ ñòåêîâîé íîòàöèè Ôîðòà
{ ñïèñîê_èíèöèàëèçèðîâàííûõ_ëîêàëîâ \ ñï.íåèíèö.ëîêàëîâ -- ÷òî óãîäíî }
Íàïðèìåð:
{ a b c d \ e f -- i j }
Èëè { a b c d \ e f[ EVALUATE_âûðàæåíèå ] -- i j }
Ýòî çíà÷èò ÷òî äëÿ ïåðåìåííîé f[ áóäåò âûäåëåí íà ñòåêå âîçâðàòîâ ó÷àñòîê
ïàìÿòè äëèíîé n áàéò. Èñïîëüçîâàíèå ïåðåìåííîé f[ äàñò àäðåñ íà÷àëà ýòîãî
ó÷àñòêà. \ ñòèëå MPE\
Èëè { a b c d \ e [ 12 ] f -- i j }
Ýòî çíà÷èò ÷òî äëÿ ïåðåìåííîé f áóäåò âûäåëåí íà ñòåêå âîçâðàòîâ ó÷àñòîê
ïàìÿòè äëèíîé 12 áàéò. Èñïîëüçîâàíèå ïåðåìåííîé f äàñò àäðåñ íà÷àëà ýòîãî
ó÷àñòêà.
×àñòü "\ ñï.íåèíèö.ëîêàëîâ" ìîæåò îòñóòñòâîâàòü, íàïðèìåð:
{ item1 item2 -- }
Ýòî çàñòàâëÿåò ÑÏ-Ôîðò àâòîìàòè÷åñêè âûäåëÿòü ìåñòî â
ñòåêå âîçâðàòîâ äëÿ ýòèõ ïåðåìåííûõ â ìîìåíò âûçîâà ñëîâà
è àâòîìàòè÷åñêè îñâîáîæäàòü ìåñòî ïðè âûõîäå èç íåãî.
Îáðàùåíèå ê òàêèì ëîêàëüíûì ïåðåìåííûì - êàê ê VALUE-ïåðåìåííûì
ïî èìåíè. Åñëè íóæåí àäðåñ ïåðåìåííîé, òî èñïîëüçóåòñÿ "^ èìÿ"
èëè "AT èìÿ".
Âìåñòî \ ìîæíî èñïîëüçîâàòü |
Âìåñòî -> ìîæíî èñïîëüçîâàòü TO
Ïðèìåðû:
: TEST { a b c d \ e f -- } a . b . c . b c + -> e e . f . ^ a @ . ;
Ok
1 2 3 4 TEST
1 2 3 5 0 1 Ok
: TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
Ok
12 34 TEST
12 34
0 12 34
1 12 34
2 12 34
3 12 34
4 12 34
Ok
: TEST { a b } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { a b -- } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c -- d } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { \ a b } a . b . 1 -> a 2 -> b a . b . ;
Ok
TEST
0 0 1 2 Ok
Èìåíà ëîêàëüíûõ ïåðåìåííûõ ñóùåñòâóþò â äèíàìè÷åñêîì
âðåìåííîì ñëîâàðå òîëüêî â ìîìåíò êîìïèëÿöèè ñëîâà, à
ïîñëå ýòîãî âû÷èùàþòñÿ è áîëåå íåäîñòóïíû.
Èñïîëüçîâàòü êîíñòðóêöèþ "{ ... }" âíóòðè îäíîãî îïðåäåëåíèÿ ìîæíî
òîëüêî îäèí ðàç.
Êîìïèëÿöèÿ ýòîé áèáëèîòåêè äîáàâëÿåò â òåêóùèé ñëîâàðü êîìïèëÿöèè
Òîëüêî äâà ñëîâà:
ñëîâàðü "vocLocalsSupport" è "{"
Âñå îñòàëüíûå äåòàëè "ñïðÿòàíû" â ñëîâàðå, èñïîëüçîâàòü èõ
íå ðåêîìåíäóåòñÿ.
)
MODULE: vocLocalsSupport
USER widLocals
USER uLocalsCnt
USER uLocalsUCnt
USER uPrevCurrent
USER uAddDepth
: (Local^) ( N -- ADDR )
RP@ +
;
: LocalOffs ( n -- offs )
uLocalsCnt @ SWAP - CELLS CELL+ uAddDepth @ +
;
BASE @ HEX
: CompileLocalsInit
uPrevCurrent @ SET-CURRENT
uLocalsCnt @ uLocalsUCnt @ - ?DUP IF CELLS LIT, POSTPONE DRMOVE THEN
uLocalsUCnt @ ?DUP
IF
LIT, POSTPONE (RALLOT)
THEN
uLocalsCnt @ ?DUP
IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
;
: CompileLocal@ ( n -- )
['] DUP MACRO,
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 8B B, 44 B, 24 B, B, \ mov eax, offset [esp]
ELSE 8B B, 84 B, 24 B, , \ mov eax, offset [esp]
THEN OPT
OPT_CLOSE
;
\ : CompileLocal@ ( n -- )
\ LocalOffs LIT, POSTPONE RP+@
\ ;
: CompileLocal! ( n -- )
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 89 B, 44 B, 24 B, B, \ mov offset [esp], eax
ELSE 89 B, 84 B, 24 B, , \ mov offset [esp], eax
THEN OPT
OPT_CLOSE
['] DROP MACRO,
;
: CompileLocalRec ( u -- )
LocalOffs DUP
['] DUP MACRO,
SHORT?
OPT_INIT SetOP
IF 8D B, 44 B, 24 B, B, \ lea eax, offset [esp]
ELSE 8D B, 84 B, 24 B, , \ lea eax, offset [esp]
THEN OPT
OPT_CLOSE
;
BASE !
: LocalsStartup
TEMP-WORDLIST widLocals !
GET-CURRENT uPrevCurrent !
ALSO vocLocalsSupport
ALSO widLocals @ CONTEXT ! DEFINITIONS
uLocalsCnt 0!
uLocalsUCnt 0!
uAddDepth 0!
;
: LocalsCleanup
PREVIOUS PREVIOUS
widLocals @ FREE-WORDLIST
;
: ProcessLocRec ( "name" -- u )
[CHAR] ] PARSE
STATE 0!
EVALUATE CELL 1- + CELL / \ äåëàåì êðàòíûì 4
-1 STATE !
DUP uLocalsCnt +!
uLocalsCnt @ 1-
;
: CreateLocArray
ProcessLocRec
CREATE ,
;
: LocalsRecDoes@ ( -- u )
DOES> @ CompileLocalRec
;
: LocalsRecDoes@2 ( -- u )
ProcessLocRec ,
DOES> @ CompileLocalRec
;
: LocalsDoes@
uLocalsCnt @ ,
uLocalsCnt 1+!
DOES> @ CompileLocal@
;
: ;; POSTPONE ; ; IMMEDIATE
: ^
' >BODY @
CompileLocalRec
; IMMEDIATE
: -> ' >BODY @ CompileLocal! ; IMMEDIATE
WARNING DUP @ SWAP 0!
: AT
[COMPILE] ^
; IMMEDIATE
: TO ( "name" -- )
>IN @ NextWord widLocals @ SEARCH-WORDLIST 1 =
IF >BODY @ CompileLocal! DROP
ELSE >IN ! [COMPILE] TO
THEN
; IMMEDIATE
WARNING !
: â POSTPONE -> ; IMMEDIATE
WARNING @ WARNING 0!
\ ===
\ ïåðåîïðåäåëåíèå ñîîòâåòñòâóþùèõ ñëîâ äëÿ âîçìîæíîñòè èñïîëüçîâàòü
\ âðåìåííûå ïåðåìåííûå âíóòðè öèêëà DO LOOP è íåçàâèñèìî îò èçìåíåíèÿ
\ ñîäåðæèìîãî ñòåêà âîçâðàòîâ ñëîâàìè >R R>
: DO POSTPONE DO [ 3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: ?DO POSTPONE ?DO [ 3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: LOOP POSTPONE LOOP [ -3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: +LOOP POSTPONE +LOOP [ -3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: >R POSTPONE >R [ 1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: R> POSTPONE R> [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: RDROP POSTPONE RDROP [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2>R POSTPONE 2>R [ 2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2R> POSTPONE 2R> [ -2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
\ ===
\ { ... | ... -- _____ }
: ParseLocals3
BEGIN
PARSE-NAME
DUP 0= ABORT" Locals bad syntax (3)"
2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
2DROP
AGAIN
;
\ { ... | _____ -- ... }
: ParseLocals2
BEGIN
PARSE-NAME
DUP 0= ABORT" Locals bad syntax (2)"
2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
2DUP S" [" COMPARE 0=
IF
2DROP CreateLocArray LocalsRecDoes@
ELSE
CREATED
LATEST DUP C@ CHARS + C@
[CHAR] [ =
IF
LocalsRecDoes@2
ELSE
LocalsDoes@ 1
THEN
THEN
uLocalsUCnt +! IMMEDIATE
AGAIN
;
\ { _____ | ... -- ... }
: ParseLocals1
BEGIN
PARSE-NAME
DUP 0= ABORT" Locals bad syntax (1)"
2DUP S" |" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
2DUP S" \" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
CREATED LocalsDoes@ IMMEDIATE
AGAIN ;
\ uLocalsCnt @ ?DUP
\ IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
: ; LocalsCleanup
S" ;" EVAL-WORD
; IMMEDIATE
WARNING !
\ =====================================================================
EXPORT
: {
LocalsStartup
ParseLocals1
CompileLocalsInit
;; IMMEDIATE
;MODULE

/programs/develop/SPForth/lib/ext/patch.f
0,0 → 1,8
\ from gforth
: REPLACE-WORD ( by-xt what-xt )
[ HEX ] E9 [ DECIMAL ] OVER C! \ JMP ...
1+ DUP >R
CELL+ -
R> !
;

/programs/develop/SPForth/lib/ext/spf-asm.f
0,0 → 1,40
REQUIRE CASE lib/ext/case.f
REQUIRE !CSP ~mak/lib/csr.f
: DEFER CREATE ['] NOOP , DOES> @ EXECUTE ;
: DEFER@ ' >BODY STATE @ IF POSTPONE LITERAL POSTPONE @ ELSE @ THEN ; IMMEDIATE
: IS ' >BODY STATE @ IF POSTPONE LITERAL POSTPONE ! ELSE ! THEN ; IMMEDIATE
: +TO ' >BODY STATE @ IF POSTPONE LITERAL POSTPONE +! ELSE +! THEN ; IMMEDIATE
: REVEAL SMUDGE ;
: COMPILE ' POSTPONE LITERAL POSTPONE COMPILE, ; IMMEDIATE
: (;CODE) R> LATEST 5 - ! ;
VECT EXIT-ASSEMBLER
VOCABULARY ASSEMBLER
S" lib/asm/486asm.f" INCLUDED
( FORTH HEADER CREATION WORDS )
ALSO ASSEMBLER ALSO ASM-HIDDEN
IN-HIDDEN
: _CODE ( START A NATIVE CODE DEFINITION )
CREATE CFL NEGATE ALLOT HIDE !CSP INIT-ASM ;
: _;CODE ( CREATE THE [;CODE] PART OF A LOW LEVEL DEFINING WORD )
?CSP !CSP COMPILE (;CODE) POSTPONE [ INIT-ASM ;
IN-FORTH
' _CODE IS CODE
' _;CODE IS ;CODE
: FCALL A; [COMPILE] ' COMPILE, ;
ONLY FORTH DEFINITIONS
ALSO FORTH IMMEDIATE PREVIOUS
S" lib/asm/asmmac.f" INCLUDED

/programs/develop/SPForth/lib/ext/vocs.f
0,0 → 1,60
REQUIRE [DEFINED] lib/include/tools.f
\ Ðàñïå÷àòàòü ñïèñîê ñëîâàðåé.
: VOCS
VOC-LIST
BEGIN @ DUP WHILE
DUP CELL+ VOC-NAME.
DUP 3 CELLS + @ \ wid ïðåäêà
?DUP IF ." defined in " VOC-NAME.
ELSE ." is the main vocabulary"
THEN CR
REPEAT
DROP
;
0x200 VALUE MAX-WORD-SIZE
C" NEAR_NFA" FIND NIP 0=
[IF] : NEAR_NFA ( addr -- NFA addr | 0 addr ) DUP WordByAddr DROP 1- SWAP
2DUP 1000 - U< IF NIP 0 SWAP THEN ;
[THEN]
\ Opposite to CDR, might be slow!
\ It does not take wordlists into account.
: NextNFA ( nfa1 -- nfa2 | 0 )
NEAR_NFA SWAP >R
BEGIN
1+ NEAR_NFA ( nfa addr )
OVER 0 >
ROT R@ <> AND
OVER R@ - MAX-WORD-SIZE > OR
UNTIL
DUP R> - MAX-WORD-SIZE >
IF DROP 0
ELSE NEAR_NFA DROP
THEN
;
: NFAInVoc? ( nfa voc -- f )
@ \ last nfa
BEGIN ( nfa 'nfa )
DUP
WHILE
2DUP = IF 2DROP TRUE EXIT THEN
CDR
REPEAT 2DROP 0
;
: VocByNFA ( nfa -- wid | 0 )
VOC-LIST
BEGIN @ DUP WHILE ( nfa voc )
2DUP CELL+ NFAInVoc?
IF
NIP CELL+ EXIT
THEN
REPEAT
2DROP 0
;

/programs/develop/SPForth/lib/ext
Property changes:
Added: tsvn:logminsize
+5
\ No newline at end of property

/programs/develop/SPForth/lib/include/core-ext.f
0,0 → 1,81
\ 94 CORE EXT
: .R ( n1 n2 -- ) \ 94 CORE EXT
\ Âûâåñòè íà ýêðàí n1 âûðàâíåííûì âïðàâî â ïîëå øèðèíîé n2 ñèìâîëîâ.
\ Åñëè ÷èñëî ñèìâîëîâ, íåîáõîäèìîå äëÿ èçîáðàæåíèÿ n1, áîëüøå ÷åì n2,
\ èçîáðàæàþòñÿ âñå öèôðû ÷èñëà áåç âåäóùèõ ïðîáåëîâ â ïîëå íåîáõîäèìîé
\ øèðèíû.
>R DUP >R ABS
S>D <# #S R> SIGN #>
R> OVER - 0 MAX SPACES TYPE
;
: 0> ( n -- flag ) \ 94 CORE EXT
\ flag "èñòèíà" òîãäà è òîëüêî òîãäà, êîãäà n áîëüøå íóëÿ
0 >
;
: MARKER ( "<spaces>name" -- ) \ 94 CORE EXT
\ Ïðîïóñòèòü âåäóùèå ïðîáåëû. Âûäåëèòü name, îãðàíè÷åííîå ïðîáåëàìè.
\ Ñîçäàòü îïðåäåëåíèå ñ ñåìàíòèêîé âûïîëíåíèÿ, îïèñàííîé íèæå.
\ name Âûïîëíåíèå: ( -- )
\ Âîññòàíîâèòü ðàñïðåäåëåíèå ïàìÿòè ñëîâàðÿ è óêàçàòåëè ïîðÿäêà ïîèñêà
\ ê ñîñòîÿíèþ, êîòîðîå îíè èìåëè ïåðåä îïðåäåëåíèåì name. Óáðàòü
\ îïðåäåëåíèå name è âñå ïîñëåäóþùèå îïðåäåëåíèÿ. Íå òðåáóåòñÿ
\ îáÿçàòåëüíî âîññòàíàâëèâàòü ëþáûå îñòàâøèåñÿ ñòðóêòóðû, êîòîðûå
\ ìîãóò áûòü ñâÿçàíû ñ óäàëåííûìè îïðåäåëåíèÿìè èëè îñâîáîæäåííûì
\ ïðîñòðàíñòâîì äàííûõ. Íèêàêàÿ äðóãàÿ êîíòåêñòóàëüíàÿ èíôîðìàöèÿ,
\ êàê îñíîâàíèå ñèñòåìû ñ÷èñëåíèÿ, íå èçìåíÿåòñÿ.
HERE
\ [C]HERE , [E]HERE ,
GET-CURRENT ,
GET-ORDER DUP , 0 ?DO DUP , @ , LOOP
CREATE ,
DOES> @ DUP \ ONLY
\ DUP @ [C]DP ! CELL+
\ DUP @ [E]DP ! CELL+
DUP @ SET-CURRENT CELL+
DUP @ >R R@ CELLS 2* + 1 CELLS - R@ 0
?DO DUP DUP @ SWAP CELL+ @ OVER ! SWAP 2 CELLS - LOOP
DROP R> SET-ORDER
DP !
;
: SAVE-INPUT ( -- xn ... x1 n ) \ 94 CORE EXT
\ x1 - xn îïèñûâàþò òåêóùåå ñîñòîÿíèå ñïåöèôèêàöèé âõîäíîãî ïîòîêà äëÿ
\ ïîñëåäóþùåãî èñïîëüçîâàíèÿ ñëîâîì RESTORE-INPUT.
SOURCE-ID 0>
IF TIB #TIB @ 2DUP C/L 2 + ALLOCATE THROW DUP >R SWAP CMOVE
R> TO TIB >IN @
SOURCE-ID FILE-POSITION THROW
5
ELSE BLK @ >IN @ 2 THEN
;
: RESTORE-INPUT ( xn ... x1 n -- flag ) \ 94 CORE EXT
\ Ïîïûòêà âîññòàíîâèòü ñïåöèôèêàöèè âõîäíîãî ïîòîêà ê ñîñòîÿíèþ,
\ îïèñàííîìó x1 - xn. flag "èñòèíà", åñëè ñïåöèôèêàöèè âõîäíîãî
\ ïîòîêà íå ìîãóò áûòü âîññòàíîâëåíû.
\ Íåîïðåäåëåííàÿ ñèòóàöèÿ âîçíèêàåò, åñëè âõîäíîé ïîòîê,
\ ïðåäñòàâëåííûé àðãóìåíòàìè íå òîò æå, ÷òî è òåêóùèé âõîäíîé ïîòîê.
SOURCE-ID 0>
IF DUP 5 <> IF 0 ?DO DROP LOOP -1 EXIT THEN
DROP SOURCE-ID REPOSITION-FILE ?DUP IF >R 2DROP DROP R> EXIT THEN
>IN ! #TIB ! TO TIB FALSE
ELSE DUP 2 <> IF 0 ?DO DROP LOOP -1 EXIT THEN
DROP >IN ! BLK ! FALSE
THEN
;
: U.R ( u n -- ) \ 94 CORE EXT
\ Âûâåñòè íà ýêðàí u âûðàâíåííûì âïðàâî â ïîëå øèðèíîé n ñèìâîëîâ.
\ Åñëè ÷èñëî ñèìâîëîâ, íåîáõîäèìîå äëÿ èçîáðàæåíèÿ u, áîëüøå ÷åì n,
\ èçîáðàæàþòñÿ âñå öèôðû ÷èñëà áåç âåäóùèõ ïðîáåëîâ â ïîëå íåîáõîäèìîé
\ øèðèíû.
>R U>D <# #S #>
R> OVER - 0 MAX SPACES TYPE
;
\EOF
: UNUSED ( -- u ) \ 94 CORE EXT
\ u - îáúåì ïàìÿòè, îñòàâøåéñÿ â îáëàñòè, àäðåñóåìîé HERE,
\ â áàéòàõ.
IMAGE-SIZE
HERE IMAGE-BASE - -
;

/programs/develop/SPForth/lib/include/tools.f
0,0 → 1,78
\ 94 TOOLS
: .S ( -- ) \ 94 TOOLS
\ Ñêîïèðîâàòü è ïîêàçàòü çíà÷åíèÿ, íàõîäÿùèåñÿ íà ñòåêå äàííûõ. Ôîðìàò çàâèñèò
\ îò ðåàëèçàöèè.
\ .S ìîæåò áûòü ðåàëèçîâàíî ñ èñïîëüçîâàíèåì ñëîâ ôîðìàòíîãî ïðåîáðàçîâàíèÿ
\ ÷èñåë. Ñîîòâåòñòâåííî, îí ìîæåò èñïîðòèòü ïåðåìåùàåìóþ îáëàñòü,
\ èäåíòèôèöèðóåìóþ #>.
DEPTH .SN
;
: ? ( a-addr -- ) \ 94 TOOLS
\ Ïîêàçàòü çíà÷åíèå, õðàíÿùååñÿ ïî àäðåñó a-addr.
\ ? ìîæåò áûòü ðåàëèçîâàí ñ èñïîëüçîâàíèåì ñëîâ ôîðìàòíîãî ïðåîáðàçîâàíèÿ
\ ÷èñåë. Ñîîòâåòñòâåííî, îí ìîæåò èñïîðòèòü ïåðåìåùàåìóþ îáëàñòü,
\ èäåíòèôèöèðóåìóþ #>.
@ .
;
: AHEAD \ 94 TOOLS EXT
\ Èíòåðïðåòàöèÿ: ñåìàíòèêà íåîïðåäåëåíà.
\ Êîìïèëÿöèÿ: ( C: -- orig )
\ Ïîëîæèòü ìåñòî íåðàçðåøåííîé ññûëêè âïåðåä orig íà ñòåê óïðàâëåíèÿ.
\ Äîáàâèòü ñåìàíòèêó âðåìåíè âûïîëíåíèÿ, äàííóþ íèæå, ê òåêóùåìó îïðåäåëåíèþ.
\ Ñåìàíòèêà íåçàâåðøåíà äî òåõ ïîð, ïîêà orig íå ðàçðåøèòñÿ (íàïðèìåð,
\ ïî THEN).
\ Âðåìÿ âûïîëíåíèÿ: ( -- )
\ Ïðîäîëæèòü âûïîëíåíèå ñ ïîçèöèè, çàäàííîé ðàçðåøåíèåì orig.
HERE BRANCH, >MARK 2
; IMMEDIATE
: [ELSE] \ 94 TOOLS EXT
\ Êîìïèëÿöèÿ: Âûïîëíèòü ñåìàíòèêó âûïîëíåíèÿ, äàííóþ íèæå.
\ Âûïîëíåíèå: ( "<spaces>name..." -- )
\ Ïðîïóñòèòü âåäóùèå ïðîáåëû, âûäåëèòü è îòáðîñèòü îãðàíè÷åííûå ïðîáåëàìè
\ ñëîâà èç ðàçáèðàåìîé îáëàñòè, âêëþ÷àÿ âëîæåííûå [IF]...[THEN] è
\ [IF]...[ELSE]...[THEN], äî âûäåëåíèÿ è îòáðàñûâàíèÿ ñëîâà [THEN].
\ Åñëè ðàçáèðàåìàÿ îáëàñòü îïóñòîøàåòñÿ, îíà ñíîâà çàïîëíÿåòñÿ ïî REFILL.
\ [ELSE] - ñëîâî íåìåäëåííîãî èñïîëíåíèÿ.
1
BEGIN
NextWord DUP
IF
2DUP S" [IF]" COMPARE 0= IF 2DROP 1+ ELSE
2DUP S" [ELSE]" COMPARE 0= IF 2DROP 1- DUP IF 1+ THEN ELSE
S" [THEN]" COMPARE 0= IF 1- THEN
THEN THEN
ELSE 2DROP REFILL AND \ SOURCE TYPE
THEN DUP 0=
UNTIL DROP ; IMMEDIATE
: [IF] \ 94 TOOLS EXT
\ Êîìïèëÿöèÿ: Âûïîëíèòü ñåìàíòèêó âûïîëíåíèÿ, äàííóþ íèæå.
\ Âûïîëíåíèå: ( flag | flag "<spaces>name..." -- )
\ Åñëè ôëàã "èñòèíà", íè÷åãî íå äåëàòü. Èíà÷å, ïðîïóñòèâ âåäóùèå ïðîáåëû,
\ âûäåëÿòü è îòáðàñûâàòü îãðàíè÷åííûå ïðîáåëàìè ñëîâà èç ðàçáèðàåìîé îáëàñòè,
\ âêëþ÷àÿ âëîæåííûå [IF]...[THEN] è [IF]...[ELSE]...[THEN], äî òåõ ïîð, ïîêà íå
\ áóäåò âûäåëåíî è îòáðîøåíî ñëîâî [ELSE] èëè [THEN].
\ Åñëè ðàçáèðàåìàÿ îáëàñòü îïóñòîøàåòñÿ, îíà ñíîâà çàïîëíÿåòñÿ ïî REFILL.
\ [ELSE] - ñëîâî íåìåäëåííîãî èñïîëíåíèÿ.
0= IF POSTPONE [ELSE] THEN
; IMMEDIATE
: [THEN] \ 94 TOOLS EXT
\ Êîìïèëÿöèÿ: Âûïîëíèòü ñåìàíòèêó âûïîëíåíèÿ, äàííóþ íèæå.
\ Âûïîëíåíèå: ( -- )
\ Íè÷åãî íå äåëàòü. [THEN] - ñëîâî íåìåäëåííîãî èñïîëíåíèÿ.
; IMMEDIATE
\ Ruvim Pinka additions:
: [DEFINED] ( -- f ) \ "name"
NextWord SFIND IF DROP TRUE ELSE 2DROP FALSE THEN
; IMMEDIATE
: [UNDEFINED] ( -- f ) \ "name"
POSTPONE [DEFINED] 0=
; IMMEDIATE

/programs/develop/SPForth/lib/include
Property changes:
Added: tsvn:logminsize
+5
\ No newline at end of property

/programs/develop/SPForth/lib/.
Property changes:
Added: tsvn:logminsize
+5
\ No newline at end of property