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