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/trunk/src/MLRISC/ppc/c-calls/ppc-macosx.sml
[smlnj] / sml / trunk / src / MLRISC / ppc / c-calls / ppc-macosx.sml  
ViewVC logotype

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

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

revision 1442, Thu Jan 15 23:12:57 2004 UTC revision 1443, Sun Jan 25 19:27:10 2004 UTC
# Line 113  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
# Line 134  Line 131 
131               of 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      fun intSizeAndAlign Ty.I_char = (1, 1)    (* layout information for integer types *)
151        | intSizeAndAlign Ty.I_short = (2, 2)      local
152        | intSizeAndAlign Ty.I_int = (4, 4)        fun layout n = {sz = n, stkAlign = n, structAlign = n}
153        | intSizeAndAlign Ty.I_long = (4, 4)  
154        | intSizeAndAlign Ty.I_long_long = (8, 8)        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 (T.C_unsigned ty) = intSizeAndAlign ty      fun szal (T.C_unsigned ty) = intSizeAndAlign ty
164        | szal (T.C_signed ty) = intSizeAndAlign ty        | szal (T.C_signed ty) = intSizeAndAlign ty
165        | szal Ty.C_void = raise Fail "unexpected void type"        | szal Ty.C_void = raise Fail "unexpected void type"
166        | szal Ty.C_float = (4, 4)        | szal Ty.C_float = layout 4
167        | szal Ty.C_PTR = (4, 4)        | szal Ty.C_PTR = layout 4
168        | szal Ty.C_double = (8, 8)        | szal Ty.C_double = {sz = 8, stkAlign = 8, structAlign = 4}
169        | szal (Ty.C_long_double) = (8, 8)        | szal (Ty.C_long_double) = {sz = 8, stkAlign = 8, structAlign = 4}
170        | szal (Ty.C_ARRAY(t, n)) = let val (s, a) = szal t in (n * s, a) end        | szal (Ty.C_ARRAY(t, n)) = let
171              val a = szal t
172              in
173                {sz = n * #sz a, stkAlign = ?, structAlign = #structAlign a}
174              end
175        | szal (Ty.C_STRUCT l) = let        | szal (Ty.C_STRUCT l) = let
176  (* FIXME: the rules for structs are more complicated (and they also depend  (* FIXME: the rules for structs are more complicated (and they also depend
177   * on the alignment mode).  In Power alignment, 8-byte quantites like   * on the alignment mode).  In Power alignment, 8-byte quantites like
# Line 186  Line 200 
200            in            in
201              pack (0, 1, l)              pack (0, 1, l)
202            end            end
203        end
204    
205        datatype arg
206          = Simple of (Ty.c_type * arg_pos)         (* includes arrays *)
207          | Struct of arg list
208    
209      (* layout arguments *)
210        fun layout argTys = let
211              fun assign ([], _, _, offset, args) = (offset, List.rev args)
212                | assign (x::xs, gprs, fprs, offset, args) = let
213                    fun assignInt sz = (case (sz, gprs)
214                           of (_, []) =>
215                                assign(xs, [], fprs,
216                            | (8, [r]) =>
217                            | (8, r1::r2::rs) =>
218                            | (_, r::rs) =>
219                          (* end case *))
220                    in
221                      case x
222                       of (Ty.C_unsigned _) => assignInt x
223                        | (Ty.C_signed _) => assignInt x
224                        | (Ty.C_PTR) => assignInt x
225                        | (Ty.C_float) => assignFlt x
226                        | (Ty.C_double) => assignFlt x
227                        | (Ty.C_long_double) => assignFlt x
228                        | (Ty.C_ARRAY(ty, n)) =>
229                        | (Ty.CSTRUCT tys) =>
230                      (* end case *)
231                    end
232              in
233              end
234    
235      fun genCall { name, proto, paramAlloc, structRet, saveRestoreDedicated,      fun genCall { name, proto, paramAlloc, structRet, saveRestoreDedicated,
236                    callComment, args } = let                    callComment, args } = let
Legend:
Removed from v.1442  
changed lines
  Added in v.1443
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge