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

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

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