1: \ assembler in forth for alpha
2:
3: \ Copyright (C) 1999,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
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:
21: \ contributed by Bernd Thallner
22:
23: \ require ../../code.fs
24:
25: get-current
26: also assembler definitions
27:
28: \ register
29:
30: $0 constant v0
31: $1 constant t0
32: $2 constant t1
33: $3 constant t2
34: $4 constant t3
35: $5 constant t4
36: $6 constant t5
37: $7 constant t6
38: $8 constant t7
39: $9 constant s0
40: $a constant s1
41: $b constant s2
42: $c constant s3
43: $d constant s4
44: $e constant s5
45: $f constant fp
46: \ commented out to avoid shadowing hex numbers
47: \ $10 constant a0
48: \ $11 constant a1
49: \ $12 constant a2
50: \ $13 constant a3
51: \ $14 constant a4
52: \ $15 constant a5
53: $16 constant t8
54: $17 constant t9
55: $18 constant t10
56: $19 constant t11
57: $1a constant ra
58: $1b constant t12
59: $1c constant at
60: $1d constant gp
61: $1e constant sp
62: $1f constant zero
63:
64: \ util
65:
66: : h@ ( addr -- n ) \ 32 bit fetch
67: dup dup aligned = if
68: @
69: $00000000ffffffff and
70: else
71: 4 - @
72: $20 rshift
73: endif
74: ;
75:
76: : h! ( n addr -- ) \ 32 bit store
77: dup dup aligned = if
78: dup @
79: $ffffffff00000000 and
80: rot or
81: swap !
82: else
83: 4 - dup @
84: $00000000ffffffff and
85: rot $20 lshift or
86: swap !
87: endif
88: ;
89:
90: : h, ( h -- ) \ 32 bit store + allot
91: here here aligned = if
92: here !
93: else
94: 32 lshift
95: here 4 - dup
96: @ rot or
97: swap !
98: endif
99: 4 allot
100: ;
101:
102: \ operands
103:
104: : check-range ( u1 u2 u3 -- )
105: within 0= -24 and throw ;
106:
107: : rega ( rega code -- code )
108: \ ra field, named rega to avoid conflict with register ra
109: swap dup 0 $20 check-range
110: 21 lshift or ;
111:
112: : rb ( rb code -- code )
113: swap dup 0 $20 check-range
114: 16 lshift or ;
115:
116: : rc ( rc code -- code )
117: swap dup 0 $20 check-range
118: or ;
119:
120: : hint ( addr code -- code )
121: swap 2 rshift $3fff and or ;
122:
123: : disp ( n code -- code )
124: swap dup -$8000 $8000 check-range
125: $ffff and or ;
126:
127: : branch-rel ( n code -- code )
128: swap dup 3 and 0<> -24 and throw
129: 2/ 2/
130: dup -$100000 $100000 check-range
131: $1fffff and or ;
132:
133: : branch-disp ( addr code -- code )
134: swap here 4 + - swap branch-rel ;
135:
136: : imm ( u code -- code )
137: swap dup 0 $100 check-range
138: 13 lshift or ;
139:
140: : palcode ( u code -- code )
141: swap dup 0 $4000000 check-range or ;
142:
143: \ formats
144:
145: : Bra ( opcode -- ) \ branch instruction format
146: create 26 lshift ,
147: does> ( rega target-addr -- )
148: @ branch-disp rega h, ;
149:
150: : Mbr ( opcode hint -- ) \ memory branch instruction format
151: create 14 lshift swap 26 lshift or ,
152: does> ( rega rb hint -- )
153: @ hint rb rega h, ;
154:
155: : F-P ( opcode func -- ) \ floating-point operate instruction format
156: create 5 lshift swap 26 lshift or ,
157: does> ( fa fb fc -- )
158: @ rc rb rega h, ;
159:
160: : Mem ( opcode -- ) \ memory instruction format
161: create 26 lshift ,
162: does> ( rega memory_disp rb -- )
163: @ rb disp rega h, ;
164:
165: : Mfc ( opcode func -- ) \ memory instruction with function code format
166: create swap 26 lshift or ,
167: does> ( rega rb -- )
168: @ rb rega h, ;
169:
170: : Opr ( opcode.ff ) \ operate instruction format
171: create 5 lshift swap 26 lshift or ,
172: does> ( rega rb rc -- )
173: @ rc rb rega h, ;
174:
175: : Opr# ( opcode func -- ) \ operate instruction format
176: create 5 lshift swap 26 lshift or 1 12 lshift or ,
177: does> ( rega imm rc -- )
178: @ rc imm rega h, ;
179:
180: : Pcd ( opcode -- ) \ palcode instruction format
181: create 26 lshift ,
182: does> ( palcode addr -- )
183: @ palcode h, ;
184:
185: \ instructions
186:
187: $15 $80 F-P addf,
188: $15 $a0 F-P addg,
189: $10 $00 Opr addl,
190: $10 $00 Opr# addl#,
191: $10 $40 Opr addlv,
192: $10 $40 Opr# addlv#,
193: $10 $20 Opr addq,
194: $10 $20 Opr# addq#,
195: $10 $60 Opr addqv,
196: $10 $60 Opr# addqv#,
197: $16 $80 F-P adds,
198: $16 $a0 F-P addt,
199: $11 $00 Opr and,
200: $11 $00 Opr# and#,
201: $39 Bra beq,
202: $3e Bra bge,
203: $3f Bra bgt,
204: $11 $08 Opr bic,
205: $11 $08 Opr# bic#,
206: $11 $20 Opr bis,
207: $11 $20 Opr# bis#,
208: $38 Bra blbc,
209: $3c Bra blbs,
210: $3b Bra ble,
211: $3a Bra blt,
212: $3d Bra bne,
213: $30 Bra br,
214: $34 Bra bsr,
215: $00 Pcd call_pal,
216: $11 $24 Opr cmoveq,
217: $11 $24 Opr# cmoveq#,
218: $11 $46 Opr cmovge,
219: $11 $46 Opr# cmovge#,
220: $11 $66 Opr cmovgt,
221: $11 $66 Opr# cmovgt#,
222: $11 $16 Opr cmovlbc,
223: $11 $16 Opr# cmovlbc#,
224: $11 $14 Opr cmovlbs,
225: $11 $14 Opr# cmovlbs#,
226: $11 $64 Opr cmovle,
227: $11 $64 Opr# cmovle#,
228: $11 $44 Opr cmovlt,
229: $11 $44 Opr# cmovlt#,
230: $11 $26 Opr cmovne,
231: $11 $26 Opr# cmovne#,
232: $10 $0f Opr cmpbge,
233: $10 $0f Opr# cmpbge#,
234: $10 $2d Opr cmpeq,
235: $10 $2d Opr# cmpeq#,
236: $15 $a5 F-P cmpgeq,
237: $15 $a7 F-P cmpgle,
238: $15 $a6 F-P cmpglt,
239: $10 $6d Opr cmple,
240: $10 $6d Opr# cmple#,
241: $10 $4d Opr cmplt,
242: $10 $4d Opr# cmplt#,
243: $16 $a5 F-P cmpteq,
244: $16 $a7 F-P cmptle,
245: $16 $a6 F-P cmptlt,
246: $16 $a4 F-P cmptun,
247: $10 $3d Opr cmpule,
248: $10 $3d Opr# cmpule#,
249: $10 $1d Opr cmpult,
250: $10 $1d Opr# cmpult#,
251: $17 $20 F-P cpys,
252: $17 $22 F-P cpyse,
253: $17 $21 F-P cpysn,
254: $15 $9e F-P cvtdg,
255: $15 $ad F-P cvtgd,
256: $15 $ac F-P cvtgf,
257: $15 $af F-P cvtgq,
258: $17 $10 F-P cvtlq,
259: $15 $bc F-P cvtqf,
260: $15 $be F-P cvtqg,
261: $17 $30 F-P cvtql,
262: $17 $530 F-P cvtqlsv,
263: $17 $130 F-P cvtqlv,
264: $16 $bc F-P cvtqs,
265: $16 $be F-P cvtqt,
266: $16 $2ac F-P cvtst,
267: $16 $af F-P cvttq,
268: $16 $ac F-P cvtts,
269: $15 $83 F-P divf,
270: $15 $a3 F-P divg,
271: $16 $83 F-P divs,
272: $16 $a3 F-P divt,
273: $11 $48 Opr eqv,
274: $11 $48 Opr# eqv#,
275: $18 $400 Mfc excb,
276: $12 $06 Opr extbl,
277: $12 $06 Opr# extbl#,
278: $12 $6a Opr extlh,
279: $12 $6a Opr# extlh#,
280: $12 $26 Opr extll,
281: $12 $26 Opr# extll#,
282: $12 $7a Opr extqh,
283: $12 $7a Opr# extqh#,
284: $12 $36 Opr extql,
285: $12 $36 Opr# extql#,
286: $12 $5a Opr extwh,
287: $12 $5a Opr# extwh#,
288: $12 $16 Opr extwl,
289: $12 $16 Opr# extwl#,
290: $31 Bra fbeq,
291: $36 Bra fbge,
292: $37 Bra fbgt,
293: $33 Bra fble,
294: $32 Bra fblt,
295: $35 Bra fbne,
296: $17 $2a F-P fcmoveq,
297: $17 $2d F-P fcmovge,
298: $17 $2f F-P fcmovgt,
299: $17 $2e F-P fcmovle,
300: $17 $2c F-P fcmovlt,
301: $17 $2b F-P fcmovne,
302: $18 $8000 Mfc fetch,
303: $18 $a000 Mfc fetch_m,
304: $12 $0b Opr insbl,
305: $12 $0b Opr# insbl#,
306: $12 $67 Opr inslh,
307: $12 $67 Opr# inslh#,
308: $12 $2b Opr insll,
309: $12 $2b Opr# insll#,
310: $12 $77 Opr insqh,
311: $12 $77 Opr# insqh#,
312: $12 $3b Opr insql,
313: $12 $3b Opr# insql#,
314: $12 $57 Opr inswh,
315: $12 $57 Opr# inswh#,
316: $12 $1b Opr inswl,
317: $12 $1b Opr# inswl#,
318: $1a $00 Mbr jmp,
319: $1a $01 Mbr jsr,
320: $1a $03 Mbr jsr_coroutine,
321: $08 Mem lda,
322: $09 Mem ldah,
323: $20 Mem ldf,
324: $21 Mem ldg,
325: $28 Mem ldl,
326: $2a Mem ldl_l,
327: $29 Mem ldq,
328: $2b Mem ldq_l,
329: $0b Mem ldq_u,
330: $22 Mem lds,
331: $23 Mem ldt,
332: $18 $4000 Mfc mb,
333: $17 $25 F-P mf_fpcr,
334: $12 $02 Opr mskbl,
335: $12 $02 Opr# mskbl#,
336: $12 $62 Opr msklh,
337: $12 $62 Opr# msklh#,
338: $12 $22 Opr mskll,
339: $12 $22 Opr# mskll#,
340: $12 $72 Opr mskqh,
341: $12 $72 Opr# mskqh#,
342: $12 $32 Opr mskql,
343: $12 $32 Opr# mskql#,
344: $12 $52 Opr mskwh,
345: $12 $52 Opr# mskwh#,
346: $12 $12 Opr mskwl,
347: $12 $12 Opr# mskwl#,
348: $17 $24 F-P mt_fpcr,
349: $15 $82 F-P mulf,
350: $15 $a2 F-P mulg,
351: $13 $00 Opr mull,
352: $13 $00 Opr# mull#,
353: $13 $40 Opr mullv,
354: $13 $40 Opr# mullv#,
355: $13 $20 Opr mullq,
356: $13 $20 Opr# mullq#,
357: $13 $60 Opr mullqv,
358: $13 $60 Opr# mullqv#,
359: $16 $82 F-P mulls,
360: $16 $a2 F-P mullt,
361: $11 $28 Opr ornot,
362: $11 $28 Opr# ornot#,
363: $18 $e000 Mfc rc,
364: $1a $02 Mbr ret,
365: $18 $c000 Mfc rpcc,
366: $18 $f000 Mfc rs,
367: $10 $02 Opr s4addl,
368: $10 $02 Opr# s4addl#,
369: $10 $22 Opr s4addq,
370: $10 $22 Opr# s4addq#,
371: $10 $0b Opr s4subl,
372: $10 $0b Opr# s4subl#,
373: $10 $2b Opr s4subq,
374: $10 $2b Opr# s4subq#,
375: $10 $12 Opr s8addl,
376: $10 $12 Opr# s8addl#,
377: $10 $32 Opr s8addq,
378: $10 $32 Opr# s8addq#,
379: $10 $1b Opr s8ubl,
380: $10 $1b Opr# s8ubl#,
381: $10 $3b Opr s8ubq,
382: $10 $3b Opr# s8ubq#,
383: $12 $39 Opr sll,
384: $12 $39 Opr# sll#,
385: $12 $3c Opr sra,
386: $12 $3c Opr# sra#,
387: $12 $34 Opr srl,
388: $12 $34 Opr# srl#,
389: $24 Mem stf,
390: $25 Mem stg,
391: $26 Mem sts,
392: $2c Mem stl,
393: $2e Mem stl_c,
394: $2d Mem stq,
395: $2f Mem stq_c,
396: $0f Mem stq_u,
397: $27 Mem stt,
398: $15 $81 F-P subf,
399: $15 $a1 F-P subg,
400: $10 $09 Opr subl,
401: $10 $09 Opr# subl#,
402: $10 $49 Opr sublv,
403: $10 $49 Opr# sublv#,
404: $10 $29 Opr subq,
405: $10 $29 Opr# subq#,
406: $10 $69 Opr subqv,
407: $10 $69 Opr# subqv#,
408: $16 $81 F-P subs,
409: $16 $a1 F-P subt,
410: $18 $00 Mfc trapb,
411: $13 $30 Opr umulh,
412: $13 $30 Opr# umulh#,
413: $18 $4400 Mfc wmb,
414: $11 $40 Opr xor,
415: $11 $40 Opr# xor#,
416: $12 $30 Opr zap,
417: $12 $30 Opr# zap#,
418: $12 $31 Opr zapnot,
419: $12 $31 Opr# zapnot#,
420:
421: \ conditions; they are reversed because of the if and until logic (the
422: \ stuff enclosed by if is performed if the branch around has the
423: \ inverse condition).
424:
425: ' beq, constant ne
426: ' bge, constant lt
427: ' bgt, constant le
428: ' blbc, constant lbs
429: ' blbs, constant lbc
430: ' ble, constant gt
431: ' blt, constant ge
432: ' bne, constant eq
433: ' fbeq, constant fne
434: ' fbge, constant flt
435: ' fbgt, constant fle
436: ' fble, constant fgt
437: ' fblt, constant fge
438: ' fbne, constant feq
439:
440: \ control structures
441:
442: : magic-asm ( u1 u2 -- u3 u4 )
443: \ turns a magic number into an asm-magic number or back
444: $fedcba0987654321 xor ;
445:
446: : patch-branch ( behind-branch-addr target-addr -- )
447: \ there is a branch just before behind-branch-addr; PATCH-BRANCH
448: \ patches this branch to branch to target-addr
449: over - ( behind-branch-addr rel )
450: swap 4 - dup >r ( rel branch-addr R:branch-addr )
451: h@ branch-rel r> h! ; \ !! relies on the imm field being 0 before
452:
453: : if, ( reg xt -- asm-orig )
454: \ xt is for a branch word ( reg addr -- )
455: here 4 + swap execute \ put 0 into the disp field
456: here live-orig magic-asm live-orig ;
457:
458: : ahead, ( -- asm-orig )
459: zero ['] br, if, ;
460:
461: : then, ( asm-orig -- )
462: orig? magic-asm orig?
463: here patch-branch ;
464:
465: : begin, ( -- asm-dest )
466: here dest magic-asm dest ;
467:
468: : until, ( asm-dest reg xt -- )
469: \ xt is a condition ( reg addr -- )
470: here 4 + swap execute
471: dest? magic-asm dest?
472: here swap patch-branch ;
473:
474: : again, ( asm-dest -- )
475: zero ['] br, until, ;
476:
477: : while, ( asm-dest -- asm-orig asm-dest )
478: if, 1 cs-roll ;
479:
480: : else, ( asm-orig1 -- asm-orig2 )
481: ahead, 1 cs-roll then, ;
482:
483: : repeat, ( asm-orig asm-dest -- )
484: again, then, ;
485:
486: : endif, ( asm-orig -- )
487: then, ;
488:
489: \ \ jump marks
490:
491: \ \ example:
492:
493: \ \ init_marktbl \ initializes mark table
494: \ \ 31 0 br,
495: \ \ 0 store_branch \ store jump address for mark 0
496: \ \ 1 2 3 addf,
497: \ \ 0 set_mark \ store mark 0
498: \ \ 2 3 4 addf,
499: \ \ 2 0 beq,
500: \ \ 0 store_branch \ store jump address for mark 0
501: \ \ calculate_marks \ calculate all jumps
502:
503: \ \ with <mark_address> <jump_address> calculate_branch you can calculate the
504: \ \ displacement field without the mark_table for one branch
505:
506: \ \ example:
507: \ \ here 31 0 br,
508: \ \ here 1 2 3 addf,
509: \ \ calculate_branch
510:
511: \ 5 constant mark_numbers
512: \ 5 constant mark_uses
513:
514: \ create mark_table
515: \ mark_numbers mark_uses 1+ * cells allot
516:
517: \ : init_marktbl ( -- ) \ initializes mark table
518: \ mark_table mark_numbers mark_uses 1+ * cells +
519: \ mark_table
520: \ begin
521: \ over over >
522: \ while
523: \ dup 0 swap !
524: \ 1 cells +
525: \ repeat
526: \ drop drop
527: \ ;
528:
529: \ : set_mark ( mark_number -- ) \ sets mark, store address in mark table
530: \ dup mark_numbers >= abort" error, illegal mark number"
531: \ mark_uses 1+ * cells
532: \ mark_table + here 8 - swap !
533: \ ;
534:
535: \ : store_branch ( mark_number -- ) \ stores address of branch in mark table
536: \ dup mark_numbers >= abort" error, illegal mark number"
537: \ mark_uses 1+ * cells
538: \ mark_table + 1 cells +
539: \ dup mark_uses cells + swap
540: \ begin
541: \ over over > over @ and
542: \ while
543: \ 1 cells +
544: \ repeat
545: \ swap over = abort" error, not enough space in mark_table, increase mark_uses"
546: \ here 4 - swap !
547: \ ;
548:
549: \ : calculate_branch ( mark_addr branch_addr -- ) \ calculate branch displacement field for one branch
550: \ swap over - 4 + 4 /
551: \ $1fffff and
552: \ over h@ or swap h!
553: \ ;
554:
555: \ : calculate_mark ( tb mark_address -- tb ) \ calculates branch displacement field for one mark
556: \ over 1 cells +
557: \ dup mark_uses cells + swap
558: \ begin
559: \ over over >
560: \ while
561: \ 2over swap drop ( ei i markaddr ej j markaddr )
562: \ over @
563: \ dup if
564: \ calculate_branch
565: \ else
566: \ drop drop
567: \ endif
568: \ 1 cells +
569: \ repeat drop drop drop
570: \ ;
571:
572: \ : calculate_marks ( -- ) \ calculates branch displacement field for all marks
573: \ mark_table mark_numbers 1- mark_uses 1+ * cells +
574: \ mark_table
575: \ begin
576: \ over over >=
577: \ while
578: \ dup @
579: \ dup if \ used mark
580: \ calculate_mark
581: \ else
582: \ drop
583: \ endif
584: \ mark_uses 1+ cells +
585: \ repeat
586: \ drop drop
587: \ ;
588:
589: previous set-current
590:
591:
592:
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 / alpha