VolksForth/msdos/asm.fb
2017-04-24 00:25:49 +02:00

1 line
23 KiB
Plaintext
Executable File

\ 8086 Assembler cas 10nov05This 8086 Assembler was written by Klaus Schleisiek. Assembler Definitions are created with the definig word CODE and closed with the word END-CODE. The 8086 Registers naming and usage in volksFORTH Intel vForth Used for 8bit-Register AX A free A+ A- DX D topmost Stackitem D+ D- CX C free C+ C- BX R Returnstack Pointer R+ R- BP U User Pointer SP S Stack Pointer SI I Instruction Pointer DI W Word Pointer, mostly free \ 8086 Assembler loadscreen cas 10nov05 Onlyforth | : u2/ ( 16b -- 15b ) 2/ $7FFF and ; | : 8* ( 15b -- 16b ) 2* 2* 2* ; | : 8/ ( 16b -- 13b ) u2/ 2/ 2/ ; Vocabulary Assembler Assembler also definitions 3 &21 thru clear .( Assembler loaded ) cr \ conditional Assembler compiler cas 10nov05 here : temp-assembler ( addr -- ) hide last off dp ! " ASSEMBLER" find nip ?exit here $1800 + sp@ u> IF display cr ." Assembler won't fit" abort THEN here sp@ $1800 - dp ! 1 load dp ! ; temp-assembler \\ : blocks ( n -- addr / ff ) first @ >r dup 0 ?DO freebuffer LOOP [ b/blk negate ] Literal * first @ + r@ u> r> and ; \ Code generating primitives cas 10nov05 Variable >codes \ points at table of execution vectors | Create nrc ] c, , here ! c! [ : nonrelocate nrc >codes ! ; nonrelocate | : >exec ( n -- n+2 ) Create dup c, 2+ Does> c@ >codes @ + perform ; 0 | >exec >c, | >exec >, | >exec >here | >exec >! | >exec >c! drop \ 8086 Registers cas 10nov05 0 Constant A 1 Constant C 2 Constant D 3 Constant R 4 Constant S 5 Constant U 6 Constant I 7 Constant W ' I Alias SI ' W Alias DI ' R Alias BX 8 Constant A- 9 Constant C- $A Constant D- $B Constant R- $C Constant A+ $D Constant C+ $E Constant D+ $F Constant R+ ' R- Alias B- ' R+ Alias B+ $100 Constant E: $101 Constant C: $102 Constant S: $103 Constant D: | 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 cas 10nov05 | 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< not ?exit $FF80 xor ; | : wexit rdrop word ; | : moderr word true Abort" invalid" ; | : ?moderr ( f -- ) 0=exit moderr ; | : ?word size @ 1- ?moderr ; | : far? ( -- f ) size @ 2 = ; \ 8086 addressing modes cas 10nov05 | 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 cas 10nov05 | : 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 0=exit displaced @ ?moderr displaced ! swap displacement ! ; | : rmode ( u1 -- u2 ) 1 size ! dup 8 and 0=exit size off $FF07 and ; | : mmode? ( 9b - 9b f) dup $C0 and ; | : rmode? ( 8b1 - 8b1 f) mmode? $C0 = ; \ 8086 decoding addressing modes cas 10nov05 | : 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 cas 10nov05| : 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 0=exit nip ; | : 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 cas 10nov05 | : w, size @ or >c, ; | : dw, size @ or direction @ IF 2 xor THEN >c, ; | : ?word, ( u1 f -- ) IF >, exit THEN >c, ; | : direct, displaced @ 0=exit displacement @ dup long? displaced @ 1+ or ?word, ; | : r/m, >c, direct, ; | : data, size @ ?word, ; \ 8086 Arithmetic instructions cas 10nov05 | : Arith: ( code -- ) Create , Does> @ >r 2address immediate? IF rmode? IF ?akku IF r> size @ IF 5 or >c, >, wexit THEN 4 or >c, >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 >c, >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 cas 10nov05 : mov [ Forth ] 2address immediate? IF rmode? IF r/m $B0 or size @ IF 8 or THEN >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 >c, r/m, wexit THEN $88 dw, r/m, wexit ; | : pupo [ Forth ] >r 1address ?word smode? IF reg 6 r> IF 1+ THEN or >c, wexit THEN rmode? IF r/m $50 or r> or >c, wexit THEN r> IF $8F ELSE $30 or $FF THEN >c, r/m, wexit ; : push 0 pupo ; : pop 8 pupo ; \ 8086 inc & dec , effective addresses cas 10nov05 | : inc/dec [ Forth ] >r 1address rmode? IF size @ IF r/m $40 or r> or >c, wexit THEN THEN $FE w, r> or r/m, wexit ; : dec 8 inc/dec ; : inc 0 inc/dec ; | : EA: ( code -- ) Create c, [ Forth ] Does> >r 2address nonimmediate rmode? direction @ 0= or ?moderr r> c@ >c, r/m, wexit ; $C4 EA: les $8D EA: lea $C5 EA: lds \ 8086 xchg segment prefix cas 10nov05 : xchg [ Forth ] 2address nonimmediate rmode? IF size @ IF dup r/m 0= IF 8/ true ELSE dup $38 and 0= THEN IF r/m $90 or >c, wexit THEN THEN THEN $86 w, r/m, wexit ; | : 1addr: ( code -- ) Create c, [ Forth ] 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 -) [ Forth ] $100 xor dup $FFFC and ?moderr 8* $26 or >c, ; \ 8086 test not neg mul imul div idiv cas 10nov05 : test [ Forth ] 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 [ Forth ] >r 1address setsize $C2 case? IF $EC r> or w, wexit THEN 6 - ?moderr $E4 r> or w, displacement @ >c, wexit ; : out 2 in/out ; : in 0 in/out ; : int 3 case? IF $CC >c, wexit THEN $CD >c, >c, wexit ; \ 8086 shifts and string instructions cas 10nov05 | : Shifts: ( code -- ) Create c, [ Forth ] 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 cas 10nov05 : Byte: ( code -- ) Create c, Does> c@ >c, ; : Word: ( code -- ) Create , Does> @ >, ; $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 cas 10nov05| : jmp/call >r setsize # case? [ Forth ] IF far? IF r> IF $EA ELSE $9A THEN >c, swap >, >, wexit THEN >here 2+ - r> IF dup long? 0= IF $EB >c, >c, wexit THEN $E9 ELSE $E8 THEN >c, 1- >, wexit THEN 1address $FF >c, $10 or r> + far? IF 8 or THEN r/m, wexit ; : call 0 jmp/call ; : jmp $10 jmp/call ; $71 Constant OS $73 Constant CS $75 Constant 0= $77 Constant >= $79 Constant 0< $7B Constant PE $7D Constant < $7F Constant <= $E2 Constant C0= $E0 Constant ?C0= : not 1 [ Forth ] xor ; \ 8086 conditional branching cas 10nov05 : +ret $C2 >c, >, ; : +lret $CA >c, >, ; | : ?range dup long? abort" out of range" ; : ?[ >, >here 1- ; : ]? >here over 1+ - ?range swap >c! ; : ][ $EB ?[ swap ]? ; : ?[[ ?[ swap ; : [[ >here ; : ?] >c, >here 1+ - ?range >c, ; : ]] $EB ?] ; : ]]? ]] ]? ; \ Next user' end-code ;c: cas 10nov05 : Next lods A W xchg W ) jmp >here next-link @ >, next-link ! ; : u' ' >body c@ ; Forth definitions \needs end-code : end-code toss also ; Assembler definitions : ;c: recover # call last off end-code 0 ] ; \ 8086 Assembler, Forth words cas 10nov05 Onlyforth : Assembler Assembler [ Assembler ] wexit ; : ;code 0 ?pairs compile (;code reveal [compile] [ Assembler ; immediate : Code Create [ Assembler ] >here dup 2- >! Assembler ; : >label ( addr -- ) here | Create immediate swap , 4 hallot here 4 - heap 4 cmove heap last @ (name> ! dp ! Does> ( -- addr ) @ state @ 0=exit [compile] Literal ; : Label [ Assembler ] >here >label Assembler ;