Diff for /gforth/arch/alpha/asm.fs between versions 1.2 and 1.3

version 1.2, 1999/09/30 14:01:09 version 1.3, 1999/10/13 13:00:07
Line 43  $1f constant zero Line 43  $1f constant zero
   
 \ util  \ util
   
 : right_shift ( a n -- a>>=n )  
 0  
 ?do  
   2/  
 loop  
 ;  
   
 : left_shift ( a n -- a<<=n )  
 0  
 ?do  
   2*  
 loop  
 ;  
   
 : h@ ( addr -- n )              \ 32 bit fetch  : h@ ( addr -- n )              \ 32 bit fetch
 dup dup aligned = if  dup dup aligned = if
   @    @
   $00000000ffffffff and    $00000000ffffffff and
 else  else
   4 - @    4 - @
   $20 right_shift    $20 rshift
 endif  endif
 ;  ;
   
Line 76  dup dup aligned = if Line 62  dup dup aligned = if
 else  else
   4 - dup @    4 - dup @
   $00000000ffffffff and    $00000000ffffffff and
   rot $20 left_shift or    rot $20 lshift or
   swap !    swap !
 endif  endif
 ;  ;
Line 85  endif Line 71  endif
 here here aligned = if  here here aligned = if
   here !    here !
 else  else
   32 left_shift    32 lshift
   here 4 - dup    here 4 - dup
   @ rot or    @ rot or
   swap !    swap !
Line 98  endif Line 84  endif
 : Bra ( oo )                    \ branch instruction format  : Bra ( oo )                    \ branch instruction format
   create ,    create ,
 does> ( ra, branch_disp, addr )  does> ( ra, branch_disp, addr )
   @ 26 left_shift    @ 26 lshift
   swap $1fffff and or    swap $1fffff and or
   swap $1f and 21 left_shift or h,    swap $1f and 21 lshift or h,
 ;  ;
   
 : Mbr ( oo.h )                  \ memory branch instruction format  : Mbr ( oo.h )                  \ memory branch instruction format
   create 2,    create 2,
 does> ( ra, rb, hint, addr )  does> ( ra, rb, hint, addr )
   2@ 14 left_shift    2@ 14 lshift
   swap 26 left_shift or    swap 26 lshift or
   swap $3fff and or    swap $3fff and or
   swap $1f and 16 left_shift or    swap $1f and 16 lshift or
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,    h,
 ;   ; 
   
 : F-P ( oo.fff )                \ floating-point operate instruction format  : F-P ( oo.fff )                \ floating-point operate instruction format
   create 2,    create 2,
 does> ( fa, fb, fc, addr )  does> ( fa, fb, fc, addr )
   2@ 5 left_shift    2@ 5 lshift
   swap 26 left_shift or    swap 26 lshift or
   swap $1f and or    swap $1f and or
   swap $1f and 16 left_shift or    swap $1f and 16 lshift or
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,    h,
 ;  ;
   
 : Mem ( oo )                    \ memory instruction format  : Mem ( oo )                    \ memory instruction format
   create ,    create ,
 does> ( ra, memory_disp, rb, addr )  does> ( ra, memory_disp, rb, addr )
   @ 26 left_shift    @ 26 lshift
   swap $1f and 16 left_shift or    swap $1f and 16 lshift or
   swap $ffff and or     swap $ffff and or 
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,    h,
 ;  ;
   
Line 139  does> ( ra, memory_disp, rb, addr ) Line 125  does> ( ra, memory_disp, rb, addr )
   create 2,    create 2,
 does> ( ra, rb, addr )  does> ( ra, rb, addr )
   2@    2@
   swap 26 left_shift or    swap 26 lshift or
   swap $1f and 16 left_shift or    swap $1f and 16 lshift or
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,    h,
 ;  ;
   
Line 149  does> ( ra, rb, addr ) Line 135  does> ( ra, rb, addr )
   create 2,    create 2,
 does> ( ra, rb, rc, addr )  does> ( ra, rb, rc, addr )
   2@    2@
   5 left_shift    5 lshift
   swap 26 left_shift or    swap 26 lshift or
   swap $1f and or    swap $1f and or
   swap $1f and 16 left_shift or    swap $1f and 16 lshift or
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,     h, 
 ;  ;
   
Line 161  does> ( ra, rb, rc, addr ) Line 147  does> ( ra, rb, rc, addr )
   create 2,    create 2,
 does> ( ra, lit, rc, addr )  does> ( ra, lit, rc, addr )
   2@    2@
   5 left_shift    5 lshift
   swap 26 left_shift or    swap 26 lshift or
   1 12 left_shift or    1 12 lshift or
   swap $1f and or    swap $1f and or
   swap $ff and 13 left_shift or    swap $ff and 13 lshift or
   swap $1f and 21 left_shift or    swap $1f and 21 lshift or
   h,     h, 
 ;  ;
   
 : Pcd ( oo )                    \ palcode instruction format  : Pcd ( oo )                    \ palcode instruction format
   create ,    create ,
 does> ( palcode, addr )  does> ( palcode, addr )
   @ 26 left_shift    @ 26 lshift
   swap $3ffffff and or    swap $3ffffff and or
   h,    h,
 ;  ;
Line 418  $12 $31   Opr# zapnot#, Line 404  $12 $31   Opr# zapnot#,
   
 \ <register_number> if, <if_code> [ else, <else_code> ] endif,  \ <register_number> if, <if_code> [ else, <else_code> ] endif,
   
 : if,  : ahead, ( -- asmorig )
   0 beq, here 4 -      31 0 br,
       here 4 -
 ;  ;
   
 : else,  : if, ( -- asmorig )
   dup here swap - 4 /    0 beq,
   $1fffff and  
   over h@ or swap h!  
   31 0 br,  
   here 4 -    here 4 -
 ;  ;
   
 : endif,  : endif, ( asmorig -- )
   dup here swap - 4 - 4 /    dup here swap - 4 - 4 /
   $1fffff and    $1fffff and
   over h@ or swap h!    over h@ or swap h!
 ;  ;
   
   : else, ( asmorig1 -- asmorig2 )
       ahead,
       swap
       endif,
   ;
   
 \ begin, <code> again,  \ begin, <code> again,
   
 : begin,  : begin, ( -- asmdest )
   here    here
 ;  ;
   
 : again,  : again, ( asmdest -- )
   here - 4 - 4 /    here - 4 - 4 /
   $1fffff and    $1fffff and
   31 swap br,    31 swap br,
Line 450  $12 $31   Opr# zapnot#, Line 440  $12 $31   Opr# zapnot#,
   
 \ begin, <code> <register_number> until,  \ begin, <code> <register_number> until,
   
 : until,  : until, ( asmdest -- )
   here rot swap - 4 - 4 /    here rot swap - 4 - 4 /
   $1fffff and    $1fffff and
   bne,    bne,
Line 458  $12 $31   Opr# zapnot#, Line 448  $12 $31   Opr# zapnot#,
   
 \ begin, <register_number> while, <code> repeat,  \ begin, <register_number> while, <code> repeat,
   
 : while,  : while, ( asmdest -- asmorig asmdest )
   0 beq, here 4 -    if,
     swap
 ;  ;
   
 : repeat,  : repeat, ( asmorig asmdest -- )
   swap here - 4 - 4 /    again,
   $1fffff and    endif,
   31 swap br,  
   dup here 4 - swap - 4 /  
   $1fffff and  
   over h@ or swap h!  
 ;  ;
   
 \ labels  \ jump marks
   
 10 constant mark_numbers  
 10 constant mark_uses  
   
 create mark_table  \ example:
 mark_numbers mark_uses 1 + * cells allot  
   
 : set_mark ( mark_number -- )  \ init_marktbl          \ initializes mark table
   \ 31 0 br,
   \ 0 store_branch        \ store jump address for mark 0
   \ 1 2 3 addf,
   \ 0 set_mark            \ store mark 0
   \ 2 3 4 addf,
   \ 2 0 beq,
   \ 0 store_branch        \ store jump address for mark 0
   \ calculate_marks       \ calculate all jumps
   
 ;  \ with <mark_address> <jump_address> calculate_branch you can calculate the
   \ displacement field without the mark_table for one branch
   
 : set_branch ( mark_number -- )  \ example:
   \ here 31 0 br,
   \ here 1 2 3 addf,
   \ calculate_branch
   
 ;  5 constant mark_numbers
   5 constant mark_uses
   
 : calculate_marks ( -- )  create mark_table
   mark_numbers mark_uses 1+ * cells allot
   
   : init_marktbl ( -- )                   \ initializes mark table
     mark_table mark_numbers mark_uses 1+ * cells +
     mark_table
     begin
       over over >
     while
       dup 0 swap !
       1 cells +
     repeat
     drop drop
   ;
   
   : set_mark ( mark_number -- )           \ sets mark, store address in mark table
     dup mark_numbers >= abort" error, illegal mark number"
     mark_uses 1+ * cells
     mark_table + here 8 - swap !
   ;
   
   : store_branch ( mark_number -- )       \ stores address of branch in mark table
     dup mark_numbers >= abort" error, illegal mark number"
     mark_uses 1+ * cells
     mark_table + 1 cells +
     dup mark_uses cells + swap
     begin
       over over > over @ and 
     while
       1 cells +
     repeat
     swap over = abort" error, not enough space in mark_table, increase mark_uses"
     here 4 - swap !
 ;  ;
   
   : calculate_branch ( mark_addr branch_addr -- ) \ calculate branch displacement field for one branch
     swap over - 4 + 4 /
     $1fffff and
     over h@ or swap h!
   ;
   
   : calculate_mark ( tb mark_address -- tb )      \ calculates branch displacement field for one mark
     over 1 cells +
     dup mark_uses cells + swap
     begin
       over over >
     while
       2over swap drop ( ei i markaddr ej j markaddr )
       over @
       dup if
         calculate_branch
       else
         drop drop
       endif
       1 cells +
     repeat drop drop drop
   ;
   
   : calculate_marks ( -- )                \ calculates branch displacement field for all marks
     mark_table mark_numbers 1- mark_uses 1+ * cells +
     mark_table
     begin
       over over >=
     while
       dup @
         dup if \ used mark
           calculate_mark
         else
           drop
         endif
       mark_uses 1+ cells +
     repeat
     drop drop
   ;

Removed from v.1.2  
changed lines
  Added in v.1.3


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>