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

1.1     ! pazsan      1: \ **************************************************************
        !             2: \ File:         ASM.FS
        !             3: \                 8086-Assembler for PC
        !             4: \ Autor:        Klaus Kohl (adaptet from volksFORTH_PC)
        !             5: \ Log:          30.07.97 KK: file generated
        !             6: \
        !             7: \ * Register using see PRIMS.FS
        !             8: 
        !             9: 
        !            10: include asm/basic.fs
        !            11: 
        !            12: also  Assembler Definitions
        !            13: 
        !            14: : | ;
        !            15: : restrict ;
        !            16: : u2/   1 rshift ;
        !            17: : 8/    3 rshift ;
        !            18: : 8*    3 lshift ;
        !            19: : case? over = IF drop TRUE ELSE FALSE THEN ;
        !            20: : (0<   $8000 and  $8000 = ;
        !            21: 
        !            22: \ 8086 registers
        !            23:   0 Constant ax   1 Constant cx   2 Constant dx   3 Constant bx
        !            24:   4 Constant sp   5 Constant bp   6 Constant si   7 Constant di
        !            25:   8 Constant al   9 Constant cl  $a Constant dl  $b Constant bl
        !            26:  $c Constant ah  $d Constant ch  $e Constant dh  $f Constant bh
        !            27: 
        !            28:  $100 Constant es          $101 Constant cs
        !            29:  $102 Constant ss          $103 Constant ds
        !            30: 
        !            31: | Variable isize        ( specifies Size by prefix)
        !            32: | : Size: ( n -- )  Create c,  Does>  c@ isize ! ;
        !            33:   0 Size: byte      1 Size: word  word    2 Size: far
        !            34: 
        !            35: 
        !            36: \ 8086 Assembler  System variables              ( 10.08.90/kk )
        !            37: | Variable direction    \ 0 reg>EA, -1 EA>reg
        !            38: | Variable size         \ 1 word, 0 byte, -1 undefined
        !            39: | Variable displaced    \ 1 direct, 0 nothing, -1 displaced
        !            40: | Variable displacement
        !            41: 
        !            42: | : setsize              isize @  size ! ;
        !            43: | : long?   ( n -- f )   $FF80 and dup (0< invert ?exit $FF80 xor ;
        !            44: | : ?range               dup long? abort" out of range" ;
        !            45: | : wexit                rdrop word ;
        !            46: | : moderr               word true Abort" invalid" ;
        !            47: | : ?moderr ( f -- )     IF moderr THEN ;
        !            48: | : ?word                size @ 1- ?moderr ;
        !            49: | : far?    ( -- f )     size @ 2 = ;
        !            50: 
        !            51: 
        !            52: \ 8086 addressing modes                         ( 24.05.91/KK )
        !            53: | Create (ea  7 c, 0 c, 6 c, 4 c, 5 c,
        !            54: | : ()  ( 8b1 -- 8b2 )
        !            55:      3 - dup 4 u> over 1 = or ?moderr (ea + c@ ;
        !            56: 
        !            57:  -1 Constant #       $c6 Constant #)       -1 Constant c*
        !            58: 
        !            59:   : )   ( u1 -- u2 )
        !            60:      () 6 case? IF  0 $86 exit  THEN  $C0 or ;
        !            61:   : I)  ( u1 u2 -- u3 )  + 9 - dup 3 u> ?moderr $C0 or ;
        !            62: 
        !            63:   : D)  ( n u1 -- n u2 )
        !            64:      () over long? IF  $40  ELSE  $80  THEN or ;
        !            65:   : DI) ( n u1 u2 -- n u3 )
        !            66:      I) over long? IF  $80  ELSE  $40  THEN xor ;
        !            67: 
        !            68: \ 8086 Registers and addressing modes             ks 25 mai 87
        !            69: 
        !            70: | : displaced?  ( [n] u1 -- [n] u1 f )
        !            71:      dup #) = IF  1 exit  THEN
        !            72:      dup $C0 and dup $40 = swap $80 = or ;
        !            73: 
        !            74: | : displace    ( [n] u1 -- u1 )
        !            75:      displaced? ?dup
        !            76:      IF displaced @ ?moderr   displaced !   swap displacement ! THEN ;
        !            77: 
        !            78: | : rmode   ( u1 -- u2 )
        !            79:      1 size !  dup 8 and
        !            80:      IF  size off  $FF07 and  THEN ;
        !            81: 
        !            82: | : mmode?  ( 9b - 9b f)     dup $C0 and ;
        !            83: 
        !            84: | : rmode?  ( 8b1 - 8b1 f)   mmode? $C0 = ;
        !            85: 
        !            86: 
        !            87: \ 8086  decoding addressing modes                 ks 25 mai 87
        !            88: | : 2address  ( [n] source [displ] dest -- 15b / [n] 16b )
        !            89:      size on   displaced off   dup # = ?moderr   mmode?
        !            90:      IF  displace False  ELSE  rmode True  THEN  direction !
        !            91:      >r # case?  IF    r> $80C0 xor  size @  1+ ?exit  setsize exit
        !            92:                  THEN  direction @
        !            93:      IF  r> 8* >r mmode? IF  displace
        !            94:          ELSE  dup 8/ 1 and  size @ = ?moderr $FF07 and  THEN
        !            95:      ELSE  rmode 8*
        !            96:      THEN  r> or $C0 xor ;
        !            97: 
        !            98: | : 1address  ( [displ] 9b -- 9b )
        !            99:      # case? ?moderr   size on   displaced off   direction off
        !           100:      mmode? IF  displace setsize  ELSE  rmode  THEN  $C0 xor ;
        !           101: 
        !           102: 
        !           103: \ 8086 assembler                                  ks 25 mai 87
        !           104: | : immediate?   ( u -- u f )  dup (0< ;
        !           105: 
        !           106: | : nonimmediate ( u -- u )    immediate? ?moderr ;
        !           107: 
        !           108: | : r/m                        7 and ;
        !           109: 
        !           110: | : reg                        $38 and ;
        !           111: 
        !           112: | : ?akku  ( u -- u ff / tf )  dup r/m 0= dup IF nip THEN ;
        !           113: 
        !           114: | : smode? ( u1 -- u1 ff / u2 tf )  dup $F00 and
        !           115:      IF  dup $100 and IF  dup r/m 8* swap reg 8/
        !           116:                           or $C0 or  direction off
        !           117:                       THEN  True exit
        !           118:      THEN  False ;
        !           119: 
        !           120: \ 8086 Registers and addressing modes             ks 25 mai 87
        !           121: | : w,          size @ or  X c, ;
        !           122: 
        !           123: | : dw,         size @  or  direction @ IF  2 xor  THEN  X c, ;
        !           124: 
        !           125: | : ?word,  ( u1 f -- )  IF   X ,  exit  THEN  X c, ;
        !           126: 
        !           127: | : direct,
        !           128:      displaced @
        !           129:      IF  displacement @ dup long?  displaced @ 1+ or ?word, THEN ;
        !           130: 
        !           131: | : r/m,        X c,  direct, ;
        !           132: 
        !           133: | : data,       size @ ?word, ;
        !           134: 
        !           135: 
        !           136: 
        !           137: \ 8086 Arithmetic instructions                  ( 24.05.91/KK )
        !           138: | : Arith: ( code -- )
        !           139:     Create [ FORTH ] , [ Assembler ]
        !           140:     Does> @ >r   2address  immediate?
        !           141:      IF  rmode? IF  ?akku IF  r> size @
        !           142:                               IF  5 or  X c,  X ,  wexit  THEN
        !           143:                               4 or  X c,  X c, wexit  THEN THEN
        !           144:          r@ or  $80 size @ or   r> (0<
        !           145:          IF  size @ IF  2 pick long? 0= IF  2 or  size off  THEN
        !           146:          THEN       THEN  X c,  X c, direct,  data,  wexit
        !           147:      THEN  r> dw, r/m,  wexit ;
        !           148: 
        !           149:   $8000 Arith: add,     $0008 Arith: or,
        !           150:   $8010 Arith: adc,     $8018 Arith: sbb,
        !           151:   $0020 Arith: and,     $8028 Arith: sub,
        !           152:   $0030 Arith: xor,     $8038 Arith: cmp,
        !           153: 
        !           154: \ 8086 move push pop                            ( 24.05.91/KK )
        !           155:   : mov,
        !           156:      2address  immediate?
        !           157:      IF    rmode? IF  r/m $B0 or size @ IF  8 or  THEN
        !           158:                     X c, data,  wexit
        !           159:                 THEN  $C6 w, r/m, data, wexit
        !           160:      THEN  6 case? IF  $A2 dw, direct, wexit  THEN
        !           161:      smode? IF  $8C direction @ IF  2 or  THEN  X c,  r/m, wexit
        !           162:             THEN  $88 dw,  r/m,  wexit ;
        !           163: 
        !           164: | : pupo
        !           165:      >r  1address  ?word
        !           166:      smode? IF  reg 6 r> IF  1+  THEN  or  X c,  wexit  THEN
        !           167:      rmode? IF  r/m $50 or r> or  X c,  wexit  THEN
        !           168:      r> IF  $8F  ELSE  $30 or $FF  THEN  X c,  r/m, wexit ;
        !           169: 
        !           170:   : push, 0 pupo ;        : pop,  8 pupo ;
        !           171: 
        !           172: \ 8086 inc & dec , effective addresses          ( 24.05.91/KK )
        !           173: | : inc/dec
        !           174:      >r 1address   rmode?
        !           175:      IF  size @ IF  r/m $40 or r> or  X c,  wexit  THEN
        !           176:      THEN  $FE w, r> or r/m, wexit ;
        !           177: 
        !           178:   : dec,  8 inc/dec ;         : inc,  0 inc/dec ;
        !           179: 
        !           180: | : EA:  ( code -- )
        !           181:     Create c,
        !           182:     Does> >r 2address nonimmediate
        !           183:      rmode? direction @ 0= or ?moderr r> c@  X c,  r/m, wexit ;
        !           184: 
        !           185:   $c4 EA: les,  $8d EA: lea,  $c5 EA: lds,
        !           186: 
        !           187: 
        !           188: \ 8086  xchg  segment prefix                    ( 24.05.91/KK )
        !           189:   : xchg,
        !           190:    2address nonimmediate rmode?
        !           191:    IF  size @ IF  dup r/m 0=
        !           192:                   IF  8/ true  ELSE  dup $38 and 0=  THEN
        !           193:                   IF  r/m $90 or  X c,  wexit  THEN
        !           194:    THEN       THEN  $86 w, r/m, wexit ;
        !           195: 
        !           196: | : 1addr:  ( code -- )
        !           197:     Create c,
        !           198:     Does> c@ >r 1address $F6 w, r> or r/m, wexit ;
        !           199: 
        !           200:   $10 1addr: com,    $18 1addr: neg,
        !           201:   $20 1addr: mul,    $28 1addr: imul,
        !           202:   $38 1addr: idiv,   $30 1addr: div,
        !           203: 
        !           204:   : seg,  ( 8b -)
        !           205:      $100 xor dup $FFFC and ?moderr  8* $26 or X c, ;
        !           206: 
        !           207: \ 8086  test not neg mul imul div idiv          ( 24.05.91/KK )
        !           208:   : test,
        !           209:      2address immediate?
        !           210:      IF  rmode? IF  ?akku IF  $a8 w, data, wexit  THEN THEN
        !           211:          $f6 w, r/m, data, wexit
        !           212:      THEN  $84 w, r/m, wexit ;
        !           213: 
        !           214: | : in/out
        !           215:      >r 1address setsize
        !           216:      $C2 case? IF  $EC r> or w, wexit  THEN
        !           217:      6 - ?moderr  $E4 r> or w,  displacement @  X c,  wexit ;
        !           218: 
        !           219:   : out, 2 in/out ;          : in,  0 in/out ;
        !           220: 
        !           221:   : int,   3 case? IF  $cc  X c,  wexit  THEN  $cd  X c,   X c,  wexit ;
        !           222: 
        !           223: 
        !           224: \ 8086 shifts  and  string instructions         ( 24.05.91/KK )
        !           225: | : Shifts:  ( code -- )
        !           226:     Create c,
        !           227:     Does> c@ >r C* case? >r 1address
        !           228:         r> direction !  $D0 dw, r> or r/m, wexit ;
        !           229: 
        !           230:   $00 Shifts: rol,    $08 Shifts: ror,
        !           231:   $10 Shifts: rcl,    $18 Shifts: rcr,
        !           232:   $20 Shifts: shl,    $28 Shifts: shr,
        !           233:   $38 Shifts: sar,    ' shl, Alias sal,
        !           234: 
        !           235: | : Str:  ( code -- )   Create c,
        !           236:   Does> c@ setsize w, wexit ;
        !           237: 
        !           238:   $a6 Str: cmps,     $ac Str: lods,    $a4 Str: movs,
        !           239:   $ae Str: scas,     $aa Str: stos,
        !           240: 
        !           241: \ implied 8086 instructions                     ( 24.05.91/KK )
        !           242:   : Byte:  ( code -- )
        !           243:     Create c,
        !           244:     Does> c@  X c,  ;
        !           245:   : Word:  ( code -- )
        !           246:     Create [ FORTH ] , [ Assembler ]
        !           247:     Does> @  X ,  ;
        !           248: 
        !           249:  $37 Byte: aaa,   $ad5 Word: aad,   $ad4 Word: aam,
        !           250:  $3f Byte: aas,    $98 Byte: cbw,    $f8 Byte: clc,
        !           251:  $fc Byte: cld,    $fa Byte: cli,    $f5 Byte: cmc,
        !           252:  $99 Byte: cwd,    $27 Byte: daa,    $2f Byte: das,
        !           253:  $f4 Byte: hlt,    $ce Byte: into,   $cf Byte: iret,
        !           254:  $9f Byte: lahf,   $f0 Byte: lock,   $90 Byte: nop,
        !           255:  $9d Byte: popf,   $9c Byte: pushf,  $9e Byte: sahf,
        !           256:  $f9 Byte: stc,    $fd Byte: std,    $fb Byte: sti,
        !           257:  $9b Byte: wait,   $d7 Byte: xlat,
        !           258:  $c3 Byte: ret,    $cb Byte: lret,
        !           259:  $f2 Byte: rep,    $f2 Byte: 0<>rep, $f3 Byte: 0=rep,
        !           260: 
        !           261: \ 8086  jmp call  conditions                    ( 24.05.91/KK )
        !           262: | : jmp/call
        !           263:      >r setsize # case?
        !           264:      IF  far? IF  r> IF $EA ELSE $9A THEN   X c,  swap  X ,   X ,  wexit
        !           265:               THEN   X here  X cell+  - r>
        !           266:          IF  dup long? 0= IF  $EB  X c,   X c,  wexit  THEN  $E9
        !           267:          ELSE  $E8  THEN   X c,  1-  X ,  wexit
        !           268:      THEN  1address $FF  X c,  $10 or r> +
        !           269:      far? IF  8 or  THEN  r/m, wexit ;
        !           270:   : call,   0 jmp/call ;         : jmp,  $10 jmp/call ;
        !           271: 
        !           272:  $75 Constant 0=   $74 Constant 0<>   $79 Constant 0<
        !           273:  $78 Constant 0>=  $7d Constant <     $7c Constant >=
        !           274:  $7f Constant <=   $7e Constant >     $73 Constant u<
        !           275:  $72 Constant u>=  $77 Constant u<=   $76 Constant u>
        !           276:  $71 Constant ov   $70 Constant nov   $e1 Constant <>c0=
        !           277:  $e2 Constant c0=  $e0 Constant ?c0=  $e3 Constant C0<>
        !           278: 
        !           279: \ 8086 conditional branching                    ( 24.05.91/KK )
        !           280:   : +ret,    $c2  X c,   X ,  ;
        !           281:   : +lret,   $ca  X c,   X ,  ;
        !           282: 
        !           283:   : IF,          X ,   X here  1- ;
        !           284:   : THEN,        X here  over 1+ - ?range swap X c!  ;
        !           285:   : ELSE,       $eb IF, swap THEN, ;
        !           286:   : WHILE,      IF, swap ;
        !           287:   : BEGIN,       X here  ;
        !           288:   : UNTIL,       X c,   X here  1+ - ?range  X c,  ;
        !           289:   : AGAIN,      $eb UNTIL, ;
        !           290:   : REPEAT,     AGAIN, THEN, ;
        !           291: 
        !           292:   : j,          1 xor  UNTIL, ;
        !           293: 
        !           294: 
        !           295: \ (Code)-8086   (End-Code)-8086
        !           296:   : (Code)-8086
        !           297:     (code)-1 ;          ' (Code)-8086 IS (code)
        !           298: 
        !           299:   : (End-Code)-8086
        !           300:     (end-code)-1 ;      ' (End-Code)-8086 IS (end-code)
        !           301: 

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