version 1.2, 1999/09/30 14:01:09
|
version 1.4, 2000/06/17 12:01:55
|
Line 2
|
Line 2
|
\ bernd thallner 9725890 881 |
\ bernd thallner 9725890 881 |
\ assembler in forth for alpha |
\ assembler in forth for alpha |
|
|
\ requires code.fs |
\ require ../../code.fs |
|
|
\ also assembler definitions |
get-current |
|
also assembler definitions |
|
|
\ register |
\ register |
|
|
Line 24
|
Line 25
|
$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 45 $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 64 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 73 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 86 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 127 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 137 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 149 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 406 $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 442 $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 450 $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, |
|
swap here - 4 - 4 / |
: repeat, ( asmorig asmdest -- ) |
$1fffff and |
again, |
31 swap br, |
endif, |
dup here 4 - swap - 4 / |
; |
$1fffff and |
|
over h@ or swap h! |
\ \ jump marks |
; |
|
|
\ \ example: |
\ labels |
|
|
\ \ init_marktbl \ initializes mark table |
10 constant mark_numbers |
\ \ 31 0 br, |
10 constant mark_uses |
\ \ 0 store_branch \ store jump address for mark 0 |
|
\ \ 1 2 3 addf, |
create mark_table |
\ \ 0 set_mark \ store mark 0 |
mark_numbers mark_uses 1 + * cells allot |
\ \ 2 3 4 addf, |
|
\ \ 2 0 beq, |
: set_mark ( mark_number -- ) |
\ \ 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 |
: set_branch ( mark_number -- ) |
\ \ displacement field without the mark_table for one branch |
|
|
; |
\ \ example: |
|
\ \ here 31 0 br, |
: calculate_marks ( -- ) |
\ \ 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 |
|
|
|
|