version 1.1, 1999/02/02 22:02:54
|
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. |
|
|
|
\ 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 |
also assembler definitions |
|
|
|
\ register |
|
|
$0 constant v0 |
$0 constant v0 |
$1 constant t0 |
$1 constant t0 |
$2 constant t1 |
$2 constant t1 |
Line 21 also assembler definitions
|
Line 43 also assembler definitions
|
$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 38 $1d constant gp
|
Line 61 $1d constant gp
|
$1e constant sp |
$1e constant sp |
$1f constant zero |
$1f constant zero |
|
|
: shift ( a n -- a<<=n ) |
\ util |
0 |
|
?do |
: h@ ( addr -- n ) \ 32 bit fetch |
2* |
dup dup aligned = if |
loop |
@ |
|
$00000000ffffffff and |
|
else |
|
4 - @ |
|
$20 rshift |
|
endif |
|
; |
|
|
|
: h! ( n addr -- ) \ 32 bit store |
|
dup dup aligned = if |
|
dup @ |
|
$ffffffff00000000 and |
|
rot or |
|
swap ! |
|
else |
|
4 - dup @ |
|
$00000000ffffffff and |
|
rot $20 lshift or |
|
swap ! |
|
endif |
; |
; |
|
|
: h, ( h -- ) \ 32 bit store |
: h, ( h -- ) \ 32 bit store + allot |
here here aligned = if |
here here aligned = if |
here ! |
here ! |
else |
else |
32 shift |
32 lshift |
here 4 - dup |
here 4 - dup |
@ rot or |
@ rot or |
swap ! |
swap ! |
Line 57 endif
|
Line 99 endif
|
4 allot |
4 allot |
; |
; |
|
|
: Bra ( oo ) \ branch instruction format |
\ operands |
create , |
|
does> ( ra, branch_disp, addr ) |
|
@ 26 shift |
|
swap $1fffff and or |
|
swap $1f and 21 shift or h, |
|
; |
|
|
|
: Mbr ( oo.h ) \ memory branch instruction format |
|
create 2, |
|
does> ( ra, rb, hint, addr ) |
|
2@ 14 shift |
|
swap 26 shift or |
|
swap $3fff and or |
|
swap $1f and 16 shift or |
|
swap $1f and 21 shift or |
|
h, |
|
; |
|
|
|
: F-P ( oo.fff ) \ floating-point operate instruction format |
|
create 2, |
|
does> ( fa, fb, fc, addr ) |
|
2@ 5 shift |
|
swap 26 shift or |
|
swap $1f and or |
|
swap $1f and 16 shift or |
|
swap $1f and 21 shift or |
|
h, |
|
; |
|
|
|
: Mem ( oo ) \ memory instruction format |
: check-range ( u1 u2 u3 -- ) |
create , |
within 0= -24 and throw ; |
does> ( ra, memory_disp, rb, addr ) |
|
@ 26 shift |
|
swap $1f and 16 shift or |
|
swap $ffff and or |
|
swap $1f and 21 shift or |
|
h, |
|
; |
|
|
|
: Mfc ( oo.ffff ) \ memory instruction with function code format |
: rega ( rega code -- code ) |
create 2, |
\ ra field, named rega to avoid conflict with register ra |
does> ( ra, rb, addr ) |
swap dup 0 $20 check-range |
2@ |
21 lshift or ; |
swap 26 shift or |
|
swap $1f and 16 shift or |
: rb ( rb code -- code ) |
swap $1f and 21 shift or |
swap dup 0 $20 check-range |
h, |
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, ; |
|
|
: Opr ( oo.ff ) \ operate instruction format |
\ instructions |
create 2, |
|
does> ( ra, rb, rc, addr ) |
|
2@ |
|
5 shift |
|
swap 26 shift or |
|
swap $1f and or |
|
swap $1f and 16 shift or |
|
swap $1f and 21 shift or |
|
h, |
|
; |
|
|
|
: Opr# ( oo.ff ) \ operate instruction format |
|
create 2, |
|
does> ( ra, lit, rc, addr ) |
|
2@ |
|
5 shift |
|
swap 26 shift or |
|
1 12 shift or |
|
swap $1f and or |
|
swap $ff and 13 shift or |
|
swap $1f and 21 shift or |
|
h, |
|
; |
|
|
|
: Pcd ( oo ) \ palcode instruction format |
|
create , |
|
does> ( palcode, addr ) |
|
@ 26 shift |
|
swap $3ffffff and or |
|
h, |
|
; |
|
|
|
$15 $80 F-P addf, |
$15 $80 F-P addf, |
$15 $a0 F-P addg, |
$15 $a0 F-P addg, |
Line 165 $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 374 $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#, |
|
|
|
\ 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 <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 |
|
|
|
|
|
|