[BACK]Return to asm.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / arch / alpha

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

version 1.2, 1999/09/30 14:01:09 version 1.8, 2000/07/16 20:11:48
Line 1 Line 1
   
 \ bernd thallner 9725890 881  
 \ assembler in forth for alpha  \ assembler in forth for alpha
   
 \ requires code.fs  \ Copyright (C) 1999,2000 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation; either version 2
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
 \ also assembler definitions  \ You should have received a copy of the GNU General Public License
   \ along with this program; if not, write to the Free Software
   \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   
   \ contributed by Bernd Thallner
   
   require ./../../code.fs
   
   get-current
   also assembler definitions
   
 \ register  \ register
   
Line 24 Line 43
  $d constant s4   $d constant s4
  $e constant s5   $e constant s5
  $f constant fp   $f constant fp
 $10 constant a0  \ commented out to avoid shadowing hex numbers
 $11 constant a1  \  $10 constant a0
 $12 constant a2  \  $11 constant a1
 $13 constant a3  \  $12 constant a2
 $14 constant a4  \  $13 constant a3
 $15 constant a5  \  $14 constant a4
   \  $15 constant a5
 $16 constant t8  $16 constant t8
 $17 constant t9  $17 constant t9
 $18 constant t10  $18 constant t10
Line 43  $1f constant zero Line 63  $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 82  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 91  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 93  endif Line 99  endif
 4 allot  4 allot
 ;  ;
   
 \ format  \ operands
   
 : Bra ( oo )                    \ branch instruction format  : check-range ( u1 u2 u3 -- )
   create ,      within 0= -24 and throw ;
 does> ( ra, branch_disp, addr )  
   @ 26 left_shift  
   swap $1fffff and or  
   swap $1f and 21 left_shift or h,  
 ;  
   
 : Mbr ( oo.h )                  \ memory branch instruction format  : rega ( rega code -- code )
   create 2,      \ ra field, named rega to avoid conflict with register ra
 does> ( ra, rb, hint, addr )      swap dup 0 $20 check-range
   2@ 14 left_shift      21 lshift or ;
   swap 26 left_shift or  
   swap $3fff and or  : rb ( rb code -- code )
   swap $1f and 16 left_shift or      swap dup 0 $20 check-range
   swap $1f and 21 left_shift or      16 lshift or ;
   h,  
 ;   : rc ( rc code -- code )
       swap dup 0 $20 check-range
 : F-P ( oo.fff )                \ floating-point operate instruction format      or ;
   create 2,  
 does> ( fa, fb, fc, addr )  : hint ( addr code -- code )
   2@ 5 left_shift      swap 2 rshift $3fff and or ;
   swap 26 left_shift or  
   swap $1f and or  : disp ( n code -- code )
   swap $1f and 16 left_shift or      swap dup -$8000 $8000 check-range
   swap $1f and 21 left_shift or      $ffff and or ;
   h,  
 ;  : branch-rel ( n code -- code )
       swap dup 3 and 0<> -24 and throw
 : Mem ( oo )                    \ memory instruction format      2/ 2/
   create ,      dup -$100000 $100000 check-range
 does> ( ra, memory_disp, rb, addr )      $1fffff and or ;
   @ 26 left_shift  
   swap $1f and 16 left_shift or  : branch-disp ( addr code -- code )
   swap $ffff and or       swap here 4 + - swap branch-rel ;
   swap $1f and 21 left_shift or  
   h,  : imm ( u code -- code )
 ;      swap dup 0 $100 check-range
       13 lshift or ;
 : Mfc ( oo.ffff )               \ memory instruction with function code format  
   create 2,  : palcode ( u code -- code )
 does> ( ra, rb, addr )      swap dup 0 $4000000 check-range or ;
   2@  
   swap 26 left_shift or  \ formats
   swap $1f and 16 left_shift or  
   swap $1f and 21 left_shift or  : Bra ( opcode -- )                     \ branch instruction format
   h,      create 26 lshift ,
 ;  does> ( rega target-addr -- )
       @ branch-disp rega h, ;
 : Opr ( oo.ff )                 \ operate instruction format  
   create 2,  : Mbr ( opcode hint -- )                \ memory branch instruction format
 does> ( ra, rb, rc, addr )      create 14 lshift swap 26 lshift or ,
   2@  does> ( rega rb hint -- )
   5 left_shift      @ hint rb rega h, ; 
   swap 26 left_shift or  
   swap $1f and or  : F-P ( opcode func -- )        \ floating-point operate instruction format
   swap $1f and 16 left_shift or      create 5 lshift swap 26 lshift or ,
   swap $1f and 21 left_shift or  does> ( fa fb fc -- )
   h,       @ rc rb rega h, ;
 ;  
   : Mem ( opcode -- )             \ memory instruction format
 : Opr# ( oo.ff )                \ operate instruction format    create 26 lshift ,
   create 2,  does> ( rega memory_disp rb -- )
 does> ( ra, lit, rc, addr )    @ rb disp rega h, ;
   2@  
   5 left_shift  : Mfc ( opcode func -- )        \ memory instruction with function code format
   swap 26 left_shift or    create swap 26 lshift or ,
   1 12 left_shift or  does> ( rega rb -- )
   swap $1f and or    @ rb rega h, ;
   swap $ff and 13 left_shift or  
   swap $1f and 21 left_shift or  : Opr ( opcode.ff )             \ operate instruction format
   h,     create 5 lshift swap 26 lshift or ,
 ;  does> ( rega rb rc -- )
     @ rc rb rega h, ;
 : Pcd ( oo )                    \ palcode instruction format  
   create ,  : Opr# ( opcode func -- )               \ operate instruction format
 does> ( palcode, addr )    create 5 lshift swap 26 lshift or 1 12 lshift or ,
   @ 26 left_shift  does> ( rega imm rc -- )
   swap $3ffffff and or    @ rc imm rega h, ;
   h,  
 ;  : Pcd ( opcode -- )             \ palcode instruction format
     create 26 lshift ,
   does> ( palcode addr -- )
     @ palcode h, ;
   
 \ instructions  \ instructions
   
Line 205  $38       Bra  blbc, Line 209  $38       Bra  blbc,
 $3c       Bra  blbs,  $3c       Bra  blbs,
 $3b       Bra  ble,  $3b       Bra  ble,
 $3a       Bra  blt,  $3a       Bra  blt,
 $3d       Bra  bne,  $3d       Bra  bne, 
 $30       Bra  br,  $30       Bra  br,
 $34       Bra  bsr,  $34       Bra  bsr,
 $00       Pcd  call_pal,  $00       Pcd  call_pal,
Line 414  $12 $30   Opr# zap#, Line 418  $12 $30   Opr# zap#,
 $12 $31   Opr  zapnot,  $12 $31   Opr  zapnot,
 $12 $31   Opr# zapnot#,  $12 $31   Opr# zapnot#,
   
 \ structures  \ conditions; they are reversed because of the if and until logic (the
   \ stuff enclosed by if is performed if the branch around has the
 \ <register_number> if, <if_code> [ else, <else_code> ] endif,  \ inverse condition).
   
 : if,  ' beq,  constant ne
   0 beq, here 4 -  ' bge,  constant lt
 ;  ' bgt,  constant le
   ' blbc, constant lbs
 : else,  ' blbs, constant lbc
   dup here swap - 4 /  ' ble,  constant gt
   $1fffff and  ' blt,  constant ge
   over h@ or swap h!  ' bne,  constant eq
   31 0 br,  ' fbeq, constant fne
   here 4 -  ' fbge, constant flt
 ;  ' fbgt, constant fle
   ' fble, constant fgt
 : endif,  ' fblt, constant fge
   dup here swap - 4 - 4 /  ' fbne, constant feq
   $1fffff and  
   over h@ or swap h!  \ control structures
 ;  
   : magic-asm ( u1 u2 -- u3 u4 )
 \ begin, <code> again,      \ turns a magic number into an asm-magic number or back
       $fedcba0987654321 xor ;
 : begin,  
   here  : patch-branch ( behind-branch-addr target-addr -- )
 ;      \ there is a branch just before behind-branch-addr; PATCH-BRANCH
       \ patches this branch to branch to target-addr
 : again,      over - ( behind-branch-addr rel )
   here - 4 - 4 /      swap 4 - dup >r ( rel branch-addr R:branch-addr )
   $1fffff and      h@ branch-rel r> h! ; \ !! relies on the imm field being 0 before
   31 swap br,  
 ;  : if, ( reg xt -- asm-orig )
       \ xt is for a branch word ( reg addr -- )
 \ begin, <code> <register_number> until,      here 4 + swap execute \ put 0 into the disp field
       here live-orig magic-asm live-orig ;
 : until,  
   here rot swap - 4 - 4 /  : ahead, ( -- asm-orig )
   $1fffff and      zero ['] br, if, ;
   bne,  
 ;  : then, ( asm-orig -- )
       orig? magic-asm orig?
 \ begin, <register_number> while, <code> repeat,      here patch-branch ;
   
 : while,  : begin, ( -- asm-dest )
   0 beq, here 4 -      here dest magic-asm dest ;
 ;  
   : until, ( asm-dest reg xt -- )
 : repeat,      \ xt is a condition ( reg addr -- )
   swap here - 4 - 4 /      here 4 + swap execute
   $1fffff and      dest? magic-asm dest?
   31 swap br,      here swap patch-branch ;
   dup here 4 - swap - 4 /  
   $1fffff and  : again, ( asm-dest -- )
   over h@ or swap h!      zero ['] br, until, ;
 ;  
   : while, ( asm-dest -- asm-orig asm-dest )
 \ labels      if, 1 cs-roll ;
   
 10 constant mark_numbers  : else, ( asm-orig1 -- asm-orig2 )
 10 constant mark_uses      ahead, 1 cs-roll then, ;
   
 create mark_table  : repeat, ( asm-orig asm-dest -- )
 mark_numbers mark_uses 1 + * cells allot      again, then, ;
   
 : set_mark ( mark_number -- )  : endif, ( asm-orig -- )
       then, ;
 ;  
   \  \ jump marks
 : set_branch ( mark_number -- )  
   \  \ example:
 ;  
   \  \ init_marktbl               \ initializes mark table
 : calculate_marks ( -- )  \  \ 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
   
   \  \ example:
   \  \ here 31 0 br,
   \  \ here 1 2 3 addf,
   \  \ calculate_branch
   
   \  5 constant mark_numbers
   \  5 constant mark_uses
   
   \  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
   \  ;
   
   previous set-current
   
   
   
Removed from v.1.2  
changed lines
  Added in v.1.8

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