VolksForth/sources/AtariST/ASSEMBLE.FB.src

324 lines
21 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:55 +00:00
Screen 0 not modified
0 \\ *** Assembler *** 25may86we
1
2 Dieses File enth<74>lt den 68000-Assembler f<>r volksFORTH-83.
3 Der Assembler basiert auf dem von Michael Perry f<>r F83 entwik-
4 kelten, enth<74>lt aber einige zus<75>tzliche Features.
5 Wegen der Heap-Struktur im volksFORTH sind z.B. echte Labels
6 verwendbar. Aus Geschwindigkeitsgr<67>nden enth<74>lt der Assembler
7 kaum Fehler<65>berpr<70>fung, es empfiehlt sich daher, nach getaner
8 Tat die Code-Worte mit einem Disassembler zu <20>berpr<70>fen.
9
10 Screen $11 enth<74>lt einen Loadscreen, mit dem man der kompletten
11 Assembler auf den Heap laden kann, damit er w<>hrend der Kompila-
12 tionszeit zur Verf<72>gung steht, aber keinen Platz im Dictionary
13 verbraucht. Mit CLEAR oder SAVE wird der Assembler entfernt,
14 wenn er nicht mehr ben<65>tigt wird.
15
Screen 1 not modified
0 \ 68000 Assembler Load Screen 26oct86we
1
2 Onlyforth
3 Vocabulary Assembler Assembler also definitions
4
5 : end-code context 2- @ context ! ;
6 ' swap | Alias *swap
7
8 base @ 4 $11 +thru base !
9
10 : reg) size push .l 0 *swap FP DI) ;
11 : Next .w IP )+ D7 move D7 reg) D6 move D6 reg) jmp
12 >here next-link @ , next-link ! ;
13
14 2 3 +thru Onlyforth
15
Screen 2 not modified
0 \ Internal Assembler 09sep86we
1
2 Onlyforth
3
4 here
5 $1300 hallot heap dp ! -1 +load
6 dp !
7
8
9
10
11
12
13
14
15
Screen 3 not modified
0 \ Extended adressing modes 09sep86we
1
2 : R#) ( addr -- ) size push
3 [ Forth ] dup 0< IF [ Assembler ] .w # D6 move D6 reg)
4 [ Forth ] exit THEN .w FP D) ;
5
6
7 | : inrange? ( addr -- offset f ) [ Forth ]
8 >here 2+ - >here 0< IF dup $FFFE >here - < exit THEN
9 dup >here negate > ;
10 : pcrel) ( addr -- ) \ pc-relativ adressing mode
11 inrange? [ Forth ] 0= abort" out of range" pcd) ;
12
13 : ;c: 0 recover R#) jsr end-code ] ;
14
15
Screen 4 not modified
0 \ Assembler Forth words 09sep86we
1 Forth definitions
2 : Assembler Assembler [ Assembler ] .w ;
3 : Code Create here dup 2- ! Assembler ;
4
5 | : (;code r> last @ name> ! ;
6 : ;Code 0 ?pairs compile (;code [compile] [ reveal
7 Assembler ; immediate restrict
8
9 : >label ( addr -- ) here | Create swap , immediate
10 4 hallot >here 4- heap 4 cmove
11 heap last @ count $1F and + even ! dp !
12 Does> ( -- addr ) @
13 state @ IF [compile] Literal THEN ;
14 : Label [ Assembler ] >here [ Forth ] 1 and
15 [ Assembler ] >allot >here >label Assembler ;
Screen 5 not modified
0 \ Code generating primitives 26oct86we
1
2 Variable >codes
3 | Create nrc ] c, , c@ here allot ! c! [
4
5 : nonrelocate nrc >codes ! ; nonrelocate
6
7 | : >exec Create c,
8 Does> c@ >codes @ + @ execute ;
9
10 | 0 >exec >c, | 2 >exec >, | 4 >exec >c@
11 | 6 >exec >here | 8 >exec >allot | $0A >exec >!
12 | $0C >exec >c!
13
14
15
Screen 6 not modified
0 \ 68000 Meta Assembler 04sep86we
1
2 | : ?, IF >, THEN >, ;
3 | : 2, >, >, ;
4 8 base !
5 Variable size
6 : .b 10000 size ! ;
7 : .w 30100 size ! ; .w
8 : .l 24600 size ! ;
9
10 | : Sz Constant Does> @ size @ and or ;
11 00300 | Sz sz3 00400 | Sz sz4
12 04000 | Sz sz40 30000 | Sz sz300
13
14 | : long? size @ 24600 = ;
15 | : -sz1 long? IF 100 or THEN ;
Screen 7 not modified
0 \ addressing modes 09sep86we
1
2 | : Regs 10 0 DO dup 1001 I * or Constant LOOP drop ;
3 | : Mode Constant Does> @ *swap 7007 and or ;
4 0000 Regs D0 D1 D2 D3 D4 D5 D6 D7
5 0110 Regs A0 A1 A2 A3 A4 A5 A6 A7
6 0220 Mode ) \ address register indirect
7 0330 Mode )+ \ adr reg ind post-increment
8 0440 Mode -) \ adr reg ind pre-decrement
9 0550 Mode D) \ adr reg ind displaced
10 0660 Mode (DI) \ adr reg ind displaced indexed s.u.
11 0770 Constant #) \ immediate address
12 1771 Constant L#) \ immediate long address
13 2772 Constant pcD) \ pc relative displaced
14 3773 Constant (pcDI) \ pc relative displaced indexed
15 4774 Constant # \ immediate data
Screen 8 not modified
0 \ fields and register assignments 08sep86we
1
2 | : Field Constant Does> @ and ;
3 7000 | Field rd 0007 | Field rs
4 0070 | Field ms 0077 | Field eas
5 0377 | Field low
6 | : dn? ( ea -- ea flag ) dup ms 0= ;
7 | : src ( ea instr -- ea instr' ) over eas or ;
8 | : dst ( ea instr -- ea instr' ) *swap rd or ;
9
10 | : ??dn ( mod -- mod ) dn? 0= abort" needs Data-Register" ;
11 | : ??an ( mod -- mod ) dup ms 1 =
12 abort" needs Adress-Register" ;
13
14 A6 Constant SP A5 Constant RP A4 Constant IP
15 A3 Constant FP
Screen 9 not modified
0 \ extended addressing 09sep86we
1 : DI) (DI) size @ *swap ;
2 : pcDI) (pcDI) size @ *swap ;
3
4 | : double? ( mode -- flag) dup L#) = *swap
5 # = long? and or ;
6 | : index? ( {n} mode -- {m} mode )
7 dup >r dup 0770 and A0 (DI) = *swap (pcDI) = or
8 IF size @ >r size !
9 dup rd 10 * *swap ms IF 100000 or THEN
10 sz40 *swap low or r> size !
11 THEN r> ;
12
13 | : more? ( ea -- ea flag ) dup ms 0040 > ;
14 | : ,more ( ea -- ) more?
15 IF index? double? ?, ELSE drop THEN ;
Screen 10 not modified
0 \ extended addressing extras 09sep86we
1
2 | Create extra here 5 dup allot erase \ temporary storage area
3
4 | : extra? ( {n} mode -- mode ) more?
5 IF >r r@ index? double? extra 1+ *swap
6 IF under ! 2+ ! 2 ELSE ! 1 THEN extra c! r>
7 ELSE 0 extra !
8 THEN ;
9
10 | : ,extra ( -- ) extra c@ ?dup
11 IF extra 1+ *swap 1 =
12 IF @ >, ELSE dup 2+ @ *swap @ 2, THEN extra 5 erase
13 THEN ;
14
15
Screen 11 not modified
0 \ immediates & address register specific 15jan86we
1 | : Imm Constant Does> @ >r extra? eas r> or
2 sz3 >, long? ?, ,extra ; ( n ea)
3 0000 Imm ori 1000 Imm andi
4 2000 Imm subi 3000 Imm addi
5 5000 Imm eori 6000 Imm cmpi
6 | : Immsr Constant Does> @ sz3 2, ; ( n )
7 001074 Immsr andi>sr
8 005074 Immsr eori>sr
9 000074 Immsr ori>sr
10 | : Iq Constant Does> @ >r extra? eas *swap rs 1000 * or
11 r> or sz3 >, ,extra ; ( n ea )
12 050000 Iq addq 050400 Iq subq
13 | : Ieaa Constant Does> @ dst src sz4 >, ,more ; ( ea an )
14 150300 Ieaa adda 130300 Ieaa cmpa
15 040700 Ieaa lea 110300 Ieaa suba
Screen 12 not modified
0 \ shifts, rotates, and bit manipulation 15jan86we
1 | : Isr Constant Does> @ >r dn?
2 IF *swap dn? IF r> 40 or >r ELSE drop *swap 1000 * THEN
3 rd *swap rs or r> or 160000 or sz3 >,
4 ELSE dup eas 300 or r@ 400 and or r> 70 and 100 * or
5 160000 or >, ,more
6 THEN ; ( dm dn ) ( m # dn ) ( ea )
7 400 Isr asl 000 Isr asr
8 410 Isr lsl 010 Isr lsr
9 420 Isr roxl 020 Isr roxr
10 430 Isr rol 030 Isr ror
11 | : Ibit Constant does> @ >r extra? dn?
12 IF rd src 400 ELSE drop dup eas 4000 THEN
13 or r> or >, ,extra ,more ; ( ea dn ) ( ea n # )
14 000 Ibit btst 100 Ibit bchg
15 200 Ibit bclr 300 Ibit bset
Screen 13 not modified
0 \ branch, loop, and set conditionals 15jan86we
1
2 | : Setclass ' *swap 0 DO I over execute LOOP drop ;
3 | : Ibra 400 * 060000 or Constant ( label )
4 Does> @ *swap >here 2+ - dup abs 200 <
5 IF low or >, ELSE *swap 2, THEN ;
6 20 Setclass Ibra bra bsr bhi bls bcc bcs bne beq
7 bvc bvs bpl bmi bge blt bgt ble
8 | : Idbr 400 * 050310 or Constant ( label \ dn - )
9 Does> @ *swap rs or >, >here - >, ;
10 20 Setclass Idbr dxit dbra dbhi dbls dbcc dbcs dbne dbeq
11 dbvc dbvs dbpl dbmi dbge dblt dbgt dble
12 | : Iset 400 * 050300 or Constant ( ea )
13 Does> @ src >, ,more ;
14 20 Setclass Iset set sno shi sls scc scs sne seq
15 svc svs spl smi sge slt sgt sle
Screen 14 not modified
0 \ moves 15jan86we
1
2 : move extra? 7700 and src sz300 >,
3 ,more ,extra ; ( ea ea )
4 : moveq ??dn rd *swap low or 070000 or >, ; ( n dn )
5 : move>usp ??an rs 047140 or >, ; ( an )
6 : move<usp ??an rs 047150 or >, ; ( an )
7 : movem>
8 extra? eas 044200 or -sz1 >, >, ,extra ; ( n ea )
9 : movem<
10 extra? eas 046200 or -sz1 >, >, ,extra ; ( n ea )
11 : movep dn? IF rd *swap rs or 410 or
12 ELSE rs rot rd or 610 or THEN -sz1 2, ;
13 ( dm d an ) ( d an dm )
14 : lmove 7700 and *swap eas or 20000 or >, ;
15 ( long reg move )
Screen 15 not modified
0 \ odds and ends 15jan86we
1
2 : cmpm rd *swap rs or 130410 or sz3 >, ; ( an@+ am@+ )
3 : exg dn? IF *swap dn? IF 140500 ELSE 140610 THEN >r
4 ELSE *swap dn? IF 140610 ELSE 140510 THEN >r *swap
5 THEN rs dst r> or >, ; ( rn rm )
6 : ext ??dn rs 044200 or -sz1 >, ; ( dn )
7 : swap ??dn rs 044100 or >, ; ( dn )
8 : stop 47162 2, ; ( n )
9 : trap 17 and 47100 or >, ; ( n )
10 : link ??an rs 047120 or 2, ; ( n an )
11 : unlk ??an rs 047130 or >, ; ( an )
12 : eor extra? eas dst sz3 130400 or >, ,extra ; ( dn ea )
13 : cmp ??dn 130000 dst src sz3 >, ,more ; ( ea dn )
14
15
Screen 16 not modified
0 \ arithmetic and logic 15jan86we
1 | : Ibcd Constant Does> @ dst over rs or *swap ms
2 IF 10 or THEN >, ; ( dn dm ) ( an@- am@- )
3 140400 Ibcd abcd 100400 Ibcd sbcd
4 | : Idd Constant Does> @ dst over rs or *swap ms
5 IF 10 or THEN sz3 >, ; ( dn dm ) ( an@- am@- )
6 150400 Idd addx 110400 Idd subx
7 | : Idea Constant Does> @ >r dn? ( ea dn ) ( dn ea )
8 IF rd src r> or sz3 >, ,more
9 ELSE extra? eas dst 400 or r> or sz3 >, ,extra THEN ;
10 150000 Idea add 110000 Idea sub
11 140000 Idea and 100000 Idea or
12 | : Iead Constant Does> @ >r ??dn r> dst src
13 >, ,more ; ( ea dn)
14 040600 Iead chk 100300 Iead divu 100700 Iead divs
15 140300 Iead mulu 140700 Iead muls
Screen 17 not modified
0 \ arithmetic and control 15jan86we
1
2 | : Iea Constant Does> @ src >, ,more ; ( ea )
3 047200 Iea jsr 047300 Iea jmp
4 042300 Iea move>ccr
5 040300 Iea move<sr 043300 Iea move>sr
6 044000 Iea nbcd 044100 Iea pea
7 045300 Iea tas
8 | : Ieas Constant Does> @ src sz3 >, ,more ; ( ea )
9 041000 Ieas clr 043000 Ieas not
10 042000 Ieas neg 040000 Ieas negx
11 045000 Ieas tst
12 | : Icon Constant Does> @ >, ;
13 47160 Icon reset 47161 Icon nop
14 47163 Icon rte 47165 Icon rts
15 47166 Icon trapv 47167 Icon rtr
Screen 18 not modified
0 \ structured conditionals +/- 256 bytes 15jan86we
1 : THEN >here over 2+ - *swap 1+ >c! ;
2 : IF >, >here 2- ; hex
3 : ELSE 6000 IF *swap THEN ;
4 : BEGIN >here ;
5 : UNTIL >, >here - >here 1- >c! ;
6 : AGAIN 6000 UNTIL ;
7 : WHILE IF *swap ;
8 : REPEAT AGAIN THEN ;
9 : DO >here *swap ;
10 : LOOP dbra ;
11 6600 Constant 0= 6700 Constant 0<>
12 6A00 Constant 0< 6B00 Constant 0>=
13 6C00 Constant < 6D00 Constant >=
14 6E00 Constant <= 6F00 Constant >
15 6500 Constant CC 6400 Constant CS