Screen 0 not modified     
 0 \\                     *** Assembler ***               25may86we
 1                                                                 
 2 Dieses File enth„lt den 68000-Assembler fr volksFORTH-83.      
 3 Der Assembler basiert auf dem von Michael Perry fr F83 entwik- 
 4 kelten, enth„lt aber einige zus„tzliche Features.               
 5 Wegen der Heap-Struktur im volksFORTH sind z.B. echte Labels    
 6 verwendbar. Aus Geschwindigkeitsgrnden enth„lt der Assembler   
 7 kaum Fehlerberprfung, es empfiehlt sich daher, nach getaner   
 8 Tat die Code-Worte mit einem Disassembler zu berprfen.        
 9                                                                 
10 Screen $11 enth„lt einen Loadscreen, mit dem man der kompletten 
11 Assembler auf den Heap laden kann, damit er w„hrend der Kompila-
12 tionszeit zur Verfgung steht, aber keinen Platz im Dictionary  
13 verbraucht. Mit  CLEAR  oder  SAVE  wird der Assembler entfernt,
14 wenn er nicht mehr ben”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                             
