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