![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ns32mcode.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 / ns32|
Return to ns32mcode.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / ns32 |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure NS32MCode : NS32MCODER = struct
3:
4: structure Jumps = struct
5: datatype JumpKind = DISPL of int
6: | LNGDISPL of int
7: | LABPTR of int
8: fun isquick k = (k<=7 andalso k>= ~8)
9:
10: fun eword i =
11: if i<0 then eword(65536+i)
12: else chr(i mod 256) ^ chr(i div 256)
13:
14: fun erword i =
15: if i<0 then erword(65536+i)
16: else chr(i div 256) ^ chr(i mod 256)
17:
18: fun elong i =
19: if i<0
20: then let val a = ~i;
21: val b = a mod 65536;
22: val c = a div 65536;
23: in eword(~b) ^ eword(~c + if b=0 then 0 else ~1)
24: end
25: else eword(i mod 65536) ^ eword(i div 65536)
26:
27: val emitlong = elong
28:
29: fun intsize(i) =
30: if i<=63 andalso i>= ~64
31: then 1
32: else if i<=8191 andalso i>= ~8192
33: then 2
34: else 4;
35:
36: fun Ldisp (len,d) =
37: if len=1 andalso d<=63 andalso d>= ~64
38: then if d>=0 then chr(d)
39: else chr(128+d)
40: else if len=2 andalso d<=8191 andalso d>= ~8192
41: then if d>=0 then erword(128*256+d)
42: else erword(128*256+d+16384)
43: else if d>=0
44: then erword(192*256+(d div 65536)) ^ erword(d mod 65536)
45: else let val a = ~d
46: val b = a mod 65536
47: val c = a div 65536
48: in erword(~c + if b=0 then 0 else ~1) ^ erword(~b)
49: end
50:
51: fun sizejump(LABPTR _,oldsize,s,d) = 4
52: | sizejump(LNGDISPL _,oldsize,s,d) = 4
53: | sizejump(DISPL i,oldsize,s,d) =
54: case oldsize of
55: 0 => intsize(d-s+i)
56: | 1 => 2 (* I question this! -- A. Appel *)
57: | _ => 4
58:
59: fun emitjump(LABPTR i,4,s,d) = elong(d-s+i)
60: | emitjump(DISPL i,sz,s,d) = Ldisp(sz,d-s+i) (* initial pc is i bytes back *)
61: | emitjump(LNGDISPL i,4,s,d) = Ldisp(4,d-s+i) (* initial pc is i bytes back *)
62: | emitjump(_,sz,s,d) = ErrorMsg.impossible "bad size in emitjump"
63:
64: end (* Jumps *)
65:
66: structure Emitter : BACKPATCH = Backpatch(Jumps)
67:
68: structure Coder : NS32CODER = struct
69:
70: open Emitter Jumps
71:
72: fun emitbyte i = emitstring(chr i)
73: fun signedbyte i = emitbyte(if i<0 then 256+i else i)
74: fun emitword i = emitstring(eword i)
75: fun emitrword i = emitstring(erword i)
76: fun emitlong i = emitstring(elong i)
77:
78: val mkjump = jump
79:
80: fun emitdisp d =
81: if d<=63 andalso d>= ~64
82: then ((if d>=0 then emitbyte(d)
83: else emitbyte(128+d));
84: 1)
85: else if d<=8191 andalso d>= ~8192
86: then ((if d>=0 then emitrword(128*256+d)
87: else emitrword(128*256+d+16384));
88: 2)
89: else if d>=0
90: then (emitrword(192*256+(d div 65536));
91: emitrword(d mod 65536);
92: 4)
93: else let val a = ~d
94: val b = a mod 65536
95: val c = a div 65536
96: in emitrword(~c + if b=0 then 0 else ~1);
97: emitrword(~b);
98: 4
99: end
100:
101: datatype Register = Genreg of int
102: | FloatReg of int
103: | FP
104: | SP
105: | SB
106: | PC
107:
108: val r0 = Genreg 0
109: val r1 = Genreg 1
110: val r2 = Genreg 2
111: val r3 = Genreg 3
112: val r4 = Genreg 4
113: val r5 = Genreg 5
114: val r6 = Genreg 6
115: val r7 = Genreg 7
116: val fp = FP
117: val sp = SP
118: val sb = SB
119: val pc = PC
120: val fp0 = FloatReg 0
121:
122: datatype Size = Byte | Word | Long
123:
124: datatype EA = Direct of Register
125: | Topofstack
126: | Displace of int * Register
127: | Immed of int
128: | Immedlab of Label
129: | Abs of int
130: | OffAddress of Label * int
131: | Index of EA * Register * Size
132:
133: fun address lab = OffAddress(lab,0) (* old Address style *)
134:
135: (* This is identical to M68PrimReal except that emitword is different,
136: and the bias is off by two. *)
137: (* This is broken, because it is really the VAX G-float rep, not
138: the NS32 IEEE rep. *)
139: structure NS32PrimReal : PRIMREAL =
140: struct
141: val significant = 53 (* 52 + redundant 1/2 bit *)
142: fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range")
143: (* Convert a portion of a boolean array to the appropriate integer. *)
144: exception Bits
145: fun bits(a,start,width) =
146: let fun b true = 1
147: | b false = 0
148: fun f 0 = b (a sub start)
149: | f n = b (a sub (start+n)) + 2 * f(n-1)
150: in if Array.length a < start+width orelse start < 0 orelse width < 0
151: then raise Bits
152: else f (width-1)
153: end
154: fun emitreal (sign,frac,exp) =
155: let val exponent = exp + 1022
156: fun emit () =
157: let val word0 =
158: case frac sub 0 of (* zero? *)
159: true => Bits.orb(Bits.lshift(sign,15),
160: Bits.orb(Bits.lshift(exponent,4),
161: bits(frac,1,4)))
162: | false => 0
163: val word1 = bits(frac,5,16)
164: val word2 = bits(frac,21,16)
165: val word3 = bits(frac,37,16)
166: in emitword word3;
167: emitword word2;
168: emitword word1;
169: emitword word0
170: end
171: in if exponent < 1 orelse exponent > 2047
172: then outofrange "" (* A hack *)
173: else emit()
174: end
175: end
176: structure NS32RealConst = RealConst(NS32PrimReal)
177: open NS32RealConst
178:
179: (* The label value, offset i, will be backpatched pc-relative. *)
180: fun emitlab (i,lab) = mkjump(LABPTR i, lab)
181:
182: fun procreg (Direct FP) = 8
183: | procreg (Direct SB) = 10
184: | procreg _ = ErrorMsg.impossible "procreg in ns32mcode"
185:
186: fun imsize k = if k<0 then 3
187: else if k<128 then 0
188: else 1
189:
190: fun quick k = if k>=0 then k else k+16
191:
192: fun gen (Direct(Genreg r)) = r
193: | gen (Direct(FloatReg r)) = r
194: | gen (Direct other) = ErrorMsg.impossible "gen direct in ns32mcode"
195: | gen (Displace(d,Genreg r)) = r+8
196: | gen (Displace(d,FP)) = 24
197: | gen (Displace(d,SP)) = 25
198: | gen (Displace(d,SB)) = 26
199: | gen (Displace(d,PC)) = 27
200: | gen (Displace(d,other)) = ErrorMsg.impossible "gen displace in ns32mcode"
201: | gen (Topofstack) = 23
202: | gen (Immed k) = 20
203: | gen (Abs k) = 21
204: | gen (Index(p,Genreg r,Byte)) = 28
205: | gen (Index(p,Genreg r,Word)) = 29
206: | gen (Index(p,Genreg r,Long)) = 30
207: | gen (Index(p,other,sz)) = ErrorMsg.impossible "gen indexreg in ns32mcode"
208: (* Labels are always pc-relative, see jump widget in emitextn. *)
209: | gen (OffAddress li) = 27 (* assuming all labels are done pc-relative *)
210: | gen (Immedlab lab) = ErrorMsg.impossible "gen immedlab in ns32mcode"
211:
212: fun emitimmed d =
213: if d>=0
214: then (emitrword(d div 65536);
215: emitrword(d mod 65536))
216: else let val a = ~d
217: val b = a mod 25536
218: val c = a div 25536
219: in emitrword(~c + if b=0 then 0 else ~1);
220: emitrword(~b)
221: end
222:
223:
224: fun extnjumps (OffAddress _) = true
225: | extnjumps (Index(OffAddress _,_,_)) = true
226: | extnjumps _ = false
227:
228: fun emitextnc (_,Direct _) = 0
229: | emitextnc (_,Displace(d,_)) = emitdisp(d)
230: | emitextnc (_,Topofstack) = 0
231: | emitextnc (_,Immed k) = (emitimmed(k); 4)
232: | emitextnc (_,Abs k) = emitdisp(k)
233: | emitextnc (_,Index(Index _,_,_)) = ErrorMsg.impossible "illegal extn mode in ns32mcode"
234: | emitextnc (off,Index(p,Genreg r,sz)) = (emitbyte(r+8*gen(p));
235: emitextnc(off+1,p)) + 1
236: | emitextnc (_,Index(p,other,sz)) = ErrorMsg.impossible "illegal extn reg in ns32mcode"
237: | emitextnc (off,OffAddress(lab,i)) = (mkjump(LNGDISPL(i+off),lab); 4)
238: | emitextnc (_,Immedlab lab) = ErrorMsg.impossible "immedlab extn in ns32mcode"
239:
240: fun emitextn (_,Direct _) = ()
241: | emitextn (_,Displace(d,_)) = (emitdisp(d); ())
242: | emitextn (_,Topofstack) = ()
243: | emitextn (_,Immed k) = emitimmed(k)
244: | emitextn (_,Abs k) = (emitdisp(k); ())
245: | emitextn (_,Index(Index _,_,_)) = ErrorMsg.impossible "illegal extn mode in ns32mcode"
246: | emitextn (off,Index(p,Genreg r,sz)) = (emitbyte(r+8*gen(p));
247: emitextn(off+1,p))
248: | emitextn (_,Index(p,other,sz)) = ErrorMsg.impossible "illegal extn reg in ns32mcode"
249: | emitextn (off,OffAddress(lab,i)) = mkjump(DISPL(i+off),lab)
250: | emitextn (_,Immedlab lab) = ErrorMsg.impossible "immedlab extn in ns32mcode"
251:
252: fun shortinstr(b,(src,dest)) =
253: (emitword(b+64*gen(dest)+2048*gen(src));
254: if extnjumps(dest)
255: then let val off = emitextnc(2,src)
256: in emitextn(2+off,dest); ()
257: end
258: else (emitextn(2,src); emitextn(0,dest)))
259:
260: fun longinstr(w,(src,dest)) =
261: (let val gd = gen(dest)
262: in emitword(w+16384*(gd mod 4));
263: emitbyte((gd div 4) + 8*gen(src))
264: end;
265: if extnjumps(dest)
266: then let val off = emitextnc(3,src)
267: in emitextn(3+off,dest); ()
268: end
269: else (emitextn(3,src); emitextn(0,dest)))
270:
271:
272: fun lprl (src,preg) = (emitword(111+128*procreg(preg)+2048*gen(src));
273: emitextn(2,src); ())
274: fun sprl (preg,dest) = (emitword(47+128*procreg(preg)+2048*gen(dest));
275: emitextn(2,dest); ())
276: fun tbit (off as Immed k,base) = shortinstr(55,(off,base))
277: | tbit (off,base) = ErrorMsg.impossible "bad tbit in ns32mcode"
278:
279: fun bfs (OffAddress(lab,i)) = (emitbyte(138);
280: mkjump(DISPL(1+i), lab))
281:
282: fun movql (Immed k,dest) = (emitword(95+128*quick(k)+2048*gen(dest));
283: emitextn(2,dest); ())
284: | movql (src,dest) = ErrorMsg.impossible "illegal movql in ns32mcode"
285:
286: (* Size problem, must detect immediate. *)
287: fun movb (src as Immed k, dest) =
288: (emitword(20+64*gen(dest)+2048*gen(src));
289: if k>127 orelse k< ~128
290: then ErrorMsg.impossible "illegal movb in ns32mcode"
291: else signedbyte(k); (* force to byte size *)
292: emitextn(3,dest); ())
293: | movb args = shortinstr(20,args)
294:
295: (* Size problem, but will always be moving from mem, so ok. *)
296: fun movzbl args = longinstr(206+256*24,args)
297:
298: fun lea args = shortinstr(39,args)
299:
300: fun movl (Immedlab l, arg) = lea(address l, arg)
301: | movl (args as (Immed k, dest)) =
302: if isquick(k)
303: then movql args
304: else shortinstr(23,args)
305: | movl args = shortinstr(23,args)
306:
307: (* Really addql for case Immed 1 *)
308: fun addl (args as (Immed k, dest)) =
309: if isquick(k)
310: then (emitword(15+128*quick(k)+2048*gen(dest));
311: emitextn(2,dest); ())
312: else shortinstr(3,args)
313: | addl args = shortinstr(3,args)
314: fun subl args = shortinstr(35,args)
315: fun negl args = longinstr(78+256*35,args)
316: (* Size problem, must force count to byte size *)
317: fun ashl (count as Immed k, dest) =
318: (let val gd = gen(dest)
319: in emitword(78+256*7+16384*(gd mod 4));
320: emitbyte((gd div 4) + 8*gen(count))
321: end;
322: if k>127 orelse k< ~128
323: then ErrorMsg.impossible "illegal ashl in ns32mcode"
324: else signedbyte(k); (* force to byte size *)
325: emitextn(4,dest); ())
326: | ashl args = longinstr(78+256*7,args)
327: fun andl args = shortinstr(43,args)
328: fun orl args = shortinstr(27,args)
329: fun xorl args = shortinstr(59,args)
330: fun coml args = longinstr(78+256*55,args)
331: fun mull args = longinstr(128+78+256*35,args)
332: fun divl args = longinstr(128+78+256*63,args)
333:
334: fun br (OffAddress(lab,i)) = (emitbyte(234);
335: mkjump(DISPL(1+i),lab))
336:
337: fun jump (arg as OffAddress _) = br arg
338: | jump arg = (emitword(127+512+2048*gen(arg));
339: emitextn(2,arg); ())
340:
341: fun bfs (OffAddress(lab,i)) = (emitbyte(138);
342: mkjump(DISPL(1+i), lab))
343:
344: local fun condj(c) =
345: fn (OffAddress(lab,i)) => (emitbyte(10+16*c);
346: mkjump(DISPL(1+i), lab))
347: | Displace(k, PC) => (emitbyte(10+16*c);
348: emitdisp(k); ())
349: in val beq = condj(0)
350: val bne = condj(1)
351: val bge = condj(13)
352: val bgt = condj(6)
353: val blt = condj(12)
354: val ble = condj(7)
355: end
356:
357: fun cmpl (args as (Immed k,arg2)) =
358: if isquick(k)
359: then (emitword(31+128*quick(k)+2048*gen(arg2));
360: emitextn(2, arg2); ())
361: else shortinstr(7,args)
362: | cmpl args = shortinstr(7,args)
363:
364: fun movg args = longinstr(190+256*4,args)
365: fun negg args = longinstr(190+256*20,args)
366: fun addg args = longinstr(190,args)
367: fun subg args = longinstr(190+256*16,args)
368: fun mulg args = longinstr(190+256*48,args)
369: fun divg args = longinstr(190+256*32,args)
370: fun cmpg args = longinstr(190+256*8,args)
371:
372: fun comment _ = ()
373:
374: end (* Coder *)
375:
376: val finish = Emitter.finish
377:
378: end (* structure MCode *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.