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