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 100 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/OldCGen/rs6000/rs6000.sml

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 : monnier 100 val bug = fn msg => ErrorMsg.impossible ("RS6kCM." ^ msg)
20 : monnier 16
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 : monnier 100 | emitlab _ = bug "emitlab"
38 : monnier 16
39 :     fun define(ImmedLab lab) = C.define lab
40 : monnier 100 | define _ = bug "RS6kCM.define"
41 : monnier 16
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 : monnier 100 | insert _ = bug "insert"
99 : monnier 16 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 : monnier 100 | move (_, Direct(Freg _)) = bug "move: bad src"
177 : monnier 16 | 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 : monnier 100 | move _ = bug "move"
184 : monnier 16
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 : monnier 100 | jmp _ = bug "jmp"
198 : monnier 16
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 : monnier 100 | loadpseudo _ = bug "[loadpseudo]"
215 : monnier 16
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 : monnier 100 | storepseudo _ = bug "[storepseudo]"
226 : monnier 16
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 : monnier 100 | jmpindexb _ = bug "jmpindexb"
238 : monnier 16
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 : monnier 100 bug "unexpected non-zero OFFp record fields"
253 :     (*
254 :     | f((t1,t2),i,(Direct r, OFFp j)::rest) =
255 : monnier 16 (emit (M.A(t1,r,Immed16Op(4*j)));
256 :     f((t2,t1),i,(Direct t1,OFFp 0)::rest))
257 : monnier 100 *)
258 : monnier 16 | f((t1,t2),i,(ea,p)::rest) =
259 :     (* convert to register-based *)
260 :     (move(ea,Direct t1);
261 :     f((t2,t1),i,(Direct t1,p)::rest))
262 :     val tmpR1 = getTmpReg()
263 :     val tmpR2 = getTmpReg()
264 :     in
265 :     (* store first word in 0(dataptr') *)
266 :     f((tmpR1,tmpR2),len-1,rev vl);
267 :     freeTmpReg tmpR1;
268 :     freeTmpReg tmpR2;
269 :     emit (M.A(z,dataptr',Immed16Op 4));
270 :     do_immed_signed(M.A,dataptr',dataptr',4*len)
271 :     end
272 : monnier 100 | record _ = bug "record"
273 : monnier 16
274 :     fun recordStore(x,y,_) =
275 :     let fun storeListUpdate r = (
276 :     emit (M.ST(r,dataptr',Immed16Op 0));
277 :     emit (M.ST(storeptr',dataptr',Immed16Op 4));
278 :     emit (M.OR(storeptr',dataptr',Immed16Op 0));
279 :     emit (M.A(dataptr',dataptr',Immed16Op 8)))
280 :     in
281 :     case (x, y)
282 :     of (Direct r, Immed 1) => storeListUpdate r
283 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
284 :     in
285 :     do_immed_signed (M.A, tmpR, r, 2*(i-1));
286 :     storeListUpdate tmpR;
287 :     freeTmpReg tmpR
288 :     end
289 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
290 :     in
291 :     emit (M.A(tmpR, r2, Immed16Op ~1));
292 :     emit (M.A(tmpR, tmpR, RegOp tmpR));
293 :     emit (M.A(tmpR, tmpR, RegOp r1));
294 :     storeListUpdate tmpR;
295 :     freeTmpReg tmpR
296 :     end
297 :     | _ => ErrorMsg.impossible "[RS6000CM.recordStore]"
298 :     (* end case *)
299 :     end (* recordStore *)
300 :    
301 :     fun select (i,Direct v',Direct w) = do_immed_signed(M.L,w,v',i*4)
302 :     | select (i,ImmedLab lab,Direct w) = emitSDI(LOAD(w,lab,i*4))
303 : monnier 100 | select _ = bug "select"
304 : monnier 16
305 :     fun offset (i,Direct v',Direct w) = do_immed_signed(M.A,w,v',i*4)
306 :     | offset (i,ImmedLab lab,Direct w) = let val tmpR = getTmpReg()
307 :     in
308 :     emitSDI(LOADADDR(tmpR,lab,0));
309 :     do_immed_signed(M.A,w,tmpR,i*4);
310 :     freeTmpReg tmpR
311 :     end
312 : monnier 100 | offset _ = bug "offset"
313 : monnier 16
314 :     fun fetchindexb(Direct x,Direct y,Immed indx) =
315 :     do_immed_signed(M.LBZ,y,x,indx)
316 :     | fetchindexb(Direct x,Direct y,Direct indx)= emit (M.LBZ(y,x,RegOp indx))
317 : monnier 100 | fetchindexb _ = bug "fetchindexb"
318 : monnier 16
319 :     fun storeindexb(Immed xi,y,z) =
320 :     let val tmpR = getTmpReg()
321 :     in load_immed(tmpR,xi);
322 :     storeindexb(Direct tmpR,y,z);
323 :     freeTmpReg tmpR
324 :     end
325 :     | storeindexb(Direct x,Direct y,Direct indx)= emit (M.STB(x,y,RegOp indx))
326 :     | storeindexb(Direct x,Direct y,Immed indx) =
327 :     do_immed_signed(M.STB,x,y,indx)
328 : monnier 100 | storeindexb _ = bug "storeindexb"
329 : monnier 16
330 :     fun fetchindexl(x,Direct y,Direct z') = let
331 :     val tmpR = getTmpReg()
332 :     in
333 :     emit (M.SL(tmpR,z',M.Int5Shift 1));
334 :     (case x
335 :     of Direct x' => ( emit (M.A(tmpR,x',RegOp tmpR));
336 :     emit (M.L(y,tmpR,Immed16Op ~2)))
337 :     | Immed n => do_immed_signed(M.L,y,tmpR,n-2)
338 :     | ImmedLab lab =>
339 :     let val tmpR2 = getTmpReg()
340 :     in
341 :     emitSDI(M.LOADADDR(tmpR2,lab,0));
342 :     emit (M.A(tmpR,tmpR,RegOp tmpR2));
343 :     freeTmpReg tmpR2;
344 :     emit (M.L(y,tmpR,Immed16Op ~2))
345 :     end);
346 :     freeTmpReg tmpR
347 :     end
348 :     | fetchindexl(x,Direct y,Immed z') =
349 :     (case x
350 :     of Direct x' => do_immed_signed(M.L,y,x',2*(z'-1))
351 :     | Immed n => do_immed_signed(M.L,y,Reg 0,n+2*(z'-1))
352 :     | ImmedLab lab => emitSDI(LOAD(y,lab,2*(z'-1))))
353 : monnier 100 | fetchindexl _ = bug "fetchindexl"
354 : monnier 16
355 :     fun storeindexl(Direct x,Direct y,Direct z) = let
356 :     val tmpR = getTmpReg()
357 :     in
358 :     emit (M.SL(tmpR,z,Int5Shift 1));
359 :     emit (M.A(tmpR,tmpR,RegOp y));
360 :     emit (M.ST(x,tmpR,Immed16Op ~2));
361 :     freeTmpReg tmpR
362 :     end
363 :     | storeindexl(Direct x,Direct y,Immed zi) =
364 :     do_immed_signed(M.ST,x,y,2*(zi-1))
365 :     | storeindexl(Immed xi,y,z) = let val tmpR = getTmpReg()
366 :     in
367 :     move(Immed xi,Direct tmpR);
368 :     storeindexl(Direct tmpR,y,z);
369 :     freeTmpReg tmpR
370 :     end
371 :     | storeindexl(ImmedLab lab,y,z) = let val tmpR = getTmpReg()
372 :     in
373 :     emitSDI(M.LOADADDR(tmpR,lab,0));
374 :     storeindexl(Direct tmpR,y,z);
375 :     freeTmpReg tmpR
376 :     end
377 :     | storeindexl(Direct x,ImmedLab lab,Immed zi) = let
378 :     val tmpR = getTmpReg()
379 :     in
380 :     emitSDI(M.LOADADDR(tmpR,lab,0));
381 :     do_immed_signed(M.ST,x,tmpR,2*(zi-1));
382 :     freeTmpReg tmpR
383 :     end
384 : monnier 100 | storeindexl _ = bug "storeindexl: bad args"
385 : monnier 16
386 :     local
387 :     fun three f (Direct x',Direct y',Immed zi) = do_immed_signed(f,x',y',zi)
388 :     | three f (x as Direct _, y as Direct _,Immed32 w) = let
389 :     val tmpR = getTmpReg()
390 :     in load_immed32(tmpR,w);
391 :     three f (x,y,Direct tmpR);
392 :     freeTmpReg tmpR
393 :     end
394 :     | three f (x, y as Immed yi, z as Immed _) = let
395 :     val tmpR = getTmpReg()
396 :     in
397 :     load_immed(tmpR, yi);
398 :     three f (x, Direct tmpR, z);
399 :     freeTmpReg tmpR
400 :     end
401 :     | three f (x, y as Immed32 yi, z as Immed32 _) = let
402 :     val tmpR = getTmpReg()
403 :     in
404 :     load_immed32(tmpR, yi);
405 :     three f (x, Direct tmpR, z);
406 :     freeTmpReg tmpR
407 :     end
408 :     | three f (x, y as Immed32 yi, z as Immed zi) = let
409 :     val tmpR = getTmpReg()
410 :     in
411 :     load_immed32(tmpR, yi);
412 :     three f (x, Direct tmpR, z);
413 :     freeTmpReg tmpR
414 :     end
415 :     | three f (x, y as Immed yi, z as Immed32 zi) = let
416 :     val tmpR = getTmpReg()
417 :     in
418 :     load_immed32(tmpR, zi);
419 :     three f (x, z, Direct tmpR);
420 :     freeTmpReg tmpR
421 :     end
422 :     | three f (x, y as Immed _, z) = three f (x, z, y)
423 :     | three f (x, y as Immed32 _, z) = three f (x, z, y)
424 :     | three f (Direct x',Direct y',Direct z') = emit (f(x',y',RegOp z'))
425 :     | three f (Direct x',Direct y',ImmedLab lab) = let
426 :     val tmpR = getTmpReg()
427 :     in
428 :     emitSDI(M.LOADADDR(tmpR,lab,0));
429 :     emit (f(x',y',RegOp tmpR));
430 :     freeTmpReg tmpR
431 :     end
432 :     | three f (Direct x,ea,Direct z) = three f (Direct x,Direct z,ea)
433 : monnier 100 | three _ _ = bug "three: bad args"
434 : monnier 16 in
435 :     fun add(x,y,z) = three M.A (z,x,y)
436 :     fun orb(x,y,z) = three M.OR (z,x,y)
437 :     fun andb(x,y,z) = three M.AND (z,x,y)
438 :     fun xorb(x,y,z) = three M.XOR (z,x,y)
439 :     end
440 :    
441 :     fun fprecord(tag, vl, Direct dst) =
442 :     let open CPS
443 :     val len = (List.length vl) * 8 + 4
444 :     fun f(_,_,_,i,nil) = ()
445 :     | f(t1,t2,f1 as (Freg fpr),i,(Direct r, SELp(j,OFFp 0))::rest) =
446 :     (do_immed_signed(M.L,t1,r,j*8);
447 :     emit(M.ST(t1,stackptr',Immed16Op M.fLoadStoreOff));
448 :     do_immed_signed(M.L,t1,r,j*8+4);
449 :     emit(M.ST(t1,stackptr',Immed16Op(M.fLoadStoreOff+4)));
450 :     emit(M.LFD(Freg fpr,stackptr',Immed16Op M.fLoadStoreOff));
451 :     f(t1,t2,f1,i,(Direct f1,OFFp 0)::rest))
452 :    
453 :     | f(t1,t2,f1,i,(Direct r, SELp(j,p))::rest) =
454 :     (do_immed_signed(M.L,t1,r,j*4);
455 :     f(t2,t1,f1,i,(Direct t1,p)::rest))
456 :    
457 :     | f(t1,t2,f1,i,(Direct (Freg fpr), OFFp 0)::rest) =
458 :     (emit(M.STFD(Freg fpr,stackptr',Immed16Op M.fLoadStoreOff));
459 :     emit(M.L(t1,stackptr',Immed16Op M.fLoadStoreOff));
460 :     do_immed_signed(M.ST,t1,dataptr',i);
461 :     emit(M.L(t1,stackptr',Immed16Op(M.fLoadStoreOff+4)));
462 :     do_immed_signed(M.ST,t1,dataptr',i+4);
463 :     f(t1,t2,f1,i-8,rest))
464 :    
465 :     | f(t1,t2,f1,i,(Direct _, OFFp _)::rest) =
466 : monnier 100 bug "wrong-type in fprecord in rs6000.sml"
467 : monnier 16
468 :     | f(t1,t2,f1,i,(ea, p)::rest) =
469 :     (move (ea, Direct t1);
470 :     f(t2,t1,f1,i,(Direct t1,p)::rest))
471 :    
472 :     val tmpR1 = getTmpReg()
473 :     val tmpR2 = getTmpReg()
474 :     val tmpF1 = tmpfpreg
475 :     in
476 :     orb(dataptr,Immed 4,dataptr); (* align *)
477 :     move(tag,Direct tmpR1);
478 :     do_immed_signed(M.ST,tmpR1,dataptr',0);
479 :     f(tmpR1, tmpR2, tmpF1, len-8, rev vl);
480 :     do_immed_signed(M.A,dst,dataptr',4);
481 :     freeTmpReg tmpR1;
482 :     freeTmpReg tmpR2;
483 :     do_immed_signed(M.A,dataptr',dataptr',len)
484 :     end
485 : monnier 100 | fprecord _ = bug "[SparcCM.fprecord]"
486 : monnier 16
487 : monnier 100 fun recordcont _ = bug "record_cont not implemented yet"
488 : monnier 16
489 :     val startgc_offset = RS6000Spec.startgcOffset
490 :    
491 :     fun testLimit() = emit (M.CMPL(limitptr',dataptr'))
492 :    
493 :     fun decLimit n = (* for polling *)
494 :     (* note: M.S doesn't work here because of overflow I think -lfh *)
495 :     do_immed_signed(M.A,limitptr',limitptr',~n)
496 :    
497 :     fun beginStdFn (ImmedLab lab,Direct reg) = emitSDI(M.SETBASEADDR(lab,reg))
498 : monnier 100 | beginStdFn _ = bug "beginStdFn"
499 : monnier 16
500 :     fun checkLimit(max_allocation, restart, mask, rlab, fregs) =
501 :     let val lab = C.newLabel()
502 :     val tmpR = getTmpReg()
503 :     val _ = if max_allocation > 4096
504 :     then (do_immed_signed(M.A,tmpR,dataptr',max_allocation-4096);
505 :     emit (M.CMPL(limitptr',tmpR)))
506 :     else ()
507 :     val _ = emitBRANCH(M.GT,true,lab)
508 :     in (case fregs
509 :     of [] => (emit (M.L(tmpR,stackptr',Immed16Op startgc_offset));
510 :     emit (M.MTSPR(M.LR,tmpR));
511 :     freeTmpReg tmpR;
512 :     move(mask, Direct M.maskReg);
513 :     move(restart, Direct gcLinkReg);
514 :     emit (M.BR()))
515 :     | _ => (let val k = length fregs
516 :     val desc = dtoi(D.makeDesc(k * 8, D.tag_string))
517 :     val retlab = C.newLabel()
518 :    
519 :     (* cps/limit.sml makes sure that there is enough
520 :     space left to save these floating
521 :     point registers *)
522 :     fun deposit([], _) = ()
523 :     | deposit((Direct(Freg fpr))::r, i) =
524 :     (emit(M.STFD(Freg fpr,stackptr',
525 :     Immed16Op M.fLoadStoreOff));
526 :     emit(M.L(tmpR,stackptr',
527 :     Immed16Op M.fLoadStoreOff));
528 :     do_immed_signed(M.ST,tmpR,dataptr',i);
529 :     emit(M.L(tmpR,stackptr',
530 :     Immed16Op(M.fLoadStoreOff+4)));
531 :     do_immed_signed(M.ST,tmpR,dataptr',i+4);
532 :     deposit(r,i+8))
533 :    
534 :     fun restore(s, [], _) = ()
535 :     | restore(s, (Direct(Freg fpr))::r, i) =
536 :     (do_immed_signed(M.L,tmpR,s,i);
537 :     emit(M.ST(tmpR,stackptr',
538 :     Immed16Op M.fLoadStoreOff));
539 :     do_immed_signed(M.L,tmpR,s,i+4);
540 :     emit(M.ST(tmpR,stackptr',
541 :     Immed16Op(M.fLoadStoreOff+4)));
542 :     emit(M.LFD(Freg fpr,stackptr',
543 :     Immed16Op M.fLoadStoreOff));
544 :     restore(s, r, i+8))
545 :    
546 :     in deposit(fregs,4);
547 :     move(immed desc, Direct tmpR);
548 :     (* orb(dataptr,Immed 4,dataptr); *) (* align *)
549 :     do_immed_signed(M.ST,tmpR,dataptr',0);
550 :     do_immed_signed(M.A,M.maskReg,dataptr',4);
551 :     do_immed_signed(M.A,dataptr',dataptr',k*8+4);
552 :     do_immed_signed(M.ST,M.maskReg,stackptr',
553 :     4+pregs_offset);
554 :    
555 :     emit (M.L(tmpR,stackptr',Immed16Op startgc_offset));
556 :     emit (M.MTSPR(M.LR,tmpR));
557 :     move(mask, Direct M.maskReg);
558 :     move(ImmedLab retlab, Direct gcLinkReg);
559 :     emit (M.BR());
560 :    
561 :     C.define retlab;
562 :     let val tmpR2 = getTmpReg()
563 :     in
564 :     do_immed_signed(M.L,tmpR2,stackptr',4+pregs_offset);
565 :     restore(tmpR2, fregs, 0);
566 :     freeTmpReg tmpR2
567 :     end;
568 :     move (rlab, Direct gcLinkReg);
569 :     emit (M.MTSPR(M.LR,gcLinkReg));
570 :     freeTmpReg tmpR;
571 :     testLimit();
572 :     emit (M.BR())
573 :     end));
574 :     C.define lab
575 :     end
576 :    
577 :     fun trapOnOverflow () = let val lab = C.newLabel()
578 :     in
579 :     emitBRANCH(M.SO,false,lab);
580 :     emit(M.TRAP());
581 :     C.define lab
582 :     end
583 :     fun trapOnDivZero () = let val lab = C.newLabel()
584 :     in
585 :     emitBRANCH(M.SO,false,lab);
586 :     emit(MTFSB1 5);
587 :     emit(M.TRAP());
588 :     C.define lab
589 :     end
590 :     local
591 :     fun move2reg (Direct(Reg r)) = (Reg r,NONE)
592 :     | move2reg (Immed n) = let val tmpR = getTmpReg()
593 :     in
594 :     move(Immed n, Direct tmpR);
595 :     (tmpR,SOME tmpR)
596 :     end
597 :     | move2reg (ImmedLab lab) = let val tmpR = getTmpReg()
598 :     in
599 :     move(ImmedLab lab, Direct tmpR);
600 :     (tmpR, SOME tmpR)
601 :     end
602 :     | move2reg (Immed32 w) = let val tmpR = getTmpReg()
603 :     in
604 :     move(Immed32 w, Direct tmpR);
605 :     (tmpR, SOME tmpR)
606 :     end
607 : monnier 100 | move2reg _ = bug "move2reg"
608 : monnier 16
609 :     fun free NONE = ()
610 :     | free (SOME r) = freeTmpReg r
611 :     in
612 :     fun addt(x,y,Direct z) = let val (x',tmpx) = move2reg x
613 :     val (y',tmpy) = move2reg y
614 :     in
615 :     emit (M.AO(z,x',y'));
616 :     trapOnOverflow();
617 :     free tmpx;
618 :     free tmpy
619 :     end
620 : monnier 100 | addt _ = bug "addt"
621 : monnier 16
622 :     fun mult(x,Direct y) = let val (x',tmpx) = move2reg x
623 :     in
624 :     emit (MULSO(y,x',y));
625 :     trapOnOverflow();
626 :     free tmpx
627 :     end
628 : monnier 100 | mult _ = bug "mult"
629 : monnier 16 end
630 :    
631 :     fun sub (Direct x,Direct y,Direct z) = emit (M.SF(z,x,RegOp y))
632 :     | sub (Direct x,Immed yi,Direct z) = do_immed_signed(M.SF,z,x,yi)
633 :     | sub (x as Direct _, Immed32 w, z as Direct _) = let val tmpR = getTmpReg()
634 :     in load_immed32(tmpR,w);
635 :     sub(x,Direct tmpR, z);
636 :     freeTmpReg tmpR
637 :     end
638 :     | sub (Immed32 w, y, z) = let val tmpR = getTmpReg()
639 :     in load_immed32(tmpR, w);
640 :     sub(Direct tmpR, y, z);
641 :     freeTmpReg tmpR
642 :     end
643 :     | sub (Immed xi,y,z) = let val tmpR = getTmpReg()
644 :     in
645 :     move(Immed xi,Direct tmpR);
646 :     sub(Direct tmpR,y,z);
647 :     freeTmpReg tmpR
648 :     end
649 : monnier 100 | sub _ = bug "sub"
650 : monnier 16
651 :     fun notb(a,b) = sub(a, Immed ~1, b)
652 :    
653 :     local
654 :     fun subtract(Direct x,Direct y,Direct z) = emit (SFO(z,x,y))
655 :     | subtract(Immed xi,y,z) = let val tmpR = getTmpReg()
656 :     in
657 :     move(Immed xi,Direct tmpR);
658 :     subtract(Direct tmpR,y,z);
659 :     freeTmpReg tmpR
660 :     end
661 :     | subtract(x,Immed yi,z) = let val tmpR = getTmpReg()
662 :     in
663 :     move(Immed yi,Direct tmpR);
664 :     subtract(x,Direct tmpR,z);
665 :     freeTmpReg tmpR
666 :     end
667 :     | subtract(Immed32 xi,y,z) = let val tmpR = getTmpReg()
668 :     in
669 :     move(Immed32 xi,Direct tmpR);
670 :     subtract(Direct tmpR,y,z);
671 :     freeTmpReg tmpR
672 :     end
673 :     | subtract(x,Immed32 yi,z) = let val tmpR = getTmpReg()
674 :     in
675 :     move(Immed32 yi,Direct tmpR);
676 :     subtract(x,Direct tmpR,z);
677 :     freeTmpReg tmpR
678 :     end
679 :    
680 : monnier 100 | subtract _ = bug "subtract"
681 : monnier 16 in
682 :     fun subt arg = (subtract arg; trapOnOverflow())
683 :     end
684 :    
685 :     (* divt(a,b) means b <- b / a *)
686 :     local
687 :     fun divide (Direct x,Direct y) = emit (M.DIVS(y,y,x))
688 :     | divide (xi as Immed _, y) = let
689 :     val tmpR = getTmpReg()
690 :     in
691 :     move(xi, Direct tmpR);
692 :     divide(Direct tmpR, y);
693 :     freeTmpReg tmpR
694 :     end
695 :     | divide (x, yi as Immed _) = let
696 :     val tmpR = getTmpReg()
697 :     in
698 :     move(yi, Direct tmpR);
699 :     divide(x, Direct tmpR);
700 :     freeTmpReg tmpR
701 :     end
702 :     | divide (xi as Immed32 _, y) = let
703 :     val tmpR = getTmpReg()
704 :     in
705 :     move(xi, Direct tmpR);
706 :     divide(Direct tmpR, y);
707 :     freeTmpReg tmpR
708 :     end
709 :     | divide (x, yi as Immed32 _) = let
710 :     val tmpR = getTmpReg()
711 :     in
712 :     move(yi, Direct tmpR);
713 :     divide(x, Direct tmpR);
714 :     freeTmpReg tmpR
715 :     end
716 : monnier 100 | divide _ = bug "divide"
717 : monnier 16 in
718 :     fun divt arg = (divide arg; trapOnDivZero())
719 :     end
720 :    
721 :     fun ashl (Direct rs,Direct rt,Direct rd) = emit (M.SL(rd,rt,RegShift rs))
722 :     | ashl (Immed n,Direct rt,Direct rd) =
723 :     if n >= 32 orelse n < 0 then
724 : monnier 100 bug "ashl: shift distance"
725 : monnier 16 else
726 :     emit (M.SL(rd,rt,Int5Shift n))
727 :     | ashl(shamt,Immed n,dst) = let
728 :     val tmpR = getTmpReg()
729 :     in
730 :     move(Immed n, Direct tmpR);
731 :     ashl(shamt,Direct tmpR,dst);
732 :     freeTmpReg tmpR
733 :     end
734 :     | ashl(shamt,Immed32 w,dst) = let
735 :     val tmpR = getTmpReg()
736 :     in
737 :     load_immed32(tmpR, w);
738 :     ashl(shamt,Direct tmpR, dst);
739 :     freeTmpReg tmpR
740 :     end
741 : monnier 100 | ashl _ = bug "ashl"
742 : monnier 16
743 :     fun ashr (Direct rs,Direct rt,Direct rd) =
744 :     emit (M.SRA(rd,rt,RegShift rs))
745 :     | ashr (Immed n,Direct rt,Direct rd) =
746 :     if n >= 32 orelse n < 0 then
747 : monnier 100 bug "ashr: shift distance"
748 : monnier 16 else
749 :     emit (M.SRA(rd,rt,Int5Shift n))
750 :     | ashr(shamt,Immed n,dst) = let
751 :     val tmpR = getTmpReg()
752 :     in
753 :     move(Immed n,Direct tmpR);
754 :     ashr(shamt,Direct tmpR,dst);
755 :     freeTmpReg tmpR
756 :     end
757 :     | ashr(shamt,Immed32 w, dst) = let
758 :     val tmpR = getTmpReg()
759 :     in
760 :     load_immed32(tmpR, w);
761 :     ashr(shamt,Direct tmpR,dst);
762 :     freeTmpReg tmpR
763 :     end
764 : monnier 100 | ashr _ = bug "ashr: bad args"
765 : monnier 16
766 :     fun lshr(Direct rs,Direct rt,Direct rd) = emit(M.SRL(rd,rt,RegShift rs))
767 :     | lshr(Immed n,Direct rt,Direct rd) =
768 :     if n >= 32 orelse n < 0 then
769 : monnier 100 bug "lshr: shift distance"
770 : monnier 16 else
771 :     emit (M.SRL(rd,rt,Int5Shift n))
772 :     | lshr(shamt,Immed n,dst) = let val tmpR = getTmpReg()
773 :     in
774 :     load_immed(tmpR,n);
775 :     lshr(shamt,Direct tmpR,dst);
776 :     freeTmpReg tmpR
777 :     end
778 :     | lshr(shamt,Immed32 w,dst) = let
779 :     val tmpR = getTmpReg()
780 :     in
781 :     load_immed32(tmpR, w);
782 :     lshr(shamt,Direct tmpR,dst);
783 :     freeTmpReg tmpR
784 :     end
785 : monnier 100 | lshr _ = bug "lshr"
786 : monnier 16
787 :     fun mulu(Direct x,Direct y) = emit(M.MULS(y,x,y))
788 :     | mulu(Immed32 xi,y) = let val tmpR = getTmpReg()
789 :     in
790 :     load_immed32(tmpR,xi);
791 :     mulu(Direct tmpR,y);
792 :     freeTmpReg tmpR
793 :     end
794 : monnier 100 | mulu _ = bug "mulu"
795 : monnier 16
796 :     (* divtu(a,b) = b <- b / a *)
797 :     fun divtu(Direct ra,Direct rb) = let
798 :     fun trap() = (emit(M.MTFSB1 5); emit(M.TRAP()))
799 :     val doneL = C.newLabel() val doitL = C.newLabel()
800 :     val tmpR = getTmpReg()
801 :     in
802 :     emit(M.CAL(tmpR,Reg 0,M.Immed16Op 0));
803 :     emit(M.CMPL(rb,ra));
804 :     emitBRANCH(M.LT,true,doneL);
805 :     emit(M.CAL(tmpR,Reg 0,M.Immed16Op 1));
806 :     emit(M.CMP(ra,M.Immed16Op 0));
807 :     emitBRANCH(M.LT,true,doneL);
808 :     emitBRANCH(M.EQ,false,doitL);
809 :     trap();
810 :     C.define doitL;
811 :     emit(M.CAL(Reg 0,Reg 0,M.Immed16Op 0));
812 :     emit(M.MTSPR(M.MQ,rb));
813 :     emit(M.DIV(tmpR,Reg 0,ra));
814 :    
815 :     C.define doneL;
816 :     emit(M.CAL(rb,tmpR,M.Immed16Op 0));
817 :     freeTmpReg tmpR
818 :     end
819 :     | divtu(x as Immed32 _,y) = let val tmpR = getTmpReg()
820 :     in
821 :     move(x,Direct tmpR);
822 :     divtu(Direct tmpR,y);
823 :     freeTmpReg tmpR
824 :     end
825 : monnier 100 | divtu _ = bug "divtu"
826 : monnier 16
827 :     local
828 :     fun floatreg (Direct(fpr as Freg _)) = fpr
829 : monnier 100 | floatreg _ = bug "floatreg"
830 : monnier 16
831 :     fun floating_arith f (x,y,z) = let
832 :     val lab = C.newLabel()
833 :     in
834 :     emit (f(floatreg x,floatreg y,floatreg z))
835 :     (*
836 :     emitFBRANCH(M.FEX,1,false,lab);
837 :     emit(M.TRAP());
838 :     C.define lab
839 :     *)
840 :     end
841 :    
842 :     val real_tag = dtoi D.desc_reald
843 :    
844 :     fun store_float(Freg fp,Direct dst,offset) = let
845 :     val tmpR = getTmpReg()
846 :     in
847 :     emit(M.STFD(Freg fp,stackptr',Immed16Op M.fLoadStoreOff));
848 :     emit(M.L(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
849 :     do_immed_signed(M.ST,tmpR,dst,offset);
850 :     emit(M.L(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
851 :     do_immed_signed(M.ST,tmpR,dst,offset+4);
852 :     freeTmpReg tmpR
853 :     end
854 : monnier 100 | store_float _ = bug "store_float"
855 : monnier 16
856 :     fun load_float (Freg dst,Direct src,offset) = let
857 :     val tmpR = getTmpReg()
858 :     in
859 :     do_immed_signed(M.L,tmpR,src,offset);
860 :     emit(M.ST(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
861 :     do_immed_signed(M.L,tmpR,src,offset+4);
862 :     emit(M.ST(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
863 :     emit(M.LFD(Freg dst,stackptr',Immed16Op M.fLoadStoreOff));
864 :     freeTmpReg tmpR
865 :    
866 :     end
867 :     | load_float (Freg dst,ImmedLab lab,offset) = let
868 :     val tmpR = getTmpReg()
869 :     in
870 :     emitSDI(LOADF(Freg dst,lab,offset,tmpR));
871 :     freeTmpReg tmpR
872 :     end
873 : monnier 100 | load_float _ = bug "load_float"
874 : monnier 16 in
875 :     fun fmuld(x,y,z) = floating_arith M.FMO (z,x,y)
876 :     fun fdivd(x,y,z) = floating_arith M.FDO (z,x,y)
877 :     fun faddd(x,y,z) = floating_arith M.FAO (z,x,y)
878 :     fun fsubd(x,y,z) = floating_arith M.FSO (z,x,y)
879 :     fun fnegd(op1,result) = emit (M.FNEG(floatreg result,floatreg op1))
880 :     fun fabsd(op1,result) = emit (M.FABS(floatreg result,floatreg op1))
881 :    
882 :     fun storefloat(src,Direct(Reg result)) =
883 :     (store_float(floatreg src,dataptr,4);
884 :     let val tmpR = getTmpReg()
885 :     in
886 :     load_immed(tmpR,real_tag);
887 :     emit (M.ST(tmpR,dataptr',Immed16Op 0));
888 :     emit (M.A(Reg result,dataptr',Immed16Op 4));
889 :     emit (M.A(dataptr',dataptr',Immed16Op 12));
890 :     freeTmpReg tmpR
891 :     end)
892 : monnier 100 | storefloat _ = bug "storefloat"
893 : monnier 16
894 :     fun loadfloat(src, dst) = load_float(floatreg dst,src,0)
895 :    
896 :     (* fetchindexd (x,y,z) y <- mem[x+4*(z-1)] *)
897 :     fun fetchindexd (Direct x,y,Immed i) =
898 :     load_float(floatreg y, Direct x, 4*(i-1))
899 :     | fetchindexd (Direct x,y,Direct z) = let
900 :     val tmpR = getTmpReg()
901 :     in
902 :     emit (M.SL(tmpR,z,Int5Shift 2));
903 :     emit (M.A(tmpR,x,RegOp tmpR));
904 :     load_float(floatreg y,Direct tmpR,~4);
905 :     freeTmpReg tmpR
906 :     end
907 : monnier 100 | fetchindexd _ = bug "fetchindexd"
908 : monnier 16
909 :     fun storeindexd (x,Direct y,Immed i) =
910 :     store_float(floatreg x,Direct y, 4*(i-1))
911 :     | storeindexd (x,Direct y,Direct z) = let
912 :     val tmpR = getTmpReg()
913 :     in
914 :     emit (M.SL(tmpR,z,Int5Shift 2));
915 :     emit (M.A(tmpR,y,RegOp tmpR));
916 :     store_float(floatreg x,Direct tmpR,~4);
917 :     freeTmpReg tmpR
918 :     end
919 : monnier 100 | storeindexd _ = bug "storeindexd"
920 : monnier 16 end
921 :    
922 :     datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
923 :     | GEU | GTU | LTU | LEU
924 :    
925 :     fun ibranch(cond,Immed a,Immed b,ImmedLab lab) = let
926 :     fun wCmp cmp (a, b) = cmp(Word31.fromInt a, Word31.fromInt b)
927 :     in
928 :     if (case cond
929 :     of EQL => a=b | NEQ => a<>b | LSS => a<b
930 :     | LEQ => a<=b | GTR => a>b | GEQ => a>=b
931 :     | GEU => wCmp Word31.>= (a, b) | GTU => wCmp Word31.> (a, b)
932 :     | LEU => wCmp Word31.<= (a, b) | LTU => wCmp Word31.< (a, b)
933 :     (* end case *))
934 :     then emit (M.B(Label24Off(POSLAB lab,0)))
935 :     else ()
936 :     end
937 :     | ibranch(cond,Immed32 a,Immed32 b,ImmedLab lab) = let
938 :     fun wtoi w = Int32.fromLarge(Word32.toLargeIntX w)
939 :     fun cmpi32(cmp, a, b) = cmp(wtoi a, wtoi b)
940 :     in
941 :     if (case cond
942 :     of EQL => a = b
943 :     | NEQ => a <> b
944 :     | GEU => Word32.>=(a,b)
945 :     | GTU => Word32.>(a,b)
946 :     | LEU => Word32.<=(a,b)
947 :     | LTU => Word32.<(a,b)
948 :     | LEQ => cmpi32(Int32.<=, a, b)
949 :     | LSS => cmpi32(Int32.<, a, b)
950 :     | GEQ => cmpi32(Int32.>=, a, b)
951 :     | GTR => cmpi32(Int32.>, a, b))
952 :     then emit(M.B(Label24Off(POSLAB lab,0)))
953 :     else ()
954 :     end
955 :     | ibranch(cond,rs as Direct _,Immed n,lab) = let
956 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
957 :     in
958 :     move(Immed n,tmpR);
959 :     ibranch(cond,rs,tmpR,lab);
960 :     freeTmpReg tmpR'
961 :     end
962 :     | ibranch(cond,rs,Immed32 w,lab) = let
963 :     val tmpR = getTmpReg()
964 :     in move(Immed32 w, Direct tmpR);
965 :     ibranch(cond, rs, Direct tmpR, lab);
966 :     freeTmpReg tmpR
967 :     end
968 :     | ibranch(cond,Immed n,rb,lab) = let
969 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
970 :     in
971 :     move(Immed n,tmpR);
972 :     ibranch(cond,tmpR,rb,lab);
973 :     freeTmpReg tmpR'
974 :     end
975 :     | ibranch(cond,Immed32 w,rb,lab) = let
976 :     val tmpR as Direct tmpR' = Direct(getTmpReg())
977 :     in
978 :     move(Immed32 w,tmpR);
979 :     ibranch(cond,tmpR,rb,lab);
980 :     freeTmpReg tmpR'
981 :     end
982 :     | ibranch(NEQ,Direct ra,Direct rb,ImmedLab lab) =
983 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.EQ,false,lab))
984 :     | ibranch(EQL,Direct ra,Direct rb,ImmedLab lab) =
985 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.EQ,true,lab))
986 :     | ibranch(GTR,Direct ra,Direct rb,ImmedLab lab) =
987 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.GT,true,lab))
988 :     | ibranch(LEQ,Direct ra,Direct rb,ImmedLab lab) =
989 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.GT,false,lab))
990 :     | ibranch(LSS,Direct ra,Direct rb,ImmedLab lab) =
991 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.LT,true,lab))
992 :     | ibranch(GEQ,Direct ra,Direct rb,ImmedLab lab) =
993 :     (emit(M.CMP(ra,RegOp rb)); emitBRANCH(M.LT,false,lab))
994 :     | ibranch(GEU,Direct ra,Direct rb,ImmedLab lab) =
995 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.LT,false,lab))
996 :     | ibranch(GTU,Direct ra,Direct rb,ImmedLab lab) =
997 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.GT,true,lab))
998 :     | ibranch(LEU,Direct ra,Direct rb,ImmedLab lab) =
999 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.GT,false,lab))
1000 :     | ibranch(LTU,Direct ra,Direct rb,ImmedLab lab) =
1001 :     (emit(M.CMPL(ra,rb)); emitBRANCH(M.LT,true,lab))
1002 : monnier 100 | ibranch _ = bug "ibranch"
1003 : monnier 16
1004 :     fun fbranchd(cond,Direct fra,Direct frb,ImmedLab lab) = let
1005 :     fun test2bits(bit1, bit2) =
1006 :     (emit(M.CROR(M.FL, bit1, bit2));
1007 :     emitFBRANCH(M.FL, 2, true, lab))
1008 :     in
1009 :     (emit (M.FCMP(fra,frb));
1010 :     case cond
1011 :     of P.fEQ => emitFBRANCH(M.FE, 2, true, lab)
1012 :     | P.fULG => emitFBRANCH(M.FE, 2, false, lab)
1013 :     | P.fUN => emitFBRANCH(M.UN, 2, true, lab)
1014 :     | P.fLEG => emitFBRANCH(M.UN, 2, false, lab)
1015 :     | P.fGT => emitFBRANCH(M.FG, 2, true, lab)
1016 :     | P.fGE => test2bits(M.FG, M.FE)
1017 :     | P.fUGT => test2bits(M.FG, M.UN)
1018 :     | P.fUGE => emitFBRANCH(M.FL, 2, false, lab)
1019 :     | P.fLT => emitFBRANCH(M.FL, 2, true, lab)
1020 :     | P.fLE => test2bits(M.FL, M.FE)
1021 :     | P.fULT => test2bits(M.UN, M.FL)
1022 :     | P.fULE => emitFBRANCH(M.FG, 2, false, lab)
1023 :     | P.fLG => test2bits(M.FL, M.FG)
1024 :     | P.fUE => test2bits(M.UN, M.FE)
1025 :     (*esac*))
1026 :     end
1027 : monnier 100 | fbranchd _ = bug "fbranch"
1028 : monnier 16
1029 :     (* Should implement ANDcc and do this better *)
1030 :     fun bbs(Immed k,Direct y,ImmedLab label) =
1031 :     let val tmpR = getTmpReg()
1032 :     val k2 = Word.toInt (Word.<<(0w1, Word.fromInt k))
1033 :     in
1034 :     do_immed_signed(M.AND,tmpR, y, k2);
1035 :     compare_immed(M.CMP, tmpR, k2);
1036 :     freeTmpReg tmpR;
1037 :     emitBRANCH(M.EQ,true,label)
1038 :     end
1039 : monnier 100 | bbs _ = bug "bbs: bad args"
1040 : monnier 16
1041 :    
1042 :     val cvti2dTmpOffset = 16
1043 :     val cvti2dConstOffset = 8
1044 :     fun cvti2d(Direct(src as Reg _),Direct(dst as Freg _)) = let
1045 :     val tmpR = getTmpReg()
1046 :     in
1047 :     emit(M.XORU(tmpR,src,Immed16Op 32768));
1048 :     emit(M.ST(tmpR,stackptr',Immed16Op(cvti2dTmpOffset+4)));
1049 :     emit(M.LIU(tmpR,Immed16Op 17200));
1050 :     emit(M.ST(tmpR,stackptr',Immed16Op cvti2dTmpOffset));
1051 :     emit(M.LFD(dst,stackptr',Immed16Op cvti2dTmpOffset));
1052 :     emit(M.LFD(tmpFreg,stackptr',Immed16Op cvti2dConstOffset));
1053 :     emit(M.FSO(dst,dst,tmpFreg));
1054 :     freeTmpReg tmpR
1055 :     end
1056 :    
1057 :     val comment = C.comment
1058 :     end
1059 :    
1060 :     (*
1061 :     * $Log: rs6000.sml,v $
1062 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:49 george
1063 :     * Version 110.5
1064 : monnier 16 *
1065 :     *)

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