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