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

SCM Repository

[smlnj] Diff of /sml/branches/primop-branch/src/MLRISC/ppc/c-calls/ppc-macosx.sml
ViewVC logotype

Diff of /sml/branches/primop-branch/src/MLRISC/ppc/c-calls/ppc-macosx.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1470, Mon Mar 29 22:45:55 2004 UTC revision 1471, Mon Mar 29 22:45:55 2004 UTC
# Line 47  Line 47 
47   *    Function arguments:   *    Function arguments:
48   *      * arguments (except for floating-point values) are passed in   *      * arguments (except for floating-point values) are passed in
49   *        registers GPR3-GPR10   *        registers GPR3-GPR10
50     *
51     * Note also that stack frames are supposed to be 16-byte aligned.
52   *)   *)
53    
54  (* we extend the interface to support generating the stubs needed for  (* we extend the interface to support generating the stubs needed for
# Line 56  Line 58 
58  signature PPC_MACOSX_C_CALLS =  signature PPC_MACOSX_C_CALLS =
59    sig    sig
60      include C_CALLS      include C_CALLS
61    
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    end;    end;
79    
80  functor PPCMacOSX_CCalls (  functor PPCMacOSX_CCalls (
# Line 94  Line 113 
113    
114      fun LI i = T.LI (T.I.fromInt (32, i))      fun LI i = T.LI (T.I.fromInt (32, i))
115    
116      val GP = C.GPReg      fun reg r = C.GPReg r
117      val FP = C.FPReg      fun freg r = C.FPReg r
   
     fun greg r = GP r  
     fun oreg r = GP (r + 8)  
     fun freg r = FP r  
118    
119      fun reg32 r = T.REG (32, r)      fun reg32 r = T.REG (32, r)
120      fun freg64 r = T.FREG (64, r)      fun freg64 r = T.FREG (64, r)
121    
122      val sp = oreg 6    (* stack pointer *)
123      val spreg = reg32 sp      val sp = reg1
124        val spR = reg32 sp
125    
126      fun addli (x, 0) = x      fun addli (x, 0) = x
127        | addli (x, d) = let        | addli (x, d) = let
128              val d' = T.I.fromInt (32, d)              val d' = T.I.fromInt (32, d)
129          in          in
130              case x of              case x
131                  T.ADD (_, r, T.LI d) =>               of T.ADD (_, r, T.LI d) =>
132                  T.ADD (32, r, T.LI (T.I.ADD (32, d, d')))                  T.ADD (32, r, T.LI (T.I.ADD (32, d, d')))
133                | _ => T.ADD (32, x, T.LI d')                | _ => T.ADD (32, x, T.LI d')
134                (* end case *)
135          end          end
136    
137      fun argaddr n = addli (spreg, paramAreaOffset + 4*n)      fun argaddr n = addli (spreg, paramAreaOffset + 4*n)
138    
139      (* temp location for transfers through memory *)    (* layout information for C types; note that stack and struct alignment
140      val tmpaddr = argaddr 1     * are different for some types
141       *)
142        type layout_info = {
143            sz : int,
144            stkAlign : int,
145            structAlign : int
146          }
147    
148      fun roundup (i, a) = a * ((i + a - 1) div a)      fun roundup (i, a) = a * ((i + a - 1) div a)
149    
150      (* layout information for integer types *)
151        local
152          fun layout n = {sz = n, stkAlign = n, structAlign = n}
153    
154          fun intSizeAndAlign Ty.I_char = layout 1
155            | intSizeAndAlign Ty.I_short = layout 2
156            | intSizeAndAlign Ty.I_int = layout 4
157            | intSizeAndAlign Ty.I_long = layout 4
158            | intSizeAndAlign Ty.I_long_long = {sz = 8, stkAlign = 8, structAlign = 4}
159    
160        in
161    
162      (* calculate size and alignment for a C type *)      (* calculate size and alignment for a C type *)
163      fun szal (Ty.C_void | Ty.C_float | Ty.C_PTR |      fun szal (T.C_unsigned ty) = intSizeAndAlign ty
164                Ty.C_signed (Ty.I_int | Ty.I_long) |        | szal (T.C_signed ty) = intSizeAndAlign ty
165                Ty.C_unsigned (Ty.I_int | Ty.I_long)) = (4, 4)        | szal Ty.C_void = raise Fail "unexpected void type"
166        | szal (Ty.C_double |        | szal Ty.C_float = layout 4
167                Ty.C_signed Ty.I_long_long |        | szal Ty.C_PTR = layout 4
168                Ty.C_unsigned Ty.I_long_long) = (8, 8)        | szal Ty.C_double = {sz = 8, stkAlign = 8, structAlign = 4}
169        | szal (Ty.C_long_double) = (16, 8)        | szal (Ty.C_long_double) = {sz = 8, stkAlign = 8, structAlign = 4}
170        | szal (Ty.C_signed Ty.I_char | Ty.C_unsigned Ty.I_char) = (1, 1)        | szal (Ty.C_ARRAY(t, n)) = let
171        | szal (Ty.C_signed Ty.I_short | Ty.C_unsigned Ty.I_short) = (2, 2)            val a = szal t
172        | szal (Ty.C_ARRAY (t, n)) = let val (s, a) = szal t in (n * s, a) end            in
173        | szal (Ty.C_STRUCT l) =              {sz = n * #sz a, stkAlign = ?, structAlign = #structAlign a}
174          let (* i: next free memory address (relative to struct start);            end
175          | szal (Ty.C_STRUCT l) = let
176    (* FIXME: the rules for structs are more complicated (and they also depend
177     * on the alignment mode).  In Power alignment, 8-byte quantites like
178     * long long and double are 4-byte aligned in structs.
179     *)
180            (* i: next free memory address (relative to struct start);
181               * a: current total alignment,               * a: current total alignment,
182               * l: list of struct member types *)           * l: list of struct member types
183             *)
184              fun pack (i, a, []) =              fun pack (i, a, []) =
185                  (* when we are done with all elements, the total size                  (* when we are done with all elements, the total size
186                   * of the struct must be padded out to its own alignment *)               * of the struct must be padded out to its own alignment
187                 *)
188                  (roundup (i, a), a)                  (roundup (i, a), a)
189                | pack (i, a, t :: tl) = let                | pack (i, a, t :: tl) = let
190                      val (ts, ta) = szal t (* size and alignment for member *)                      val (ts, ta) = szal t (* size and alignment for member *)
# Line 157  Line 200 
200          in          in
201              pack (0, 1, l)              pack (0, 1, l)
202          end          end
203        end
204    
205      fun genCall { name, proto, paramAlloc, structRet, saveRestoreDedicated,      fun assignIntLoc (ty, gprs, offset) = let
206                    callComment, args } = let            val {sz, alignStk, alignStruct} = szal ty
207              val offset = align(offset, alignStk)
208              in
209                case (sz, gprs)
210                 of (_, []) => ({offset = offset, loc = ARG(??)}, offset+sz, [])
211                  | (8, [r]) =>
212                  | (8, r1::r2::rs) =>
213                  | (_, r::rs) =>({offset = offset, loc = GPR r}, offset+sz, rs)
214                (* end case *)
215              end
216    
217        fun genCall {
218              name, proto, paramAlloc, structRet, saveRestoreDedicated,
219              callComment, args
220            } = let
221          val { conv, retTy, paramTys } = proto          val { conv, retTy, paramTys } = proto
222          val _ = case conv of            val callseq = List.concat [
223                      ("" | "ccall") => ()                    sp_sub,
224                    | _ => error (concat ["unknown calling convention \"",                    copycode,
225                                          String.toString conv, "\""])                    argsetupcode,
226          val res_szal =                    sretsetup,
227              case retTy of                    save,
228                  (Ty.C_long_double | Ty.C_STRUCT _) => SOME (szal retTy)                    [call],
229                      srethandshake,
230                      restore,
231                      sp_add
232                    ]
233              in
234              (* check calling convention *)
235                case conv
236                 of ("" | "ccall") => ()
237                  | _ => error (concat [
238                        "unknown calling convention \"",
239                        String.toString conv, "\""
240                      ])
241                (* end case *);
242                {callseq = callseq, result = result}
243              end
244    
245    (******
246            val res_szal = (case retTy
247                   of (Ty.C_long_double | Ty.C_STRUCT _) => SOME(szal retTy)
248                | _ => NONE                | _ => NONE
249    
250          val nargwords = let          val nargwords = let
# Line 467  Line 544 
544      in      in
545          { callseq = callseq, result = result }          { callseq = callseq, result = result }
546      end      end
547    *****)
548    
549  end  end

Legend:
Removed from v.1470  
changed lines
  Added in v.1471

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