VolksForth/sources/msdos/asm.fb.src

392 lines
25 KiB
Plaintext
Raw Normal View History

2017-04-23 22:25:49 +00:00
Screen 0 not modified
0 \ 8086 Assembler cas 10nov05
1 This 8086 Assembler was written by Klaus Schleisiek.
2 Assembler Definitions are created with the definig word
3 CODE and closed with the word END-CODE.
4
5 The 8086 Registers naming and usage in volksFORTH
6
7 Intel vForth Used for 8bit-Register
8 AX A free A+ A-
9 DX D topmost Stackitem D+ D-
10 CX C free C+ C-
11 BX R Returnstack Pointer R+ R-
12 BP U User Pointer
13 SP S Stack Pointer
14 SI I Instruction Pointer
15 DI W Word Pointer, mostly free
Screen 1 not modified
0 \ 8086 Assembler loadscreen cas 10nov05
1 Onlyforth
2
3 | : u2/ ( 16b -- 15b ) 2/ $7FFF and ;
4 | : 8* ( 15b -- 16b ) 2* 2* 2* ;
5 | : 8/ ( 16b -- 13b ) u2/ 2/ 2/ ;
6
7 Vocabulary Assembler
8 Assembler also definitions
9
10 3 &21 thru clear .( Assembler loaded ) cr
11
12
13
14
15
Screen 2 not modified
0 \ conditional Assembler compiler cas 10nov05
1 here
2
3 : temp-assembler ( addr -- ) hide last off dp !
4 " ASSEMBLER" find nip ?exit here $1800 + sp@ u>
5 IF display cr ." Assembler won't fit" abort THEN
6 here sp@ $1800 - dp ! 1 load dp ! ;
7
8 temp-assembler \\
9
10 : blocks ( n -- addr / ff )
11 first @ >r dup 0 ?DO freebuffer LOOP
12 [ b/blk negate ] Literal * first @ + r@ u> r> and ;
13
14
15
Screen 3 not modified
0 \ Code generating primitives cas 10nov05
1
2 Variable >codes \ points at table of execution vectors
3
4 | Create nrc ] c, , here ! c! [
5
6 : nonrelocate nrc >codes ! ; nonrelocate
7
8 | : >exec ( n -- n+2 ) Create dup c, 2+
9 Does> c@ >codes @ + perform ;
10
11 0 | >exec >c, | >exec >, | >exec >here
12 | >exec >! | >exec >c! drop
13
14
15
Screen 4 not modified
0 \ 8086 Registers cas 10nov05
1
2 0 Constant A 1 Constant C 2 Constant D 3 Constant R
3 4 Constant S 5 Constant U 6 Constant I 7 Constant W
4 ' I Alias SI ' W Alias DI ' R Alias BX
5
6 8 Constant A- 9 Constant C- $A Constant D- $B Constant R-
7 $C Constant A+ $D Constant C+ $E Constant D+ $F Constant R+
8 ' R- Alias B- ' R+ Alias B+
9
10 $100 Constant E: $101 Constant C:
11 $102 Constant S: $103 Constant D:
12
13 | Variable isize ( specifies Size by prefix)
14 | : Size: ( n -- ) Create c, Does> c@ isize ! ;
15 0 Size: byte 1 Size: word word 2 Size: far
Screen 5 not modified
0 \ 8086 Assembler System variables cas 10nov05
1
2 | Variable direction \ 0 reg>EA, -1 EA>reg
3 | Variable size \ 1 word, 0 byte, -1 undefined
4 | Variable displaced \ 1 direct, 0 nothing, -1 displaced
5 | Variable displacement
6
7 | : setsize isize @ size ! ;
8 | : long? ( n -- f ) $FF80 and dup 0< not ?exit $FF80 xor ;
9 | : wexit rdrop word ;
10 | : moderr word true Abort" invalid" ;
11 | : ?moderr ( f -- ) 0=exit moderr ;
12 | : ?word size @ 1- ?moderr ;
13 | : far? ( -- f ) size @ 2 = ;
14
15
Screen 6 not modified
0 \ 8086 addressing modes cas 10nov05
1
2 | Create (EA 7 c, 0 c, 6 c, 4 c, 5 c,
3 | : () ( 8b1 -- 8b2 )
4 3 - dup 4 u> over 1 = or ?moderr (EA + c@ ;
5
6 -1 Constant # $C6 Constant #) -1 Constant C*
7
8 : ) ( u1 -- u2 )
9 () 6 case? IF 0 $86 exit THEN $C0 or ;
10 : I) ( u1 u2 -- u3 ) + 9 - dup 3 u> ?moderr $C0 or ;
11
12 : D) ( n u1 -- n u2 )
13 () over long? IF $40 ELSE $80 THEN or ;
14 : DI) ( n u1 u2 -- n u3 )
15 I) over long? IF $80 ELSE $40 THEN xor ;
Screen 7 not modified
0 \ 8086 Registers and addressing modes cas 10nov05
1
2 | : displaced? ( [n] u1 -- [n] u1 f )
3 dup #) = IF 1 exit THEN
4 dup $C0 and dup $40 = swap $80 = or ;
5
6 | : displace ( [n] u1 -- u1 ) displaced? ?dup 0=exit
7 displaced @ ?moderr displaced ! swap displacement ! ;
8
9 | : rmode ( u1 -- u2 ) 1 size ! dup 8 and 0=exit
10 size off $FF07 and ;
11
12 | : mmode? ( 9b - 9b f) dup $C0 and ;
13
14 | : rmode? ( 8b1 - 8b1 f) mmode? $C0 = ;
15
Screen 8 not modified
0 \ 8086 decoding addressing modes cas 10nov05
1
2 | : 2address ( [n] source [displ] dest -- 15b / [n] 16b )
3 size on displaced off dup # = ?moderr mmode?
4 IF displace False ELSE rmode True THEN direction !
5 >r # case? IF r> $80C0 xor size @ 1+ ?exit setsize exit
6 THEN direction @
7 IF r> 8* >r mmode? IF displace
8 ELSE dup 8/ 1 and size @ = ?moderr $FF07 and THEN
9 ELSE rmode 8*
10 THEN r> or $C0 xor ;
11
12 | : 1address ( [displ] 9b -- 9b )
13 # case? ?moderr size on displaced off direction off
14 mmode? IF displace setsize ELSE rmode THEN $C0 xor ;
15
Screen 9 not modified
0 \ 8086 assembler cas 10nov05
1 | : immediate? ( u -- u f ) dup 0< ;
2
3 | : nonimmediate ( u -- u ) immediate? ?moderr ;
4
5 | : r/m 7 and ;
6
7 | : reg $38 and ;
8
9 | : ?akku ( u -- u ff / tf ) dup r/m 0= dup 0=exit nip ;
10
11 | : smode? ( u1 -- u1 ff / u2 tf ) dup $F00 and
12 IF dup $100 and IF dup r/m 8* swap reg 8/
13 or $C0 or direction off
14 THEN True exit
15 THEN False ;
Screen 10 not modified
0 \ 8086 Registers and addressing modes cas 10nov05
1
2 | : w, size @ or >c, ;
3
4 | : dw, size @ or direction @ IF 2 xor THEN >c, ;
5
6 | : ?word, ( u1 f -- ) IF >, exit THEN >c, ;
7
8 | : direct, displaced @ 0=exit
9 displacement @ dup long? displaced @ 1+ or ?word, ;
10
11 | : r/m, >c, direct, ;
12
13 | : data, size @ ?word, ;
14
15
Screen 11 not modified
0 \ 8086 Arithmetic instructions cas 10nov05
1
2 | : Arith: ( code -- ) Create ,
3 Does> @ >r 2address immediate?
4 IF rmode? IF ?akku IF r> size @
5 IF 5 or >c, >, wexit THEN
6 4 or >c, >c, wexit THEN THEN
7 r@ or $80 size @ or r> 0<
8 IF size @ IF 2 pick long? 0= IF 2 or size off THEN
9 THEN THEN >c, >c, direct, data, wexit
10 THEN r> dw, r/m, wexit ;
11
12 $8000 Arith: add $0008 Arith: or
13 $8010 Arith: adc $8018 Arith: sbb
14 $0020 Arith: and $8028 Arith: sub
15 $0030 Arith: xor $8038 Arith: cmp
Screen 12 not modified
0 \ 8086 move push pop cas 10nov05
1
2 : mov [ Forth ] 2address immediate?
3 IF rmode? IF r/m $B0 or size @ IF 8 or THEN
4 >c, data, wexit
5 THEN $C6 w, r/m, data, wexit
6 THEN 6 case? IF $A2 dw, direct, wexit THEN
7 smode? IF $8C direction @ IF 2 or THEN >c, r/m, wexit
8 THEN $88 dw, r/m, wexit ;
9
10 | : pupo [ Forth ] >r 1address ?word
11 smode? IF reg 6 r> IF 1+ THEN or >c, wexit THEN
12 rmode? IF r/m $50 or r> or >c, wexit THEN
13 r> IF $8F ELSE $30 or $FF THEN >c, r/m, wexit ;
14
15 : push 0 pupo ; : pop 8 pupo ;
Screen 13 not modified
0 \ 8086 inc & dec , effective addresses cas 10nov05
1
2 | : inc/dec [ Forth ] >r 1address rmode?
3 IF size @ IF r/m $40 or r> or >c, wexit THEN
4 THEN $FE w, r> or r/m, wexit ;
5
6 : dec 8 inc/dec ; : inc 0 inc/dec ;
7
8 | : EA: ( code -- ) Create c, [ Forth ]
9 Does> >r 2address nonimmediate
10 rmode? direction @ 0= or ?moderr r> c@ >c, r/m, wexit ;
11
12 $C4 EA: les $8D EA: lea $C5 EA: lds
13
14
15
Screen 14 not modified
0 \ 8086 xchg segment prefix cas 10nov05
1 : xchg [ Forth ] 2address nonimmediate rmode?
2 IF size @ IF dup r/m 0=
3 IF 8/ true ELSE dup $38 and 0= THEN
4 IF r/m $90 or >c, wexit THEN
5 THEN THEN $86 w, r/m, wexit ;
6
7 | : 1addr: ( code -- ) Create c, [ Forth ]
8 Does> c@ >r 1address $F6 w, r> or r/m, wexit ;
9
10 $10 1addr: com $18 1addr: neg
11 $20 1addr: mul $28 1addr: imul
12 $38 1addr: idiv $30 1addr: div
13
14 : seg ( 8b -) [ Forth ]
15 $100 xor dup $FFFC and ?moderr 8* $26 or >c, ;
Screen 15 not modified
0 \ 8086 test not neg mul imul div idiv cas 10nov05
1
2 : test [ Forth ] 2address immediate?
3 IF rmode? IF ?akku IF $A8 w, data, wexit THEN THEN
4 $F6 w, r/m, data, wexit
5 THEN $84 w, r/m, wexit ;
6
7 | : in/out [ Forth ] >r 1address setsize
8 $C2 case? IF $EC r> or w, wexit THEN
9 6 - ?moderr $E4 r> or w, displacement @ >c, wexit ;
10
11 : out 2 in/out ; : in 0 in/out ;
12
13 : int 3 case? IF $CC >c, wexit THEN $CD >c, >c, wexit ;
14
15
Screen 16 not modified
0 \ 8086 shifts and string instructions cas 10nov05
1
2 | : Shifts: ( code -- ) Create c, [ Forth ]
3 Does> c@ >r C* case? >r 1address
4 r> direction ! $D0 dw, r> or r/m, wexit ;
5
6 $00 Shifts: rol $08 Shifts: ror
7 $10 Shifts: rcl $18 Shifts: rcr
8 $20 Shifts: shl $28 Shifts: shr
9 $38 Shifts: sar ' shl Alias sal
10
11 | : Str: ( code -- ) Create c,
12 Does> c@ setsize w, wexit ;
13
14 $A6 Str: cmps $AC Str: lods $A4 Str: movs
15 $AE Str: scas $AA Str: stos
Screen 17 not modified
0 \ implied 8086 instructions cas 10nov05
1
2 : Byte: ( code -- ) Create c, Does> c@ >c, ;
3 : Word: ( code -- ) Create , Does> @ >, ;
4
5 $37 Byte: aaa $AD5 Word: aad $AD4 Word: aam
6 $3F Byte: aas $98 Byte: cbw $F8 Byte: clc
7 $FC Byte: cld $FA Byte: cli $F5 Byte: cmc
8 $99 Byte: cwd $27 Byte: daa $2F Byte: das
9 $F4 Byte: hlt $CE Byte: into $CF Byte: iret
10 $9F Byte: lahf $F0 Byte: lock $90 Byte: nop
11 $9D Byte: popf $9C Byte: pushf $9E Byte: sahf
12 $F9 Byte: stc $FD Byte: std $FB Byte: sti
13 $9B Byte: wait $D7 Byte: xlat
14 $C3 Byte: ret $CB Byte: lret
15 $F2 Byte: rep $F2 Byte: 0<>rep $F3 Byte: 0=rep
Screen 18 not modified
0 \ 8086 jmp call conditions cas 10nov05
1 | : jmp/call >r setsize # case? [ Forth ]
2 IF far? IF r> IF $EA ELSE $9A THEN >c, swap >, >, wexit
3 THEN >here 2+ - r>
4 IF dup long? 0= IF $EB >c, >c, wexit THEN $E9
5 ELSE $E8 THEN >c, 1- >, wexit
6 THEN 1address $FF >c, $10 or r> +
7 far? IF 8 or THEN r/m, wexit ;
8 : call 0 jmp/call ; : jmp $10 jmp/call ;
9
10 $71 Constant OS $73 Constant CS
11 $75 Constant 0= $77 Constant >=
12 $79 Constant 0< $7B Constant PE
13 $7D Constant < $7F Constant <=
14 $E2 Constant C0= $E0 Constant ?C0=
15 : not 1 [ Forth ] xor ;
Screen 19 not modified
0 \ 8086 conditional branching cas 10nov05
1
2 : +ret $C2 >c, >, ;
3 : +lret $CA >c, >, ;
4
5 | : ?range dup long? abort" out of range" ;
6
7 : ?[ >, >here 1- ;
8 : ]? >here over 1+ - ?range swap >c! ;
9 : ][ $EB ?[ swap ]? ;
10 : ?[[ ?[ swap ;
11 : [[ >here ;
12 : ?] >c, >here 1+ - ?range >c, ;
13 : ]] $EB ?] ;
14 : ]]? ]] ]? ;
15
Screen 20 not modified
0 \ Next user' end-code ;c: cas 10nov05
1
2 : Next lods A W xchg W ) jmp
3 >here next-link @ >, next-link ! ;
4
5 : u' ' >body c@ ;
6
7 Forth definitions
8
9 \needs end-code : end-code toss also ;
10
11 Assembler definitions
12
13 : ;c: recover # call last off end-code 0 ] ;
14
15
Screen 21 not modified
0 \ 8086 Assembler, Forth words cas 10nov05
1 Onlyforth
2
3 : Assembler Assembler [ Assembler ] wexit ;
4
5 : ;code 0 ?pairs compile (;code
6 reveal [compile] [ Assembler ; immediate
7
8 : Code Create [ Assembler ] >here dup 2- >! Assembler ;
9
10 : >label ( addr -- )
11 here | Create immediate swap , 4 hallot
12 here 4 - heap 4 cmove heap last @ (name> ! dp !
13 Does> ( -- addr ) @ state @ 0=exit [compile] Literal ;
14
15 : Label [ Assembler ] >here >label Assembler ;
Screen 22 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15