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 3039 - (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 :     (* An arg_location specifies the location of arguments/parameters
18 :     * for a C call. Offsets are given with respect to the low end
19 :     * of the parameter area. *)
20 :     datatype arg_location =
21 :     C_GPR of (T.ty * T.reg) (* integer/pointer argument in register *)
22 :     | C_FPR of (T.fty * T.reg) (* floating-point argument in register *)
23 :     | C_STK of (T.ty * T.I.machine_int) (* integer/pointer argument on the call stack *)
24 :     | C_FSTK of (T.fty * T.I.machine_int) (* floating-point argument on the call stack *)
25 :    
26 :     fun copyToReg (mty, r, e) = let
27 :     val tmp = C.newReg ()
28 :     in
29 :     [T.COPY (mty, [r], [tmp]), T.MV (mty, tmp, e)]
30 :     end
31 :    
32 :     fun copyToFReg (mty, r, e) = let
33 :     val tmp = C.newFreg ()
34 :     in
35 :     [T.FCOPY (mty, [r], [tmp]), T.FMV (mty, tmp, e)]
36 :     end
37 :    
38 :     val stack = T.Region.stack
39 :    
40 : mrainey 3039 fun lit i = T.LI (T.I.fromInt (32, i))
41 : mrainey 3009
42 :     (* generate MLRISC statements for copying a C argument to a parameter / return location *)
43 :     fun copyLoc arg (i, loc, (stms, gprs, fprs)) = (case (arg, loc)
44 :     (* GPR arguments *)
45 :     of (ARG (e as T.REG _), C_STK (mty, offset)) =>
46 :     (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)
47 :     | (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty, r)) =>
48 : mrainey 3039 (copyToReg(mty, r, T.LOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) @ stms, r :: gprs, fprs)
49 : mrainey 3009 | (ARG (T.LOAD (ty, e, rgn)), C_STK (mty, offset)) => let
50 :     val tmp = C.newReg ()
51 :     in
52 :     (T.STORE (ty, offSp offset, T.REG (ty, tmp), stack) ::
53 : mrainey 3039 T.MV (ty, tmp, T.LOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) :: stms, gprs, fprs)
54 : mrainey 3009 end
55 :     | (ARG e, C_STK (mty, offset)) => let
56 :     val tmp = C.newReg ()
57 :     in
58 :     (T.STORE (wordTy, offSp offset, T.REG (wordTy, tmp), stack) ::T.MV (wordTy, tmp, e) :: stms, gprs, fprs)
59 :     end
60 :     | (ARG e, C_GPR (mty, r)) => (copyToReg(mty, r, e) @ stms, r :: gprs, fprs)
61 :     (* floating-point arguments *)
62 :     | (FARG (e as T.FREG _), C_STK (mty, offset)) =>
63 :     (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)
64 :     | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty, r)) =>
65 : mrainey 3039 (copyToFReg(mty, r, T.FLOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) @ stms, gprs, (mty, r) :: fprs)
66 : mrainey 3009 | (FARG (T.FLOAD (ty, e, rgn)), C_STK (mty, offset)) => let
67 :     val tmp = C.newFreg ()
68 :     in
69 :     (T.FSTORE (wordTy, offSp offset, T.FREG (wordTy, tmp), stack) ::
70 : mrainey 3039 T.FMV (wordTy, tmp, T.FLOAD (ty, T.ADD(wordTy, e, lit (i*8)), rgn)) :: stms, gprs, fprs)
71 : mrainey 3009 end
72 :     | (FARG e, C_STK (mty, offset)) => let
73 :     val tmp = C.newFreg ()
74 :     in
75 :     (T.FSTORE (wordTy, offSp offset, T.FREG (wordTy, tmp), stack) :: T.FMV (wordTy, tmp, e) :: stms, gprs, fprs)
76 :     end
77 :     | (FARG e, C_FPR (mty, r)) => (copyToFReg(mty, r, e) @ stms, gprs, (mty, r) :: fprs)
78 :     | _ => raise Fail "invalid arg / location combination"
79 :     (* end case *))
80 :    
81 :     fun copyArgLocs (arg, locs, (stms, gprs, fprs)) =
82 :     ListPair.foldl (copyLoc arg) (stms, gprs, fprs) (List.tabulate(List.length locs, fn i => i), locs)
83 :    
84 :     (* copy C arguments into parameter locations *)
85 :     fun copyArgs (args, argLocs) = let
86 :     val (stms, gprs, fprs) = ListPair.foldl copyArgLocs ([], [], []) (args, argLocs)
87 :     in
88 :     (List.rev stms, gprs, fprs)
89 :     end
90 :    
91 :     end (* CCallFn *)

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