Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/OldCGen/rs6000/rs6000.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/OldCGen/rs6000/rs6000.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* Copyright (c) 1992 by AT&T Bell Laboratories
2 :     *
3 :     *)
4 :    
5 :     (* IBM RS6000 Cmachine implementation *)
6 :    
7 :     functor RS6000CM (structure C : CODER
8 :     where type 'a instruction = 'a RS6000InstrSet.instruction
9 :     and type 'a sdi = 'a RS6000InstrSet.sdi) : CMACHINE =
10 :     struct
11 :    
12 :     structure M = RS6000InstrSet
13 :     structure P = CPS.P
14 :     structure D = RS6000Spec.ObjDesc
15 :     val dtoi = LargeWord.toInt (* convert descriptor to int *)
16 :    
17 :     open M
18 :    
19 :     val error = fn msg => ErrorMsg.impossible ("RS6kCM." ^ msg)
20 :    
21 :     val wtoi = Word.toIntX
22 :    
23 :     type EA = C.label M.EA
24 :     exception BadReal = C.BadReal
25 :     val align = fn () => ()
26 :     val mark = C.mark
27 :     val emitlong = C.emitLong
28 :     val realconst = C.emitReal
29 :     val emitstring = C.emitString
30 :     val newlabel = M.ImmedLab o C.newLabel
31 :     val immed = M.Immed
32 :     val immed32 = M.Immed32
33 :     val emitSDI = C.emitSDI
34 :     val emit = C.emit
35 :    
36 :     fun emitlab(k,ImmedLab lab) = C.emitLabel(lab,k)
37 :     | emitlab _ = error "emitlab"
38 :    
39 :     fun define(ImmedLab lab) = C.define lab
40 :     | define _ = error "RS6kCM.define"
41 :    
42 :     (**
43 :     Register Map
44 :     Reg gc desc
45 :     -------------------------------------
46 :     0 n odd ball register
47 :     1 n stack pointer (not used in ML)
48 :     2 n TOC (not used in ML)
49 :     3-13 y miscregs
50 :     14 y data pointer
51 :     15 n heap limit
52 :     16 y store pointer
53 :     17 y standardlink
54 :     18 y standardclosure
55 :     19 y standardarg
56 :     20 y standardcont
57 :     21 y exception pointer
58 :     22 y varptr
59 :     23 y base pointer
60 :     24-27 y misc regs
61 :     28 n temporary (also gclink)
62 :     29-31 n temporaries
63 :     **)
64 :    
65 :     val varptr_indexable = true
66 :     val stackptr as Direct stackptr' : EA = Direct(M.stackReg)
67 :    
68 :     val dataptr as Direct dataptr' : EA = Direct(M.allocReg)
69 :     val limitptr as Direct limitptr' : EA = Direct(M.limitReg)
70 :     val storeptr as Direct storeptr' : EA = Direct(Reg 16)
71 :     val standardlink = Direct(Reg 17)
72 :     val standardclosure = Direct(Reg 18)
73 :     val standardarg = Direct(Reg 19)
74 :     val standardcont = Direct(Reg 20)
75 :     val exnptr = Direct(M.exnptrReg)
76 :     val varptr = Direct(Reg 22)
77 :     val miscregs : EA list = map (Direct o Reg)
78 :     [24,25,26,27,3,4,5,6,7,8,9,10,11,12,13]
79 :     val gcLinkReg = Reg 28
80 :    
81 :     val floatregs: EA list = map (Direct o Freg)
82 :     [1,2,3,4,5,6,7,8,9,10,11,12,13]
83 :     val savedfpregs: EA list = map (Direct o Freg)
84 :     [14,15,16,17,18,19,20,21,22,23,
85 :     24,25,26,27,28,29,30,31]
86 :     val arithtemps: EA list = []
87 :     val tmpFreg = Freg 0
88 :    
89 :     local
90 :     exception NoTmpRegs
91 :     val front = ref 0
92 :     val back = ref 0
93 :     val tmpRegs = [M.maskReg,Reg 30,Reg 31]
94 :     val qsize = length tmpRegs + 1
95 :     val queue = Array.array(qsize,~1)
96 :     fun insert(Reg r) = Array.update(queue,!back,r)
97 :     before back := (!back+1) mod qsize
98 :     | insert _ = error "insert"
99 :     fun remove() = if !front = !back then raise NoTmpRegs
100 :     else Array.sub(queue,!front)
101 :     before front := (!front+1) mod qsize
102 :     val _ = app insert tmpRegs
103 :     in
104 :     fun getTmpReg() = Reg(remove())
105 :     fun freeTmpReg reg = insert reg
106 :    
107 :     (* should be cleaned up in the future *)
108 :     val tmpfpreg = (Freg 30)
109 :    
110 :     end
111 :    
112 :     fun emitBRANCH(cond,bool,lab) =
113 :     let val flabel = C.newLabel()
114 :     val tmpR = getTmpReg()
115 :     in
116 :     emitSDI(M.BRANCH(cond,bool,lab,tmpR,flabel));
117 :     C.define flabel;
118 :     freeTmpReg tmpR
119 :     end
120 :    
121 :     fun emitFBRANCH(cond,cr,bool,lab) =
122 :     let val flabel = C.newLabel()
123 :     val tmpR = getTmpReg()
124 :     in
125 :     emitSDI(M.FBRANCH(cond,cr,bool,lab,tmpR,flabel));
126 :     C.define flabel;
127 :     freeTmpReg tmpR
128 :     end
129 :    
130 :     datatype immedSize = IMMED16 | IMMED32
131 :    
132 :     fun immed_size n = if (~32768 <= n) andalso (n < 32768) then IMMED16
133 :     else IMMED32
134 :    
135 :     fun do_immed_signed(instr,rt,ra,si) =
136 :     case (immed_size si)
137 :     of IMMED16 => emit (instr(rt,ra,Immed16Op si))
138 :     | IMMED32 => let
139 :     val (hi,lo) = M.split si
140 :     val tmpR = getTmpReg()
141 :     in
142 :     emit (M.LIU(tmpR, Immed16Op(wtoi hi)));
143 :     emit (M.A(tmpR,tmpR,Immed16Op(wtoi lo)));
144 :     emit (instr(rt,ra,RegOp tmpR));
145 :     freeTmpReg tmpR
146 :     end
147 :    
148 :     fun load_immed(rt,n) =
149 :     case (immed_size n)
150 :     of IMMED16 => emit (M.CAL(rt,Reg 0,Immed16Op n))
151 :     | IMMED32 => let
152 :     val (hi,lo) = M.split n
153 :     in
154 :     emit (M.LIU(rt,Immed16Op(wtoi hi)));
155 :     emit (M.A(rt,rt,Immed16Op(wtoi lo)))
156 :     end
157 :    
158 :     local
159 :     structure W = Word32
160 :     in
161 :     fun load_immed32(rt,w) = let
162 :     val lo' = W.andb(w, 0w65535)
163 :     val hi' = W.~>>(w, 0w16)
164 :     val (hi,lo) = if W.<(lo', 0w32768)
165 :     then (hi',lo')
166 :     else (W.+(hi', 0w1), W.-(lo', 0w65536))
167 :     in
168 :     if hi = 0w0 then emit(M.CAL(rt, Reg 0, Immed16Op(W.toIntX lo)))
169 :     else (emit(M.LIU(rt, Immed16Op(W.toIntX hi)));
170 :     emit(M.A(rt, rt, Immed16Op(W.toIntX lo))))
171 :     end
172 :     end
173 :    
174 :     (* move(a,b) means a -> b *)
175 :     fun move (Direct(fp1 as Freg _),Direct(fp2 as Freg _)) = emit (M.FMR(fp2,fp1))
176 :     | move (_, Direct(Freg _)) = error "move: bad src"
177 :     | move (Immed n, Direct dst) = load_immed(dst,n)
178 :     | move (Immed32 w, Direct dst) = load_immed32(dst,w)
179 :     | move (ImmedLab lab, Direct dst) = emitSDI(LOADADDR(dst,lab,0))
180 :     | move (Direct src, Direct dst) = if src = dst
181 :     then ()
182 :     else emit (M.AND(dst,src,RegOp src))
183 :     | move _ = error "move"
184 :    
185 :     fun compare_immed(cmp,ra,n) =
186 :     if n >= ~32768 andalso n <= 32767
187 :     then emit (cmp(ra,Immed16Op n))
188 :     else let val tmpR = getTmpReg()
189 :     in
190 :     move(Immed n,Direct tmpR);
191 :     emit (cmp(ra,RegOp tmpR));
192 :     freeTmpReg tmpR
193 :     end
194 :    
195 :     fun jmp (Direct r) = (emit (M.MTSPR(M.LR,r)); emit (M.BR()))
196 :     | jmp (ImmedLab lab) = emit (B(Label24Off(M.POSLAB lab,0)))
197 :     | jmp _ = error "jmp"
198 :    
199 :     (* stackptr' is the stack pointer; pregs_offset is the initial stack
200 :     * offset for pseudo registers, it should be consistent with the
201 :     * offset in the RS6000.prim.asm file.
202 :     *)
203 :     val pregs_offset = 40
204 :    
205 :     fun loadpseudo (Direct x,Immed i) =
206 :     do_immed_signed(M.L, x, stackptr', 2*(i-1)+pregs_offset)
207 :     | loadpseudo (Direct x,Direct y) = (* this case is never used *)
208 :     let val tmpR = getTmpReg()
209 :     in emit(M.SL(tmpR, y, M.Int5Shift 1));
210 :     emit(M.A(tmpR, stackptr', RegOp tmpR));
211 :     do_immed_signed(M.L, x, tmpR, pregs_offset-2);
212 :     freeTmpReg tmpR
213 :     end
214 :     | loadpseudo _ = error "[loadpseudo]"
215 :    
216 :     fun storepseudo(Direct x,Immed i) =
217 :     do_immed_signed(M.ST, x, stackptr', 2*(i-1)+pregs_offset)
218 :     | storepseudo(Direct x,Direct y) = (* this case is never used *)
219 :     let val tmpR = getTmpReg()
220 :     in emit(M.SL(tmpR, y, M.Int5Shift 1));
221 :     emit(M.A(tmpR, stackptr', RegOp tmpR));
222 :     do_immed_signed(M.ST, x, tmpR, pregs_offset-2);
223 :     freeTmpReg tmpR
224 :     end
225 :     | storepseudo _ = error "[storepseudo]"
226 :    
227 :     (* jmpindexb(x,y) means pc <- x + y *)
228 :     fun jmpindexb (ImmedLab lab,Direct y) = let
229 :     val tmpR = getTmpReg()
230 :     in
231 :     emitSDI(M.LOADADDR(tmpR,lab,0));
232 :     emit (M.A(tmpR,y,RegOp tmpR));
233 :     emit (M.MTSPR(M.LR,tmpR));
234 :     freeTmpReg tmpR;
235 :     emit (M.BR())
236 :     end
237 :     | jmpindexb _ = error "jmpindexb"
238 :    
239 :     fun record(vl, Direct z) = let
240 :     open CPS
241 :     val len = List.length vl
242 :     fun f(_,i,nil) = ()
243 :     | f((t1,t2),i,(Direct r, SELp(j,p))::rest) =
244 :     (** follow ptrs to get the item **)
245 :     (do_immed_signed(M.L,t1,r,j*4);
246 :     f((t2,t1),i,(Direct t1,p)::rest))
247 :     | f(t,i,(Direct r,OFFp 0)::rest) =
248 :     (** simple store, last first **)
249 :     (do_immed_signed(M.ST,r,dataptr',i*4);
250 :     f(t,i-1,rest))
251 :     | f((t1,t2),i,(Direct r, OFFp j)::rest) =
252 :     (emit (M.A(t1,r,Immed16Op(4*j)));
253 :     f((t2,t1),i,(Direct t1,OFFp 0)::rest))
254 :     | f((t1,t2),i,(ea,p)::rest) =
255 :     (* convert to register-based *)
256 :     (move(ea,Direct t1);
257 :     f((t2,t1),i,(Direct t1,p)::rest))
258 :     val tmpR1 = getTmpReg()
259 :     val tmpR2 = getTmpReg()
260 :     in
261 :     (* store first word in 0(dataptr') *)
262 :     f((tmpR1,tmpR2),len-1,rev vl);
263 :     freeTmpReg tmpR1;
264 :     freeTmpReg tmpR2;
265 :     emit (M.A(z,dataptr',Immed16Op 4));
266 :     do_immed_signed(M.A,dataptr',dataptr',4*len)
267 :     end
268 :     | record _ = error "record"
269 :    
270 :     fun recordStore(x,y,_) =
271 :     let fun storeListUpdate r = (
272 :     emit (M.ST(r,dataptr',Immed16Op 0));
273 :     emit (M.ST(storeptr',dataptr',Immed16Op 4));
274 :     emit (M.OR(storeptr',dataptr',Immed16Op 0));
275 :     emit (M.A(dataptr',dataptr',Immed16Op 8)))
276 :     in
277 :     case (x, y)
278 :     of (Direct r, Immed 1) => storeListUpdate r
279 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
280 :     in
281 :     do_immed_signed (M.A, tmpR, r, 2*(i-1));
282 :     storeListUpdate tmpR;
283 :     freeTmpReg tmpR
284 :     end
285 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
286 :     in
287 :     emit (M.A(tmpR, r2, Immed16Op ~1));
288 :     emit (M.A(tmpR, tmpR, RegOp tmpR));
289 :     emit (M.A(tmpR, tmpR, RegOp r1));
290 :     storeListUpdate tmpR;
291 :     freeTmpReg tmpR
292 :     end
293 :     | _ => ErrorMsg.impossible "[RS6000CM.recordStore]"
294 :     (* end case *)
295 :     end (* recordStore *)
296 :    
297 :     fun select (i,Direct v',Direct w) = do_immed_signed(M.L,w,v',i*4)
298 :     | select (i,ImmedLab lab,Direct w) = emitSDI(LOAD(w,lab,i*4))
299 :     | select _ = error "select"
300 :    
301 :     fun offset (i,Direct v',Direct w) = do_immed_signed(M.A,w,v',i*4)
302 :     | offset (i,ImmedLab lab,Direct w) = let val tmpR = getTmpReg()
303 :     in
304 :     emitSDI(LOADADDR(tmpR,lab,0));
305 :     do_immed_signed(M.A,w,tmpR,i*4);
306 :     freeTmpReg tmpR
307 :     end
308 :     | offset _ = error "offset"
309 :    
310 :     fun fetchindexb(Direct x,Direct y,Immed indx) =
311 :     do_immed_signed(M.LBZ,y,x,indx)
312 :     | fetchindexb(Direct x,Direct y,Direct indx)= emit (M.LBZ(y,x,RegOp indx))
313 :     | fetchindexb _ = error "fetchindexb"
314 :    
315 :     fun storeindexb(Immed xi,y,z) =
316 :     let val tmpR = getTmpReg()
317 :     in load_immed(tmpR,xi);
318 :     storeindexb(Direct tmpR,y,z);
319 :     freeTmpReg tmpR
320 :     end
321 :     | storeindexb(Direct x,Direct y,Direct indx)= emit (M.STB(x,y,RegOp indx))
322 :     | storeindexb(Direct x,Direct y,Immed indx) =
323 :     do_immed_signed(M.STB,x,y,indx)
324 :     | storeindexb _ = error "storeindexb"
325 :    
326 :     fun fetchindexl(x,Direct y,Direct z') = let
327 :     val tmpR = getTmpReg()
328 :     in
329 :     emit (M.SL(tmpR,z',M.Int5Shift 1));
330 :     (case x
331 :     of Direct x' => ( emit (M.A(tmpR,x',RegOp tmpR));
332 :     emit (M.L(y,tmpR,Immed16Op ~2)))
333 :     | Immed n => do_immed_signed(M.L,y,tmpR,n-2)
334 :     | ImmedLab lab =>
335 :     let val tmpR2 = getTmpReg()
336 :     in
337 :     emitSDI(M.LOADADDR(tmpR2,lab,0));
338 :     emit (M.A(tmpR,tmpR,RegOp tmpR2));
339 :     freeTmpReg tmpR2;
340 :     emit (M.L(y,tmpR,Immed16Op ~2))
341 :     end);
342 :     freeTmpReg tmpR
343 :     end
344 :     | fetchindexl(x,Direct y,Immed z') =
345 :     (case x
346 :     of Direct x' => do_immed_signed(M.L,y,x',2*(z'-1))
347 :     | Immed n => do_immed_signed(M.L,y,Reg 0,n+2*(z'-1))
348 :     | ImmedLab lab => emitSDI(LOAD(y,lab,2*(z'-1))))
349 :     | fetchindexl _ = error "fetchindexl"
350 :    
351 :     fun storeindexl(Direct x,Direct y,Direct z) = let
352 :     val tmpR = getTmpReg()
353 :     in
354 :     emit (M.SL(tmpR,z,Int5Shift 1));
355 :     emit (M.A(tmpR,tmpR,RegOp y));
356 :     emit (M.ST(x,tmpR,Immed16Op ~2));
357 :     freeTmpReg tmpR
358 :     end
359 :     | storeindexl(Direct x,Direct y,Immed zi) =
360 :     do_immed_signed(M.ST,x,y,2*(zi-1))
361 :     | storeindexl(Immed xi,y,z) = let val tmpR = getTmpReg()
362 :     in
363 :     move(Immed xi,Direct tmpR);
364 :     storeindexl(Direct tmpR,y,z);
365 :     freeTmpReg tmpR
366 :     end
367 :     | storeindexl(ImmedLab lab,y,z) = let val tmpR = getTmpReg()
368 :     in
369 :     emitSDI(M.LOADADDR(tmpR,lab,0));
370 :     storeindexl(Direct tmpR,y,z);
371 :     freeTmpReg tmpR
372 :     end
373 :     | storeindexl(Direct x,ImmedLab lab,Immed zi) = let
374 :     val tmpR = getTmpReg()
375 :     in
376 :     emitSDI(M.LOADADDR(tmpR,lab,0));
377 :     do_immed_signed(M.ST,x,tmpR,2*(zi-1));
378 :     freeTmpReg tmpR
379 :     end
380 :     | storeindexl _ = error "storeindexl: bad args"
381 :    
382 :     local
383 :     fun three f (Direct x',Direct y',Immed zi) = do_immed_signed(f,x',y',zi)
384 :     | three f (x as Direct _, y as Direct _,Immed32 w) = let
385 :     val tmpR = getTmpReg()
386 :     in load_immed32(tmpR,w);
387 :     three f (x,y,Direct tmpR);
388 :     freeTmpReg tmpR
389 :     end
390 :     | three f (x, y as Immed yi, z as Immed _) = let
391 :     val tmpR = getTmpReg()
392 :     in
393 :     load_immed(tmpR, yi);
394 :     three f (x, Direct tmpR, z);
395 :     freeTmpReg tmpR
396 :     end
397 :     | three f (x, y as Immed32 yi, z as Immed32 _) = let
398 :     val tmpR = getTmpReg()
399 :     in
400 :     load_immed32(tmpR, yi);
401 :     three f (x, Direct tmpR, z);
402 :     freeTmpReg tmpR
403 :     end
404 :     | three f (x, y as Immed32 yi, z as Immed zi) = let
405 :     val tmpR = getTmpReg()
406 :     in
407 :     load_immed32(tmpR, yi);
408 :     three f (x, Direct tmpR, z);
409 :     freeTmpReg tmpR
410 :     end
411 :     | three f (x, y as Immed yi, z as Immed32 zi) = let
412 :     val tmpR = getTmpReg()
413 :     in
414 :     load_immed32(tmpR, zi);
415 :     three f (x, z, Direct tmpR);
416 :     freeTmpReg tmpR
417 :     end
418 :     | three f (x, y as Immed _, z) = three f (x, z, y)
419 :     | three f (x, y as Immed32 _, z) = three f (x, z, y)
420 :     | three f (Direct x',Direct y',Direct z') = emit (f(x',y',RegOp z'))
421 :     | three f (Direct x',Direct y',ImmedLab lab) = let
422 :     val tmpR = getTmpReg()
423 :     in
424 :     emitSDI(M.LOADADDR(tmpR,lab,0));
425 :     emit (f(x',y',RegOp tmpR));
426 :     freeTmpReg tmpR
427 :     end
428 :     | three f (Direct x,ea,Direct z) = three f (Direct x,Direct z,ea)
429 :     | three _ _ = error "three: bad args"
430 :     in
431 :     fun add(x,y,z) = three M.A (z,x,y)
432 :     fun orb(x,y,z) = three M.OR (z,x,y)
433 :     fun andb(x,y,z) = three M.AND (z,x,y)
434 :     fun xorb(x,y,z) = three M.XOR (z,x,y)
435 :     end
436 :    
437 :     fun fprecord(tag, vl, Direct dst) =
438 :     let open CPS
439 :     val len = (List.length vl) * 8 + 4
440 :     fun f(_,_,_,i,nil) = ()
441 :     | f(t1,t2,f1 as (Freg fpr),i,(Direct r, SELp(j,OFFp 0))::rest) =
442 :     (do_immed_signed(M.L,t1,r,j*8);
443 :     emit(M.ST(t1,stackptr',Immed16Op M.fLoadStoreOff));
444 :     do_immed_signed(M.L,t1,r,j*8+4);
445 :     emit(M.ST(t1,stackptr',Immed16Op(M.fLoadStoreOff+4)));
446 :     emit(M.LFD(Freg fpr,stackptr',Immed16Op M.fLoadStoreOff));
447 :     f(t1,t2,f1,i,(Direct f1,OFFp 0)::rest))
448 :    
449 :     | f(t1,t2,f1,i,(Direct r, SELp(j,p))::rest) =
450 :     (do_immed_signed(M.L,t1,r,j*4);
451 :     f(t2,t1,f1,i,(Direct t1,p)::rest))
452 :    
453 :     | f(t1,t2,f1,i,(Direct (Freg fpr), OFFp 0)::rest) =
454 :     (emit(M.STFD(Freg fpr,stackptr',Immed16Op M.fLoadStoreOff));
455 :     emit(M.L(t1,stackptr',Immed16Op M.fLoadStoreOff));
456 :     do_immed_signed(M.ST,t1,dataptr',i);
457 :     emit(M.L(t1,stackptr',Immed16Op(M.fLoadStoreOff+4)));
458 :     do_immed_signed(M.ST,t1,dataptr',i+4);
459 :     f(t1,t2,f1,i-8,rest))
460 :    
461 :     | f(t1,t2,f1,i,(Direct _, OFFp _)::rest) =
462 :     error "wrong-type in fprecord in rs6000.sml"
463 :    
464 :     | f(t1,t2,f1,i,(ea, p)::rest) =
465 :     (move (ea, Direct t1);
466 :     f(t2,t1,f1,i,(Direct t1,p)::rest))
467 :    
468 :     val tmpR1 = getTmpReg()
469 :     val tmpR2 = getTmpReg()
470 :     val tmpF1 = tmpfpreg
471 :     in
472 :     orb(dataptr,Immed 4,dataptr); (* align *)
473 :     move(tag,Direct tmpR1);
474 :     do_immed_signed(M.ST,tmpR1,dataptr',0);
475 :     f(tmpR1, tmpR2, tmpF1, len-8, rev vl);
476 :     do_immed_signed(M.A,dst,dataptr',4);
477 :     freeTmpReg tmpR1;
478 :     freeTmpReg tmpR2;
479 :     do_immed_signed(M.A,dataptr',dataptr',len)
480 :     end
481 :     | fprecord _ = error "[SparcCM.fprecord]"
482 :    
483 :     fun recordcont _ = error "record_cont not implemented yet"
484 :    
485 :     val startgc_offset = RS6000Spec.startgcOffset
486 :    
487 :     fun testLimit() = emit (M.CMPL(limitptr',dataptr'))
488 :    
489 :     fun decLimit n = (* for polling *)
490 :     (* note: M.S doesn't work here because of overflow I think -lfh *)
491 :     do_immed_signed(M.A,limitptr',limitptr',~n)
492 :    
493 :     fun beginStdFn (ImmedLab lab,Direct reg) = emitSDI(M.SETBASEADDR(lab,reg))
494 :     | beginStdFn _ = error "beginStdFn"
495 :    
496 :     fun checkLimit(max_allocation, restart, mask, rlab, fregs) =
497 :     let val lab = C.newLabel()
498 :     val tmpR = getTmpReg()
499 :     val _ = if max_allocation > 4096
500 :     then (do_immed_signed(M.A,tmpR,dataptr',max_allocation-4096);
501 :     emit (M.CMPL(limitptr',tmpR)))
502 :     else ()
503 :     val _ = emitBRANCH(M.GT,true,lab)
504 :     in (case fregs
505 :     of [] => (emit (M.L(tmpR,stackptr',Immed16Op startgc_offset));
506 :     emit (M.MTSPR(M.LR,tmpR));
507 :     freeTmpReg tmpR;
508 :     move(mask, Direct M.maskReg);
509 :     move(restart, Direct gcLinkReg);
510 :     emit (M.BR()))
511 :     | _ => (let val k = length fregs
512 :     val desc = dtoi(D.makeDesc(k * 8, D.tag_string))
513 :     val retlab = C.newLabel()
514 :    
515 :     (* cps/limit.sml makes sure that there is enough
516 :     space left to save these floating
517 :     point registers *)
518 :     fun deposit([], _) = ()
519 :     | deposit((Direct(Freg fpr))::r, i) =
520 :     (emit(M.STFD(Freg fpr,stackptr',
521 :     Immed16Op M.fLoadStoreOff));
522 :     emit(M.L(tmpR,stackptr',
523 :     Immed16Op M.fLoadStoreOff));
524 :     do_immed_signed(M.ST,tmpR,dataptr',i);
525 :     emit(M.L(tmpR,stackptr',
526 :     Immed16Op(M.fLoadStoreOff+4)));
527 :     do_immed_signed(M.ST,tmpR,dataptr',i+4);
528 :     deposit(r,i+8))
529 :    
530 :     fun restore(s, [], _) = ()
531 :     | restore(s, (Direct(Freg fpr))::r, i) =
532 :     (do_immed_signed(M.L,tmpR,s,i);
533 :     emit(M.ST(tmpR,stackptr',
534 :     Immed16Op M.fLoadStoreOff));
535 :     do_immed_signed(M.L,tmpR,s,i+4);
536 :     emit(M.ST(tmpR,stackptr',
537 :     Immed16Op(M.fLoadStoreOff+4)));
538 :     emit(M.LFD(Freg fpr,stackptr',
539 :     Immed16Op M.fLoadStoreOff));
540 :     restore(s, r, i+8))
541 :    
542 :     in deposit(fregs,4);
543 :     move(immed desc, Direct tmpR);
544 :     (* orb(dataptr,Immed 4,dataptr); *) (* align *)
545 :     do_immed_signed(M.ST,tmpR,dataptr',0);
546 :     do_immed_signed(M.A,M.maskReg,dataptr',4);
547 :     do_immed_signed(M.A,dataptr',dataptr',k*8+4);
548 :     do_immed_signed(M.ST,M.maskReg,stackptr',
549 :     4+pregs_offset);
550 :    
551 :     emit (M.L(tmpR,stackptr',Immed16Op startgc_offset));
552 :     emit (M.MTSPR(M.LR,tmpR));
553 :     move(mask, Direct M.maskReg);
554 :     move(ImmedLab retlab, Direct gcLinkReg);
555 :     emit (M.BR());
556 :    
557 :     C.define retlab;
558 :     let val tmpR2 = getTmpReg()
559 :     in
560 :     do_immed_signed(M.L,tmpR2,stackptr',4+pregs_offset);
561 :     restore(tmpR2, fregs, 0);
562 :     freeTmpReg tmpR2
563 :     end;
564 :     move (rlab, Direct gcLinkReg);
565 :     emit (M.MTSPR(M.LR,gcLinkReg));
566 :     freeTmpReg tmpR;
567 :     testLimit();
568 :     emit (M.BR())
569 :     end));
570 :     C.define lab
571 :     end
572 :    
573 :     fun trapOnOverflow () = let val lab = C.newLabel()
574 :     in
575 :     emitBRANCH(M.SO,false,lab);
576 :     emit(M.TRAP());
577 :     C.define lab
578 :     end
579 :     fun trapOnDivZero () = let val lab = C.newLabel()
580 :     in
581 :     emitBRANCH(M.SO,false,lab);
582 :     emit(MTFSB1 5);
583 :     emit(M.TRAP());
584 :     C.define lab
585 :     end
586 :     local
587 :     fun move2reg (Direct(Reg r)) = (Reg r,NONE)
588 :     | move2reg (Immed n) = let val tmpR = getTmpReg()
589 :     in
590 :     move(Immed n, Direct tmpR);
591 :     (tmpR,SOME tmpR)
592 :     end
593 :     | move2reg (ImmedLab lab) = let val tmpR = getTmpReg()
594 :     in
595 :     move(ImmedLab lab, Direct tmpR);
596 :     (tmpR, SOME tmpR)
597 :     end
598 :     | move2reg (Immed32 w) = let val tmpR = getTmpReg()
599 :     in
600 :     move(Immed32 w, Direct tmpR);
601 :     (tmpR, SOME tmpR)
602 :     end
603 :     | move2reg _ = error "move2reg"
604 :    
605 :     fun free NONE = ()
606 :     | free (SOME r) = freeTmpReg r
607 :     in
608 :     fun addt(x,y,Direct z) = let val (x',tmpx) = move2reg x
609 :     val (y',tmpy) = move2reg y
610 :     in
611 :     emit (M.AO(z,x',y'));
612 :     trapOnOverflow();
613 :     free tmpx;
614 :     free tmpy
615 :     end
616 :     | addt _ = error "addt"
617 :    
618 :     fun mult(x,Direct y) = let val (x',tmpx) = move2reg x
619 :     in
620 :     emit (MULSO(y,x',y));
621 :     trapOnOverflow();
622 :     free tmpx
623 :     end
624 :     | mult _ = error "mult"
625 :     end
626 :    
627 :     fun sub (Direct x,Direct y,Direct z) = emit (M.SF(z,x,RegOp y))
628 :     | sub (Direct x,Immed yi,Direct z) = do_immed_signed(M.SF,z,x,yi)
629 :     | sub (x as Direct _, Immed32 w, z as Direct _) = let val tmpR = getTmpReg()
630 :     in load_immed32(tmpR,w);
631 :     sub(x,Direct tmpR, z);
632 :     freeTmpReg tmpR
633 :     end
634 :     | sub (Immed32 w, y, z) = let val tmpR = getTmpReg()
635 :     in load_immed32(tmpR, w);
636 :     sub(Direct tmpR, y, z);
637 :     freeTmpReg tmpR
638 :     end
639 :     | sub (Immed xi,y,z) = let val tmpR = getTmpReg()
640 :     in
641 :     move(Immed xi,Direct tmpR);
642 :     sub(Direct tmpR,y,z);
643 :     freeTmpReg tmpR
644 :     end
645 :     | sub _ = error "sub"
646 :    
647 :     fun notb(a,b) = sub(a, Immed ~1, b)
648 :    
649 :     local
650 :     fun subtract(Direct x,Direct y,Direct z) = emit (SFO(z,x,y))
651 :     | subtract(Immed xi,y,z) = let val tmpR = getTmpReg()
652 :     in
653 :     move(Immed xi,Direct tmpR);
654 :     subtract(Direct tmpR,y,z);
655 :     freeTmpReg tmpR
656 :     end
657 :     | subtract(x,Immed yi,z) = let val tmpR = getTmpReg()
658 :     in
659 :     move(Immed yi,Direct tmpR);
660 :     subtract(x,Direct tmpR,z);
661 :     freeTmpReg tmpR
662 :     end
663 :     | subtract(Immed32 xi,y,z) = let val tmpR = getTmpReg()
664 :     in
665 :     move(Immed32 xi,Direct tmpR);
666 :     subtract(Direct tmpR,y,z);
667 :     freeTmpReg tmpR
668 :     end
669 :     | subtract(x,Immed32 yi,z) = let val tmpR = getTmpReg()
670 :     in
671 :     move(Immed32 yi,Direct tmpR);
672 :     subtract(x,Direct tmpR,z);
673 :     freeTmpReg tmpR
674 :     end
675 :    
676 :     | subtract _ = error "subtract"
677 :     in
678 :     fun subt arg = (subtract arg; trapOnOverflow())
679 :     end
680 :    
681 :     (* divt(a,b) means b <- b / a *)
682 :     local
683 :     fun divide (Direct x,Direct y) = emit (M.DIVS(y,y,x))
684 :     | divide (xi as Immed _, y) = let
685 :     val tmpR = getTmpReg()
686 :     in
687 :     move(xi, Direct tmpR);
688 :     divide(Direct tmpR, y);
689 :     freeTmpReg tmpR
690 :     end
691 :     | divide (x, yi as Immed _) = let
692 :     val tmpR = getTmpReg()
693 :     in
694 :     move(yi, Direct tmpR);
695 :     divide(x, Direct tmpR);
696 :     freeTmpReg tmpR
697 :     end
698 :     | divide (xi as Immed32 _, y) = let
699 :     val tmpR = getTmpReg()
700 :     in
701 :     move(xi, Direct tmpR);
702 :     divide(Direct tmpR, y);
703 :     freeTmpReg tmpR
704 :     end
705 :     | divide (x, yi as Immed32 _) = let
706 :     val tmpR = getTmpReg()
707 :     in
708 :     move(yi, Direct tmpR);
709 :     divide(x, Direct tmpR);
710 :     freeTmpReg tmpR
711 :     end
712 :     | divide _ = error "divide"
713 :     in
714 :     fun divt arg = (divide arg; trapOnDivZero())
715 :     end
716 :    
717 :     fun ashl (Direct rs,Direct rt,Direct rd) = emit (M.SL(rd,rt,RegShift rs))
718 :     | ashl (Immed n,Direct rt,Direct rd) =
719 :     if n >= 32 orelse n < 0 then
720 :     error "ashl: shift distance"
721 :     else
722 :     emit (M.SL(rd,rt,Int5Shift n))
723 :     | ashl(shamt,Immed n,dst) = let
724 :     val tmpR = getTmpReg()
725 :     in
726 :     move(Immed n, Direct tmpR);
727 :     ashl(shamt,Direct tmpR,dst);
728 :     freeTmpReg tmpR
729 :     end
730 :     | ashl(shamt,Immed32 w,dst) = let
731 :     val tmpR = getTmpReg()
732 :     in
733 :     load_immed32(tmpR, w);
734 :     ashl(shamt,Direct tmpR, dst);
735 :     freeTmpReg tmpR
736 :     end
737 :     | ashl _ = error "ashl"
738 :    
739 :     fun ashr (Direct rs,Direct rt,Direct rd) =
740 :     emit (M.SRA(rd,rt,RegShift rs))
741 :     | ashr (Immed n,Direct rt,Direct rd) =
742 :     if n >= 32 orelse n < 0 then
743 :     error "ashr: shift distance"
744 :     else
745 :     emit (M.SRA(rd,rt,Int5Shift n))
746 :     | ashr(shamt,Immed n,dst) = let
747 :     val tmpR = getTmpReg()
748 :     in
749 :     move(Immed n,Direct tmpR);
750 :     ashr(shamt,Direct tmpR,dst);
751 :     freeTmpReg tmpR
752 :     end
753 :     | ashr(shamt,Immed32 w, dst) = let
754 :     val tmpR = getTmpReg()
755 :     in
756 :     load_immed32(tmpR, w);
757 :     ashr(shamt,Direct tmpR,dst);
758 :     freeTmpReg tmpR
759 :     end
760 :     | ashr _ = error "ashr: bad args"
761 :    
762 :     fun lshr(Direct rs,Direct rt,Direct rd) = emit(M.SRL(rd,rt,RegShift rs))
763 :     | lshr(Immed n,Direct rt,Direct rd) =
764 :     if n >= 32 orelse n < 0 then
765 :     error "lshr: shift distance"
766 :     else
767 :     emit (M.SRL(rd,rt,Int5Shift n))
768 :     | lshr(shamt,Immed n,dst) = let val tmpR = getTmpReg()
769 :     in
770 :     load_immed(tmpR,n);
771 :     lshr(shamt,Direct tmpR,dst);
772 :     freeTmpReg tmpR
773 :     end
774 :     | lshr(shamt,Immed32 w,dst) = let
775 :     val tmpR = getTmpReg()
776 :     in
777 :     load_immed32(tmpR, w);
778 :     lshr(shamt,Direct tmpR,dst);
779 :     freeTmpReg tmpR
780 :     end
781 :     | lshr _ = error "lshr"
782 :    
783 :     fun mulu(Direct x,Direct y) = emit(M.MULS(y,x,y))
784 :     | mulu(Immed32 xi,y) = let val tmpR = getTmpReg()
785 :     in
786 :     load_immed32(tmpR,xi);
787 :     mulu(Direct tmpR,y);
788 :     freeTmpReg tmpR
789 :     end
790 :     | mulu _ = error "mulu"
791 :    
792 :     (* divtu(a,b) = b <- b / a *)
793 :     fun divtu(Direct ra,Direct rb) = let
794 :     fun trap() = (emit(M.MTFSB1 5); emit(M.TRAP()))
795 :     val doneL = C.newLabel() val doitL = C.newLabel()
796 :     val tmpR = getTmpReg()
797 :     in
798 :     emit(M.CAL(tmpR,Reg 0,M.Immed16Op 0));
799 :     emit(M.CMPL(rb,ra));
800 :     emitBRANCH(M.LT,true,doneL);
801 :     emit(M.CAL(tmpR,Reg 0,M.Immed16Op 1));
802 :     emit(M.CMP(ra,M.Immed16Op 0));
803 :     emitBRANCH(M.LT,true,doneL);
804 :     emitBRANCH(M.EQ,false,doitL);
805 :     trap();
806 :     C.define doitL;
807 :     emit(M.CAL(Reg 0,Reg 0,M.Immed16Op 0));
808 :     emit(M.MTSPR(M.MQ,rb));
809 :     emit(M.DIV(tmpR,Reg 0,ra));
810 :    
811 :     C.define doneL;
812 :     emit(M.CAL(rb,tmpR,M.Immed16Op 0));
813 :     freeTmpReg tmpR
814 :     end
815 :     | divtu(x as Immed32 _,y) = let val tmpR = getTmpReg()
816 :     in
817 :     move(x,Direct tmpR);
818 :     divtu(Direct tmpR,y);
819 :     freeTmpReg tmpR
820 :     end
821 :     | divtu _ = error "divtu"
822 :    
823 :     local
824 :     fun floatreg (Direct(fpr as Freg _)) = fpr
825 :     | floatreg _ = error "floatreg"
826 :    
827 :     fun floating_arith f (x,y,z) = let
828 :     val lab = C.newLabel()
829 :     in
830 :     emit (f(floatreg x,floatreg y,floatreg z))
831 :     (*
832 :     emitFBRANCH(M.FEX,1,false,lab);
833 :     emit(M.TRAP());
834 :     C.define lab
835 :     *)
836 :     end
837 :    
838 :     val real_tag = dtoi D.desc_reald
839 :    
840 :     fun store_float(Freg fp,Direct dst,offset) = let
841 :     val tmpR = getTmpReg()
842 :     in
843 :     emit(M.STFD(Freg fp,stackptr',Immed16Op M.fLoadStoreOff));
844 :     emit(M.L(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
845 :     do_immed_signed(M.ST,tmpR,dst,offset);
846 :     emit(M.L(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
847 :     do_immed_signed(M.ST,tmpR,dst,offset+4);
848 :     freeTmpReg tmpR
849 :     end
850 :     | store_float _ = error "store_float"
851 :    
852 :     fun load_float (Freg dst,Direct src,offset) = let
853 :     val tmpR = getTmpReg()
854 :     in
855 :     do_immed_signed(M.L,tmpR,src,offset);
856 :     emit(M.ST(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
857 :     do_immed_signed(M.L,tmpR,src,offset+4);
858 :     emit(M.ST(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
859 :     emit(M.LFD(Freg dst,stackptr',Immed16Op M.fLoadStoreOff));
860 :     freeTmpReg tmpR
861 :    
862 :     end
863 :     | load_float (Freg dst,ImmedLab lab,offset) = let
864 :     val tmpR = getTmpReg()
865 :     in
866 :     emitSDI(LOADF(Freg dst,lab,offset,tmpR));
867 :     freeTmpReg tmpR
868 :     end
869 :     | load_float _ = error "load_float"
870 :     in
871 :     fun fmuld(x,y,z) = floating_arith M.FMO (z,x,y)
872 :     fun fdivd(x,y,z) = floating_arith M.FDO (z,x,y)
873 :     fun faddd(x,y,z) = floating_arith M.FAO (z,x,y)
874 :     fun fsubd(x,y,z) = floating_arith M.FSO (z,x,y)
875 :     fun fnegd(op1,result) = emit (M.FNEG(floatreg result,floatreg op1))
876 :     fun fabsd(op1,result) = emit (M.FABS(floatreg result,floatreg op1))
877 :    
878 :     fun storefloat(src,Direct(Reg result)) =
879 :     (store_float(floatreg src,dataptr,4);
880 :     let val tmpR = getTmpReg()
881 :     in
882 :     load_immed(tmpR,real_tag);
883 :     emit (M.ST(tmpR,dataptr',Immed16Op 0));
884 :     emit (M.A(Reg result,dataptr',Immed16Op 4));
885 :     emit (M.A(dataptr',dataptr',Immed16Op 12));
886 :     freeTmpReg tmpR
887 :     end)
888 :     | storefloat _ = error "storefloat"
889 :    
890 :     fun loadfloat(src, dst) = load_float(floatreg dst,src,0)
891 :    
892 :     (* fetchindexd (x,y,z) y <- mem[x+4*(z-1)] *)
893 :     fun fetchindexd (Direct x,y,Immed i) =
894 :     load_float(floatreg y, Direct x, 4*(i-1))
895 :     | fetchindexd (Direct x,y,Direct z) = let
896 :     val tmpR = getTmpReg()
897 :     in
898 :     emit (M.SL(tmpR,z,Int5Shift 2));
899 :     emit (M.A(tmpR,x,RegOp tmpR));
900 :     load_float(floatreg y,Direct tmpR,~4);
901 :     freeTmpReg tmpR
902 :     end
903 :     | fetchindexd _ = error "fetchindexd"
904 :    
905 :     fun storeindexd (x,Direct y,Immed i) =
906 :     store_float(floatreg x,Direct y, 4*(i-1))
907 :     | storeindexd (x,Direct y,Direct z) = let
908 :     val tmpR = getTmpReg()
909 :     in
910 :     emit (M.SL(tmpR,z,Int5Shift 2));
911 :     emit (M.A(tmpR,y,RegOp tmpR));
912 :     store_float(floatreg x,Direct tmpR,~4);
913 :     freeTmpReg tmpR
914 :     end
915 :     | storeindexd _ = error "storeindexd"
916 :     end
917 :    
918 :     datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
919 :     | GEU | GTU | LTU | LEU
920 :    
921 :     fun ibranch(cond,Immed a,Immed b,ImmedLab lab) = let
922 :     fun wCmp cmp (a, b) = cmp(Word31.fromInt a, Word31.fromInt b)
923 :     in
924 :     if (case cond
925 :     of EQL => a=b | NEQ => a<>b | LSS => a<b
926 :     | LEQ => a<=b | GTR => a>b | GEQ => a>=b
927 :     | GEU => wCmp Word31.>= (a, b) | GTU => wCmp Word31.> (a, b)
928 :     | LEU => wCmp Word31.<= (a, b) | LTU => wCmp Word31.< (a, b)
929 :     (* end case *))
930 :     then emit (M.B(Label24Off(POSLAB lab,0)))
931 :     else ()
932 :     end
933 :     | ibranch(cond,Immed32 a,Immed32 b,ImmedLab lab) = let
934 :     fun wtoi w = Int32.fromLarge(Word32.toLargeIntX w)
935 :     fun cmpi32(cmp, a, b) = cmp(wtoi a, wtoi b)
936 :     in
937 :     if (case cond
938 :     of EQL => a = b
939 :     | NEQ => a <> b
940 :     | GEU => Word32.>=(a,b)
941 :     | GTU => Word32.>(a,b)
942 :     | LEU => Word32.<=(a,b)
943 :     | LTU => Word32.<(a,b)
944 :     | LEQ => cmpi32(Int32.<=, a, b)
945 :     | LSS => cmpi32(Int32.<, a, b)
946 :     | GEQ => cmpi32(Int32.>=, a, b)
947 :     | GTR => cmpi32(Int32.>, a, b))
948 :     then emit(M.B(Label24Off(POSLAB lab,0)))
949 :     else ()
950 :     end
951 :     | ibranch(cond,rs as Direct _,Immed n,lab) = let
952 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
953 :     in
954 :     move(Immed n,tmpR);
955 :     ibranch(cond,rs,tmpR,lab);
956 :     freeTmpReg tmpR'
957 :     end
958 :     | ibranch(cond,rs,Immed32 w,lab) = let
959 :     val tmpR = getTmpReg()
960 :     in move(Immed32 w, Direct tmpR);
961 :     ibranch(cond, rs, Direct tmpR, lab);
962 :     freeTmpReg tmpR
963 :     end
964 :     | ibranch(cond,Immed n,rb,lab) = let
965 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
966 :     in
967 :     move(Immed n,tmpR);
968 :     ibranch(cond,tmpR,rb,lab);
969 :     freeTmpReg tmpR'
970 :     end
971 :     | ibranch(cond,Immed32 w,rb,lab) = let
972 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
973 :     in
974 :     move(Immed32 w,tmpR);
975 :     ibranch(cond,tmpR,rb,lab);
976 :     freeTmpReg tmpR'
977 :     end
978 :     | ibranch(NEQ,Direct ra,Direct rb,ImmedLab lab) =
979 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.EQ,false,lab))
980 :     | ibranch(EQL,Direct ra,Direct rb,ImmedLab lab) =
981 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.EQ,true,lab))
982 :     | ibranch(GTR,Direct ra,Direct rb,ImmedLab lab) =
983 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.GT,true,lab))
984 :     | ibranch(LEQ,Direct ra,Direct rb,ImmedLab lab) =
985 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.GT,false,lab))
986 :     | ibranch(LSS,Direct ra,Direct rb,ImmedLab lab) =
987 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.LT,true,lab))
988 :     | ibranch(GEQ,Direct ra,Direct rb,ImmedLab lab) =
989 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.LT,false,lab))
990 :     | ibranch(GEU,Direct ra,Direct rb,ImmedLab lab) =
991 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.LT,false,lab))
992 :     | ibranch(GTU,Direct ra,Direct rb,ImmedLab lab) =
993 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.GT,true,lab))
994 :     | ibranch(LEU,Direct ra,Direct rb,ImmedLab lab) =
995 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.GT,false,lab))
996 :     | ibranch(LTU,Direct ra,Direct rb,ImmedLab lab) =
997 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.LT,true,lab))
998 :     | ibranch _ = error "ibranch"
999 :    
1000 :     fun fbranchd(cond,Direct fra,Direct frb,ImmedLab lab) = let
1001 :     fun test2bits(bit1, bit2) =
1002 :     (emit(M.CROR(M.FL, bit1, bit2));
1003 :     emitFBRANCH(M.FL, 2, true, lab))
1004 :     in
1005 :     (emit (M.FCMP(fra,frb));
1006 :     case cond
1007 :     of P.fEQ => emitFBRANCH(M.FE, 2, true, lab)
1008 :     | P.fULG => emitFBRANCH(M.FE, 2, false, lab)
1009 :     | P.fUN => emitFBRANCH(M.UN, 2, true, lab)
1010 :     | P.fLEG => emitFBRANCH(M.UN, 2, false, lab)
1011 :     | P.fGT => emitFBRANCH(M.FG, 2, true, lab)
1012 :     | P.fGE => test2bits(M.FG, M.FE)
1013 :     | P.fUGT => test2bits(M.FG, M.UN)
1014 :     | P.fUGE => emitFBRANCH(M.FL, 2, false, lab)
1015 :     | P.fLT => emitFBRANCH(M.FL, 2, true, lab)
1016 :     | P.fLE => test2bits(M.FL, M.FE)
1017 :     | P.fULT => test2bits(M.UN, M.FL)
1018 :     | P.fULE => emitFBRANCH(M.FG, 2, false, lab)
1019 :     | P.fLG => test2bits(M.FL, M.FG)
1020 :     | P.fUE => test2bits(M.UN, M.FE)
1021 :     (*esac*))
1022 :     end
1023 :     | fbranchd _ = error "fbranch"
1024 :    
1025 :     (* Should implement ANDcc and do this better *)
1026 :     fun bbs(Immed k,Direct y,ImmedLab label) =
1027 :     let val tmpR = getTmpReg()
1028 :     val k2 = Word.toInt (Word.<<(0w1, Word.fromInt k))
1029 :     in
1030 :     do_immed_signed(M.AND,tmpR, y, k2);
1031 :     compare_immed(M.CMP, tmpR, k2);
1032 :     freeTmpReg tmpR;
1033 :     emitBRANCH(M.EQ,true,label)
1034 :     end
1035 :     | bbs _ = error "bbs: bad args"
1036 :    
1037 :    
1038 :     val cvti2dTmpOffset = 16
1039 :     val cvti2dConstOffset = 8
1040 :     fun cvti2d(Direct(src as Reg _),Direct(dst as Freg _)) = let
1041 :     val tmpR = getTmpReg()
1042 :     in
1043 :     emit(M.XORU(tmpR,src,Immed16Op 32768));
1044 :     emit(M.ST(tmpR,stackptr',Immed16Op(cvti2dTmpOffset+4)));
1045 :     emit(M.LIU(tmpR,Immed16Op 17200));
1046 :     emit(M.ST(tmpR,stackptr',Immed16Op cvti2dTmpOffset));
1047 :     emit(M.LFD(dst,stackptr',Immed16Op cvti2dTmpOffset));
1048 :     emit(M.LFD(tmpFreg,stackptr',Immed16Op cvti2dConstOffset));
1049 :     emit(M.FSO(dst,dst,tmpFreg));
1050 :     freeTmpReg tmpR
1051 :     end
1052 :    
1053 :     val comment = C.comment
1054 :     end
1055 :    
1056 :     (*
1057 :     * $Log: rs6000.sml,v $
1058 :     * Revision 1.8 1998/02/12 20:48:43 jhr
1059 :     * Removed references to System.Tags.
1060 :     *
1061 :     * Revision 1.7 1998/01/15 10:44:59 george
1062 :     * Fix for bug 1335.
1063 :     * ibranch did not deal with signed comparisions when the arguments
1064 :     * were 32 bit words.
1065 :     *
1066 :     * Revision 1.6 1997/12/03 19:04:57 george
1067 :     * removed rangeChk
1068 :     *
1069 :     * Revision 1.5 1997/11/18 16:57:55 jhr
1070 :     * Added missing zero divide trap to divtu.
1071 :     *
1072 :     * Revision 1.4 1997/11/14 21:48:08 jhr
1073 :     * Restored the support for the Power architecture; the PowerPC code
1074 :     * generator will be MLRisc based.
1075 :     *
1076 :     * Revision 1.3 1997/08/25 16:43:32 jhr
1077 :     * Replaced some old Power architecture instructions with PowerPC instructions.
1078 :     * This means that the Power architecture is no longer supported by this
1079 :     * code generator. Also improved implementation of emitString.
1080 :     *
1081 :     * Revision 1.2 1997/05/20 12:28:37 dbm
1082 :     * SML '97 sharing, where structure.
1083 :     *
1084 :     * Revision 1.1.1.1 1997/01/14 01:38:44 george
1085 :     * Version 109.24
1086 :     *
1087 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0