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>