--- gforth/arch/alpha/asm.fs 1999/09/30 14:01:09 1.2 +++ gforth/arch/alpha/asm.fs 2007/12/31 18:40:25 1.10 @@ -1,10 +1,28 @@ - -\ bernd thallner 9725890 881 \ 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 3 +\ 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, see http://www.gnu.org/licenses/. + +\ contributed by Bernd Thallner + +require ./../../code.fs + +get-current +also assembler definitions \ register @@ -24,12 +42,13 @@ $d constant s4 $e constant s5 $f constant fp -$10 constant a0 -$11 constant a1 -$12 constant a2 -$13 constant a3 -$14 constant a4 -$15 constant a5 +\ commented out to avoid shadowing hex numbers +\ $10 constant a0 +\ $11 constant a1 +\ $12 constant a2 +\ $13 constant a3 +\ $14 constant a4 +\ $15 constant a5 $16 constant t8 $17 constant t9 $18 constant t10 @@ -43,27 +62,13 @@ $1f constant zero \ 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 dup dup aligned = if @ $00000000ffffffff and else 4 - @ - $20 right_shift + $20 rshift endif ; @@ -76,7 +81,7 @@ dup dup aligned = if else 4 - dup @ $00000000ffffffff and - rot $20 left_shift or + rot $20 lshift or swap ! endif ; @@ -85,7 +90,7 @@ endif here here aligned = if here ! else - 32 left_shift + 32 lshift here 4 - dup @ rot or swap ! @@ -93,90 +98,88 @@ endif 4 allot ; -\ format +\ operands -: Bra ( oo ) \ branch instruction format - create , -does> ( ra, branch_disp, addr ) - @ 26 left_shift - swap $1fffff and or - swap $1f and 21 left_shift or h, -; +: check-range ( u1 u2 u3 -- ) + within 0= -24 and throw ; -: Mbr ( oo.h ) \ memory branch instruction format - create 2, -does> ( ra, rb, hint, addr ) - 2@ 14 left_shift - swap 26 left_shift or - swap $3fff and or - swap $1f and 16 left_shift or - swap $1f and 21 left_shift or - h, -; - -: F-P ( oo.fff ) \ floating-point operate instruction format - create 2, -does> ( fa, fb, fc, addr ) - 2@ 5 left_shift - swap 26 left_shift or - swap $1f and or - swap $1f and 16 left_shift or - swap $1f and 21 left_shift or - h, -; - -: Mem ( oo ) \ memory instruction format - create , -does> ( ra, memory_disp, rb, addr ) - @ 26 left_shift - swap $1f and 16 left_shift or - swap $ffff and or - swap $1f and 21 left_shift or - h, -; - -: Mfc ( oo.ffff ) \ memory instruction with function code format - create 2, -does> ( ra, rb, addr ) - 2@ - swap 26 left_shift or - swap $1f and 16 left_shift or - swap $1f and 21 left_shift or - h, -; - -: Opr ( oo.ff ) \ operate instruction format - create 2, -does> ( ra, rb, rc, addr ) - 2@ - 5 left_shift - swap 26 left_shift or - swap $1f and or - swap $1f and 16 left_shift or - swap $1f and 21 left_shift or - h, -; - -: Opr# ( oo.ff ) \ operate instruction format - create 2, -does> ( ra, lit, rc, addr ) - 2@ - 5 left_shift - swap 26 left_shift or - 1 12 left_shift or - swap $1f and or - swap $ff and 13 left_shift or - swap $1f and 21 left_shift or - h, -; - -: Pcd ( oo ) \ palcode instruction format - create , -does> ( palcode, addr ) - @ 26 left_shift - swap $3ffffff and or - h, -; +: rega ( rega code -- code ) + \ ra field, named rega to avoid conflict with register ra + swap dup 0 $20 check-range + 21 lshift or ; + +: rb ( rb code -- code ) + swap dup 0 $20 check-range + 16 lshift or ; + +: rc ( rc code -- code ) + swap dup 0 $20 check-range + or ; + +: hint ( addr code -- code ) + swap 2 rshift $3fff and or ; + +: disp ( n code -- code ) + swap dup -$8000 $8000 check-range + $ffff and or ; + +: branch-rel ( n code -- code ) + swap dup 3 and 0<> -24 and throw + 2/ 2/ + dup -$100000 $100000 check-range + $1fffff and or ; + +: branch-disp ( addr code -- code ) + swap here 4 + - swap branch-rel ; + +: imm ( u code -- code ) + swap dup 0 $100 check-range + 13 lshift or ; + +: palcode ( u code -- code ) + swap dup 0 $4000000 check-range or ; + +\ formats + +: Bra ( opcode -- ) \ branch instruction format + create 26 lshift , +does> ( rega target-addr -- ) + @ branch-disp rega h, ; + +: Mbr ( opcode hint -- ) \ memory branch instruction format + create 14 lshift swap 26 lshift or , +does> ( rega rb hint -- ) + @ hint rb rega h, ; + +: F-P ( opcode func -- ) \ floating-point operate instruction format + create 5 lshift swap 26 lshift or , +does> ( fa fb fc -- ) + @ rc rb rega h, ; + +: Mem ( opcode -- ) \ memory instruction format + create 26 lshift , +does> ( rega memory_disp rb -- ) + @ rb disp rega h, ; + +: Mfc ( opcode func -- ) \ memory instruction with function code format + create swap 26 lshift or , +does> ( rega rb -- ) + @ rb rega h, ; + +: Opr ( opcode.ff ) \ operate instruction format + create 5 lshift swap 26 lshift or , +does> ( rega rb rc -- ) + @ rc rb rega h, ; + +: Opr# ( opcode func -- ) \ operate instruction format + create 5 lshift swap 26 lshift or 1 12 lshift or , +does> ( rega imm rc -- ) + @ rc imm rega h, ; + +: Pcd ( opcode -- ) \ palcode instruction format + create 26 lshift , +does> ( palcode addr -- ) + @ palcode h, ; \ instructions @@ -205,7 +208,7 @@ $38 Bra blbc, $3c Bra blbs, $3b Bra ble, $3a Bra blt, -$3d Bra bne, +$3d Bra bne, $30 Bra br, $34 Bra bsr, $00 Pcd call_pal, @@ -414,86 +417,175 @@ $12 $30 Opr# zap#, $12 $31 Opr zapnot, $12 $31 Opr# zapnot#, -\ structures - -\ if, [ else, ] endif, - -: if, - 0 beq, here 4 - -; - -: else, - dup here swap - 4 / - $1fffff and - over h@ or swap h! - 31 0 br, - here 4 - -; - -: endif, - dup here swap - 4 - 4 / - $1fffff and - over h@ or swap h! -; - -\ begin, again, - -: begin, - here -; - -: again, - here - 4 - 4 / - $1fffff and - 31 swap br, -; - -\ begin, until, - -: until, - here rot swap - 4 - 4 / - $1fffff and - bne, -; - -\ begin, while, repeat, - -: while, - 0 beq, here 4 - -; - -: repeat, - swap here - 4 - 4 / - $1fffff and - 31 swap br, - dup here 4 - swap - 4 / - $1fffff and - over h@ or swap h! -; - -\ labels - -10 constant mark_numbers -10 constant mark_uses - -create mark_table -mark_numbers mark_uses 1 + * cells allot - -: set_mark ( mark_number -- ) - -; - -: set_branch ( mark_number -- ) - -; - -: calculate_marks ( -- ) - -; - - - +\ conditions; they are reversed because of the if and until logic (the +\ stuff enclosed by if is performed if the branch around has the +\ inverse condition). + +' beq, constant ne +' bge, constant lt +' bgt, constant le +' blbc, constant lbs +' blbs, constant lbc +' ble, constant gt +' blt, constant ge +' bne, constant eq +' fbeq, constant fne +' fbge, constant flt +' fbgt, constant fle +' fble, constant fgt +' fblt, constant fge +' fbne, constant feq + +\ control structures + +: magic-asm ( u1 u2 -- u3 u4 ) + \ turns a magic number into an asm-magic number or back + $fedcba0987654321 xor ; + +: 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 + over - ( behind-branch-addr rel ) + swap 4 - dup >r ( rel branch-addr R:branch-addr ) + h@ branch-rel r> h! ; \ !! relies on the imm field being 0 before + +: if, ( reg xt -- asm-orig ) + \ xt is for a branch word ( reg addr -- ) + here 4 + swap execute \ put 0 into the disp field + here live-orig magic-asm live-orig ; + +: ahead, ( -- asm-orig ) + zero ['] br, if, ; + +: then, ( asm-orig -- ) + orig? magic-asm orig? + here patch-branch ; + +: begin, ( -- asm-dest ) + here dest magic-asm dest ; + +: until, ( asm-dest reg xt -- ) + \ xt is a condition ( reg addr -- ) + here 4 + swap execute + dest? magic-asm dest? + here swap patch-branch ; + +: again, ( asm-dest -- ) + zero ['] br, until, ; + +: while, ( asm-dest -- asm-orig asm-dest ) + if, 1 cs-roll ; + +: else, ( asm-orig1 -- asm-orig2 ) + ahead, 1 cs-roll then, ; + +: repeat, ( asm-orig asm-dest -- ) + again, then, ; + +: endif, ( asm-orig -- ) + then, ; + +\ \ jump marks + +\ \ example: + +\ \ 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 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