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 /MLRISC/trunk/staged-allocation/c-call-fn.sml
ViewVC logotype

Annotation of /MLRISC/trunk/staged-allocation/c-call-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3068 - (view) (download)

1 : mrainey 3009 functor CCallFn (
2 :     structure T : MLTREE
3 :     structure C : CELLS
4 :     val offSp : T.I.machine_int -> T.rexp
5 :     val wordTy : int
6 :     ) = struct
7 :    
8 :     datatype c_arg
9 :     = ARG of T.rexp
10 :     (* rexp specifies integer or pointer; if the
11 :     * corresponding parameter is a C struct, then
12 :     * this argument is the address of the struct.
13 :     *)
14 :     | FARG of T.fexp
15 :     (* fexp specifies floating-point argument *)
16 :    
17 : mrainey 3049 (* kinds of locations for passing C arguments *)
18 :     datatype location_kinds
19 :     = K_GPR (* general-purpose registers *)
20 :     | K_FPR (* floating-point registers *)
21 :     | K_MEM (* memory locations *)
22 :    
23 : mrainey 3009 (* An arg_location specifies the location of arguments/parameters
24 :     * for a C call. Offsets are given with respect to the low end
25 :     * of the parameter area. *)
26 :     datatype arg_location =
27 :     C_GPR of (T.ty * T.reg) (* integer/pointer argument in register *)
28 :     | C_FPR of (T.fty * T.reg) (* floating-point argument in register *)
29 :     | C_STK of (T.ty * T.I.machine_int) (* integer/pointer argument on the call stack *)
30 :     | C_FSTK of (T.fty * T.I.machine_int) (* floating-point argument on the call stack *)
31 :    
32 :     fun copyToReg (mty, r, e) = let
33 :     val tmp = C.newReg ()
34 :     in
35 :     [T.COPY (mty, [r], [tmp]), T.MV (mty, tmp, e)]
36 :     end
37 :    
38 :     fun copyToFReg (mty, r, e) = let
39 :     val tmp = C.newFreg ()
40 :     in
41 :     [T.FCOPY (mty, [r], [tmp]), T.FMV (mty, tmp, e)]
42 :     end
43 :    
44 :     val stack = T.Region.stack
45 :    
46 : mrainey 3039 fun lit i = T.LI (T.I.fromInt (32, i))
47 : mrainey 3009
48 :     (* generate MLRISC statements for copying a C argument to a parameter / return location *)
49 :     fun copyLoc arg (i, loc, (stms, gprs, fprs)) = (case (arg, loc)
50 :     (* GPR arguments *)
51 :     of (ARG (e as T.REG _), C_STK (mty, offset)) =>
52 :     (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)
53 :     | (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty, r)) =>
54 : mrainey 3039 (copyToReg(mty, r, T.LOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) @ stms, r :: gprs, fprs)
55 : mrainey 3009 | (ARG (T.LOAD (ty, e, rgn)), C_STK (mty, offset)) => let
56 :     val tmp = C.newReg ()
57 :     in
58 :     (T.STORE (ty, offSp offset, T.REG (ty, tmp), stack) ::
59 : mrainey 3039 T.MV (ty, tmp, T.LOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) :: stms, gprs, fprs)
60 : mrainey 3009 end
61 :     | (ARG e, C_STK (mty, offset)) => let
62 :     val tmp = C.newReg ()
63 :     in
64 :     (T.STORE (wordTy, offSp offset, T.REG (wordTy, tmp), stack) ::T.MV (wordTy, tmp, e) :: stms, gprs, fprs)
65 :     end
66 :     | (ARG e, C_GPR (mty, r)) => (copyToReg(mty, r, e) @ stms, r :: gprs, fprs)
67 :     (* floating-point arguments *)
68 :     | (FARG (e as T.FREG _), C_STK (mty, offset)) =>
69 :     (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)
70 :     | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty, r)) =>
71 : mrainey 3039 (copyToFReg(mty, r, T.FLOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) @ stms, gprs, (mty, r) :: fprs)
72 : mrainey 3068 | (FARG (T.FLOAD (ty, e, rgn)), C_FSTK (mty, offset)) => let
73 : mrainey 3009 val tmp = C.newFreg ()
74 :     in
75 : mrainey 3068 (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) ::
76 :     T.FMV (mty, tmp, T.FLOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) :: stms, gprs, fprs)
77 : mrainey 3009 end
78 : mrainey 3068 | (FARG e, C_FSTK (mty, offset)) => let
79 : mrainey 3009 val tmp = C.newFreg ()
80 :     in
81 : mrainey 3068 (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) :: T.FMV (mty, tmp, e) :: stms, gprs, fprs)
82 : mrainey 3009 end
83 :     | (FARG e, C_FPR (mty, r)) => (copyToFReg(mty, r, e) @ stms, gprs, (mty, r) :: fprs)
84 :     | _ => raise Fail "invalid arg / location combination"
85 :     (* end case *))
86 :    
87 :     fun copyArgLocs (arg, locs, (stms, gprs, fprs)) =
88 :     ListPair.foldl (copyLoc arg) (stms, gprs, fprs) (List.tabulate(List.length locs, fn i => i), locs)
89 :    
90 :     (* copy C arguments into parameter locations *)
91 :     fun copyArgs (args, argLocs) = let
92 :     val (stms, gprs, fprs) = ListPair.foldl copyArgLocs ([], [], []) (args, argLocs)
93 :     in
94 :     (List.rev stms, gprs, fprs)
95 :     end
96 :    
97 :     end (* CCallFn *)

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