[gforth] / gforth / asm / generic.fs  

gforth: gforth/asm/generic.fs


1 : pazsan 1.1 \ generic.fs implements generic assembler definitions 13aug97jaw
2 :    
3 : anton 1.4 \ Copyright (C) 1998,2000 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!" ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help