1: \ generic.fs implements generic assembler definitions 13aug97jaw
2:
3: \ Copyright (C) 1998 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 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: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20:
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!" ;
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