\ **************************************************************
\ File: ASM.FS
\ 8086-Assembler for PC
\ Autor: Klaus Kohl (adaptet from volksFORTH_PC)
\ Log: 30.07.97 KK: file generated
\
\ * Register using see PRIMS.FS
\ This file is in the public domain, like the original volksForth
include asm/basic.fs
also Assembler Definitions
: | ;
: restrict ;
: u2/ 1 rshift ;
: 8/ 3 rshift ;
: 8* 3 lshift ;
: case? over = IF drop TRUE ELSE FALSE THEN ;
: (0< $8000 and $8000 = ;
\ 8086 registers
0 Constant ax 1 Constant cx 2 Constant dx 3 Constant bx
4 Constant sp 5 Constant bp 6 Constant si 7 Constant di
8 Constant al 9 Constant cl $a Constant dl $b Constant bl
$c Constant ah $d Constant ch $e Constant dh $f Constant bh
$100 Constant es $101 Constant cs
$102 Constant ss $103 Constant ds
| Variable isize ( specifies Size by prefix)
| : Size: ( n -- ) Create c, Does> c@ isize ! ;
0 Size: byte 1 Size: word word 2 Size: far
\ 8086 Assembler System variables ( 10.08.90/kk )
| Variable direction \ 0 reg>EA, -1 EA>reg
| Variable size \ 1 word, 0 byte, -1 undefined
| Variable displaced \ 1 direct, 0 nothing, -1 displaced
| Variable displacement
| : setsize isize @ size ! ;
| : long? ( n -- f ) $FF80 and dup (0< invert ?exit $FF80 xor ;
| : ?range dup long? abort" out of range" ;
| : wexit rdrop word ;
| : moderr word true Abort" invalid" ;
| : ?moderr ( f -- ) IF moderr THEN ;
| : ?word size @ 1- ?moderr ;
| : far? ( -- f ) size @ 2 = ;
\ 8086 addressing modes ( 24.05.91/KK )
| Create (ea 7 c, 0 c, 6 c, 4 c, 5 c,
| : () ( 8b1 -- 8b2 )
3 - dup 4 u> over 1 = or ?moderr (ea + c@ ;
-1 Constant # $c6 Constant #) -1 Constant c*
: ) ( u1 -- u2 )
() 6 case? IF 0 $86 exit THEN $C0 or ;
: I) ( u1 u2 -- u3 ) + 9 - dup 3 u> ?moderr $C0 or ;
: D) ( n u1 -- n u2 )
() over long? IF $40 ELSE $80 THEN or ;
: DI) ( n u1 u2 -- n u3 )
I) over long? IF $80 ELSE $40 THEN xor ;
\ 8086 Registers and addressing modes ks 25 mai 87
| : displaced? ( [n] u1 -- [n] u1 f )
dup #) = IF 1 exit THEN
dup $C0 and dup $40 = swap $80 = or ;
| : displace ( [n] u1 -- u1 )
displaced? ?dup
IF displaced @ ?moderr displaced ! swap displacement ! THEN ;
| : rmode ( u1 -- u2 )
1 size ! dup 8 and
IF size off $FF07 and THEN ;
| : mmode? ( 9b - 9b f) dup $C0 and ;
| : rmode? ( 8b1 - 8b1 f) mmode? $C0 = ;
\ 8086 decoding addressing modes ks 25 mai 87
| : 2address ( [n] source [displ] dest -- 15b / [n] 16b )
size on displaced off dup # = ?moderr mmode?
IF displace False ELSE rmode True THEN direction !
>r # case? IF r> $80C0 xor size @ 1+ ?exit setsize exit
THEN direction @
IF r> 8* >r mmode? IF displace
ELSE dup 8/ 1 and size @ = ?moderr $FF07 and THEN
ELSE rmode 8*
THEN r> or $C0 xor ;
| : 1address ( [displ] 9b -- 9b )
# case? ?moderr size on displaced off direction off
mmode? IF displace setsize ELSE rmode THEN $C0 xor ;
\ 8086 assembler ks 25 mai 87
| : immediate? ( u -- u f ) dup (0< ;
| : nonimmediate ( u -- u ) immediate? ?moderr ;
| : r/m 7 and ;
| : reg $38 and ;
| : ?akku ( u -- u ff / tf ) dup r/m 0= dup IF nip THEN ;
| : smode? ( u1 -- u1 ff / u2 tf ) dup $F00 and
IF dup $100 and IF dup r/m 8* swap reg 8/
or $C0 or direction off
THEN True exit
THEN False ;
\ 8086 Registers and addressing modes ks 25 mai 87
| : w, size @ or X c, ;
| : dw, size @ or direction @ IF 2 xor THEN X c, ;
| : ?word, ( u1 f -- ) IF X , exit THEN X c, ;
| : direct,
displaced @
IF displacement @ dup long? displaced @ 1+ or ?word, THEN ;
| : r/m, X c, direct, ;
| : data, size @ ?word, ;
\ 8086 Arithmetic instructions ( 24.05.91/KK )
| : Arith: ( code -- )
Create [ FORTH ] , [ Assembler ]
Does> @ >r 2address immediate?
IF rmode? IF ?akku IF r> size @
IF 5 or X c, X , wexit THEN
4 or X c, X c, wexit THEN THEN
r@ or $80 size @ or r> (0<
IF size @ IF 2 pick long? 0= IF 2 or size off THEN
THEN THEN X c, X c, direct, data, wexit
THEN r> dw, r/m, wexit ;
$8000 Arith: add, $0008 Arith: or,
$8010 Arith: adc, $8018 Arith: sbb,
$0020 Arith: and, $8028 Arith: sub,
$0030 Arith: xor, $8038 Arith: cmp,
\ 8086 move push pop ( 24.05.91/KK )
: mov,
2address immediate?
IF rmode? IF r/m $B0 or size @ IF 8 or THEN
X c, data, wexit
THEN $C6 w, r/m, data, wexit
THEN 6 case? IF $A2 dw, direct, wexit THEN
smode? IF $8C direction @ IF 2 or THEN X c, r/m, wexit
THEN $88 dw, r/m, wexit ;
| : pupo
>r 1address ?word
smode? IF reg 6 r> IF 1+ THEN or X c, wexit THEN
rmode? IF r/m $50 or r> or X c, wexit THEN
r> IF $8F ELSE $30 or $FF THEN X c, r/m, wexit ;
: push, 0 pupo ; : pop, 8 pupo ;
\ 8086 inc & dec , effective addresses ( 24.05.91/KK )
| : inc/dec
>r 1address rmode?
IF size @ IF r/m $40 or r> or X c, wexit THEN
THEN $FE w, r> or r/m, wexit ;
: dec, 8 inc/dec ; : inc, 0 inc/dec ;
| : EA: ( code -- )
Create c,
Does> >r 2address nonimmediate
rmode? direction @ 0= or ?moderr r> c@ X c, r/m, wexit ;
$c4 EA: les, $8d EA: lea, $c5 EA: lds,
\ 8086 xchg segment prefix ( 24.05.91/KK )
: xchg,
2address nonimmediate rmode?
IF size @ IF dup r/m 0=
IF 8/ true ELSE dup $38 and 0= THEN
IF r/m $90 or X c, wexit THEN
THEN THEN $86 w, r/m, wexit ;
| : 1addr: ( code -- )
Create c,
Does> c@ >r 1address $F6 w, r> or r/m, wexit ;
$10 1addr: com, $18 1addr: neg,
$20 1addr: mul, $28 1addr: imul,
$38 1addr: idiv, $30 1addr: div,
: seg, ( 8b -)
$100 xor dup $FFFC and ?moderr 8* $26 or X c, ;
\ 8086 test not neg mul imul div idiv ( 24.05.91/KK )
: test,
2address immediate?
IF rmode? IF ?akku IF $a8 w, data, wexit THEN THEN
$f6 w, r/m, data, wexit
THEN $84 w, r/m, wexit ;
| : in/out
>r 1address setsize
$C2 case? IF $EC r> or w, wexit THEN
6 - ?moderr $E4 r> or w, displacement @ X c, wexit ;
: out, 2 in/out ; : in, 0 in/out ;
: int, 3 case? IF $cc X c, wexit THEN $cd X c, X c, wexit ;
\ 8086 shifts and string instructions ( 24.05.91/KK )
| : Shifts: ( code -- )
Create c,
Does> c@ >r C* case? >r 1address
r> direction ! $D0 dw, r> or r/m, wexit ;
$00 Shifts: rol, $08 Shifts: ror,
$10 Shifts: rcl, $18 Shifts: rcr,
$20 Shifts: shl, $28 Shifts: shr,
$38 Shifts: sar, ' shl, Alias sal,
| : Str: ( code -- ) Create c,
Does> c@ setsize w, wexit ;
$a6 Str: cmps, $ac Str: lods, $a4 Str: movs,
$ae Str: scas, $aa Str: stos,
\ implied 8086 instructions ( 24.05.91/KK )
: Byte: ( code -- )
Create c,
Does> c@ X c, ;
: Word: ( code -- )
Create [ FORTH ] , [ Assembler ]
Does> @ X , ;
$37 Byte: aaa, $ad5 Word: aad, $ad4 Word: aam,
$3f Byte: aas, $98 Byte: cbw, $f8 Byte: clc,
$fc Byte: cld, $fa Byte: cli, $f5 Byte: cmc,
$99 Byte: cwd, $27 Byte: daa, $2f Byte: das,
$f4 Byte: hlt, $ce Byte: into, $cf Byte: iret,
$9f Byte: lahf, $f0 Byte: lock, $90 Byte: nop,
$9d Byte: popf, $9c Byte: pushf, $9e Byte: sahf,
$f9 Byte: stc, $fd Byte: std, $fb Byte: sti,
$9b Byte: wait, $d7 Byte: xlat,
$c3 Byte: ret, $cb Byte: lret,
$f2 Byte: rep, $f2 Byte: 0<>rep, $f3 Byte: 0=rep,
\ 8086 jmp call conditions ( 24.05.91/KK )
| : jmp/call
>r setsize # case?
IF far? IF r> IF $EA ELSE $9A THEN X c, swap X , X , wexit
THEN X here X cell+ - r>
IF dup long? 0= IF $EB X c, X c, wexit THEN $E9
ELSE $E8 THEN X c, 1- X , wexit
THEN 1address $FF X c, $10 or r> +
far? IF 8 or THEN r/m, wexit ;
: call, 0 jmp/call ; : jmp, $10 jmp/call ;
$75 Constant 0= $74 Constant 0<> $79 Constant 0<
$78 Constant 0>= $7d Constant < $7c Constant >=
$7f Constant <= $7e Constant > $73 Constant u<
$72 Constant u>= $77 Constant u<= $76 Constant u>
$71 Constant ov $70 Constant nov $e1 Constant <>c0=
$e2 Constant c0= $e0 Constant ?c0= $e3 Constant C0<>
\ 8086 conditional branching ( 24.05.91/KK )
: +ret, $c2 X c, X , ;
: +lret, $ca X c, X , ;
: IF, X , X here 1- ;
: THEN, X here over 1+ - ?range swap X c! ;
: ELSE, $eb IF, swap THEN, ;
: WHILE, IF, swap ;
: BEGIN, X here ;
: UNTIL, X c, X here 1+ - ?range X c, ;
: AGAIN, $eb UNTIL, ;
: REPEAT, AGAIN, THEN, ;
: j, 1 xor UNTIL, ;
\ (Code)-8086 (End-Code)-8086
: (Code)-8086
(code)-1 ; ' (Code)-8086 IS (code)
: (End-Code)-8086
(end-code)-1 ; ' (End-Code)-8086 IS (end-code)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>