Annotation of gforth/asm/generic.fs, revision 1.7
1.1 pazsan 1: \ generic.fs implements generic assembler definitions 13aug97jaw
2:
1.7 ! anton 3: \ Copyright (C) 1998,2000,2003,2007 Free Software Foundation, Inc.
1.2 anton 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
1.6 anton 9: \ as published by the Free Software Foundation, either version 3
1.2 anton 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
1.6 anton 18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1 pazsan 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:
29: \ general definitions
30:
31: : clearstack depth 0 ?DO drop LOOP ;
32:
33: \ redefinitions to avoid conflicts
34:
35: ' , ALIAS dic,
36: ' NOOP ALIAS X
37:
38: \ ------------ Modes
39:
40: [IFUNDEF] modes#
41: 4 Constant modes#
42: [THEN]
43:
44: Create modes modes# cells allot \ Modes for differend operands are stored here
45: \ Example:
46: \ Offset 0: general modifier ( .B, .W, .L)
47: \ Offset 1: addressing mode operand 1
48: \ Offset 2: addressing mode operand 2
49:
50: : Mode-Compare ( adr1 adr2 -- flag )
51: modes#
52: BEGIN dup WHILE >r 2dup @ swap @ <> IF rdrop 2drop false EXIT THEN
53: cell+ swap cell+ r> 1-
54: REPEAT drop 2drop true ;
55:
56: Variable Start-Depth
57: Variable Mode#
58:
59: : reset
60: modes modes# cells erase
61: 1 Mode# !
62: depth Start-Depth ! ;
63:
64: : Mode! ( n -- )
65: Modes Mode# @ cells + ! ;
66:
67: : +Mode! ( n -- )
68: Modes Mode# @ cells + tuck @ or swap ! ;
69:
70: : 0Mode! ( n -- )
71: Modes ! ;
72:
73: : ,
74: 1 Mode# +! ;
75:
76: : Mode
77: Create dic, DOES> @ +Mode! ;
78:
79: : 0Mode
80: Create dic, DOES> @ 0Mode! ;
81:
82: : Reg
83: Create dic, dic, DOES> dup perform cell+ @ ;
84:
85: \ --------- Instruction Latch
86:
87: Create I-Latch 10 chars allot
88: Variable I-Len
89:
90: : opc! ( adr len -- )
91: dup I-Len @ max I-Len !
92: I-Latch -rot bounds DO I c@ over c@ or over c! char+ LOOP drop ;
93:
94: : I-Init 0 I-Len ! I-Latch 10 erase ;
95: : I-Flush I-Latch I-len @ bounds DO i c@ X c, LOOP reset ;
96:
97: : (g!) ( val addr n -1/1 -- )
98: dup 0< IF rot 2 pick + 1- -rot THEN
99: swap >r -rot r> 0
100: DO 2dup c! 2 pick + swap 8 rshift swap LOOP
101: 2drop drop ;
102:
103: : (g@) ( addr n -1/1 -- val )
104: negate dup 0< IF rot 2 pick + 1- -rot THEN
105: swap >r swap 0 swap r> 0
106: DO swap 8 lshift over c@ or swap 2 pick + LOOP
107: drop nip ;
108:
109: Variable ByteDirection \ -1 = big endian; 1 = little endian
110:
111: : g@ ByteDirection @ (g@) ;
112: : g! ByteDirection @ (g!) ;
113:
114: \ ---------------- Tables
115:
116: : >modes ( addr -- addr ) 5 cells + ;
117: : >data ( addr -- addr ) >modes modes# cells + ;
118:
119: 0 Value Describ
120:
121: : Table-Exec ( addr -- )
122: to Describ
123: Describ 2 cells + perform \ to store the opcode
124: Describ 3 cells + perform \ to store the operands
125: Describ 4 cells + perform \ to flush the instruction
126: ;
127:
128: : 1st-mc ( addr -- flag )
129: dup >modes modes Mode-Compare
130: IF Table-Exec
131: true
132: ELSE false
133: THEN ;
134:
135: : 1st-always ( addr -- flag )
136: Table-Exec true ;
137:
138: : 1st-thru
139: dup Table-Exec false ;
140:
141: : 2nd-opc!
142: Describ >data count opc! ;
143:
144: : opcode,
145: here 0 c,
146: BEGIN bl word count dup WHILE s>number drop c,
147: REPEAT 2drop here over - 1- swap c! ;
148:
149: : modes,
150: modes# 0 DO I cells modes + @ dic, LOOP ;
151:
152: 0 Value Table-Link
153:
154: : Table
155: Reset
156: Create here to Table-Link 0 dic,
157: DOES> I-Init
158: BEGIN @ dup WHILE dup
159: cell+ perform \ first element is executed always
160: \ makes check
161: ?EXIT
162: REPEAT -1 ABORT" no valid mode!"
163: ;
164:
165: : Follows
166: ' >body @ Table-Link @ ! ;
167:
168: : opc,
169: modes, opcode, clearstack reset ;
170:
171: : (Opc()
172: \ Opcode with Operands
173: ['] 1st-mc dic,
174: ['] 2nd-opc! dic,
175: dic,
176: ['] I-Flush dic,
177: opc, ;
178:
179: : (Opc)
180: \ Opcode without Operands
181: ['] 1st-always dic,
182: ['] 2nd-opc! dic,
183: ['] Noop dic,
184: ['] I-Flush dic,
185: opc, ;
186:
187: : Opc(
188: \ Opcode with Operands
189: Table-Link linked
190: (Opc() ;
191:
192: : Opc
193: \ Opcode without Operands
194: Table-Link linked
195: (Opc) ;
196:
197: : Opc+
198: \ Additional Opcode
199: Table-Link linked
200: ['] 1st-thru dic,
201: ['] 2nd-opc! dic,
202: ['] Noop dic,
203: ['] Noop dic,
204: opc, ;
205:
206: : Opc(+
207: \ Additional Opcode with Operands
208: Table-Link linked
209: ['] 1st-thru dic,
210: ['] 2nd-opc! dic,
211: dic,
212: ['] Noop dic,
213: opc, ;
214:
215: : End-Table ;
216:
217: : alone
218: Create 0 dic, ( Dummy Linkfield ) (opc)
219: DOES> dup cell+ perform 0= ABORT" must work always!" ;
220:
221: : alone(
222: Create 0 dic, ( Dummy Linkfield ) (opc()
223: 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