![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to vaxmcode.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 / vax|
Return to vaxmcode.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / vax |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure VaxMCode : VAXMCODER = struct
3:
4: structure Jumps = struct
5: datatype JumpKind = MODE | WHICH of (int ref * int * int)
6: | BYTEDISPL
7: | LABPTR of int
8: | COND of (int ref * int * int) | JBR
9: fun sbyte i = chr(if i<0 then 256+i else i)
10: fun eword i =
11: if i<0 then eword(65536+i)
12: else [chr(i mod 256), chr(i div 256)]
13: fun elong i =
14: if i<0
15: then let val a = ~i;
16: val b = a mod 65536;
17: val c = a div 65536;
18: in eword(~b) @ eword(~c + if b=0 then 0 else ~1)
19: end
20: else eword(i mod 65536) @ eword(i div 65536)
21: fun intsize(i) =
22: if i >= ~128 andalso i < 128
23: then 1
24: else if i >= ~32768 andalso i < 32768
25: then 2
26: else 4;
27:
28: fun emitlong i = implode(elong i)
29:
30: fun sizejump(mode,oldsize,s,d) =
31: let fun which (r,a,b) =
32: case oldsize of 1 => r := a | _ => r := b
33: in case (mode,intsize(d-(s+oldsize)))
34: of (MODE,i) => i+1
35: | (LABPTR _, _) => 4
36: | (BYTEDISPL, _) => 1
37: | (WHICH _, _) => 1
38: | (COND x, 1) => (which x; 1)
39: | (COND x, 2) => (which x; 4)
40: | (COND x, _) => (which x; 7)
41: | (JBR,1) => 2
42: | (JBR,2) => 3
43: | (JBR,_) => 6
44: end
45:
46: fun emitjump(MODE,2,s,d) = chr(10*16+15) ^ sbyte(d-s-2)
47: | emitjump(MODE,3,s,d) = implode(chr(12*16+15) :: eword(d-s-3))
48: | emitjump(MODE,5,s,d) = implode(chr(14*16+15) :: elong (d-s-5))
49: | emitjump(BYTEDISPL,1,s,d) = sbyte(d-s-1)
50: | emitjump(LABPTR i, _,s,d) = emitlong(d-s+i)
51: | emitjump(WHICH(ref i,_,_), _,_,_) = chr i
52: | emitjump(COND _, 1,s,d) = sbyte(d-s-1)
53: | emitjump(COND _, 4,s,d) = implode(chr 3 :: chr(3*16+1) :: eword(d-s-4))
54: | emitjump(COND _, 7,s,d) = implode(chr 6 :: chr(16+7) :: chr(14*16+15)
55: :: elong (d-s-7))
56: | emitjump(JBR,2,s,d) = chr(16+1) ^ sbyte (d-s-2)
57: | emitjump(JBR,3,s,d) = implode(chr(3*16+1) :: eword (d-s-3))
58: | emitjump(JBR,6,s,d) = implode(chr(16+7):: chr(14*16+15) :: elong (d-s-6))
59: | emitjump _ = ErrorMsg.impossible "emitjump"
60:
61: end (* Jumps *)
62:
63: structure Emitter : BACKPATCH = Backpatch(Jumps)
64:
65: structure Coder : VAXCODER = struct
66:
67: open Emitter Jumps
68:
69: fun emitbyte i = emitstring(chr i)
70: fun signedbyte i = emitbyte(if i<0 then 256+i else i)
71: fun emitword i =
72: if i<0 then emitword(65536+i)
73: else (emitbyte(i mod 256); emitbyte(i div 256));
74: fun emitlong i =
75: if i<0
76: then let val a = ~i;
77: val b = a mod 65536;
78: val c = a div 65536;
79: in emitword(~b);
80: emitword(~c + if b=0 then 0 else ~1)
81: end
82: else (emitword(i mod 65536); emitword(i div 65536))
83: fun intsize(i) =
84: if i >= ~128 andalso i < 128
85: then 1
86: else if i >= ~32768 andalso i < 32768
87: then 2
88: else 4;
89:
90: datatype Register = reg of int
91:
92: val r0 = reg 0
93: val r1 = reg 1
94: val r2 = reg 2
95: val r3 = reg 3
96: val r4 = reg 4
97: val r5 = reg 5
98: val r6 = reg 6
99: val r7 = reg 7
100: val r8 = reg 8
101: val r9 = reg 9
102: val r10 = reg 10
103: val r11 = reg 11
104: val r12 = reg 12
105: val r13 = reg 13
106: val sp = reg 14
107: val pc = reg 15
108:
109: datatype EA = direct of Register
110: | autoinc of Register
111: | autodec of Register
112: | displace of int * Register
113: | deferred of int * Register
114: | immed of int
115: | immedlab of Label
116: | address of Label
117: | index of EA * Register
118:
119: (* This is identical to M68PrimReal except that emitword is different,
120: and the bias is off by two. *)
121: structure VaxPrimReal : PRIMREAL =
122: struct
123: val significant = 53 (* 52 + redundant 1/2 bit *)
124: fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range")
125: (* Convert a portion of a boolean array to the appropriate integer. *)
126: exception Bits
127: fun bits(a,start,width) =
128: let fun b true = 1
129: | b false = 0
130: fun f 0 = b (a sub start)
131: | f n = b (a sub (start+n)) + 2 * f(n-1)
132: in if Array.length a < start+width orelse start < 0 orelse width < 0
133: then raise Bits
134: else f (width-1)
135: end
136: fun emitreal (sign,frac,exp) =
137: let val exponent = exp + 1024
138: fun emit () =
139: let val word0 =
140: case frac sub 0 of (* zero? *)
141: true => Bits.orb(Bits.lshift(sign,15),
142: Bits.orb(Bits.lshift(exponent,4),
143: bits(frac,1,4)))
144: | false => 0
145: val word1 = bits(frac,5,16)
146: val word2 = bits(frac,21,16)
147: val word3 = bits(frac,37,16)
148: in emitword word0;
149: emitword word1;
150: emitword word2;
151: emitword word3
152: end
153: in if exponent < 1 orelse exponent > 2047
154: then outofrange "" (* A hack *)
155: else emit()
156: end
157: end
158: structure VaxRealConst = RealConst(VaxPrimReal)
159: open VaxRealConst
160:
161: fun regmode(mode,r) = emitbyte(mode*16+r)
162:
163: fun emitarg (direct(reg r)) = regmode(5,r)
164: | emitarg (autoinc(reg r)) = regmode(8,r)
165: | emitarg (autodec(reg r)) = regmode(7,r)
166: | emitarg (immed i) =
167: if i>=0 andalso i<64 then emitbyte i
168: else (emitarg(autoinc pc); emitlong i)
169: | emitarg (displace(i,reg r)) =
170: if i=0 then regmode(6,r)
171: else (case intsize i
172: of 1 => (regmode(10,r); signedbyte i)
173: | 2 => (regmode(12,r); emitword i)
174: | 4 => (regmode(14,r); emitlong i))
175: | emitarg (deferred(i,reg r)) =
176: (case intsize i of
177: 1 => (regmode(11,r); signedbyte i)
178: | 2 => (regmode(13,r); emitword i)
179: | 4 => (regmode(15,r); emitlong i))
180: | emitarg (index(ea, reg r)) = (regmode(4,r); emitarg ea)
181: | emitarg (address lab) = jump(MODE,lab) (* no good for branches *)
182:
183: fun emit2arg (arg1,arg2) = (emitarg arg1; emitarg arg2)
184:
185: fun emit3arg (arg1,arg2,arg3) = (emitarg arg1; emitarg arg2; emitarg arg3)
186:
187: fun pure (autoinc _) = false
188: | pure (autodec _) = false
189: | pure _ = true
190:
191: fun args23(f2,f3) (args as (a,b,c)) =
192: if b=c andalso pure b then (f2(a,b)) else f3 args
193:
194: fun immedbyte(i) =
195: if i>=0 andalso i<64 then emitbyte i
196: else (emitarg(autoinc pc); signedbyte i);
197:
198: fun immedword(i) =
199: if i>=0 andalso i<64 then emitbyte i
200: else (emitarg(autoinc pc); emitword i);
201:
202: fun emitlab (i,lab) = jump(LABPTR i, lab)
203:
204: fun jbr (address lab) = jump(JBR,lab)
205: fun bbc (immed 0, arg, address lab) =
206: let val r = (ref 0, 14*16+9,14*16+8)
207: in jump(WHICH r, lab); emitarg arg; jump(COND r, lab)
208: end
209: | bbc (arg1, arg2, address lab) =
210: let val r = (ref 0, 14*16+1,14*16+0)
211: in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
212: end
213: fun bbs (immed 0, arg, address lab) =
214: let val r = (ref 0, 14*16+8,14*16+9)
215: in jump(WHICH r, lab); emitarg arg; jump(COND r, lab)
216: end
217: | bbs (arg1, arg2, address lab) =
218: let val r = (ref 0, 14*16+0,14*16+1)
219: in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
220: end
221:
222: fun movb (immed i, arg2) = (emitbyte(9*16); immedbyte i; emitarg arg2)
223: | movb args = (emitbyte (9*16); emit2arg args)
224:
225: fun movzbl args = (emitbyte (9*16+10); emit2arg args)
226:
227: fun pushal args = (emitbyte (13*16+15); emitarg args)
228:
229: fun addl2 (immed 1, arg) = (emitbyte(13*16+6); emitarg arg)
230: | addl2 args = (emitbyte (12*16); emit2arg args)
231:
232: fun moval (arg, autodec(reg 14)) = pushal arg
233: | moval (args as (displace(i, reg p),direct (reg q))) =
234: if p=q andalso i> ~128 andalso i < 128
235: then addl2(immed i, direct(reg p))
236: else (emitbyte (13*16+14); emit2arg args)
237: | moval args = (emitbyte (13*16+14); emit2arg args)
238:
239: fun movl (immedlab l, arg) = moval(address l, arg)
240: | movl (arg, autodec(reg 14)) = (emitbyte(13*16+13); emitarg arg)
241: | movl (immed 0, arg) = (emitbyte(13*16+4); emitarg arg)
242: | movl args = (emitbyte (13*16); emit2arg args)
243:
244: fun movq args = (emitbyte (7*16+13); emit2arg args)
245:
246: fun rsb () = emitbyte 5
247: fun cmpl args = (emitbyte (13*16+1); emit2arg args)
248: fun addl3 args = (emitbyte (12*16+1); emit3arg args)
249: val addl3 = args23 (addl2,addl3)
250: fun subl2 args = (emitbyte (12*16+2); emit2arg args)
251: fun subl3 args = (emitbyte (12*16+3); emit3arg args)
252: val subl3 = args23 (subl2,subl3)
253: fun bisl3 args = (emitbyte (12*16+9); emit3arg args)
254: fun bicl3 args = (emitbyte (12*16+11); emit3arg args)
255: fun xorl3 args = (emitbyte (12*16+13); emit3arg args)
256: fun ashl(immed i,arg2,arg3)=(emitbyte(7*16+8);immedbyte i;emitarg arg2;emitarg arg3)
257: | ashl args = (emitbyte (7*16+8); emit3arg args)
258: fun mull2 args = (emitbyte (12*16+4); emit2arg args)
259: fun divl3 args = (emitbyte (12*16+7); emit3arg args)
260: fun divl2 args = (emitbyte (12*16+6); emit2arg args)
261: val divl3 = args23 (divl2,divl3)
262: fun jmp (arg as address lab) = jbr arg
263: | jmp arg = (emitbyte (16+7); emitarg arg)
264: fun brb (displace(i,reg 15)) = (emitbyte (16+1); signedbyte i)
265: fun brw (displace(i,reg 15)) = (emitbyte (3*16+1); emitword i)
266:
267: local fun condj(i,j) =
268: fn (address lab) => let val r = (ref 0,16+i,16+j)
269: in jump(WHICH r, lab); jump(COND r, lab)
270: end
271: | displace(k, reg 15) => (emitbyte (16+i); signedbyte k)
272: in val beql = condj(3,2)
273: val bneq = condj(2,3)
274: val jne = bneq
275: val bgeq = condj(8,9)
276: val bgtr = condj(4,5)
277: val blss = condj(9,8)
278: val bleq = condj(5,4)
279: end
280: fun sobgeq (arg,address lab) = (emitbyte (15*16+4); emitarg arg;
281: jump(BYTEDISPL,lab))
282:
283: fun movg args = (emitword(20733); emit2arg args)
284: fun mnegg args = (emitword(21245); emit2arg args)
285: fun addg3 args = (emitword(16893); emit3arg args)
286: fun subg3 args = (emitword(17405); emit3arg args)
287: fun mulg3 args = (emitword(17917); emit3arg args)
288: fun divg3 args = (emitword(18429); emit3arg args)
289: fun cmpg args = (emitword(20989); emit2arg args)
290:
291: fun push arg = movl(arg,autodec sp)
292: fun pusha arg = pushal arg
293: fun pop arg = movl(autoinc sp,arg)
294:
295: fun comment _ = ()
296:
297: end (* Coder *)
298:
299: val finish = Emitter.finish
300:
301: end (* structure MCode *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.