1: \ generic.fs implements generic assembler definitions 13aug97jaw
2:
3: \ Copyright (C) 1998,2000,2003,2007,2010 Free Software Foundation, Inc.
4:
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 3
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, see http://www.gnu.org/licenses/.
19:
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: \
28: \ 24apr10dk Added documentation
29:
30: \ general definitions
31:
32: : clearstack ( k*x -- ) 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: \G End an opcode / star a new opcode.
62: modes modes# cells erase
63: 1 Mode# !
64: depth Start-Depth ! ;
65:
66: : Mode! ( x -- )
67: \G Set current operand's mode to X
68: Modes Mode# @ cells + ! ;
69:
70: : +Mode! ( x -- )
71: \G Logically OR X to current operand's mode
72: Modes Mode# @ cells + tuck @ or swap ! ;
73:
74: : 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: Modes ! ;
79:
80: : , ( -- )
81: \G Advance to next operand
82: 1 Mode# +! ;
83:
84: : Mode ( x "name" -- )
85: \G Define a new mode that logically ors X to current mode when executed
86: Create dic, DOES> @ +Mode! ;
87:
88: : 0Mode ( x "name" -- )
89: \G Define a new mode that sets operand #0 when executed
90: Create dic, DOES> @ 0Mode! ;
91:
92: : Reg ( xt x "name" -- )
93: \G Define a parametrized mode, that executes mode XT, then puts X onto the
94: \G stack
95: 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: \G Logically OR string of bytes into instruction latch
104: dup I-Len @ max I-Len !
105: I-Latch -rot bounds ?DO I c@ over c@ or over c! char+ LOOP drop ;
106:
107: : 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:
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: : 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:
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: : 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: dup >modes modes Mode-Compare
151: IF Table-Exec
152: true
153: ELSE false
154: THEN ;
155:
156: : 1st-always ( addr -- flag )
157: \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: Table-Exec true ;
161:
162: : 1st-thru
163: \G Unconditionally encode, but return false to make assembler execute next
164: \G table rows also.
165: dup Table-Exec false ;
166:
167: : 2nd-opc! ( -- )
168: \G encode opcode by ORing data column of current instruction row into
169: \G instruction latch
170: Describ >data count opc! ;
171:
172: : 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: here 0 c,
177: BEGIN bl word count dup WHILE s>number drop c,
178: REPEAT 2drop here over - 1- swap c! ;
179:
180: : modes, ( -- )
181: \G append contents of MODES to dictionary
182: modes# 0 DO I cells modes + @ dic, LOOP ;
183:
184: 0 Value Table-Link
185:
186: : Table ( "name" -- )
187: \G create table that lists allowed operand/mode combinations for opcode
188: \G "name". Note that during assembling, table will be scanned in reverse
189: \G order!
190: Reset
191: Create here to Table-Link 0 dic,
192: DOES> I-Init
193: BEGIN @ dup WHILE dup
194: cell+ perform \ first element is executed always
195: \ makes check
196: ?EXIT
197: REPEAT -1 ABORT" no valid mode!"
198: ;
199:
200: : Follows ( "name" -- )
201: \G Link current instruction's table to execute all rows of table "name"
202: \G (after executing all rows already defined). Do not add any more rows to
203: \G current table, after executing Follows. Else you're going to modify
204: \G "name"'s table!
205: ' >body @ Table-Link @ ! ;
206:
207: : opc, ( k*x "<NNN> ..." -- )
208: \G Append current modes and opcode given byte-wise on current input line to
209: \G dictionary. Clear forth stack to remove any data provided by the
210: \G otherwise unused operands that wer used to set up the modes array.
211: modes, opcode, clearstack reset ;
212:
213: : (Opc() ( k*x xt "<NNN> ..." -- )
214: \G Fill table row for opcode with Operands. XT will be executed by the
215: \G assembler for encoding the operands using data from the stack.
216: ['] 1st-mc dic,
217: ['] 2nd-opc! dic,
218: dic,
219: ['] I-Flush dic,
220: opc, ;
221:
222: : (Opc) ( k*x xt "<NNN> ..." -- )
223: \ Opcode without Operands
224: ['] 1st-always dic,
225: ['] 2nd-opc! dic,
226: ['] Noop dic,
227: ['] I-Flush dic,
228: opc, ;
229:
230: : Opc( ( k*x xt "<NNN> ..." -- )
231: \G Append a new table row for an opcode with Operands. Use your assembler
232: \G operands to fill the MODES array with data showing how the opcode is
233: \G used. Only the types of operands are recorded, any operand parameters
234: \G passed on the stack are dropped. The opcode's instruction code is read
235: \G as 8-bit numbers from the current input line and stored as counted string
236: \G in the table's opcode column
237: \G
238: \G When assembling an instruction, the assembler checks for matching
239: \G operands. If this row matches, first XT is called to consume operands
240: \G parameters from the stack and encode them into the instruction latch.
241: \G Then the opcode column is ORed to the instruction latch and the assembler
242: \G quits assembly of the current instruction.
243: Table-Link linked
244: (Opc() ;
245:
246: : Opc ( k*x "<NNN> ..." -- )
247: \G Append a new table row for an opcode without operand parameters.
248: \G
249: \G When assembling an instruction, and the assembler reaches this row, it
250: \G will assume the opcode is fully assembled and quits assembly of the
251: \G instruction, after endcoding the opcode.
252: Table-Link linked
253: (Opc) ;
254:
255: : Opc+ ( k*x "<NNN> ..." -- )
256: \G Append a new table row that encodes part of an opcode, but falls through
257: \G to following lines.
258: Table-Link linked
259: ['] 1st-thru dic,
260: ['] 2nd-opc! dic,
261: ['] Noop dic,
262: ['] Noop dic,
263: opc, ;
264:
265: : Opc(+ ( k*x xt "<NNN> ..." -- )
266: \G Like OPC+ but for a table row that has operands
267: Table-Link linked
268: ['] 1st-thru dic,
269: ['] 2nd-opc! dic,
270: dic,
271: ['] Noop dic,
272: opc, ;
273:
274: : End-Table ;
275:
276: : alone ( k*x "<NNN> ..." -- )
277: \G Create a single-row instruction table for an instruction without operands.
278: Create 0 dic, ( Dummy Linkfield ) (opc)
279: DOES> dup cell+ perform 0= ABORT" must work always!" ;
280:
281: : alone( ( k*x xt "<NNN> ..." -- )
282: \G Create a single-row instruction table for an instruction with operands.
283: Create 0 dic, ( Dummy Linkfield ) (opc()
284: DOES> dup cell+ perform 0= ABORT" must work always!" ;
285:
286:
287: \ Configure Emacs forth-mode to keep this file's formatting
288: 0 [IF]
289: Local Variables:
290: forth-indent-level: 2
291: forth-local-indent-words:
292: (((";") (0 . -2) (0 . -2))
293: (("does>") (0 . 0) (0 . 0)))
294: End:
295: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to generic.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / asm