Annotation of gforth/arch/386/asm.fs, revision 1.3

1.1       anton       1: \ asm386.fth
                      2: \ Andrew McKewan
                      3: \ mckewan@netcom.com
                      4: 
                      5: \ 80386 "subset" assembler.
                      6: \ Greatly inspired by:
                      7: \    1. 32-BIT MINI ASSEMBLER BASED ON riFORTH by Richard Astle
                      8: \    2. F83 8086 Assembler by Mike Perry
                      9: 
                     10: \ This assembler will run under Win32Forth.  It was written to support a 
                     11: \ metacompiler so it does not implement the full range of opcodes and 
                     12: \ operands.  In particular, it does not support direct memory access
                     13: \ (i.e.  mov [memory],eax ).  This is because the Forth system, like 
                     14: \ Win32Forth, uses only relative addresses (index or base+index).
                     15: \ The syntax is postfix and is similar to F83.  Here are some examples:
                     16: \
                     17: \       EAX EBX MOV             \ move ebx,eax
                     18: \       3 # EAX MOV             \ mov eax,3
                     19: \       100 [EDI] EAX MOV       \ mov eax,100[edi]
                     20: \       4 [EBX] [ECX] EAX MOV   \ mov eax,4[ebx][ecx]
                     21: \       16: EAX EBX MOV         \ mov bx,ax
                     22: 
                     23: 
1.2       anton      24: \ additional words for Gforth port
1.1       anton      25: 
1.2       anton      26: : w, ( x -- )
                     27:     here ! 2 allot ;
1.1       anton      28: 
1.2       anton      29: base @ get-current ALSO ASSEMBLER DEFINITIONS   HEX
1.1       anton      30: 
                     31: \ ---------------------------------------------------------------------
                     32: \ Defer memory-access words for the metacompiler
                     33: 
                     34: DEFER HERE     FORTH ' HERE  ASSEMBLER IS HERE
                     35: DEFER ,        FORTH ' ,     ASSEMBLER IS ,
                     36: DEFER C,       FORTH ' C,    ASSEMBLER IS C,
                     37: DEFER TC@      FORTH ' C@    ASSEMBLER IS TC@
                     38: DEFER TC!      FORTH ' C!    ASSEMBLER IS TC!
                     39: 
                     40: 
                     41: \ ---------------------------------------------------------------------
                     42: \ Register Fields:  8000 <flags> <sib>
                     43: 
                     44: \ Flag bits:    0 = size field   1 = DWORD, 0 = BYTE
                     45: \               1 = index field  1 = INDEXED MODE
                     46: \               2 = sib flag     1 = SIB byte required
                     47: 
                     48: : REG     ( mask off register field )   7 AND ;
                     49: : REG?    ( reg -- f )     FFFF0200 AND 80000000 = ;
                     50: : R32?    ( reg -- f )     FFFF0300 AND 80000100 = ;
                     51: : INDEX?  ( reg -- f )     FFFF0200 AND 80000200 = ;
                     52: : SIZE?   ( reg -- 0/1 )   8 RSHIFT 1 AND ;
                     53: : SIB?    ( reg -- f )     400 AND ;
                     54: 
                     55: : INDEX  ( n -- )  \ create an index register
                     56:     CREATE ,  DOES> @
                     57:     OVER INDEX?
                     58:     IF    REG 3 LSHIFT         ( move reg to index field in sib )
                     59:           400 OR                ( set sib flag )
                     60:           SWAP FFFFFFC7 AND OR  ( put into sib byte of previous register )
                     61:     THEN ;
                     62: 
                     63: 80000100 CONSTANT EAX       80000000 CONSTANT AL
                     64: 80000101 CONSTANT ECX       80000001 CONSTANT CL
                     65: 80000102 CONSTANT EDX       80000002 CONSTANT DL
                     66: 80000103 CONSTANT EBX       80000003 CONSTANT BL
                     67: 80000104 CONSTANT ESP       80000004 CONSTANT AH
                     68: 80000105 CONSTANT EBP       80000005 CONSTANT CH
                     69: 80000106 CONSTANT ESI       80000006 CONSTANT DH
                     70: 80000107 CONSTANT EDI       80000007 CONSTANT BH
                     71: 
                     72: 80000300 INDEX [EAX]
                     73: 80000301 INDEX [ECX]
                     74: 80000302 INDEX [EDX]
                     75: 80000303 INDEX [EBX]
                     76: 80000724 INDEX [ESP]
                     77: 80000305 INDEX [EBP]
                     78: 80000306 INDEX [ESI]
                     79: 80000307 INDEX [EDI]
                     80: 
                     81: 80010000 CONSTANT #   ( just different from any register )
                     82: 
                     83: \ Scaled index mode must have a base register, i.e.
                     84: \      0 [EDI] [EAX] *4 ECX MOV
                     85: : *2  40 OR ;
                     86: : *4  80 OR ;
                     87: : *8  C0 OR ;
                     88: 
                     89: \ ---------------------------------------------------------------------
                     90: \ Assembler addressing mode bytes
                     91: 
                     92: VARIABLE SIZE  1 SIZE !
                     93: : BYTE   0 SIZE ! ;
                     94: : OP,    ( n op -- )    OR C, ;
                     95: : SIZE,  ( op reg -- )  SIZE? OP, ;
                     96: : SHORT? ( n -- f )    -80 80 WITHIN ;
                     97: : DISP?  ( n reg -- n reg f )   2DUP REG 5 = ( [EBP] ) OR ;
                     98: 
                     99: : RR,   ( reg reg/op -- )  3 LSHIFT OR C0 OP, ;
                    100: 
                    101: : MEM, ( operand [reg] reg -- )
                    102:     3 LSHIFT >R  ( move to reg/opcode field )
                    103:     DUP SIB?
                    104:     IF    DISP?
                    105:           IF  OVER SHORT?
                    106:               IF      R> 44 OP, C, C,
                    107:               ELSE    R> 84 OP, C, ,
                    108:               THEN
                    109:           ELSE        R> 4 OP, C, DROP   ( no displacement )
                    110:           THEN
                    111:     ELSE  DISP?
                    112:           IF  OVER SHORT?
                    113:               IF    R> OR 40 OP, C,
                    114:               ELSE  R> OR 80 OP, ,
                    115:               THEN
                    116:           ELSE     R> OP, DROP  ( no displacement )
                    117:           THEN
                    118:     THEN ;
                    119: 
                    120: : R/M,  ( operand [reg] reg | reg reg -- )
                    121:     OVER REG? IF  RR,  ELSE  MEM,  THEN ;
                    122: 
                    123: : WR/SM,  ( r/m reg op -- )  2 PICK REG?
                    124:     IF  2 PICK SIZE, RR,  ELSE  SIZE @ OP,  MEM,  THEN  1 SIZE ! ;
                    125: 
                    126: 
                    127: \ ---------------------------------------------------------------------
                    128: \ Opcode Defining Words
                    129: 
                    130: : CPU  ( op -- )  CREATE C,  DOES> C@ C, ;
                    131: 
                    132: 66 CPU 16:     \ 16-bit opcode prefix (cannot use with immedate ops)
1.3     ! anton     133: C3 CPU RET,
        !           134: F2 CPU REP,   F2 CPU REPNZ,   F3 CPU REPZ,
        !           135: FC CPU CLD,   FD CPU STD,     99 CPU CDQ,
1.1       anton     136: 
                    137: 
                    138: : SHORT  ( op opex regop -- )
                    139:     CREATE C, C, C,
                    140:     DOES>  ( reg | offset [reg] -- )  OVER R32?
                    141:     IF  C@ OP,  ELSE  1+ COUNT SWAP C@ WR/SM,  THEN ;
                    142: 
1.3     ! anton     143: FF 6 50 SHORT PUSH,   8F 0 58 SHORT POP,
        !           144: FE 0 40 SHORT INC,    FE 1 48 SHORT DEC,
1.1       anton     145: 
                    146: 
                    147: : UNARY  ( opex -- )
                    148:     CREATE C,  DOES>  ( reg | offset [reg] )  C@ F6 WR/SM, ;
                    149: 
1.3     ! anton     150: 2 UNARY NOT,
        !           151: 3 UNARY NEG,   4 UNARY MUL,
        !           152: 5 UNARY IMUL,  6 UNARY DIV,   7 UNARY IDIV,
1.1       anton     153: 
                    154: 
                    155: \ The following forms are accepted for binary operands.
                    156: \ Note that immediate to memory is not supported.
                    157: \      reg reg <op>
                    158: \      n # reg <op>
                    159: \      ofs [reg] reg <op>
                    160: \      reg ofs [reg] <op>
                    161: 
                    162: : BINARY  ( op -- )
                    163:     CREATE C,
                    164:     DOES> C@ 2 PICK # =
                    165:     IF OVER SIZE?
                    166:         IF    81 C,  RR,  DROP ,
                    167:         ELSE  80 C,  RR,  DROP C,
                    168:         THEN
                    169:     ELSE  3 LSHIFT
                    170:           OVER INDEX? IF  >R ROT R>  ELSE  2 OR  THEN
                    171:           OVER SIZE, R/M,
                    172:     THEN ;
                    173: 
1.3     ! anton     174: : MOV,   ( operands... -- )
1.1       anton     175:     OVER # =
                    176:     IF    DUP SIZE? IF  B8 OP, DROP ,  ELSE  B0 OP, DROP C,  THEN
                    177:     ELSE  DUP INDEX? IF  ROT 88  ELSE  8A  THEN  OVER SIZE, R/M,
                    178:     THEN ;
                    179: 
1.3     ! anton     180: : LEA,   ( reg/mem reg -- )   8D C,  MEM, ;
1.1       anton     181: 
1.3     ! anton     182: : XCHG,  ( mr1 reg -- )
1.1       anton     183:     OVER REG? OVER EAX = AND
                    184:     IF    DROP REG 90 OP,
                    185:     ELSE  86 OVER SIZE,  R/M,  THEN ;
                    186:     
                    187: ( TEST ... )
                    188: 
                    189: 
                    190: \ Shift/Rotate syntax:
                    191: \      eax shl         0 [ecx] [edi] shl
                    192: \      eax 4 shl       0 [ecx] [edi] 4 shl
                    193: \      eax cl shl      0 [ecx] [edi] cl shl
                    194: 
                    195: : SHIFT  ( op -- )
                    196:     CREATE C,
                    197:     DOES> C@ OVER CL =
                    198:     IF    NIP D2 WR/SM,
                    199:     ELSE  OVER 0< ( reg/index)
                    200:         IF    D0 WR/SM,
                    201:         ELSE  OVER 1 =
                    202:             IF    NIP D0 WR/SM,
                    203:             ELSE  SWAP >R C0 WR/SM, R> C,
                    204:             THEN
                    205:         THEN
                    206:     THEN ;
                    207: 
1.3     ! anton     208: 0 SHIFT ROL,   1 SHIFT ROR,   2 SHIFT RCL,   3 SHIFT RCR,
        !           209: 4 SHIFT SHL,   5 SHIFT SHR,   7 SHIFT SAR,
1.1       anton     210: 
                    211: \ String instructions. Precede with BYTE for byte version
                    212: : STR  ( op -- )
                    213:     CREATE C,  DOES> C@ SIZE @ OP,  1 SIZE ! ;
                    214: 
1.3     ! anton     215: A4 STR MOVS,   A6 STR CMPS,
        !           216: AA STR STOS,   AC STR LODS,   AE STR SCAS,
1.1       anton     217: 
                    218: 
                    219: \ ---------------------------------------------------------------------
                    220: \ Relative jumps and calls
                    221: 
                    222: : OFFSET  ( dest source -- offset )
                    223:    1+ -  DUP SHORT? 0= ABORT" branch target out of range"  ;
                    224: 
                    225: : REL8,   ( addr -- )  HERE OFFSET C, ;
                    226: : REL32,  ( addr -- )  HERE CELL+ - , ;
                    227: 
                    228: : REL  ( op -- )   CREATE C,  DOES> C@ C,  REL8, ;
                    229: 
1.3     ! anton     230: 70 REL JO,    71 REL JNO,   72 REL JB,    73 REL JAE,
        !           231: 74 REL JE,    75 REL JNE,   76 REL JBE,   77 REL JA,
        !           232: 78 REL JS,    79 REL JNS,   7A REL JPE,   7B REL JNP,
        !           233: 7C REL JL,    7D REL JGE,   7E REL JLE,   7F REL JG,
        !           234: E3 REL JECXZ,
1.1       anton     235: 
1.3     ! anton     236: : JMP,  ( addr | r/m -- )
1.1       anton     237:    DUP 0< ( reg/index ) IF  FF C,  4 R/M,
                    238:    ELSE  DUP HERE 2 + - SHORT? IF  EB C,  REL8,
                    239:    ELSE  E9 C,  REL32,  THEN THEN ;
                    240: 
1.3     ! anton     241: : CALL,  ( addr | r/m -- )
1.1       anton     242:    DUP 0< ( reg/index ) IF  FF C,  2 R/M,  ELSE  E8 C,  REL32,  THEN ;
                    243: 
                    244: 
                    245: \ ---------------------------------------------------------------------
                    246: \ Local labels
                    247: 
                    248: 10 CONSTANT MAX-LABELS  ( adjust as required )
                    249: 
                    250: : ARRAY  CREATE CELLS ALLOT  DOES> SWAP CELLS + ;
                    251: 
                    252: MAX-LABELS ARRAY LABEL-VALUE    ( value of label or zero if not resolved )
                    253: MAX-LABELS ARRAY LABEL-LINK     ( linked list of unresolved references   )
                    254: 
                    255: : CLEAR-LABELS   ( initialize label arrays )
                    256:    0 LABEL-VALUE MAX-LABELS CELLS ERASE
                    257:    0 LABEL-LINK  MAX-LABELS CELLS ERASE  ;   CLEAR-LABELS
                    258: 
                    259: : CHECK-LABELS  ( make sure all labels have been resolved )
                    260:    MAX-LABELS 0
                    261:    DO  I LABEL-LINK @ IF CR ." Label " I . ." not resolved" THEN  LOOP ;
                    262: 
                    263: : $:  ( n -- )   ( define a label )
                    264:    DUP LABEL-VALUE @ ABORT" Duplicate label"
                    265:    HERE OVER LABEL-LINK @ ?DUP      ( any unresolved references? )
                    266:    IF  ( n address link )
                    267:        BEGIN  DUP TC@ >R            ( save offset to next reference )
                    268:               2DUP OFFSET OVER TC!  ( resolve this reference )
                    269:               R@ 100 - +            ( go to next reference )
                    270:               R> 0=                 ( more references? )
                    271:        UNTIL
                    272:        DROP OVER LABEL-LINK OFF     ( clear unresolved list )
                    273:    THEN
                    274:    SWAP LABEL-VALUE !  ;            ( resolve label address )
                    275: 
                    276: : $  ( n -- addr )    ( reference a label )
                    277:    DUP LABEL-VALUE @  ( already resolved? )
                    278:    IF    LABEL-VALUE @  
                    279:    ELSE  DUP LABEL-LINK @ ?DUP 0=   ( first reference? )
                    280:          IF   HERE 1+  THEN  1+     ( link to previous label )
                    281:          HERE 1+ ROT LABEL-LINK !   ( save current label at head of list )
                    282:    THEN ;
                    283: 
                    284: 
                    285: \ ---------------------------------------------------------------------
                    286: \ Structured Conditionals
                    287: 
                    288: 75 CONSTANT 0=   79 CONSTANT 0<   73 CONSTANT U<   76 CONSTANT U>
                    289: 7D CONSTANT <    7E CONSTANT >    71 CONSTANT OV   E3 CONSTANT ECX0<>
                    290: 
                    291: : NOT   1 XOR ;  ( reverse logic of conditional )
                    292: 
1.3     ! anton     293: : IF,        C, HERE 0 C, ;
        !           294: : THEN,      HERE OVER OFFSET  SWAP TC! ;
        !           295: : ELSE,      EB IF,  SWAP THEN, ;
        !           296: : BEGIN,     HERE ;
        !           297: : UNTIL,     C, REL8, ;
        !           298: : LOOP,      E2 UNTIL, ;
        !           299: : AGAIN,     EB UNTIL, ;
        !           300: : WHILE,     IF, SWAP ;
        !           301: : REPEAT,    AGAIN, THEN, ;
1.1       anton     302: 
1.3     ! anton     303: 0 BINARY ADD,   1 BINARY OR,    2 BINARY ADC,   3 BINARY SBB,
        !           304: 4 BINARY AND,   5 BINARY SUB,   6 BINARY XOR,   7 BINARY CMP,
1.1       anton     305: 
1.3     ! anton     306: : RET#,   ( n -- )  C2 C, W, ;
        !           307: : PUSH#,  ( n -- )  68 C, ,  ;
1.1       anton     308: 
1.2       anton     309: previous set-current decimal base !
1.1       anton     310: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>