Annotation of gforth/arch/mips/asm.fs, revision 1.14
1.1 anton 1: \ asm.fs assembler file (for MIPS R3000)
2: \
3: \ Copyright (C) 1995-97 Martin Anton Ertl, Christian Pirker
4: \
5: \ This file is part of RAFTS.
6: \
7: \ RAFTS 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., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
1.8 anton 21: \ test this with
22: \ gforth arch/mips/asm.fs -e "also assembler here" arch/mips/testasm.fs -e "here over - here" arch/mips/testdisasm.fs -e "here over - compare throw bye"
23:
1.14 ! anton 24: require ../../code.fs
1.4 anton 25:
1.7 anton 26: get-current
1.4 anton 27: also assembler definitions
28:
1.1 anton 29: $20 constant asm-registers
30:
1.3 anton 31: \ register names
32: 0 constant $zero
33: 1 constant $at
34: 2 constant $v0
35: 3 constant $v1
36: \ 4 constant $a0 \ commented out to avoid shadowing hex numbers
37: \ 5 constant $a1
38: \ 6 constant $a2
39: \ 7 constant $a3
40: 8 constant $t0
41: 9 constant $t1
42: 10 constant $t2
43: 11 constant $t3
44: 12 constant $t4
45: 13 constant $t5
46: 14 constant $t6
47: 15 constant $t7
48: 16 constant $s0
49: 17 constant $s1
50: 18 constant $s2
51: 19 constant $s3
52: 20 constant $s4
53: 21 constant $s5
54: 22 constant $s6
55: 23 constant $s7
56: 24 constant $t8
57: 25 constant $t9
58: 26 constant $k0
59: 27 constant $k1
60: 28 constant $gp
61: 29 constant $sp
62: 30 constant $s8
63: 31 constant $ra
1.1 anton 64:
65: $00 constant asm-init-code
66:
1.3 anton 67: $1F constant asm-bm05
68: $3F constant asm-bm06
69: $FFFF constant asm-bm10
70: $3FFFFFF constant asm-bm1A
1.1 anton 71:
72: : asm-op ( n -- code )
73: asm-bm06 and $1a lshift ;
74:
1.8 anton 75: : check-range ( u1 u2 u3 -- )
76: within 0= -24 and throw ;
77:
78: : asm-rs ( u code -- code )
79: over 0 $20 check-range
80: swap $15 lshift or ;
1.1 anton 81:
82: : asm-rt ( n code -- code )
1.8 anton 83: over 0 $20 check-range
84: swap $10 lshift or ;
1.1 anton 85:
86: : asm-imm ( n code -- code )
1.8 anton 87: over -$8000 $8000 check-range
88: swap $ffff and or ;
1.1 anton 89: ' asm-imm alias asm-offset
90:
1.8 anton 91: : asm-uimm ( u code -- code )
92: over 0 $10000 check-range
93: or ;
94:
95: : asm-rel ( n code -- code )
96: over 3 and 0<> -24 and throw \ check lower 2 bits
97: swap 2/ 2/ swap asm-imm ;
98:
1.1 anton 99: : asm-target ( n code -- code )
1.8 anton 100: over here cell+ xor $f0000003 and 0<> -24 and throw
1.1 anton 101: swap 2 rshift asm-bm1A and or ;
102:
103: : asm-rd ( n code -- code )
1.8 anton 104: over 0 $20 check-range
105: swap $b lshift or ;
1.1 anton 106:
107: : asm-shamt ( n code -- code )
1.8 anton 108: over 0 $20 check-range
109: swap $6 lshift or ;
1.1 anton 110: ' asm-shamt alias asm-sa
111:
112: : asm-funct ( n code -- code )
113: swap asm-bm06 and or ;
114:
1.3 anton 115: : asm-special ( code1 -- code2 )
116: asm-init-code asm-funct ;
117:
1.1 anton 118: \ ***** I-types
1.3 anton 119: : asm-I-rt,imm ( code -- )
120: create ,
121: does> ( rt imm -- )
122: @ asm-imm asm-rt , ;
123:
1.7 anton 124: : asm-I-rt,uimm ( code -- )
125: create ,
126: does> ( rt uimm -- )
127: @ asm-uimm asm-rt , ;
128:
1.3 anton 129: : asm-I-rs,imm ( code -- )
130: create ,
131: does> ( rs imm -- )
1.8 anton 132: @ asm-rel asm-rs , ;
1.3 anton 133:
134: : asm-I-rt,rs,imm ( code -- )
135: create ,
136: does> ( rt rs imm -- )
137: @ asm-imm asm-rs asm-rt , ;
138:
1.7 anton 139: : asm-I-rt,rs,uimm ( code -- )
140: create ,
141: does> ( rt rs uimm -- )
142: @ asm-uimm asm-rs asm-rt , ;
143:
1.3 anton 144: : asm-I-rs,rt,imm ( code -- )
145: create ,
146: does> ( rs rt imm -- )
1.8 anton 147: @ asm-rel asm-rt asm-rs , ;
1.3 anton 148:
149: : asm-I-rt,offset,rs ( code -- )
150: create ,
151: does> ( rt offset rs -- )
152: @ asm-rs asm-offset asm-rt , ;
1.1 anton 153:
154: \ ***** regimm types
155: : asm-regimm-rs,imm ( funct -- )
156: $01 asm-op asm-rt asm-I-rs,imm ;
157:
158: \ ***** copz types 1
159:
1.3 anton 160: : asm-I-imm,z ( code -- )
161: create ,
162: does> ( imm z -- )
1.8 anton 163: @ swap asm-op or asm-rel , ;
1.1 anton 164:
165: : asm-copz-imm ( code -- )
166: $10 asm-op or asm-I-imm,z ;
167:
1.3 anton 168: : asm-I-rt,offset,rs,z ( code -- )
169: create ,
170: does> ( rt offset rs z -- )
171: @ swap asm-op or asm-rs asm-offset asm-rt , ;
1.1 anton 172:
173: : asm-copz-rt,offset,rs ( code -- )
174: asm-op asm-I-rt,offset,rs,z ;
175:
1.3 anton 176: : asm-J-target ( code -- )
177: create ,
178: does> ( target -- )
179: @ asm-target , ;
1.1 anton 180:
181: \ ***** special types
1.3 anton 182: : asm-special-nothing ( code -- )
183: asm-special create ,
184: does> ( addr -- )
185: @ , ;
186:
187: : asm-special-rd ( code -- )
188: asm-special create ,
189: does> ( rd addr -- )
190: @ asm-rd , ;
191:
192: : asm-special-rs ( code -- )
193: asm-special create ,
194: does> ( rs addr -- )
195: @ asm-rs , ;
196:
197: : asm-special-rd,rs ( code -- )
198: asm-special create ,
199: does> ( rd rs addr -- )
200: @ asm-rs asm-rd , ;
201:
202: : asm-special-rs,rt ( code -- )
203: asm-special create ,
204: does> ( rs rt addr -- )
205: @ asm-rt asm-rs , ;
206:
207: : asm-special-rd,rs,rt ( code -- )
208: asm-special create ,
209: does> ( rd rs rt addr -- )
210: @ asm-rt asm-rs asm-rd , ;
211:
212: : asm-special-rd,rt,rs ( code -- )
213: asm-special create ,
214: does> ( rd rt rs addr -- )
215: @ asm-rs asm-rt asm-rd , ;
216:
217: : asm-special-rd,rt,sa ( code -- )
218: asm-special create ,
219: does> ( rd rt sa addr -- )
220: @ asm-sa asm-rt asm-rd , ;
1.1 anton 221:
222: \ ***** copz types 2
223: : asm-copz0 ( funct -- )
1.3 anton 224: $10 $10 asm-op asm-rs asm-funct create ,
225: does> ( addr -- )
226: @ , ;
1.1 anton 227:
228: : asm-copz-rt,rd ( funct -- )
1.3 anton 229: $10 asm-op or create ,
230: does> ( rt rd z addr -- )
231: @ swap asm-op or asm-rd asm-rt , ;
1.1 anton 232:
233: : nop, ( -- )
1.3 anton 234: 0 , ;
1.1 anton 235:
1.5 anton 236: include ./insts.fs
1.1 anton 237:
238: : move, ( rd rs -- )
1.3 anton 239: $zero addu, ;
1.1 anton 240:
1.9 anton 241: \ commented out to reduce delay slot exceptions
242: \ : abs, ( rd rs -- )
243: \ dup $0008 bgez,
244: \ 2dup move,
245: \ $zero swap subu, ;
1.1 anton 246:
247: : neg, ( rd rs -- )
1.3 anton 248: $zero swap subu, ;
1.1 anton 249:
250: : negu, ( rd rs -- )
1.3 anton 251: $zero swap subu, ;
1.1 anton 252:
253: : not, ( rd rs -- )
1.3 anton 254: $zero nor, ;
1.1 anton 255:
256: : li, ( rd imm -- )
257: dup 0= if
1.3 anton 258: drop dup $zero = if
1.1 anton 259: drop nop, assert( false )
260: else
1.3 anton 261: $zero move,
1.1 anton 262: endif
263: else
264: dup $8000 u< if
1.3 anton 265: $zero swap addiu,
1.1 anton 266: else
267: dup $10000 u< if
1.3 anton 268: $zero swap ori,
1.1 anton 269: else
270: dup $ffff and 0= if
271: $10 rshift lui,
272: else
273: dup $ffff8000 and $ffff8000 = if
1.3 anton 274: $zero swap addiu,
1.1 anton 275: else
276: 2dup $10 rshift lui,
277: over swap ori,
278: endif
279: endif
280: endif
281: endif
282: endif ;
283:
284: : blt, ( rs rt imm -- ) \ <
1.3 anton 285: >r $at rot rot slt,
286: $at $zero r> bne, ;
1.1 anton 287:
288: : ble, ( rs rt imm -- ) \ <=
1.3 anton 289: >r $at rot rot swap slt,
290: $at $zero r> beq, ;
1.1 anton 291:
292: : bgt, ( rs rt imm -- ) \ >
1.3 anton 293: >r $at rot rot swap slt,
294: $at $zero r> bne, ;
1.1 anton 295:
296: : bge, ( rs rt imm -- ) \ >=
1.3 anton 297: >r $at rot rot slt,
298: $at $zero r> beq, ;
1.1 anton 299:
300: : bltu, ( rs rt imm -- ) \ < unsigned
1.3 anton 301: >r $at rot rot sltu,
302: $at $zero r> bne, ;
1.1 anton 303:
304: : bleu, ( rs rt imm -- ) \ <= unsigned
1.3 anton 305: >r $at rot rot swap sltu,
306: $at $zero r> beq, ;
1.1 anton 307:
308: : bgtu, ( rs rt imm -- ) \ > unsigned
1.3 anton 309: >r $at rot rot swap sltu,
310: $at $zero r> bne, ;
1.1 anton 311:
312: : bgeu, ( rs rt imm -- ) \ >= unsigned
1.3 anton 313: >r $at rot rot sltu,
314: $at $zero r> beq, ;
1.9 anton 315:
316: \ control structures
317:
318: \ conditions; they are reversed because of the if and until logic (the
319: \ stuff enclosed by if is performed if the branch around has the
1.10 anton 320: \ inverse condition, cf. 0branch).
1.9 anton 321:
322: ' beq, constant ne
323: ' bne, constant eq
324: ' blez, constant gtz
325: ' bgtz, constant lez
326: ' bltz, constant gez
327: ' bgez, constant ltz
1.13 anton 328: \ bczf, bczt, \ these don't take the relative address as last argument
1.9 anton 329: ' blt, constant ge
330: ' ble, constant gt
331: ' bgt, constant le
332: ' bge, constant lt
333: ' bltu, constant geu
334: ' bleu, constant gtu
335: ' bgtu, constant leu
336: ' bgeu, constant ltu
337:
1.10 anton 338: \ an asm-cs-item consists of ( addr magic1 magic2 ). addr is the
339: \ address behind the branch or the destination. magic2 is LIVE-ORIG or
340: \ DEST xored with asm-magic to make it harder to confuse with a
341: \ register number or immediate value. magic1 is LIVE-orig or DEST.
342: \ It's there to make CS-ROLL etc. work.
1.9 anton 343:
1.10 anton 344: : magic-asm ( u1 u2 -- u3 u4 )
1.9 anton 345: \ turns a magic number into an asm-magic number or back
346: $87654321 xor ;
347:
1.10 anton 348: : patch-branch ( branch-delay-addr target-addr -- )
349: \ there is a branch just before branch-delay-addr; PATCH-BRANCH
350: \ patches this branch to branch to target-addr
351: over - ( branch-delay-addr rel )
352: swap cell - dup >r ( rel branch-addr R:branch-addr )
353: @ asm-rel r> ! ; \ !! relies on the imm field being 0 before
354:
1.9 anton 355: : if, ( ... xt -- asm-orig )
356: \ xt is for a branch word ( ... addr -- )
357: 0 swap execute
1.10 anton 358: here live-orig magic-asm live-orig ;
1.9 anton 359:
360: : ahead, ( -- asm-orig )
361: $zero $zero ne if, ;
362:
363: : then, ( asm-orig -- )
1.10 anton 364: orig? magic-asm orig?
365: here patch-branch ;
366:
367: : begin, ( -- asm-dest )
368: here dest magic-asm dest ;
369:
370: : until, ( asm-dest ... xt -- )
371: \ xt is a condition and ... are its arguments
372: 0 swap execute
373: dest? magic-asm dest?
374: here swap patch-branch ;
375:
376: : again, ( asm-dest -- )
377: $zero $zero ne until, ;
378:
379: : while, ( asm-dest -- asm-orig asm-dest )
380: if, 1 cs-roll ;
381:
1.11 anton 382: : delayed-then, ( asm-orig -- )
383: \ set the target of asm-orig to one instruction after the current one
384: 0 , then, -1 cells allot ;
385:
386: : else, ( asm-orig1 -- asm-orig2 )
387: ahead, 1 cs-roll delayed-then, ;
388:
1.10 anton 389: : repeat, ( asm-orig asm-dest -- )
1.11 anton 390: again, delayed-then, ;
1.1 anton 391:
1.12 anton 392: : endif, ( asm-orig -- )
393: then, ;
394:
1.4 anton 395: previous
1.10 anton 396: set-current
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>