| 1 : |
pazsan
|
1.1
|
\ generic.fs implements generic assembler definitions 13aug97jaw |
| 2 : |
|
|
|
| 3 : |
anton
|
1.5
|
\ Copyright (C) 1998,2000,2003 Free Software Foundation, Inc. |
| 4 : |
anton
|
1.2
|
|
| 5 : |
|
|
\ This file is part of Gforth. |
| 6 : |
|
|
|
| 7 : |
|
|
\ Gforth is free software; you can redistribute it and/or |
| 8 : |
|
|
\ modify it under the terms of the GNU General Public License |
| 9 : |
|
|
\ as published by the Free Software Foundation; either version 2 |
| 10 : |
|
|
\ of the License, or (at your option) any later version. |
| 11 : |
|
|
|
| 12 : |
|
|
\ This program is distributed in the hope that it will be useful, |
| 13 : |
|
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 : |
|
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 : |
|
|
\ GNU General Public License for more details. |
| 16 : |
|
|
|
| 17 : |
|
|
\ You should have received a copy of the GNU General Public License |
| 18 : |
|
|
\ along with this program; if not, write to the Free Software |
| 19 : |
anton
|
1.3
|
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
| 20 : |
pazsan
|
1.1
|
|
| 21 : |
|
|
\ These are generic routines to build up a table-driven assembler |
| 22 : |
|
|
\ fo any modern (RISC)-CPU |
| 23 : |
|
|
|
| 24 : |
|
|
\ Revision Log: |
| 25 : |
|
|
\ |
| 26 : |
|
|
\ 13aug97jaw-14aug97 Initial Version -> V0.5 |
| 27 : |
|
|
\ ToDo: operand count checking |
| 28 : |
|
|
\ |
| 29 : |
|
|
|
| 30 : |
|
|
\ general definitions |
| 31 : |
|
|
|
| 32 : |
|
|
: clearstack depth 0 ?DO drop LOOP ; |
| 33 : |
|
|
|
| 34 : |
|
|
\ redefinitions to avoid conflicts |
| 35 : |
|
|
|
| 36 : |
|
|
' , ALIAS dic, |
| 37 : |
|
|
' NOOP ALIAS X |
| 38 : |
|
|
|
| 39 : |
|
|
\ ------------ Modes |
| 40 : |
|
|
|
| 41 : |
|
|
[IFUNDEF] modes# |
| 42 : |
|
|
4 Constant modes# |
| 43 : |
|
|
[THEN] |
| 44 : |
|
|
|
| 45 : |
|
|
Create modes modes# cells allot \ Modes for differend operands are stored here |
| 46 : |
|
|
\ Example: |
| 47 : |
|
|
\ Offset 0: general modifier ( .B, .W, .L) |
| 48 : |
|
|
\ Offset 1: addressing mode operand 1 |
| 49 : |
|
|
\ Offset 2: addressing mode operand 2 |
| 50 : |
|
|
|
| 51 : |
|
|
: Mode-Compare ( adr1 adr2 -- flag ) |
| 52 : |
|
|
modes# |
| 53 : |
|
|
BEGIN dup WHILE >r 2dup @ swap @ <> IF rdrop 2drop false EXIT THEN |
| 54 : |
|
|
cell+ swap cell+ r> 1- |
| 55 : |
|
|
REPEAT drop 2drop true ; |
| 56 : |
|
|
|
| 57 : |
|
|
Variable Start-Depth |
| 58 : |
|
|
Variable Mode# |
| 59 : |
|
|
|
| 60 : |
|
|
: reset |
| 61 : |
|
|
modes modes# cells erase |
| 62 : |
|
|
1 Mode# ! |
| 63 : |
|
|
depth Start-Depth ! ; |
| 64 : |
|
|
|
| 65 : |
|
|
: Mode! ( n -- ) |
| 66 : |
|
|
Modes Mode# @ cells + ! ; |
| 67 : |
|
|
|
| 68 : |
|
|
: +Mode! ( n -- ) |
| 69 : |
|
|
Modes Mode# @ cells + tuck @ or swap ! ; |
| 70 : |
|
|
|
| 71 : |
|
|
: 0Mode! ( n -- ) |
| 72 : |
|
|
Modes ! ; |
| 73 : |
|
|
|
| 74 : |
|
|
: , |
| 75 : |
|
|
1 Mode# +! ; |
| 76 : |
|
|
|
| 77 : |
|
|
: Mode |
| 78 : |
|
|
Create dic, DOES> @ +Mode! ; |
| 79 : |
|
|
|
| 80 : |
|
|
: 0Mode |
| 81 : |
|
|
Create dic, DOES> @ 0Mode! ; |
| 82 : |
|
|
|
| 83 : |
|
|
: Reg |
| 84 : |
|
|
Create dic, dic, DOES> dup perform cell+ @ ; |
| 85 : |
|
|
|
| 86 : |
|
|
\ --------- Instruction Latch |
| 87 : |
|
|
|
| 88 : |
|
|
Create I-Latch 10 chars allot |
| 89 : |
|
|
Variable I-Len |
| 90 : |
|
|
|
| 91 : |
|
|
: opc! ( adr len -- ) |
| 92 : |
|
|
dup I-Len @ max I-Len ! |
| 93 : |
|
|
I-Latch -rot bounds DO I c@ over c@ or over c! char+ LOOP drop ; |
| 94 : |
|
|
|
| 95 : |
|
|
: I-Init 0 I-Len ! I-Latch 10 erase ; |
| 96 : |
|
|
: I-Flush I-Latch I-len @ bounds DO i c@ X c, LOOP reset ; |
| 97 : |
|
|
|
| 98 : |
|
|
: (g!) ( val addr n -1/1 -- ) |
| 99 : |
|
|
dup 0< IF rot 2 pick + 1- -rot THEN |
| 100 : |
|
|
swap >r -rot r> 0 |
| 101 : |
|
|
DO 2dup c! 2 pick + swap 8 rshift swap LOOP |
| 102 : |
|
|
2drop drop ; |
| 103 : |
|
|
|
| 104 : |
|
|
: (g@) ( addr n -1/1 -- val ) |
| 105 : |
|
|
negate dup 0< IF rot 2 pick + 1- -rot THEN |
| 106 : |
|
|
swap >r swap 0 swap r> 0 |
| 107 : |
|
|
DO swap 8 lshift over c@ or swap 2 pick + LOOP |
| 108 : |
|
|
drop nip ; |
| 109 : |
|
|
|
| 110 : |
|
|
Variable ByteDirection \ -1 = big endian; 1 = little endian |
| 111 : |
|
|
|
| 112 : |
|
|
: g@ ByteDirection @ (g@) ; |
| 113 : |
|
|
: g! ByteDirection @ (g!) ; |
| 114 : |
|
|
|
| 115 : |
|
|
\ ---------------- Tables |
| 116 : |
|
|
|
| 117 : |
|
|
: >modes ( addr -- addr ) 5 cells + ; |
| 118 : |
|
|
: >data ( addr -- addr ) >modes modes# cells + ; |
| 119 : |
|
|
|
| 120 : |
|
|
0 Value Describ |
| 121 : |
|
|
|
| 122 : |
|
|
: Table-Exec ( addr -- ) |
| 123 : |
|
|
to Describ |
| 124 : |
|
|
Describ 2 cells + perform \ to store the opcode |
| 125 : |
|
|
Describ 3 cells + perform \ to store the operands |
| 126 : |
|
|
Describ 4 cells + perform \ to flush the instruction |
| 127 : |
|
|
; |
| 128 : |
|
|
|
| 129 : |
|
|
: 1st-mc ( addr -- flag ) |
| 130 : |
|
|
dup >modes modes Mode-Compare |
| 131 : |
|
|
IF Table-Exec |
| 132 : |
|
|
true |
| 133 : |
|
|
ELSE false |
| 134 : |
|
|
THEN ; |
| 135 : |
|
|
|
| 136 : |
|
|
: 1st-always ( addr -- flag ) |
| 137 : |
|
|
Table-Exec true ; |
| 138 : |
|
|
|
| 139 : |
|
|
: 1st-thru |
| 140 : |
|
|
dup Table-Exec false ; |
| 141 : |
|
|
|
| 142 : |
|
|
: 2nd-opc! |
| 143 : |
|
|
Describ >data count opc! ; |
| 144 : |
|
|
|
| 145 : |
|
|
: opcode, |
| 146 : |
|
|
here 0 c, |
| 147 : |
|
|
BEGIN bl word count dup WHILE s>number drop c, |
| 148 : |
|
|
REPEAT 2drop here over - 1- swap c! ; |
| 149 : |
|
|
|
| 150 : |
|
|
: modes, |
| 151 : |
|
|
modes# 0 DO I cells modes + @ dic, LOOP ; |
| 152 : |
|
|
|
| 153 : |
|
|
0 Value Table-Link |
| 154 : |
|
|
|
| 155 : |
|
|
: Table |
| 156 : |
|
|
Reset |
| 157 : |
|
|
Create here to Table-Link 0 dic, |
| 158 : |
|
|
DOES> I-Init |
| 159 : |
|
|
BEGIN @ dup WHILE dup |
| 160 : |
|
|
cell+ perform \ first element is executed always |
| 161 : |
|
|
\ makes check |
| 162 : |
|
|
?EXIT |
| 163 : |
|
|
REPEAT -1 ABORT" no valid mode!" |
| 164 : |
|
|
; |
| 165 : |
|
|
|
| 166 : |
|
|
: Follows |
| 167 : |
|
|
' >body @ Table-Link @ ! ; |
| 168 : |
|
|
|
| 169 : |
|
|
: opc, |
| 170 : |
|
|
modes, opcode, clearstack reset ; |
| 171 : |
|
|
|
| 172 : |
|
|
: (Opc() |
| 173 : |
|
|
\ Opcode with Operands |
| 174 : |
|
|
['] 1st-mc dic, |
| 175 : |
|
|
['] 2nd-opc! dic, |
| 176 : |
|
|
dic, |
| 177 : |
|
|
['] I-Flush dic, |
| 178 : |
|
|
opc, ; |
| 179 : |
|
|
|
| 180 : |
|
|
: (Opc) |
| 181 : |
|
|
\ Opcode without Operands |
| 182 : |
|
|
['] 1st-always dic, |
| 183 : |
|
|
['] 2nd-opc! dic, |
| 184 : |
|
|
['] Noop dic, |
| 185 : |
|
|
['] I-Flush dic, |
| 186 : |
|
|
opc, ; |
| 187 : |
|
|
|
| 188 : |
|
|
: Opc( |
| 189 : |
|
|
\ Opcode with Operands |
| 190 : |
|
|
Table-Link linked |
| 191 : |
|
|
(Opc() ; |
| 192 : |
|
|
|
| 193 : |
|
|
: Opc |
| 194 : |
|
|
\ Opcode without Operands |
| 195 : |
|
|
Table-Link linked |
| 196 : |
|
|
(Opc) ; |
| 197 : |
|
|
|
| 198 : |
|
|
: Opc+ |
| 199 : |
|
|
\ Additional Opcode |
| 200 : |
|
|
Table-Link linked |
| 201 : |
|
|
['] 1st-thru dic, |
| 202 : |
|
|
['] 2nd-opc! dic, |
| 203 : |
|
|
['] Noop dic, |
| 204 : |
|
|
['] Noop dic, |
| 205 : |
|
|
opc, ; |
| 206 : |
|
|
|
| 207 : |
|
|
: Opc(+ |
| 208 : |
|
|
\ Additional Opcode with Operands |
| 209 : |
|
|
Table-Link linked |
| 210 : |
|
|
['] 1st-thru dic, |
| 211 : |
|
|
['] 2nd-opc! dic, |
| 212 : |
|
|
dic, |
| 213 : |
|
|
['] Noop dic, |
| 214 : |
|
|
opc, ; |
| 215 : |
|
|
|
| 216 : |
|
|
: End-Table ; |
| 217 : |
|
|
|
| 218 : |
|
|
: alone |
| 219 : |
|
|
Create 0 dic, ( Dummy Linkfield ) (opc) |
| 220 : |
|
|
DOES> dup cell+ perform 0= ABORT" must work always!" ; |
| 221 : |
|
|
|
| 222 : |
|
|
: alone( |
| 223 : |
|
|
Create 0 dic, ( Dummy Linkfield ) (opc() |
| 224 : |
|
|
DOES> dup cell+ perform 0= ABORT" must work always!" ; |