| 1 : |
pazsan
|
1.1
|
\ generic.fs implements generic assembler definitions 13aug97jaw |
| 2 : |
|
|
|
| 3 : |
anton
|
1.7
|
\ Copyright (C) 1998,2000,2003,2007 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 : |
anton
|
1.6
|
\ as published by the Free Software Foundation, either version 3 |
| 10 : |
anton
|
1.2
|
\ 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 : |
anton
|
1.6
|
\ along with this program. If not, see http://www.gnu.org/licenses/. |
| 19 : |
pazsan
|
1.1
|
|
| 20 : |
|
|
\ These are generic routines to build up a table-driven assembler |
| 21 : |
|
|
\ fo any modern (RISC)-CPU |
| 22 : |
|
|
|
| 23 : |
|
|
\ Revision Log: |
| 24 : |
|
|
\ |
| 25 : |
|
|
\ 13aug97jaw-14aug97 Initial Version -> V0.5 |
| 26 : |
|
|
\ ToDo: operand count checking |
| 27 : |
dvdkhlng
|
1.8
|
\ |
| 28 : |
|
|
\ 24apr10dk Added documentation |
| 29 : |
pazsan
|
1.1
|
|
| 30 : |
|
|
\ general definitions |
| 31 : |
|
|
|
| 32 : |
dvdkhlng
|
1.8
|
: clearstack ( k*x -- ) depth 0 ?DO drop LOOP ; |
| 33 : |
pazsan
|
1.1
|
|
| 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 : |
dvdkhlng
|
1.8
|
: reset ( -- ) |
| 61 : |
|
|
\G End an opcode / star a new opcode. |
| 62 : |
pazsan
|
1.1
|
modes modes# cells erase |
| 63 : |
|
|
1 Mode# ! |
| 64 : |
|
|
depth Start-Depth ! ; |
| 65 : |
|
|
|
| 66 : |
dvdkhlng
|
1.8
|
: Mode! ( x -- ) |
| 67 : |
|
|
\G Set current operand's mode to X |
| 68 : |
pazsan
|
1.1
|
Modes Mode# @ cells + ! ; |
| 69 : |
|
|
|
| 70 : |
dvdkhlng
|
1.8
|
: +Mode! ( x -- ) |
| 71 : |
|
|
\G Logically OR X to current operand's mode |
| 72 : |
pazsan
|
1.1
|
Modes Mode# @ cells + tuck @ or swap ! ; |
| 73 : |
|
|
|
| 74 : |
dvdkhlng
|
1.8
|
: 0Mode! ( x -- ) |
| 75 : |
|
|
\G Set mode of operand #0. Use operand #0 for an (optional) operands that |
| 76 : |
|
|
\G can be placed anywhere, e.g. condition codes or operand lengths .B .W .L |
| 77 : |
|
|
\G etc. |
| 78 : |
pazsan
|
1.1
|
Modes ! ; |
| 79 : |
|
|
|
| 80 : |
dvdkhlng
|
1.8
|
: , ( -- ) |
| 81 : |
|
|
\G Advance to next operand |
| 82 : |
pazsan
|
1.1
|
1 Mode# +! ; |
| 83 : |
|
|
|
| 84 : |
dvdkhlng
|
1.8
|
: Mode ( x "name" -- ) |
| 85 : |
|
|
\G Define a new mode that logically ors X to current mode when executed |
| 86 : |
pazsan
|
1.1
|
Create dic, DOES> @ +Mode! ; |
| 87 : |
|
|
|
| 88 : |
dvdkhlng
|
1.8
|
: 0Mode ( x "name" -- ) |
| 89 : |
|
|
\G Define a new mode that sets operand #0 when executed |
| 90 : |
pazsan
|
1.1
|
Create dic, DOES> @ 0Mode! ; |
| 91 : |
|
|
|
| 92 : |
dvdkhlng
|
1.8
|
: Reg ( xt x "name" -- ) |
| 93 : |
|
|
\G Define a parametrized mode, that executes mode XT, then puts X onto the |
| 94 : |
|
|
\G stack |
| 95 : |
pazsan
|
1.1
|
Create dic, dic, DOES> dup perform cell+ @ ; |
| 96 : |
|
|
|
| 97 : |
|
|
\ --------- Instruction Latch |
| 98 : |
|
|
|
| 99 : |
|
|
Create I-Latch 10 chars allot |
| 100 : |
|
|
Variable I-Len |
| 101 : |
|
|
|
| 102 : |
|
|
: opc! ( adr len -- ) |
| 103 : |
dvdkhlng
|
1.8
|
\G Logically OR string of bytes into instruction latch |
| 104 : |
pazsan
|
1.1
|
dup I-Len @ max I-Len ! |
| 105 : |
dvdkhlng
|
1.9
|
I-Latch -rot bounds ?DO I c@ over c@ or over c! char+ LOOP drop ; |
| 106 : |
pazsan
|
1.1
|
|
| 107 : |
dvdkhlng
|
1.8
|
: I-Init ( -- ) 0 I-Len ! I-Latch 10 erase ; |
| 108 : |
|
|
: I-Flush ( -- ) |
| 109 : |
|
|
\G Append contents of instruction latch to dictionary |
| 110 : |
|
|
I-Latch I-len @ bounds DO i c@ X c, LOOP reset ; |
| 111 : |
pazsan
|
1.1
|
|
| 112 : |
|
|
: (g!) ( val addr n -1/1 -- ) |
| 113 : |
|
|
dup 0< IF rot 2 pick + 1- -rot THEN |
| 114 : |
|
|
swap >r -rot r> 0 |
| 115 : |
|
|
DO 2dup c! 2 pick + swap 8 rshift swap LOOP |
| 116 : |
|
|
2drop drop ; |
| 117 : |
|
|
|
| 118 : |
|
|
: (g@) ( addr n -1/1 -- val ) |
| 119 : |
|
|
negate dup 0< IF rot 2 pick + 1- -rot THEN |
| 120 : |
|
|
swap >r swap 0 swap r> 0 |
| 121 : |
|
|
DO swap 8 lshift over c@ or swap 2 pick + LOOP |
| 122 : |
|
|
drop nip ; |
| 123 : |
|
|
|
| 124 : |
|
|
Variable ByteDirection \ -1 = big endian; 1 = little endian |
| 125 : |
|
|
|
| 126 : |
dvdkhlng
|
1.8
|
: g@ ( addr n -- val ) |
| 127 : |
|
|
\G read n-byte integer from addr using current endianess |
| 128 : |
|
|
ByteDirection @ (g@) ; |
| 129 : |
|
|
: g! ( val addr n -- ) |
| 130 : |
|
|
\G write n-byte integer to addr using current endianess |
| 131 : |
|
|
ByteDirection @ (g!) ; |
| 132 : |
pazsan
|
1.1
|
|
| 133 : |
|
|
\ ---------------- Tables |
| 134 : |
|
|
|
| 135 : |
|
|
: >modes ( addr -- addr ) 5 cells + ; |
| 136 : |
|
|
: >data ( addr -- addr ) >modes modes# cells + ; |
| 137 : |
|
|
|
| 138 : |
|
|
0 Value Describ |
| 139 : |
|
|
|
| 140 : |
|
|
: Table-Exec ( addr -- ) |
| 141 : |
|
|
to Describ |
| 142 : |
|
|
Describ 2 cells + perform \ to store the opcode |
| 143 : |
|
|
Describ 3 cells + perform \ to store the operands |
| 144 : |
|
|
Describ 4 cells + perform \ to flush the instruction |
| 145 : |
|
|
; |
| 146 : |
|
|
|
| 147 : |
dvdkhlng
|
1.8
|
: 1st-mc ( addr -- flag ) |
| 148 : |
|
|
\G mnemonic check? check for matching operands. if matching, execute code |
| 149 : |
|
|
\G to encode mode and operands and return true, else return false |
| 150 : |
pazsan
|
1.1
|
dup >modes modes Mode-Compare |
| 151 : |
|
|
IF Table-Exec |
| 152 : |
|
|
true |
| 153 : |
|
|
ELSE false |
| 154 : |
|
|
THEN ; |
| 155 : |
|
|
|
| 156 : |
|
|
: 1st-always ( addr -- flag ) |
| 157 : |
dvdkhlng
|
1.8
|
\G Undconditionally encode operands and/or instruction used for instructions |
| 158 : |
|
|
\G that do not have any operands. Return true i.e. make the assembler stop |
| 159 : |
|
|
\G looking for more instruction variants |
| 160 : |
pazsan
|
1.1
|
Table-Exec true ; |
| 161 : |
|
|
|
| 162 : |
|
|
: 1st-thru |
| 163 : |
dvdkhlng
|
1.8
|
\G Unconditionally encode, but return false to make assembler execute next |
| 164 : |
|
|
\G table rows also. |
| 165 : |
pazsan
|
1.1
|
dup Table-Exec false ; |
| 166 : |
|
|
|
| 167 : |
dvdkhlng
|
1.8
|
: 2nd-opc! ( -- ) |
| 168 : |
|
|
\G encode opcode by ORing data column of current instruction row into |
| 169 : |
|
|
\G instruction latch |
| 170 : |
pazsan
|
1.1
|
Describ >data count opc! ; |
| 171 : |
|
|
|
| 172 : |
dvdkhlng
|
1.8
|
: opcode, ( "<NNN> ..." -- ) |
| 173 : |
|
|
\G Append a counted string to dictionary, reading in every character as |
| 174 : |
|
|
\G space-terminated numbers form the parser until the end of line is |
| 175 : |
|
|
\G reached. |
| 176 : |
pazsan
|
1.1
|
here 0 c, |
| 177 : |
|
|
BEGIN bl word count dup WHILE s>number drop c, |
| 178 : |
|
|
REPEAT 2drop here over - 1- swap c! ; |
| 179 : |
|
|
|
| 180 : |
dvdkhlng
|
1.8
|
: modes, ( -- ) |
| 181 : |
|
|
\G append contents of MODES to dictionary |
| 182 : |
pazsan
|
1.1
|
modes# 0 DO I cells modes + @ dic, LOOP ; |
| 183 : |
|
|
|
| 184 : |
|
|
0 Value Table-Link |
| 185 : |
|
|
|
| 186 : |
dvdkhlng
|
1.8
|
: Table ( "name" -- ) |
| 187 : |
|
|
\G create table that lists allowed operand/mode combinations for opcode |
| 188 : |
|
|
\G "name" |
| 189 : |
pazsan
|
1.1
|
Reset |
| 190 : |
|
|
Create here to Table-Link 0 dic, |
| 191 : |
|
|
DOES> I-Init |
| 192 : |
|
|
BEGIN @ dup WHILE dup |
| 193 : |
|
|
cell+ perform \ first element is executed always |
| 194 : |
|
|
\ makes check |
| 195 : |
|
|
?EXIT |
| 196 : |
|
|
REPEAT -1 ABORT" no valid mode!" |
| 197 : |
|
|
; |
| 198 : |
dvdkhlng
|
1.8
|
|
| 199 : |
|
|
: Follows ( "name" -- ) |
| 200 : |
|
|
\G Link current instruction's table to execute all rows of table "name" |
| 201 : |
|
|
\G (after executing all rows already defined). Do not add any more rows to |
| 202 : |
|
|
\G current table, after executing Follows. Else you're going to modify |
| 203 : |
|
|
\G "name"'s table! |
| 204 : |
pazsan
|
1.1
|
' >body @ Table-Link @ ! ; |
| 205 : |
|
|
|
| 206 : |
dvdkhlng
|
1.8
|
: opc, ( k*x "<NNN> ..." -- ) |
| 207 : |
|
|
\G Append current modes and opcode given byte-wise on current input line to |
| 208 : |
|
|
\G dictionary. Clear forth stack to remove any data provided by the |
| 209 : |
|
|
\G otherwise unused operands that wer used to set up the modes array. |
| 210 : |
pazsan
|
1.1
|
modes, opcode, clearstack reset ; |
| 211 : |
|
|
|
| 212 : |
dvdkhlng
|
1.8
|
: (Opc() ( k*x xt "<NNN> ..." -- ) |
| 213 : |
|
|
\G Fill table row for opcode with Operands. XT will be executed by the |
| 214 : |
|
|
\G assembler for encoding the operands using data from the stack. |
| 215 : |
pazsan
|
1.1
|
['] 1st-mc dic, |
| 216 : |
|
|
['] 2nd-opc! dic, |
| 217 : |
|
|
dic, |
| 218 : |
|
|
['] I-Flush dic, |
| 219 : |
|
|
opc, ; |
| 220 : |
|
|
|
| 221 : |
dvdkhlng
|
1.8
|
: (Opc) ( k*x xt "<NNN> ..." -- ) |
| 222 : |
pazsan
|
1.1
|
\ Opcode without Operands |
| 223 : |
|
|
['] 1st-always dic, |
| 224 : |
|
|
['] 2nd-opc! dic, |
| 225 : |
|
|
['] Noop dic, |
| 226 : |
|
|
['] I-Flush dic, |
| 227 : |
|
|
opc, ; |
| 228 : |
|
|
|
| 229 : |
dvdkhlng
|
1.8
|
: Opc( ( k*x xt "<NNN> ..." -- ) |
| 230 : |
|
|
\G Append a new table row for an opcode with Operands. Use your assembler |
| 231 : |
|
|
\G operands to fill the MODES array with data showing how the opcode is |
| 232 : |
|
|
\G used. Only the types of operands are recorded, any operand parameters |
| 233 : |
|
|
\G passed on the stack are dropped. The opcode's instruction code is read |
| 234 : |
|
|
\G as 8-bit numbers from the current input line and stored as counted string |
| 235 : |
|
|
\G in the table's opcode column |
| 236 : |
|
|
\G |
| 237 : |
|
|
\G When assembling an instruction, the assembler checks for matching |
| 238 : |
|
|
\G operands. If this row matches, first XT is called to consume operands |
| 239 : |
|
|
\G parameters from the stack and encode them into the instruction latch. |
| 240 : |
|
|
\G Then the opcode column is ORed to the instruction latch and the assembler |
| 241 : |
|
|
\G quits assembly of the current instruction. |
| 242 : |
pazsan
|
1.1
|
Table-Link linked |
| 243 : |
|
|
(Opc() ; |
| 244 : |
|
|
|
| 245 : |
dvdkhlng
|
1.8
|
: Opc ( k*x "<NNN> ..." -- ) |
| 246 : |
|
|
\G Append a new table row for an opcode without operand parameters. |
| 247 : |
|
|
\G |
| 248 : |
|
|
\G When assembling an instruction, and the assembler reaches this row, it |
| 249 : |
|
|
\G will assume the opcode is fully assembled and quits assembly of the |
| 250 : |
|
|
\G instruction, after endcoding the opcode. |
| 251 : |
pazsan
|
1.1
|
Table-Link linked |
| 252 : |
|
|
(Opc) ; |
| 253 : |
|
|
|
| 254 : |
dvdkhlng
|
1.8
|
: Opc+ ( k*x "<NNN> ..." -- ) |
| 255 : |
|
|
\G Append a new table row that encodes part of an opcode, but falls through |
| 256 : |
|
|
\G to following lines. |
| 257 : |
pazsan
|
1.1
|
Table-Link linked |
| 258 : |
|
|
['] 1st-thru dic, |
| 259 : |
|
|
['] 2nd-opc! dic, |
| 260 : |
|
|
['] Noop dic, |
| 261 : |
|
|
['] Noop dic, |
| 262 : |
|
|
opc, ; |
| 263 : |
|
|
|
| 264 : |
dvdkhlng
|
1.8
|
: Opc(+ ( k*x xt "<NNN> ..." -- ) |
| 265 : |
|
|
\G Like OPC+ but for a table row that has operands |
| 266 : |
pazsan
|
1.1
|
Table-Link linked |
| 267 : |
|
|
['] 1st-thru dic, |
| 268 : |
|
|
['] 2nd-opc! dic, |
| 269 : |
|
|
dic, |
| 270 : |
|
|
['] Noop dic, |
| 271 : |
|
|
opc, ; |
| 272 : |
|
|
|
| 273 : |
|
|
: End-Table ; |
| 274 : |
|
|
|
| 275 : |
dvdkhlng
|
1.8
|
: alone ( k*x "<NNN> ..." -- ) |
| 276 : |
|
|
\G Create a single-row instruction table for an instruction without operands. |
| 277 : |
pazsan
|
1.1
|
Create 0 dic, ( Dummy Linkfield ) (opc) |
| 278 : |
|
|
DOES> dup cell+ perform 0= ABORT" must work always!" ; |
| 279 : |
dvdkhlng
|
1.8
|
|
| 280 : |
|
|
: alone( ( k*x xt "<NNN> ..." -- ) |
| 281 : |
|
|
\G Create a single-row instruction table for an instruction with operands. |
| 282 : |
pazsan
|
1.1
|
Create 0 dic, ( Dummy Linkfield ) (opc() |
| 283 : |
|
|
DOES> dup cell+ perform 0= ABORT" must work always!" ; |
| 284 : |
dvdkhlng
|
1.8
|
|
| 285 : |
|
|
|
| 286 : |
|
|
\ Configure Emacs forth-mode to keep this file's formatting |
| 287 : |
|
|
0 [IF] |
| 288 : |
|
|
Local Variables: |
| 289 : |
|
|
forth-indent-level: 2 |
| 290 : |
|
|
forth-local-indent-words: |
| 291 : |
|
|
(((";") (0 . -2) (0 . -2)) |
| 292 : |
|
|
(("does>") (0 . 0) (0 . 0))) |
| 293 : |
|
|
End: |
| 294 : |
|
|
[THEN] |