\ x86 assembler in Forth \ Copyright (C) 2006 Alastair Bridgewater. All Rights Reserved. HEX \ A few things to keep in mind while reading this code: \ * It was originally written under the constraints of 1k \ source blocks, with a very primitive block editor. \ * It is not a complete assembler. Many instructions are \ sufficiently infrequent (one or two uses in my entire \ system) as to be easier to code inline. For the same \ reason, SIB addressing modes and 16-bit addressing \ modes are unimplemented. As a result, 16-bit mode \ assembly is also unusable (no 16-bit amodes, no code \ checks to see if the amode prefix is needed). \ * There are almost certainly still bugs in here. \ * My system returns -1 (FFFFFFFF) for true from all \ boolean operations. Quite often, I will then bitwise \ AND that result with a bitfield. I don't remember if \ this is standard Forth, but it's too useful to give up. \ * This was retyped from block source in a hurry, and \ modified since without ever being built. There could \ be typos in here that would prevent it from even \ compiling. \ Assembler mode control VARIABLE ASMMODE \ The assembler mode constants are laid out as masks against \ the argument words laid out below. : ASM16 5000 ASMMODE ! ; : ASM32 A000 ASMMODE ! ; \ Instruction operand word layouts ( AAWW RI8S Ceas xrrr ) \ AA -- Addressing mode bits ( 8000 is 32-bit valid, 4000 is 16-bit valid ) \ WW -- Data mode bits ( 2000 is 32-bit valid, 1000 is 16-bit valid ) \ R -- Register operand \ I -- Immediate operand \ 8 -- 8-bit operand \ S -- Segment register \ e -- Is [ESP] ( must use a SIB byte to represent this operand ) \ a -- Accumulator ( AL, AX, or EAX ) \ s -- Is [EBP] ( can't use mod 00 ) \ x -- unused \ rrr -- encoded register number : ?imm 0400 AND ; : ?reg 0800 AND ; : ?acc 0020 AND ; : ?8bit 0200 AND ; : ?word 1000 AND ; : ?seg 0100 AND ; \ Immediate data VARIABLE IMMEDDATA : IMM IMMEDDATA @ ; : #, DUP IMMEDDATA ! DUP ?byte 0200 AND SWAP FFFF <= 1000 AND E400 OR OR ; : C,I IMM C, ; : W,I IMM W, ; : ,I IMM , ; \ Utilities : ?byte -80 7F WITHIN ; : ?width ASMMODE @ 3000 AND AND 0= IF 66 C, THEN ; \ Registers FA20 CONSTANT AL FA04 CONSTANT AH F900 CONSTANT ES FA01 CONSTANT CL FA05 CONSTANT CH F901 CONSTANT CS FA02 CONSTANT DL FA06 CONSTANT DH F902 CONSTANT SS FA03 CONSTANT BL FA07 CONSTANT BH F903 CONSTANT DS D820 CONSTANT AX D804 CONSTANT SP D801 CONSTANT CX D805 CONSTANT BP D802 CONSTANT DX D806 CONSTANT SI D803 CONSTANT BX D807 CONSTANT DI E820 CONSTANT EAX E804 CONSTANT ESP E801 CONSTANT ECX E805 CONSTANT EBP E802 CONSTANT EDX E806 CONSTANT ESI E803 CONSTANT EBX E807 CONSTANT EDI \ Addressing modes VARIABLE OFFSET : amode CREATE , DOES> @ SWAP OFFSET ! ; B000 amode [EAX] B044 amode [ESP] B001 amode [ECX] B015 amode [EBP] B002 amode [EDX] B006 amode [ESI] B003 amode [EBX] B007 amode [EDI] \ displacements for memory reference VARIABLE displacer VARIABLE is-esp : disp-8 OFFSET @ C, ; : disp-32 OFFSET @ , ; : disp8 ['] disp-8 displacer ! ; : disp32 ['] disp-32 displacer ! ; : displace is-esp @ IF 24 C, THEN displacer @ EXECUTE ; \ mod/rm construction : as-reg 7 AND 8 * ; : as-modrm DUP 050 AND 40 = is-esp ! ['] NOP displacer ! DUP ?reg IF 7 AND C0 OR EXIT THEN ( register case [mod 11] ) DUP 050 AND 050 = IF disp32 7 AND EXIT THEN DUP 10 AND 0= OFFSET @ 0= AND IF 7 AND EXIT THEN OFFSET @ ?byte IF disp8 7 AND 40 OR ELSE disp32 7 AND 80 OR THEN ; \ 1byte general instructions : 1byte-reg CREATE C, DOES> C@ SWAP DUP ?width 7 AND OR C, ; 40 1byte-reg INC, 48 1byte-reg DEC, 50 1byte-reg PUSH, 58 1byte-reg POP, \ 1byte implied instructions : 1byte CREATE C, DOES> C@ C, ; F8 1byte CLC, FC 1byte CLD, FA 1byte CLI, F9 1byte STC, FD 1byte STD, FB 1byte STI, F2 1byte REP, F2 1byte REPNZ, F3 1byte REPZ, F2 1byte REPNE, F3 1byte REPE, \ Group 1 instructions : grp1-acc8 4 + C, C,I ; : grp1-acc16 5 + C, W,I ; : grp1-acc32 5 + C, ,I ; : grp1-acc OVER AL = IF grp1-acc8 EXIT THEN OVER AX = IF grp1-acc16 EXIT THEN grp1-acc32 ; : grp1-imm, C, SWAP as-modrm + C, displace DROP ; : grp1-imm OVER ?acc IF grp1-acc 2DROP EXIT THEN OVER ?8bit IF 80 grp1-imm, C,I EXIT THEN IMM ?byte IF 83 grp1-imm, C,I EXIT THEN OVER ?word IF 81 grp1-imm, W,I EXIT THEN 81 grp1-imm, ,I ; : ?grp1-8bit THIRD THIRD OR ?8bit 0= 1 AND OR ; : grp1-toxxx as-reg SWAP as-modrm OR C, displace ; : grp1-toreg 2 OR ?grp1-8bit C, grp1-toxxx ; : grp1-tomem ?grp1-8bit C, SWAP grp1-toxxx ; : grp1 ( src dst n) THIRD ?imm IF grp1-imm EXIT THEN ( immediate source case ) OVER ?reg IF grp1-toreg ELSE grp1-tomem THEN ; : [grp1] CREATE 8 * C, DOES> C@ OVER ?width grp1 ; 0 [grp1] ADD, 1 [grp1] OR, 2 [grp1] ADC, 3 [grp1] SBB, 4 [grp1] AND, 5 [grp1] SUB, 6 [grp1] XOR, 7 [grp1] CMP, \ group 2 instructions : grp2-core THIRD ?8bit 0= 1 AND OR C, SWAP as-modrm OR C, displace DROP ; : grp2-imm8 C0 grp2-core C,I ; : grp2-1 D0 grp2-core ; : grp2-cl D2 grp2-core ; : grp2-imm IMM 1= IF grp2-1 ELSE grp2-imm2 THEN ; : grp2 ( src dst n) THIRD ?imm IF grp2-imm EXIT THEN ( immediate source case ) THIRD CL = IF grp2-cl EXIT THEN ." grp2 not imm or CL " ; ( error case ) : [grp2] CREATE 8 * C, DOES> C@ OVER ?width grp2 ; 0 [grp2] ROL, 1 [grp2] ROR, 2 [grp2] RCL, 3 [grp2] RCR, 4 [grp2] SHL, 5 [grp2] SHR, ( SHL again ) 7 [grp2] SAR, \ MOV instructions : mov-seg DUP ?seg IF 8E C, ELSE 8C C, SWAP THEN as-reg SWAP as-modrm OR C, displace ; : s,I NIP DUP ?8bit IF DROP C,I EXIT THEN ?word IF W,I EXIT THEN ,I ; : mov-immreg DUP ?8bit 0= 8 AND B0 OR OVER 7 AND OR C, s,I ; : mov-imm DUP ?reg IF mov-immreg EXIT THEN DUP ?8bit 0= 1 AND C6 OR C, DUP as-modrm C, displace S,I ; : MOV, OVER OVER OR ?seg IF mov-seg EXIT THEN ( segment register case ) OVER OVER AND ?width ( supply data size prefix if needed ) OVER ?imm IF mov-imm EXIT THEN ( immediate data case ) 88 OVER ?reg IF grp1-toreg ELSE grp1-tomem THEN ; \ string instructions : SBinstr CREATE C, DOES> C@ C, ; : SWinstr CREATE C, DOES> AX ?width C@ C, ; : SDinstr CREATE C, DOES> EAX ?width C@ C, ; A4 SBinstr MOVSB, A5 SWinstr MOVSW, A5 SDinstr MOVSD, 6C SBinstr INSB, 6D SWinstr INSW, 6D SDinstr INSD, 6E SBinstr OUTSB, 6F SWinstr OUTSW, 6F SDinstr OUTSD, AC SBinstr LODSB, AD SWinstr LODSW, AD SDinstr LODSD, AA SBinstr STOSB, AB SWinstr STOSW, AB SDinstr STOSD, A6 SBinstr CMPSB, A7 SWinstr CMPSW, A7 SDinstr CMPSD, AE SBinstr SCASB, AF SWinstr SCASW, AF SDinstr SCASD, \ I/O instructions : IN, DUP ?width ?8bit 0= 1 AND EC OR SWAP ?imm IF F7 AND C, IMM THEN C, ; : OUT, SWAP DUP ?width ?8bit 0= 1 AND EE OR SWAP ?imm IF F7 AND C, IMM THEN C, ; \ jumps and branches : JMP_short EB C, HERE 1+ - C, ; : JMP, DUP HERE 2 + - ?byte IF JMP_short EXIT THEN E9 C, HERE 4 + - , ; : Jcc-short ( n a) SWAP C, HERE 1+ - C, ; : Jcc-long ( n a) 0F C, SWAP 10 + C, HERE 4 + - C, ; : Jcc ( a n) SWAP DUP HERE 2 + - ?byte IF Jcc-short ELSE Jcc-long THEN ; : [jcc] CREATE C, DOES> C@ Jcc ; 77 [jcc] JA, 73 [jcc] JAE, 72 [jcc] JB, 76 [jcc] JBE, 72 [jcc] JC, 74 [jcc] JE, 74 [jcc] JZ, 7F [jcc] JG, 7D [jcc] JGE, 7C [jcc] JL, 7E [jcc] JLE, 76 [jcc] JNA, 72 [jcc] JNAE, 73 [jcc] JNB, 77 [jcc] JNBE, 73 [jcc] JNC, 75 [jcc] JNE, 7E [jcc] JNG, 7C [jcc] JNGE, 7D [jcc] JNL, 7F [jcc] JNLE, 71 [jcc] JNO, 7B [jcc] JNP, 79 [jcc] JNS, 75 [jcc] JNZ, 79 [jcc] JO, 7A [jcc] JP, 7A [jcc] JPE, 7B [jcc] JPO, 78 [jcc] JS, \ EOF