Annotation of /sml/trunk/src/MLRISC/ppc/c-calls/ppc-macosx.sml

Parent Directory | Revision Log

---

Revision 1521 - (view) (download)

1 :	jhr	1346	(* ppc-macosx.sml
2 :			*
3 :			* COPYRIGHT (c) 2003 John Reppy (http://www.cs.uchicago.edu/~jhr)
4 :			* All rights reserved.
5 :			*
6 :			* C function calls for the PowerPC using the MacOS X ABI.
7 :			*
8 :			* Register conventions:
9 :			*
10 :			* Register Callee-save Purpose
11 :			* -------- ----------- -------
12 :			* GPR0 no Zero
13 :			* 1 no Stack pointer
14 :			* 2 no scratch (TOC on AIX)
15 :			* 3 no arg0 and return result
16 :			* 4-10 no arg1-arg7
17 :			* 11 no scratch
18 :			* 12 no holds taget of indirect call
19 :			* 13-31 yes callee-save registers
20 :			*
21 :			* FPR0 no scratch
22 :			* 1-13 no floating-point arguments
23 :			* 14-31 yes floating-point callee-save registers
24 :			*
25 :			* V0-V1 no scratch vector registers
26 :			* 2-13 no vector argument registers
27 :			* 14-19 no scratch vector registers
28 :			* 20-31 yes callee-save vector registers
29 :			*
30 :			* LR no link register holds return address
31 :			*
32 :			* CR0-CR1 no scratch condition registers
33 :			* 2-4 yes callee-save condition registers
34 :			* 5-7 no scratch condition registers
35 :			*
36 :			* Calling convention:
37 :			*
38 :			* Return result:
39 :			* + Integer and pointer results are returned in GPR3
40 :			* + 64-bit integers (long long) returned in GPR3/GPR4
41 :			* + float/double results are returned in FPR1
42 :			* + Struct results are returned in space provided by the caller.
43 :			* The address of this space is passed to the callee as an
44 :			* implicit first argument in GPR3 and the first real argument is
45 :			* passed in GPR4.
46 :			*
47 :			* Function arguments:
48 :			* * arguments (except for floating-point values) are passed in
49 :			* registers GPR3-GPR10
50 :	jhr	1438	*
51 :			* Note also that stack frames are supposed to be 16-byte aligned.
52 :	jhr	1346	*)
53 :
54 :			(* we extend the interface to support generating the stubs needed for
55 :			* dynamic linking (see "Inside MacOS X: Mach-O Runtime Architecture"
56 :			* for details.
57 :			*)
58 :			signature PPC_MACOSX_C_CALLS =
59 :			sig
60 :			include C_CALLS
61 :	jhr	1438
62 :			(*
63 :			val genStub : {
64 :			name : T.rexp,
65 :			proto : CTypes.c_proto,
66 :			paramAlloc : {szb : int, align : int} -> bool,
67 :			structRet : {szb : int, align : int} -> T.rexp,
68 :			saveRestoreDedicated :
69 :			T.mlrisc list -> {save: T.stm list, restore: T.stm list},
70 :			callComment : string option,
71 :			args : c_arg list
72 :			} -> {
73 :			callseq : T.stm list,
74 :			result: T.mlrisc list
75 :			}
76 :			*)
77 :
78 :	jhr	1346	end;
79 :
80 :			functor PPCMacOSX_CCalls (
81 :
82 :			structure T : MLTREE
83 :			val ix : (T.stm, T.rexp, T.fexp, T.ccexp) PPCInstrExt.sext -> T.sext
84 :
85 :			): PPC_MACOSX_C_CALLS = struct
86 :			structure T = T
87 :	jhr	1521	structure CTy = CTypes
88 :	jhr	1346	structure C = PPCCells
89 :			structure IX = PPCInstrExt
90 :
91 :			fun error msg = MLRiscErrorMsg.error ("PPCCompCCalls", msg)
92 :
93 :	jhr	1521	(* the location of arguments/parameters; offsets are given with respect to the
94 :			* low end of the parameter area.
95 :			*)
96 :			datatype arg_location
97 :			= Reg of T.ty * T.reg (* integer/pointer argument in register *)
98 :			| FReg of T.fty * T.freg (* floating-point argument in register *)
99 :			| Stk of T.ty * T.I.machine_int (* integer/pointer argument in parameter area *)
100 :			| FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
101 :			| Args of arg_location list
102 :
103 :			(* ?? use arg_location instead of the following? *)
104 :	jhr	1346	datatype arg_loc
105 :			= GPR of C.cell
106 :	jhr	1521	| GPR2 of C.cell * C.cell
107 :	jhr	1346	| FPR of C.cell
108 :			| STK
109 :
110 :			type arg_pos = {
111 :			offset : int, (* stack offset of memory for argument *)
112 :			loc : arg_loc (* location where argument is passed *)
113 :			}
114 :
115 :	jhr	1521	(* registers used for parameter passing *)
116 :			val argGPRs = List.map C.GPReg [3, 4, 5, 6, 7, 8, 9, 10]
117 :			val argFPRs = List.map C.FPReg [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13]
118 :
119 :			(* C callee-save registers *)
120 :			val calleeSaveRegs = List.map C.GPReg [
121 :			13, 14, 15, 16, 17, 18, 19, 20, 21, 22,
122 :			23, 24, 25, 26, 27, 28, 29, 30, 31
123 :			]
124 :			val calleeSaveFRegs = List.map C.FPReg [
125 :			14, 15, 16, 17, 18, 19, 20, 21, 22,
126 :			23, 24, 25, 26, 27, 28, 29, 30, 31
127 :			]
128 :
129 :			(* size of integer types *)
130 :			fun sizeOf CTy.I_char = {sz = 1, pad = 3}
131 :			| sizeOf CTy.I_short = {sz = 2, pad = 2}
132 :			| sizeOf CTy.I_int = {sz = 4, pad = 0}
133 :			| sizeOf CTy.I_long = {sz = 4, pad = 0}
134 :			| sizeOf CTy.I_long_long = {sz = 8, pad = 0}
135 :
136 :			(* compute the layout of a C call's arguments *)
137 :			fun layout {conv, retTy, paramTys} = let
138 :			val structRet = (case retTy
139 :			of CTy.C_STRUCT _ => true
140 :			| _ => false
141 :			(* end case *))
142 :			fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}
143 :			| assign (arg::args, offset, availGPRs, availFPRs, layout) = (
144 :			case arg
145 :			of CTy.C_void => error "unexpected void argument type"
146 :			| CTy.C_float =>
147 :			| CTy.C_double =>
148 :			| CTy.C_long_double =>
149 :			| CTy.C_unsigned isz =>
150 :			| CTy.C_signed isz =>
151 :			| CTy.C_PTR =>
152 :			| CTy.C_ARRAY _ =>
153 :			| CTy.C_STRUCT tys =>
154 :			(* end case *))
155 :			and assignGPR (offset, sz, pad, availGPRs, availFPRs) = let
156 :			val offset' = offset + sz + pad
157 :			in
158 :			({offset = offset, loc = loc}, offset')
159 :			end
160 :			| assignGPR (args, offset, [], availFPRs) =
161 :			and assignFPR (offset, gpr::availGPRs, fpr::availFPRs) =
162 :			| assignFPR (offset, [], fpr::availFPRs) =
163 :			| assignFPR (offset, [], []) =
164 :			in
165 :			assign (paramTys, 0, argGPRs, argFPRs, [])
166 :			end
167 :
168 :	jhr	1346	datatype c_arg
169 :			= ARG of T.rexp
170 :			| FARG of T.fexp
171 :			| ARGS of c_arg list
172 :
173 :			val mem = T.Region.memory
174 :			val stack = T.Region.memory
175 :
176 :			val maxRegArgs = 6
177 :			val paramAreaOffset = 68
178 :
179 :	jhr	1443	fun LI i = T.LI(T.I.fromInt (32, i))
180 :	jhr	1346
181 :	jhr	1443	fun reg r = C.GPReg r
182 :			fun freg r = C.FPReg r
183 :	jhr	1346
184 :	jhr	1443	fun reg32 r = T.REG(32, r)
185 :			fun freg64 r = T.FREG(64, r)
186 :	jhr	1346
187 :	jhr	1443	(* stack pointer *)
188 :			val sp = reg1
189 :			val spR = reg32 sp
190 :	jhr	1346
191 :			fun addli (x, 0) = x
192 :			| addli (x, d) = let
193 :	jhr	1438	val d' = T.I.fromInt (32, d)
194 :			in
195 :			case x
196 :			of T.ADD (_, r, T.LI d) =>
197 :			T.ADD (32, r, T.LI (T.I.ADD (32, d, d')))
198 :	jhr	1346	| _ => T.ADD (32, x, T.LI d')
199 :	jhr	1443	(* end case *)
200 :	jhr	1438	end
201 :	jhr	1346
202 :			fun argaddr n = addli (spreg, paramAreaOffset + 4*n)
203 :
204 :	jhr	1443	(* layout information for C types; note that stack and struct alignment
205 :			* are different for some types
206 :			*)
207 :			type layout_info = {
208 :			sz : int,
209 :			stkAlign : int,
210 :			structAlign : int
211 :			}
212 :	jhr	1346
213 :			fun roundup (i, a) = a * ((i + a - 1) div a)
214 :
215 :	jhr	1443	(* layout information for integer types *)
216 :			local
217 :			fun layout n = {sz = n, stkAlign = n, structAlign = n}
218 :	jhr	1438
219 :	jhr	1443	fun intSizeAndAlign Ty.I_char = layout 1
220 :			| intSizeAndAlign Ty.I_short = layout 2
221 :			| intSizeAndAlign Ty.I_int = layout 4
222 :			| intSizeAndAlign Ty.I_long = layout 4
223 :			| intSizeAndAlign Ty.I_long_long = {sz = 8, stkAlign = 8, structAlign = 4}
224 :
225 :			in
226 :
227 :	jhr	1438	(* calculate size and alignment for a C type *)
228 :			fun szal (T.C_unsigned ty) = intSizeAndAlign ty
229 :			| szal (T.C_signed ty) = intSizeAndAlign ty
230 :			| szal Ty.C_void = raise Fail "unexpected void type"
231 :	jhr	1443	| szal Ty.C_float = layout 4
232 :			| szal Ty.C_PTR = layout 4
233 :			| szal Ty.C_double = {sz = 8, stkAlign = 8, structAlign = 4}
234 :			| szal (Ty.C_long_double) = {sz = 8, stkAlign = 8, structAlign = 4}
235 :			| szal (Ty.C_ARRAY(t, n)) = let
236 :			val a = szal t
237 :			in
238 :			{sz = n * #sz a, stkAlign = ?, structAlign = #structAlign a}
239 :			end
240 :	jhr	1438	| szal (Ty.C_STRUCT l) = let
241 :			(* FIXME: the rules for structs are more complicated (and they also depend
242 :			* on the alignment mode). In Power alignment, 8-byte quantites like
243 :			* long long and double are 4-byte aligned in structs.
244 :			*)
245 :			(* i: next free memory address (relative to struct start);
246 :			* a: current total alignment,
247 :			* l: list of struct member types
248 :			*)
249 :			fun pack (i, a, []) =
250 :			(* when we are done with all elements, the total size
251 :			* of the struct must be padded out to its own alignment
252 :			*)
253 :	jhr	1346	(roundup (i, a), a)
254 :	jhr	1438	| pack (i, a, t :: tl) = let
255 :			val (ts, ta) = szal t (* size and alignment for member *)
256 :	jhr	1346	in
257 :	jhr	1438	(* member must be aligned according to its own
258 :			* alignment requirement; the next free position
259 :			* is then at "aligned member-address plus member-size";
260 :			* new total alignment is max of current alignment
261 :			* and member alignment (assuming all alignments are
262 :			* powers of 2) *)
263 :			pack (roundup (i, ta) + ts, Int.max (a, ta), tl)
264 :	jhr	1346	end
265 :	jhr	1438	in
266 :	jhr	1346	pack (0, 1, l)
267 :	jhr	1438	end
268 :	jhr	1443	end
269 :	jhr	1346
270 :	jhr	1445	fun assignIntLoc (ty, gprs, offset) = let
271 :			val {sz, alignStk, alignStruct} = szal ty
272 :			val offset = align(offset, alignStk)
273 :	jhr	1443	in
274 :	jhr	1445	case (sz, gprs)
275 :			of (_, []) => ({offset = offset, loc = ARG(??)}, offset+sz, [])
276 :			| (8, [r]) =>
277 :			| (8, r1::r2::rs) =>
278 :			| (_, r::rs) =>({offset = offset, loc = GPR r}, offset+sz, rs)
279 :			(* end case *)
280 :	jhr	1443	end
281 :
282 :	jhr	1445	fun genCall {
283 :			name, proto, paramAlloc, structRet, saveRestoreDedicated,
284 :			callComment, args
285 :			} = let
286 :			val {conv, retTy, paramTys} = proto
287 :			val callseq = List.concat [
288 :			sp_sub,
289 :			copycode,
290 :			argsetupcode,
291 :			sretsetup,
292 :			save,
293 :			[call],
294 :			srethandshake,
295 :			restore,
296 :			sp_add
297 :			]
298 :			in
299 :			(* check calling convention *)
300 :			case conv
301 :			of ("" | "ccall") => ()
302 :			| _ => error (concat [
303 :			"unknown calling convention \"",
304 :			String.toString conv, "\""
305 :			])
306 :			(* end case *);
307 :			{callseq = callseq, result = result}
308 :			end
309 :	jhr	1346
310 :	jhr	1445	(******
311 :			val res_szal = (case retTy
312 :			of (Ty.C_long_double | Ty.C_STRUCT _) => SOME(szal retTy)
313 :			| _ => NONE
314 :
315 :	jhr	1346	val nargwords = let
316 :			fun loop ([], n) = n
317 :			| loop (t :: tl, n) =
318 :			loop (tl, (case t of
319 :			(Ty.C_double | Ty.C_signed Ty.I_long_long |
320 :			Ty.C_unsigned Ty.I_long_long) => 2
321 :			| _ => 1) + n)
322 :			in
323 :			loop (paramTys, 0)
324 :			end
325 :
326 :			val regargwords = Int.min (nargwords, maxRegArgs)
327 :			val stackargwords = Int.max (nargwords, maxRegArgs) - maxRegArgs
328 :
329 :			val stackargsstart = paramAreaOffset + 4 * maxRegArgs
330 :
331 :			val scratchstart = stackargsstart + 4 * stackargwords
332 :
333 :			(* Copy struct or part thereof to designated area on the stack.
334 :			* An already properly aligned address (relative to %sp) is
335 :			* in to_off. *)
336 :			fun struct_copy (sz, al, ARG a, t, to_off, cpc) =
337 :			(* Two main cases here:
338 :			* 1. t is C_STRUCT _: in this case "a" computes the address
339 :			* of the struct to be copied.
340 :			* 2. t is some other non-floating type; "a" computes the
341 :			* the corresponding value (i.e., not its address).
342 :			*)
343 :			let fun ldst ty =
344 :			T.STORE (ty, addli (spreg, to_off), a, stack) :: cpc
345 :			in
346 :			case t of
347 :			(Ty.C_void | Ty.C_PTR |
348 :			Ty.C_signed (Ty.I_int | Ty.I_long) |
349 :			Ty.C_unsigned (Ty.I_int | Ty.I_long)) => ldst 32
350 :			| (Ty.C_signed Ty.I_char | Ty.C_unsigned Ty.I_char) => ldst 8
351 :			| (Ty.C_signed Ty.I_short | Ty.C_unsigned Ty.I_short) =>
352 :			ldst 16
353 :			| (Ty.C_signed Ty.I_long_long |
354 :			Ty.C_unsigned Ty.I_long_long) => ldst 64
355 :			| (Ty.C_ARRAY _) =>
356 :			error "ARRAY within gather/scatter struct"
357 :			| (Ty.C_STRUCT _) =>
358 :			(* Here we have to do the equivalent of a "memcpy". *)
359 :			let val from = a (* argument is address of struct *)
360 :			fun cp (ty, incr) = let
361 :			fun load_from from_off =
362 :			T.LOAD (32, addli (from, from_off), mem)
363 :			(* from_off is relative to from,
364 :			* to_off is relative to %sp *)
365 :			fun loop (i, from_off, to_off, cpc) =
366 :			if i <= 0 then cpc
367 :			else loop (i - incr,
368 :			from_off + incr, to_off + incr,
369 :			T.STORE (ty, addli (spreg, to_off),
370 :			load_from from_off,
371 :			stack)
372 :			:: cpc)
373 :			in
374 :			loop (sz, 0, to_off, cpc)
375 :			end
376 :			in
377 :			case al of
378 :			1 => cp (8, 1)
379 :			| 2 => cp (16, 2)
380 :			| _ => (* 4 or more *) cp (32, 4)
381 :			end
382 :			| (Ty.C_float | Ty.C_double | Ty.C_long_double) =>
383 :			error "floating point type does not match ARG"
384 :			end
385 :			| struct_copy (_, _, ARGS args, Ty.C_STRUCT tl, to_off, cpc) =
386 :			(* gather/scatter case *)
387 :			let fun loop ([], [], _, cpc) = cpc
388 :			| loop (t :: tl, a :: al, to_off, cpc) = let
389 :			val (tsz, tal) = szal t
390 :			val to_off' = roundup (to_off, tal)
391 :			val cpc' = struct_copy (tsz, tal, a, t, to_off', cpc)
392 :			in
393 :			loop (tl, al, to_off' + tsz, cpc')
394 :			end
395 :			| loop _ =
396 :			error "number of types does not match number of arguments"
397 :			in
398 :			loop (tl, args, to_off, cpc)
399 :			end
400 :			| struct_copy (_, _, ARGS _, _, _, _) =
401 :			error "gather/scatter for non-struct"
402 :			| struct_copy (sz, al, FARG a, t, to_off, cpc) =
403 :			let fun fldst ty =
404 :			T.FSTORE (ty, addli (spreg, to_off), a, stack) :: cpc
405 :			in
406 :			case t of
407 :			Ty.C_float => fldst 32
408 :			| Ty.C_double => fldst 64
409 :			| Ty.C_long_double => fldst 128
410 :			| _ => error "non-floating-point type does not match FARG"
411 :			end
412 :
413 :			val (stackdelta, argsetupcode, copycode) = let
414 :			fun loop ([], [], _, ss, asc, cpc) =
415 :			(roundup (Int.max (0, ss - stackargsstart), 8), asc, cpc)
416 :			| loop (t :: tl, a :: al, n, ss, asc, cpc) = let
417 :			fun wordassign a =
418 :			if n < 6 then T.MV (32, oreg n, a)
419 :			else T.STORE (32, argaddr n, a, stack)
420 :			fun wordarg (a, cpc, ss) =
421 :			loop (tl, al, n + 1, ss, wordassign a :: asc, cpc)
422 :
423 :			fun dwordmemarg (addr, region, tmpstore) = let
424 :			fun toreg (n, addr) =
425 :			T.MV (32, oreg n, T.LOAD (32, addr, region))
426 :			fun tomem (n, addr) =
427 :			T.STORE (32,
428 :			argaddr n,
429 :			T.LOAD (32, addr, region),
430 :			stack)
431 :			fun toany (n, addr) =
432 :			if n < 6 then toreg (n, addr) else tomem (n, addr)
433 :			in
434 :			(* if n < 6 andalso n div 2 = 0 then
435 :			* use ldd here once MLRISC gets its usage right
436 :			* else
437 :			* ... *)
438 :			loop (tl, al, n+2, ss,
439 :			tmpstore @
440 :			toany (n, addr)
441 :			:: toany (n+1, addli (addr, 4))
442 :			:: asc,
443 :			cpc)
444 :			end
445 :			fun dwordarg mkstore =
446 :			if n > 6 andalso n div 2 = 1 then
447 :			(* 8-byte aligned memory *)
448 :			loop (tl, al, n+2, ss,
449 :			mkstore (argaddr n) :: asc,
450 :			cpc)
451 :			else dwordmemarg (tmpaddr, stack, [mkstore tmpaddr])
452 :			in
453 :			case (t, a) of
454 :			((Ty.C_void | Ty.C_PTR | Ty.C_ARRAY _ |
455 :			Ty.C_unsigned (Ty.I_int | Ty.I_long) |
456 :			Ty.C_signed (Ty.I_int | Ty.I_long)),
457 :			ARG a) => wordarg (a, cpc, ss)
458 :			| (Ty.C_signed Ty.I_char, ARG a) =>
459 :			wordarg (T.SX (32, 8, a), cpc, ss)
460 :			| (Ty.C_unsigned Ty.I_char, ARG a) =>
461 :			wordarg (T.ZX (32, 8, a), cpc, ss)
462 :			| (Ty.C_signed Ty.I_short, ARG a) =>
463 :			wordarg (T.SX (32, 16, a), cpc, ss)
464 :			| (Ty.C_unsigned Ty.I_short, ARG a) =>
465 :			wordarg (T.ZX (32, 16, a), cpc, ss)
466 :			| ((Ty.C_signed Ty.I_long_long |
467 :			Ty.C_unsigned Ty.I_long_long), ARG a) =>
468 :			(case a of
469 :			T.LOAD (_, addr, region) =>
470 :			dwordmemarg (addr, region, [])
471 :			| _ => dwordarg (fn addr =>
472 :			T.STORE (64, addr, a, stack)))
473 :			| (Ty.C_float, FARG a) =>
474 :			(* we use the stack region reserved for storing
475 :			* %o0-%o5 as temporary storage for transferring
476 :			* floating point values *)
477 :			(case a of
478 :			T.FLOAD (_, addr, region) =>
479 :			wordarg (T.LOAD (32, addr, region), cpc, ss)
480 :			| _ =>
481 :			if n < 6 then let
482 :			val ld = T.MV (32, oreg n,
483 :			T.LOAD (32, tmpaddr, stack))
484 :			val cp = T.FSTORE (32, tmpaddr, a, stack)
485 :			in
486 :			loop (tl, al, n + 1, ss, cp :: ld :: asc, cpc)
487 :			end
488 :			else loop (tl, al, n + 1, ss,
489 :			T.FSTORE (32, argaddr n, a, stack)
490 :			:: asc,
491 :			cpc))
492 :			| (Ty.C_double, FARG a) =>
493 :			(case a of
494 :			T.FLOAD (_, addr, region) =>
495 :			dwordmemarg (addr, region, [])
496 :			| _ => dwordarg (fn addr =>
497 :			T.FSTORE (64, addr, a, stack)))
498 :			| (Ty.C_long_double, FARG a) => let
499 :			(* Copy 128-bit floating point value (16 bytes)
500 :			* into scratch space (aligned at 8-byte boundary).
501 :			* The address of the scratch copy is then
502 :			* passed as a regular 32-bit argument. *)
503 :			val ss' = roundup (ss, 8)
504 :			val ssaddr = addli (spreg, ss')
505 :			in
506 :			wordarg (ssaddr,
507 :			T.FSTORE (128, ssaddr, a, stack) :: cpc,
508 :			ss' + 16)
509 :			end
510 :			| (t as Ty.C_STRUCT _, a) => let
511 :			(* copy entire struct into scratch space
512 :			* (aligned according to struct's alignment
513 :			* requirements). The address of the scratch
514 :			* copy is then passed as a regular 32-bit
515 :			* argument. *)
516 :			val (sz, al) = szal t
517 :			val ss' = roundup (ss, al)
518 :			val ssaddr = addli (spreg, ss')
519 :			val cpc' = struct_copy (sz, al, a, t, ss', cpc)
520 :			in
521 :			wordarg (ssaddr, cpc', ss' + sz)
522 :			end
523 :			| _ => error "argument/type mismatch"
524 :			end
525 :			| loop _ = error "wrong number of arguments"
526 :			in
527 :			loop (paramTys, args, 0, scratchstart, [], [])
528 :			end
529 :
530 :			val (defs, uses) = let
531 :			val gp = T.GPR o reg32
532 :			val fp = T.FPR o freg64
533 :			val g_regs = map (gp o greg) [1, 2, 3, 4, 5, 6, 7]
534 :			val a_regs = map (gp o oreg) [0, 1, 2, 3, 4, 5]
535 :			val l_reg = gp (oreg 7)
536 :			val f_regs = map (fp o freg)
537 :			[0, 2, 4, 6, 8, 10, 12, 14,
538 :			16, 18, 20, 22, 24, 26, 28, 30]
539 :			(* a call instruction defines all caller-save registers:
540 :			* - %g1 - %g7
541 :			* - %o0 - %o5 (argument registers)
542 :			* - %o7 (link register)
543 :			* - all fp registers *)
544 :
545 :			val defs = g_regs @ a_regs @ l_reg :: f_regs
546 :			(* A call instruction "uses" just the argument registers. *)
547 :			val uses = List.take (a_regs, regargwords)
548 :			in
549 :			(defs, uses)
550 :			end
551 :
552 :			val result =
553 :			case retTy of
554 :			Ty.C_float => [T.FPR (T.FREG (32, FP 0))]
555 :			| Ty.C_double => [T.FPR (T.FREG (64, FP 0))] (* %f0/%f1 *)
556 :			| Ty.C_long_double => []
557 :			| Ty.C_STRUCT _ => []
558 :			| Ty.C_ARRAY _ => error "array return type"
559 :			| (Ty.C_PTR | Ty.C_void |
560 :			Ty.C_signed (Ty.I_int | Ty.I_long) |
561 :			Ty.C_unsigned (Ty.I_int | Ty.I_long)) =>
562 :			[T.GPR (T.REG (32, oreg 0))]
563 :			| (Ty.C_signed Ty.I_char | Ty.C_unsigned Ty.I_char) =>
564 :			[T.GPR (T.REG (8, oreg 0))]
565 :			| (Ty.C_signed Ty.I_short | Ty.C_unsigned Ty.I_short) =>
566 :			[T.GPR (T.REG (16, oreg 0))]
567 :			| (Ty.C_signed Ty.I_long_long | Ty.C_unsigned Ty.I_long_long) =>
568 :			[T.GPR (T.REG (64, oreg 0))]
569 :
570 :			val { save, restore } = saveRestoreDedicated defs
571 :
572 :			val (sretsetup, srethandshake) =
573 :			case res_szal of
574 :			NONE => ([], [])
575 :			| SOME (sz, al) => let
576 :			val addr = structRet { szb = sz, align = al }
577 :			in
578 :			([T.STORE (32, addli (spreg, 64), addr, stack)],
579 :			[T.EXT (ix (IX.UNIMP sz))])
580 :			end
581 :
582 :			val call = T.CALL { funct = name, targets = [],
583 :			defs = defs, uses = uses,
584 :			region = mem, pops = 0 }
585 :
586 :			val call =
587 :			case callComment of
588 :			NONE => call
589 :			| SOME c =>
590 :			T.ANNOTATION (call, #create MLRiscAnnotations.COMMENT c)
591 :
592 :			val (sp_sub, sp_add) =
593 :			if stackdelta = 0 then ([], []) else
594 :			if paramAlloc { szb = stackdelta, align = 4 } then ([], [])
595 :			else ([T.MV (32, sp, T.SUB (32, spreg, LI stackdelta))],
596 :			[T.MV (32, sp, addli (spreg, stackdelta))])
597 :
598 :			val callseq =
599 :			List.concat [sp_sub,
600 :			copycode,
601 :			argsetupcode,
602 :			sretsetup,
603 :			save,
604 :			[call],
605 :			srethandshake,
606 :			restore,
607 :			sp_add]
608 :
609 :			in
610 :			{ callseq = callseq, result = result }
611 :			end
612 :	jhr	1445	*****)
613 :
614 :			end

---

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