![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to m68mcode.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / m68|
Return to m68mcode.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / m68 |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure M68MCode : M68MCODER = struct
3:
4: (* DEBUG
5: fun diag (s : string) f x =
6: f x handle e =>
7: (print "?exception "; print (System.exn_name e);
8: print " in basicm68."; print s; print "\n";
9: raise e)
10: *)
11:
12: structure Jumps = struct
13: datatype JumpKind = Jcc of int | LEA of int | FJcc of int | LABPTR of int
14: | MODE
15: datatype Size = Byte | Word | Long
16:
17: fun sizeint i =
18: if i < 128 andalso i > ~129 then Byte
19: else if i < 32768 andalso i > ~32769 then Word
20: else Long
21:
22: exception TooBig (* pc relative addressing only has 16-bit displacement *)
23:
24: fun sizejump (LEA _, _,s,d) = (* pc relative addressing *)
25: (case sizeint (d - s - 2) of
26: Byte => 4
27: | Word => 4
28: | Long => 8)
29: | sizejump (LABPTR _, _, _, _) = 4
30: | sizejump (Jcc _, _, s, d) =
31: (case sizeint (d - s - 2) of
32: Byte => 2
33: | Word => 4
34: | Long => 6)
35: | sizejump (FJcc _, _, s, d) =
36: (case sizeint (d - s - 2) of
37: Byte => 4
38: | Word => 4
39: | Long => 6)
40: | sizejump (MODE,_,_,_) = 2
41:
42: (* DEBUG val sizejump = diag "sizejump" sizejump *)
43:
44: fun eword i =
45: if i < 0 then eword(65536 + i)
46: else chr(i div 256) ^ chr(i mod 256)
47:
48: fun elong i =
49: if i < 0 then
50: let val a = ~i
51: val b = a mod 65536
52: val c = a div 65536
53: in eword(~c + (if b = 0 then 0 else ~1)) ^ eword(~b)
54: end
55: else eword(i div 65536) ^ eword(i mod 65536)
56:
57: val emitlong = elong
58:
59: fun signedbyte i = if i < 0 then signedbyte (256 + i) else i
60:
61: exception Illegal
62:
63: fun emitjump (Jcc(opcode),2,s,d) =
64: (case (d-s-2) of
65: 0 => eword(20081) (* nop *)
66: | _ => eword(opcode + signedbyte (d - s - 2)))
67: | emitjump (Jcc(opcode),4,s,d) = eword(opcode) ^ eword(d-s-2)
68: | emitjump(Jcc(opcode),6,s,d) = eword(opcode+255) ^ elong(d-s-2)
69: | emitjump(LABPTR i, _,s,d) = elong(d-s+i)
70: | emitjump (LEA(opcode),4,s,d) = (* pc relative *)
71: eword(opcode+58) ^ eword (d-s-2)
72: | emitjump (LEA(opcode),8,s,d) = (* pc relative *)
73: eword(opcode+59) ^ eword 368 ^ elong (d-s-2)
74: | emitjump (FJcc(cond),4,s,d) =
75: eword(62080+cond) ^ eword(d-s-2)
76: | emitjump (FJcc(cond),6,s,d) =
77: eword(62144+cond) ^ elong(d-s-2)
78: | emitjump (MODE,2,s,d) =
79: let val x = Integer.-(d,s)
80: in if x < 32768 andalso ~32768 <= x
81: then eword(d-s)
82: else raise Illegal
83: end
84:
85: (* DEBUG val emitjump = diag "emitjump" emitjump *)
86: end (* structure Jumps *)
87:
88: structure Emitter : BACKPATCH = Backpatch(Jumps)
89:
90: structure Coder : M68CODER = struct
91:
92: open Emitter
93: open Jumps
94:
95: val emitword = fn i => emitstring(eword i)
96: val emitlong = fn i => emitstring(elong i)
97:
98: datatype Register = DataReg of int
99: | AddrReg of int
100: | FloatReg of int
101: | PC
102:
103: datatype EA = Direct of Register
104: | PostInc of Register
105: | PreDec of Register
106: | Displace of Register * int
107: | Index of Register * int * Register * Size
108: | Immedlab of Label
109: | Immed of int
110: | Abs of int
111: | Address of Label
112:
113: val d0 = DataReg 0
114: and d1 = DataReg 1
115: and d2 = DataReg 2
116: and d3 = DataReg 3
117: and d4 = DataReg 4
118: and d5 = DataReg 5
119: and d6 = DataReg 6
120: and d7 = DataReg 7
121: and a0 = AddrReg 0
122: and a1 = AddrReg 1
123: and a2 = AddrReg 2
124: and a3 = AddrReg 3
125: and a4 = AddrReg 4
126: and a5 = AddrReg 5
127: and a6 = AddrReg 6
128: and sp = AddrReg 7
129: and fp0 = FloatReg 0
130: and fp1 = FloatReg 1
131: and fp2 = FloatReg 2
132: and fp3 = FloatReg 3
133: and fp4 = FloatReg 4
134: and fp5 = FloatReg 5
135: and fp6 = FloatReg 6
136: and fp7 = FloatReg 7
137:
138: exception BadLabelUse
139:
140: (* DEBUG
141: fun diag (s : string) f x =
142: f x handle e =>
143: (print "?exception "; print (System.exn_name e);
144: print " in m68mcode."; print s; print "\n";
145: raise e)
146: *)
147:
148: fun reg (Direct(DataReg d)) = d
149: | reg (Direct(AddrReg a)) = a
150: | reg (PostInc(AddrReg a)) = a
151: | reg (PreDec(AddrReg a)) = a
152: | reg (Displace(AddrReg a,_)) = a
153: | reg (Displace(DataReg a,_)) = 0
154: | reg (Index(PC,_,_,_)) = 3
155: | reg (Index(AddrReg a,_,_,_)) = a
156: | reg (Abs i) = (case sizeint i of
157: Byte => 0
158: | Word => 0
159: | Long => 1)
160: | reg (Immed _) = 4
161: | reg (Address _) = 2
162:
163: (* DEBUG val reg = diag "reg" reg *)
164:
165: fun mode (Direct(DataReg _)) = 0
166: | mode (Direct(AddrReg _)) = 1
167: | mode (Displace(AddrReg _, 0)) = 2
168: | mode (PostInc(AddrReg _)) = 3
169: | mode (PreDec(AddrReg _)) = 4
170: | mode (Displace(AddrReg _,_)) = 5
171: | mode (Displace(DataReg _,_)) = 6
172: | mode (Index(PC,_,_,_)) = 7
173: | mode (Index(AddrReg _,_,_,_)) = 6
174: | mode (Abs _) = 7
175: | mode (Immed _) = 7
176: | mode (Address _) = 7
177:
178: (* DEBUG val mode = diag "mode" mode *)
179:
180: (* Very similar to Vax G_float format, except that the byte order within words
181: is different and the bias is different by 2. *)
182: structure M68PrimReal : PRIMREAL =
183: struct
184: val significant = 53 (* 52 + redundant 1 bit *)
185: fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range")
186: (* Convert a portion of a boolean array to the appropriate integer. *)
187: exception Bits
188: fun bits(a,start,width) =
189: let fun b true = 1
190: | b false = 0
191: fun f 0 = b (a sub start)
192: | f n = b (a sub (start+n)) + 2 * f(n-1)
193: in if Array.length a < start+width orelse start < 0 orelse width < 0
194: then raise Bits
195: else f (width-1)
196: end
197: fun emitreal (sign,frac,exp) =
198: let val exponent = exp + 1022
199: fun emit () =
200: let val word0 =
201: case frac sub 0 of (* zero? *)
202: true => Bits.orb(Bits.lshift(sign,15),
203: Bits.orb(Bits.lshift(exponent,4),
204: bits(frac,1,4)))
205: | false => 0
206: val word1 = bits(frac,5,16)
207: val word2 = bits(frac,21,16)
208: val word3 = bits(frac,37,16)
209: in emitword word0;
210: emitword word1;
211: emitword word2;
212: emitword word3
213: end
214: in if exponent < 1 orelse exponent > 2047
215: then outofrange "" (* A hack *)
216: else emit()
217: end
218: end
219: structure M68RealConst = RealConst(M68PrimReal)
220: open M68RealConst
221:
222: fun scale Byte = 0
223: | scale Word = 512
224: | scale Long = 1024
225:
226: fun emitext (Immed i) = emitlong i
227: | emitext (Abs i) =
228: (case sizeint i of
229: Byte => emitword i
230: | Word => emitword i
231: | Long => emitlong i)
232: | emitext (Direct _) = ()
233: | emitext (PostInc _) = ()
234: | emitext (PreDec _) = ()
235: | emitext (Displace(AddrReg _, 0)) = ()
236: | emitext (Displace (AddrReg _, i)) = emitword i
237: | emitext (Displace (DataReg d, 0)) = emitword(d*4096+2448)
238: | emitext (Displace (DataReg d, i)) = (emitword(d*4096+2464); emitword i)
239: | emitext (Index (_,disp,DataReg d,s)) =
240: emitword(d * 4096 + 2048 + scale s + signedbyte disp)
241: | emitext (Index (_,disp,AddrReg d,s)) =
242: emitword(32768 + d * 4096 + 2048 + scale s + signedbyte disp)
243: | emitext (Address lab) = jump(MODE,lab)
244:
245: (* DEBUG val emitext = diag "emitext" emitext *)
246:
247: fun emitF (opcode,Direct(FloatReg a),Direct(FloatReg b)) =
248: (emitword(61952); emitword(opcode+128*b+1024*a))
249: | emitF (opcode,src,Direct(FloatReg f)) =
250: (emitword(61952 + 8 * mode src + reg src);
251: emitword(opcode+21504+128*f);
252: emitext src)
253: | emitF (opcode,Direct(FloatReg f),dest) =
254: (emitword(61952 + 8 * mode dest + reg dest);
255: emitword(opcode+21504+128*f);
256: emitext dest)
257:
258: (* DEBUG val emitF = diag "emitF" emitF *)
259:
260: fun rts() = emitword 20085
261:
262: fun exg (Direct(AddrReg a),Direct(AddrReg b)) =
263: if a = b then () else emitword(49480 + 512 * a + b)
264: | exg (Direct(DataReg a),Direct(DataReg b)) =
265: if a = b then () else emitword(49472 + 512 * a + b)
266: | exg (Direct(AddrReg b),Direct(DataReg a)) =
267: emitword(49544 + 512 * a + b)
268: | exg (Direct(DataReg a),Direct(AddrReg b)) =
269: emitword(49544 + 512 * a + b)
270:
271: (* DEBUG val exg = diag "exg" exg *)
272:
273: fun pea (Direct _) = raise Illegal
274: | pea (PreDec _) = raise Illegal
275: | pea (PostInc _) = raise Illegal
276: | pea (Immed _) = raise Illegal
277: | pea (Address lab) = (jump(LEA(18496),lab))
278: | pea src = (emitword(18496 + 8 * mode src + reg src); emitext src)
279:
280: (* DEBUG val pea = diag "pea" pea *)
281:
282: fun movl (_,Immed _) = raise Illegal
283: (* labels not implemented *)
284: (* CLR *)
285: | movl(Immed 0,dest) =
286: (emitword(17024 + reg dest + 8 * mode dest); emitext dest)
287: (* MOVEQ/MOVE *)
288: | movl (src as (Immed i),dest as (Direct(DataReg d))) =
289: (case sizeint i of
290: Byte => emitword(28672 + 512 * d + signedbyte i)
291: | _ => (emitword(8192+512*reg dest+64*mode dest+8*mode src+reg src);
292: emitext src))
293: (* MOVEA *)
294: | movl (Address lab,Direct(AddrReg a)) = jump(LEA(8256+512*a),lab)
295: | movl (src,Direct(AddrReg a)) =
296: (emitword(8256 + a * 512 + mode src * 8 + reg src); emitext src)
297: (* general MOVE *)
298: | movl (src,dest) =
299: (emitword(8192 + 512 * reg dest + 64 * mode dest + 8 * mode src + reg src);
300: emitext src;
301: emitext dest)
302:
303: fun exg (Direct (DataReg a), Direct(DataReg b)) = emitword(49472+a*512+b)
304: | exg (Direct (AddrReg a), Direct(AddrReg b)) = emitword(49480+a*512+b)
305: | exg (Direct (DataReg a), Direct(AddrReg b)) = emitword(49544+a*512+b)
306: | exg (Direct (AddrReg a), Direct(DataReg b)) = emitword(49544+b*512+a)
307:
308: (* DEBUG val movl = diag "movl" movl *)
309:
310: fun addl (_,Immed _) = raise Illegal
311: (* ADDQ/ADDA *)
312: | addl (src as (Immed i),dest as (Direct(AddrReg a))) =
313: if i <= 8 andalso i >= 1
314: then emitword(20608 + 512 * (i mod 8) + 8 * mode dest + reg dest)
315: else (emitword(53696 + 512 * a + 8 * mode src + reg src); emitext src)
316: | addl (src,Direct(AddrReg a)) =
317: (emitword(53696 + 512 * a + 8 * mode src + reg src); emitext src)
318: (* ADDQ/ADDI *)
319: | addl (src as (Immed i),dest) =
320: if i <= 8 andalso i >= 1
321: then (emitword(20608+512*(i mod 8)+8*mode dest+reg dest); emitext dest)
322: else (emitword(1664 + 8 * mode dest + reg dest); emitext src; emitext dest)
323: (* general ADD *)
324: | addl (src,Direct(DataReg d)) =
325: (emitword(53376 + 512 * d + reg src + 8 * mode src); emitext src)
326: | addl (Direct(DataReg d),dest) =
327: (emitword(53632 + 512 * d + reg dest + 8 * mode dest); emitext dest)
328:
329: (* DEBUG val addl = diag "addl" addl *)
330:
331: fun lea (Direct _,_) = raise Illegal
332: | lea (PreDec _,_) = raise Illegal
333: | lea (PostInc _,_) = raise Illegal
334: | lea (Immed _,_) = raise Illegal
335: | lea (Address lab,Direct(AddrReg a)) = jump(LEA(16832+512*a),lab)
336: | lea (src,Direct(AddrReg a)) =
337: (emitword(16832 + 512 * a + 8 * mode src + reg src); emitext src)
338: | lea (Displace(a, i), dest as (Direct(DataReg _))) =
339: (movl(Immed(i), dest); addl(Direct(a), dest))
340: | lea _ = raise Illegal
341:
342: (* DEBUG val lea = diag "lea" lea *)
343:
344: fun subl (_,Immed _) = raise Illegal
345: (* SUBQ/SUBA *)
346: | subl (src as (Immed i),dest as (Direct(AddrReg a))) =
347: if i <= 8 andalso i >= 1
348: then emitword(20864 + 512 * (i mod 8) + 8 * mode dest + reg dest)
349: else (emitword(37312 + 512 * a + 8 * mode src + reg src); emitext src)
350: (* SUBA *)
351: | subl (src,Direct(AddrReg a)) =
352: (emitword(37312 + 512 * a + 8 * mode src + reg src); emitext src)
353: (* SUBQ/SUBI *)
354: | subl (src as (Immed i),dest) =
355: if i <= 8 andalso i >= 1
356: then (emitword(20864+512*(i mod 8)+8 * mode dest + reg dest); emitext dest)
357: else (emitword(1152 + reg dest + 8 * mode dest); emitext src; emitext dest)
358: (* general SUB *)
359: | subl (src,Direct(DataReg d)) =
360: (emitword(36992 + 512 * d + reg src + 8 * mode src); emitext src)
361: | subl (Direct(DataReg d),dest) =
362: (emitword(37248 + 512 * d + reg dest + 8 * mode dest); emitext dest)
363:
364: (* DEBUG val subl = diag "subl" subl *)
365:
366: fun eorl (_, Direct(AddrReg _)) = raise Illegal
367: | eorl (Immed i, dest) =
368: if i<65536
369: then (emitword(2624 + reg dest + 8*mode dest); emitword i)
370: else raise Match
371: | eorl (Direct(DataReg d), dest) =
372: (emitword(45440 + 512*d + 8*mode dest + reg dest); emitext dest)
373: | eorl _ = raise Illegal
374:
375: (* DEBUG val eorl = diag "eorl" eorl *)
376:
377: fun orl (_, Direct(AddrReg _)) = raise Illegal
378: | orl (Immed i, dest) =
379: if i<65536
380: then (emitword(64 + reg dest + 8*mode dest); emitword i)
381: else raise Match
382: | orl (src, Direct(DataReg d)) =
383: (emitword(32896 + 512*d + 8*mode src + reg src); emitext src)
384: | orl (Direct(DataReg d), dest) =
385: (emitword(33152 + 512*d + 8*mode dest + reg dest); emitext dest)
386: | orl _ = raise Illegal
387:
388: (* DEBUG val orl = diag "orl" orl *)
389:
390: fun andl (_, Direct(AddrReg _)) = raise Illegal
391: | andl (Immed i, dest) =
392: if i<65536
393: then (emitword(576 + reg dest + 8*mode dest); emitword i)
394: else raise Match
395: | andl (src, Direct(DataReg d)) =
396: (emitword(49280 + 512*d + 8*mode src + reg src); emitext src)
397: | andl (Direct(DataReg d), dest) =
398: (emitword(49536 + 512*d + 8*mode dest + reg dest); emitext dest)
399: | andl _ = raise Illegal
400:
401: (* DEBUG val andl = diag "andl" andl *)
402:
403: fun mull (src,Direct(DataReg d)) =
404: (emitword(19456 + reg src + 8 * mode src);
405: emitword(2048+4096*d);
406: emitext src)
407:
408: (* DEBUG val mull = diag "mull" mull *)
409:
410: fun divl (src,Direct(DataReg d)) =
411: (emitword(19520 + reg src + 8 * mode src);
412: emitword(2048 + 4097 (*yes, 4097!*) * d);
413: emitext src)
414:
415: (* DEBUG val divl = diag "divl" divl *)
416:
417: fun movb (_,Immed _) = raise Illegal
418: (* labels not implemented *)
419: | movb (Address _,_) = raise Illegal
420: | movb (_,Address _) = raise Illegal
421: (* CLR *)
422: | movb (Immed 0, dest) =
423: (emitword(16896 + reg dest + 8 * mode dest); emitext dest)
424: (* general MOVE *)
425: | movb (src,dest) =
426: (emitword(4096 + 512 * reg dest + 64 * mode dest + 8 * mode src + reg src);
427: emitext src;
428: emitext dest)
429:
430: (* DEBUG val movb = diag "movb" movb *)
431:
432: fun shift dir =
433: let val dr = dir * 256
434: fun f (Immed 0, _) = ()
435: | f (Immed 8, Direct(DataReg d)) = emitword(57472+dr+d)
436: | f (Immed i, Direct(DataReg d)) =
437: if i<1 orelse i>7 then raise Illegal else emitword(57472+dr + 512*i + d)
438: | f (Immed 1, Direct _) = raise Illegal
439: | f (Immed 1, dest) =
440: (emitword(57536 + dr + 8*mode dest + reg dest); emitext dest)
441: | f (Direct(DataReg s), Direct(DataReg d)) = (emitword(57504+dr + 512*s + d))
442: | f _ = raise Illegal
443: in f
444: end
445:
446: val asll = shift 1
447: val asrl = shift 0
448:
449: fun cmpl (_,Immed _) = raise Illegal
450: (* CMP *)
451: | cmpl (src,Direct(DataReg d)) =
452: (emitword(45184 + 512 * d + 8 * mode src + reg src); emitext src)
453: (* CMPA *)
454: | cmpl (src,Direct(AddrReg a)) =
455: (emitword(45504 + 512 * a + 8 * mode src + reg src); emitext src)
456: (* CMPI *)
457: | cmpl (Immed i,dest) =
458: (emitword(3200 + 8 * mode dest + reg dest); emitext dest)
459: (* CMPM *)
460: | cmpl (PostInc(AddrReg y),PostInc(AddrReg x)) = emitword(45448 + 512 * x + y)
461:
462: (* DEBUG val cmpl = diag "cmpl" cmpl *)
463:
464: fun btst (_,Direct(AddrReg _)) = raise Illegal
465: | btst (_,Immed _) = raise Illegal
466: | btst (Direct(DataReg d),dest) =
467: (emitword(256 + 512 * d + 8 * mode dest + reg dest); emitext dest)
468: | btst (Immed i,dest) =
469: (emitword(2048 + 8 * mode dest + reg dest); emitword i; emitext dest)
470:
471: (* DEBUG val btst = diag "btst" btst *)
472:
473: fun emitlab (i,lab) = jump(LABPTR i, lab)
474:
475: fun jne (Address lab) = jump (Jcc(26112),lab)
476: fun jeq (Address lab) = jump (Jcc(26368),lab)
477: fun jgt (Address lab) = jump (Jcc(28160),lab)
478: fun jge (Address lab) = jump (Jcc(27648),lab)
479: fun jlt (Address lab) = jump (Jcc(27904),lab)
480: fun jle (Address lab) = jump (Jcc(28416),lab)
481:
482: fun jra (Address lab) = jump (Jcc(24576),lab)
483: | jra (arg as (Displace(AddrReg _,_))) =
484: (emitword (20160 + 8 * mode arg + reg arg); emitext arg)
485: | jra (arg as Index _) =
486: (emitword (20160 + 8 * mode arg + reg arg); emitext arg)
487:
488: fun jbsr (Address lab) = jump (Jcc(24832),lab)
489: | jbsr (dest as (Displace(AddrReg _,_))) =
490: (emitword(20096 + 8 * mode dest + reg dest); emitext dest)
491: (* doesn't handle >16bit displacement *)
492:
493: (* 68881 float operations *)
494: (* Some src/dest combinations are illegal, but not caught here. *)
495: fun fjne (Address lab) = jump (FJcc(14),lab)
496: fun fjeq (Address lab) = jump (FJcc(1),lab)
497: fun fjgt (Address lab) = jump (FJcc(18),lab)
498: fun fjge (Address lab) = jump (FJcc(19),lab)
499: fun fjlt (Address lab) = jump (FJcc(20),lab)
500: fun fjle (Address lab) = jump (FJcc(21),lab)
501:
502: fun fcmpd (src,dest) = emitF(56,src,dest)
503: fun faddd (src,dest) = emitF(34,src,dest)
504: fun fsubd (src,dest) = emitF(40,src,dest)
505: fun fmuld (src,dest) = emitF(35,src,dest)
506: fun fdivd (src,dest) = emitF(32,src,dest)
507: fun fnegd (src,dest) = emitF(26,src,dest)
508: fun fmoved (src,dest as Direct(FloatReg f)) = emitF(0,src,dest)
509: | fmoved (src as Direct(FloatReg f),dest) = emitF(8192,src,dest)
510:
511: fun trapv() = emitword(20086)
512: fun trapmi() = emitword 23548
513:
514: fun push ea = movl(ea,PreDec sp)
515:
516: fun pop ea = movl(PostInc sp,ea)
517:
518: val pusha = pea
519:
520: fun comment _ = ()
521:
522: end (* Coder *)
523:
524: val finish = Emitter.finish
525:
526: end (* structure MCode *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.