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