![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to m68.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 m68.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / m68 |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: functor M68CM(V : M68CODER) : CMACHINE = struct
3:
4: structure V' : sig
5: datatype Register = DataReg of int
6: | AddrReg of int
7: | FloatReg of int
8: | PC
9:
10: type Label sharing type Label = V.Label
11: datatype Size = Byte | Word | Long
12:
13: datatype EA = Direct of Register
14: | PostInc of Register
15: | PreDec of Register
16: | Displace of Register * int
17: | Index of Register * int * Register * Size
18: | Immed of int
19: | Immedlab of Label
20: | Abs of int
21: | Address of Label
22:
23: end = V
24: open V'
25:
26: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
27:
28: (* +DEBUG *)
29: fun diag (s : string) f x =
30: f x handle e =>
31: (print "?exception "; print (System.exn_name e);
32: print " in m68."; print s; print "\n";
33: raise e)
34: (* -DEBUG *)
35:
36: fun defer(Direct r) = Displace(r,0)
37: | defer(Immedlab lab) = Address lab
38: | defer _ = ErrorMsg.impossible "defer in cpsm68"
39:
40: (* DEBUG *) val defer = diag "defer" defer
41:
42: val exnptr = Direct(DataReg 7)
43: val dataptr as Direct dataptr' = Direct(AddrReg 6)
44: val arithtemp as Direct arithtemp' = Direct(DataReg 1)
45: val arithtemp2 = Direct(DataReg 2)
46: val arithtemp3 = Direct(DataReg 4)
47: val storeptr = Direct(DataReg 6)
48: val standardclosure = Direct(AddrReg 2)
49: val standardarg = Direct(AddrReg 0)
50: val standardcont = Direct(AddrReg 1)
51: val miscregs = map (Direct o AddrReg) [3,4]
52: val datalimit = Direct(DataReg 5)
53:
54: val ptrtemp2 = Direct(DataReg 3)
55: val ptrtemp as Direct ptrtemp' = Direct(AddrReg 5)
56:
57: fun reg(Direct r) = r
58:
59: fun newlabel() = Immedlab(V.newlabel())
60: (* DEBUG *) val newlabel = diag "newlabel" newlabel
61: fun emitlab(i,Immedlab lab) = V.emitlab(i,lab)
62: fun define (Immedlab lab) = V.define lab
63:
64: fun beginStdFn _ = ()
65:
66: (* checkLimit (n):
67: * Generate code to check the heap limit to see if there is enough free space
68: * to allocate n bytes.
69: *)
70: fun checkLimit maxAllocSize = (
71: V.comment ("check limit, max alloc = "^(makestring maxAllocSize)^"\n");
72: (* Check the heap limit register *)
73: if (maxAllocSize <= 4096)
74: then (
75: V.cmpl(dataptr, datalimit);
76: V.trapmi())
77: else (
78: V.movl (dataptr, arithtemp3);
79: V.addl(Immed(maxAllocSize-4096), arithtemp3);
80: V.cmpl(arithtemp3, datalimit);
81: V.trapmi()))
82:
83: val align = V.align
84: val mark = V.mark
85: fun move(Immedlab l, dest as Direct(AddrReg x)) = V.lea(Address l, dest)
86: | move(Immedlab l, dest) =
87: (V.lea(Address l, ptrtemp);
88: move(ptrtemp,dest))
89: | move(Displace(DataReg(d), i), dest) =
90: (V.movl(Direct(DataReg(d)), ptrtemp);
91: move(Displace(reg(ptrtemp), i), dest))
92: (* let's hope that ptrtemp never shows up in both src and dest! *)
93: | move(src, Address l) =
94: (V.lea(Address l, ptrtemp);
95: move(src, Displace(reg(ptrtemp), 0)))
96: | move x = V.movl x
97: (* DEBUG *) val move = diag "move" move
98:
99: val emitlong = V.emitlong
100: val realconst = V.realconst
101: val emitstring = V.emitstring
102:
103: fun ashl(s as Immed k, r, d as Direct(DataReg _)) =
104: (if r<>d then move(r,d) else (); V.asll(s,d))
105: | ashl(s as Direct(DataReg _),r,d) =
106: (move(r,arithtemp3); V.asll(s,arithtemp3); move(arithtemp3,d))
107: | ashl(s as Immed k,r,d) =
108: (move(r,arithtemp3);
109: if k>8
110: then (move(s,arithtemp2); V.asll(arithtemp2,arithtemp3))
111: else V.asll(s,arithtemp3);
112: move(arithtemp3,d))
113:
114: (* DEBUG *) val ashl = diag "ashl" ashl
115:
116: fun ashr(s as Immed k, r, d as Direct(DataReg _)) =
117: (if r<>d then move(r,d) else ();
118: if k>8 then (move(s,arithtemp3); V.asrl(arithtemp3,d)) else V.asrl(s,d))
119: | ashr(s as Direct(DataReg _),r,d) =
120: (move(r,arithtemp3); V.asrl(s,arithtemp3); move(arithtemp3,d))
121: | ashr(s as Immed k,r,d) =
122: (move(r,arithtemp3);
123: if k>8
124: then (move(s,arithtemp2); V.asrl(arithtemp2,arithtemp3))
125: else V.asrl(s,arithtemp3);
126: move(arithtemp3,d))
127:
128: fun jmpindexb lab = V.jra(Index(PC,2,arithtemp',Byte))
129: (* DEBUG *) val jmpindexb = diag "jmpindexb" jmpindexb
130:
131: fun record(vl, z) =
132: let open CPS
133: fun f (Direct r, SELp(j,p)) = f(Displace(r,j*4),p)
134: | f (Immedlab l, p) = (V.lea(Address l, ptrtemp); f(ptrtemp,p))
135: | f (x,OFFp 0) = V.movl(x, PostInc dataptr')
136: | f (Direct r, OFFp j) = (V.lea(Displace(r,j*4),ptrtemp);
137: f(ptrtemp,OFFp 0))
138: | f (x,p) = (V.movl(x,ptrtemp); f(ptrtemp,p))
139: in
140: app f vl;
141: V.lea(Displace(dataptr',~4*(List.length(vl)-1)),z)
142: end
143:
144: fun select(i, Direct r, s) = move(Displace(r,i*4),s)
145: | select(0, a, s) = move(defer a,s)
146:
147: fun offset(i, Direct r, s) = V.lea(Displace(r,i*4),s)
148: (* DEBUG *) val select = diag "select" select
149: (* DEBUG *) val offset = diag "offset" offset
150:
151: exception Three
152: fun three opcode (a as Direct(AddrReg _), b as Direct(AddrReg _),
153: c as Direct(AddrReg _)) =
154: (three opcode(a,b,arithtemp3); move(arithtemp3,c))
155: | three opcode (a,b,c) =
156: if b=c then opcode(a,b)
157: else if a=c then (move(a,arithtemp3); three opcode(arithtemp3,b,c))
158: else (move(b,c); opcode(a,c))
159:
160: fun threet opcode (a,b,c as Direct(AddrReg _)) =
161: (threet opcode(a,b,arithtemp3); move(arithtemp3,c))
162: | threet opcode (a,b,c) =
163: if b=c then (opcode(a,b); V.trapv())
164: else if a=c then (move(a,arithtemp3); threet opcode(arithtemp3,b,c))
165: else (move(b,c); opcode(a,c); V.trapv())
166:
167: fun three' opcode (a as Immed _,b,c as Direct(DataReg _)) =
168: three opcode(a,b,c)
169: | three' opcode (a as Direct(AddrReg _),b,c) =
170: (move(b,arithtemp3); move(a,arithtemp2);
171: opcode(arithtemp2,arithtemp3); move(arithtemp3,c))
172: | three' opcode (a,b,c) =
173: (move(b,arithtemp3); opcode(a,arithtemp3); move(arithtemp3,c))
174:
175: fun orb(a as Immed k,b,c as Direct(DataReg _)) =
176: if k<65538
177: then if k<=0
178: then raise Match
179: else if b=c then V.orl(a,b) else (move(b,c); V.orl(a,c))
180: else (move(a,arithtemp3);
181: if b=c then V.orl(arithtemp3,b) else (move(b,c); V.orl(arithtemp3,c)))
182: | orb(a as Direct(AddrReg _),b,c) =
183: (move(b,arithtemp3); move(a,arithtemp2);
184: V.orl(arithtemp2,arithtemp3); move(arithtemp3,c))
185: | orb(a as Immed k,b,c) =
186: if k<65536
187: then if k<=0
188: then raise Match
189: else (move(b,arithtemp3); V.orl(a,arithtemp3); move(arithtemp3,c))
190: else (move(a,arithtemp2);
191: move(b,arithtemp3);
192: V.orl(arithtemp2,arithtemp3);
193: move(arithtemp3,c))
194: | orb(a,b,c) = (move(b,arithtemp3); V.orl(a,arithtemp3); move(arithtemp3,c))
195:
196: fun xorb(a as Immed k,b,c as Direct(DataReg _)) =
197: if k<65536
198: then if k<=0
199: then raise Match
200: else if b=c then V.eorl(a,b) else (move(b,c); V.eorl(a,c))
201: else (move(a,arithtemp3);
202: if b=c then V.eorl(arithtemp3,b) else (move(b,c); V.eorl(arithtemp3,c)))
203: | xorb(a as Direct(AddrReg _),b,c) =
204: (move(b,arithtemp3); move(a,arithtemp2);
205: V.eorl(arithtemp2,arithtemp3); move(arithtemp3,c))
206: | xorb(a as Immed k,b,c) =
207: if k<65538
208: then if k<=0
209: then raise Match
210: else (move(b,arithtemp3); V.eorl(a,arithtemp3); move(arithtemp3,c))
211: else (move(a,arithtemp2);
212: move(b,arithtemp3);
213: V.eorl(arithtemp2,arithtemp3);
214: move(arithtemp3,c))
215: | xorb(a,b,c) = (move(b,arithtemp3); V.eorl(a,arithtemp3); move(arithtemp3,c))
216:
217: fun notb(a,b) = (move(Immed ~1,arithtemp3); V.subl(a,arithtemp3);
218: move(arithtemp3,b))
219: val andb = three' V.andl
220: val addl3 = three V.addl
221: val addl3t = threet V.addl
222: val subl3 = three V.subl
223: val subl3t = threet V.subl
224: val mull2 = V.mull
225: fun mull2t x = (mull2 x; V.trapv())
226: val divl2 = V.divl
227:
228: exception Fetchindexb
229: fun fetchindexb(Direct x,y) = (if y=arithtemp then raise Fetchindexb else ();
230: move(Immed 0,y);
231: V.movb(Index(x,0,arithtemp',Byte),y))
232: (* DEBUG *) val fetchindexb = diag "fetchindexb" fetchindexb
233: fun storeindexb(x, Direct y) = V.movb(x,Index(y,0,arithtemp',Byte))
234: (* DEBUG *) val storeindexb = diag "storeindexb" storeindexb
235: fun fetchindexl(Direct x,y,Immed k) = move(Displace(x,k+k-2),y)
236: | fetchindexl(Direct x,y,Direct z) = move(Index(x,~2,z,Word),y)
237: | fetchindexl(Immedlab lab, y, Direct z) =
238: (* this is a hack, since it depends on lab being PC+6 *)
239: move(Index(PC,4,z,Word), y);
240: (* DEBUG *) val fetchindexl = diag "fetchindexl" fetchindexl
241: fun storeindexl(x, y, Immed 1) = move(x, defer y)
242: | storeindexl(x, Direct y, Immed k) = move(x, Displace(y,k+k-2))
243: | storeindexl(x, Direct y, Direct z) = move(x,Index(y,~2,z,Word))
244: (* DEBUG *) val storeindexl = diag "storeindexl" storeindexl
245:
246: val fp0 = FloatReg 0
247:
248: fun finishreal(c) = (V.cmpl(dataptr,datalimit);
249: V.trapmi();
250: V.movl(Immed(8*System.Tags.power_tags
251: + System.Tags.tag_string),
252: PostInc dataptr');
253: V.movl(dataptr,c);
254: V.fmoved(Direct fp0, PostInc dataptr'))
255:
256: fun float f (a,b,c) =
257: (V.fmoved(defer a, Direct fp0);
258: f(defer b, Direct fp0);
259: finishreal c)
260:
261: fun mnegg (a,c) = (V.fnegd(defer a, Direct fp0); finishreal c)
262:
263: val mulg3 = float V.fmuld
264: val divg3 = float V.fdivd
265: val addg3 = float V.faddd
266: val subg3 = float V.fsubd
267:
268: fun cbranch NEQ = V.jne
269: | cbranch EQL = V.jeq
270: | cbranch LEQ = V.jle
271: | cbranch GEQ = V.jge
272: | cbranch LSS = V.jlt
273: | cbranch GTR = V.jgt
274:
275: fun fbranch NEQ = V.fjne
276: | fbranch EQL = V.fjeq
277: | fbranch LEQ = V.fjle
278: | fbranch GEQ = V.fjge
279: | fbranch LSS = V.fjlt
280: | fbranch GTR = V.fjgt
281:
282: fun rev LEQ = GEQ
283: | rev GEQ = LEQ
284: | rev LSS = GTR
285: | rev GTR = LSS
286: | rev NEQ = NEQ
287: | rev EQL = EQL
288:
289: fun ibranch (cond, op1 as Immed _, op2, label) =
290: (V.cmpl(op1, op2); cbranch (rev cond) (defer label))
291: | ibranch (cond, op1, op2, label) =
292: (V.cmpl(op2, op1); cbranch cond (defer label))
293:
294: fun gbranch (cond, op1, op2, label) =
295: (V.fmoved(defer op1,Direct fp0);
296: V.fcmpd(defer op2, Direct fp0);
297: fbranch cond (defer label))
298:
299: fun defer' j = fn x => j(defer x)
300: val jmp = defer' V.jra
301: fun bbs (x,dest as Direct(AddrReg _) ,l) = (move(dest,ptrtemp2);
302: bbs(x,ptrtemp2,l))
303: | bbs (x,y,l) = (V.btst(x,y); V.jne(defer l))
304: (* DEBUG *) val bbs = diag "bbs" bbs
305:
306: val immed = Immed
307: fun isimmed(Immed i) = SOME i
308: | isimmed _ = NONE
309: fun isreg(Direct(AddrReg i)) = SOME i
310: | isreg(Direct(DataReg i)) = SOME(i+8)
311: | isreg _ = NONE
312:
313: fun eqreg (a: EA) b = a=b
314: (* DEBUG *) val eqreg = diag "eqreg" eqreg
315:
316: fun profile(index,incr) = V.addl(Immed incr, Displace(V.sp,4*index))
317:
318: val comment = V.comment
319: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.