version 1.5, 2000/06/17 19:38:28
|
version 1.10, 2007/12/31 18:40:25
|
Line 1
|
Line 1
|
|
|
\ bernd thallner 9725890 881 |
|
\ assembler in forth for alpha |
\ assembler in forth for alpha |
|
|
\ require ../../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. |
|
|
|
\ 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 |
get-current |
also assembler definitions |
also assembler definitions |
Line 106 endif
|
Line 123 endif
|
swap dup -$8000 $8000 check-range |
swap dup -$8000 $8000 check-range |
$ffff and or ; |
$ffff and or ; |
|
|
: branch-disp ( addr code -- code ) |
: branch-rel ( n code -- code ) |
swap here 4 + - |
swap dup 3 and 0<> -24 and throw |
dup 3 and 0<> -24 and throw |
2/ 2/ |
dup -$100000 $100000 check-range |
dup -$100000 $100000 check-range |
$1fffff and or ; |
$1fffff and or ; |
|
|
|
: branch-disp ( addr code -- code ) |
|
swap here 4 + - swap branch-rel ; |
|
|
: imm ( u code -- code ) |
: imm ( u code -- code ) |
swap dup 0 $100 check-range |
swap dup 0 $100 check-range |
13 lshift or ; |
13 lshift or ; |
Line 397 $12 $30 Opr# zap#,
|
Line 417 $12 $30 Opr# zap#,
|
$12 $31 Opr zapnot, |
$12 $31 Opr zapnot, |
$12 $31 Opr# zapnot#, |
$12 $31 Opr# zapnot#, |
|
|
\ conditions |
\ 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 |
' beq, constant ne |
' bge, constant lt |
' bge, constant lt |
Line 416 $12 $31 Opr# zapnot#,
|
Line 438 $12 $31 Opr# zapnot#,
|
|
|
\ control structures |
\ control structures |
|
|
\ <register_number> if, <if_code> [ else, <else_code> ] endif, |
: magic-asm ( u1 u2 -- u3 u4 ) |
|
\ turns a magic number into an asm-magic number or back |
\ : magic-asm ( u1 u2 -- u3 u4 ) |
$fedcba0987654321 xor ; |
\ \ 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 |
\ : patch-branch ( branch-delay-addr target-addr -- ) |
\ patches this branch to branch to target-addr |
\ \ there is a branch just before branch-delay-addr; PATCH-BRANCH |
over - ( behind-branch-addr rel ) |
\ \ patches this branch to branch to target-addr |
swap 4 - dup >r ( rel branch-addr R:branch-addr ) |
\ over - ( branch-delay-addr rel ) |
h@ branch-rel r> h! ; \ !! relies on the imm field being 0 before |
\ swap cell - dup >r ( rel branch-addr R:branch-addr ) |
|
\ @ asm-rel r> ! ; \ !! 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, ( -- asmorig ) |
|
31 0 br, |
: ahead, ( -- asm-orig ) |
here 4 - |
zero ['] br, if, ; |
; |
|
|
: then, ( asm-orig -- ) |
: if, ( -- asmorig ) |
orig? magic-asm orig? |
0 beq, |
here patch-branch ; |
here 4 - |
|
; |
: begin, ( -- asm-dest ) |
|
here dest magic-asm dest ; |
: endif, ( asmorig -- ) |
|
dup here swap - 4 - 4 / |
: until, ( asm-dest reg xt -- ) |
$1fffff and |
\ xt is a condition ( reg addr -- ) |
over h@ or swap h! |
here 4 + swap execute |
; |
dest? magic-asm dest? |
|
here swap patch-branch ; |
: else, ( asmorig1 -- asmorig2 ) |
|
ahead, |
: again, ( asm-dest -- ) |
swap |
zero ['] br, until, ; |
endif, |
|
; |
: while, ( asm-dest -- asm-orig asm-dest ) |
|
if, 1 cs-roll ; |
\ begin, <code> again, |
|
|
|
: begin, ( -- asmdest ) |
|
here |
|
; |
|
|
|
: again, ( asmdest -- ) |
|
here - 4 - 4 / |
|
$1fffff and |
|
31 swap br, |
|
; |
|
|
|
\ begin, <code> <register_number> until, |
|
|
|
: until, ( asmdest -- ) |
: else, ( asm-orig1 -- asm-orig2 ) |
here rot swap - 4 - 4 / |
ahead, 1 cs-roll then, ; |
$1fffff and |
|
bne, |
|
; |
|
|
|
\ begin, <register_number> while, <code> repeat, |
|
|
|
: while, ( asmdest -- asmorig asmdest ) |
: repeat, ( asm-orig asm-dest -- ) |
if, |
again, then, ; |
swap |
|
; |
|
|
|
: repeat, ( asmorig asmdest -- ) |
: endif, ( asm-orig -- ) |
again, |
then, ; |
endif, |
|
; |
|
|
|
\ \ jump marks |
\ \ jump marks |
|
|