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
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 1521, Wed Jun 30 21:44:58 2004 UTC revision 1522, Tue Jul 6 17:09:21 2004 UTC
# Line 94  Line 94 
94     * low end of the parameter area.     * low end of the parameter area.
95     *)     *)
96      datatype arg_location      datatype arg_location
97        = Reg of T.ty * T.reg             (* integer/pointer argument in register *)        = Reg of T.ty * T.reg * T.I.machine_int option
98        | FReg of T.fty * T.freg          (* floating-point argument in register *)                                          (* integer/pointer argument in register *)
99          | FReg of T.fty * T.freg * T.I.machine_int option
100                                            (* floating-point argument in register *)
101        | Stk of T.ty * T.I.machine_int   (* integer/pointer argument in parameter area *)        | Stk of T.ty * T.I.machine_int   (* integer/pointer argument in parameter area *)
102        | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)        | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
103        | Args of arg_location list        | Args of arg_location list
104    
105  (* ?? use arg_location instead of the following? *)      val wordTy = 32
106      datatype arg_loc      val fltTy = 32      (* MLRISC type of float *)
107        = GPR of C.cell      val dblTy = 64      (* MLRISC type of double *)
       | GPR2 of C.cell * C.cell  
       | FPR of C.cell  
       | STK  
   
     type arg_pos = {  
         offset : int,           (* stack offset of memory for argument *)  
         loc : arg_loc           (* location where argument is passed *)  
       }  
108    
109    (* registers used for parameter passing *)    (* registers used for parameter passing *)
110      val argGPRs = List.map C.GPReg [3, 4, 5, 6, 7, 8, 9, 10]      val argGPRs = List.map C.GPReg [3, 4, 5, 6, 7, 8, 9, 10]
111      val argFPRs = List.map C.FPReg [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13]      val argFPRs = List.map C.FPReg [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13]
112        val resGPR = C.GPReg 3
113        val resFPR = C.FPReg 1
114    
115    (* C callee-save registers *)    (* C callee-save registers *)
116      val calleeSaveRegs = List.map C.GPReg [      val calleeSaveRegs = List.map C.GPReg [
# Line 126  Line 122 
122              23, 24, 25, 26, 27, 28, 29, 30, 31              23, 24, 25, 26, 27, 28, 29, 30, 31
123            ]            ]
124    
125    (* size of integer types *)    (* size and padding for integer types.  Note that the padding is based on the
126       * parameter-passing description on p. 35 of the documentation.
127       *)
128      fun sizeOf CTy.I_char = {sz = 1, pad = 3}      fun sizeOf CTy.I_char = {sz = 1, pad = 3}
129        | sizeOf CTy.I_short = {sz = 2, pad = 2}        | sizeOf CTy.I_short = {sz = 2, pad = 2}
130        | sizeOf CTy.I_int = {sz = 4, pad = 0}        | sizeOf CTy.I_int = {sz = 4, pad = 0}
131        | sizeOf CTy.I_long = {sz = 4, pad = 0}        | sizeOf CTy.I_long = {sz = 4, pad = 0}
132        | sizeOf CTy.I_long_long = {sz = 8, pad = 0}        | sizeOf CTy.I_long_long = {sz = 8, pad = 0}
133    
134      (* sizes of other C types *)
135        val sizeOfPtr = {sz = 4, pad = 0}
136    
137        fun sizeOfStruct ? = ?
138    
139    (* compute the layout of a C call's arguments *)    (* compute the layout of a C call's arguments *)
140      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
141            val structRet = (case retTy            fun gprRes isz = (case sizeOf isz
142                   of CTy.C_STRUCT _ => true                   of 8 => raise Fail "register pairs not yet supported"
143                    | _ => false                    | _ => SOME resGPR
144                    (* end case *))
145              val (resReg, availGPRs) = (case retTy
146                     of CTy.C_void => (NONE, availGPRs)
147                      | CTy.C_float => (SOME resFPR, availGPRs)
148                      | CTy.C_double => (SOME resFPR, availGPRs)
149                      | CTy.C_long_double => (SOME resFPR, availGPRs)
150                      | CTy.C_unsigned isz => (gprRes isz, availGPRs)
151                      | CTy.C_signed isz => (gprRes isz, availGPRs)
152                      | CTy.C_PTR => (SOME resGPR, availGPRs)
153                      | CTy.C_ARRAY _ => error "array return type"
154                      | CTy.C_STRUCT s => let
155                          val sz = sizeOfStruct s
156                          in
157                          (* Note that this is a place where the MacOS X and Linux ABIs differ.
158                           * In Linux, GPR3/GPR4 are used to return composite values of 8 bytes.
159                           *)
160                            if (sz > 4)
161                              then (SOME resGPR, List.tl availGPRs)
162                              else (SOME resGPR, availGPRs)
163                          end
164                  (* end case *))                  (* end case *))
165            fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}            fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}
166              | assign (arg::args, offset, availGPRs, availFPRs, layout) = (              | assign (arg::args, offset, availGPRs, availFPRs, layout) = (
167                  case arg                  case arg
168                   of CTy.C_void => error "unexpected void argument type"                   of CTy.C_void => error "unexpected void argument type"
169                    | CTy.C_float =>                    | CTy.C_float => (case (availGPRs, availFPRs)
170                           of (_:gprs, fpr::fprs) =>
171                                assign (args, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)
172                            | ([], fpr::fprs) =>
173                                assign (args, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)
174                            | ([], []) =>
175                                assign (args, offset+4, [], [], FStk(fltTy, offset)::layout)
176                          (* end case *))
177                    | CTy.C_double =>                    | CTy.C_double =>
178                    | CTy.C_long_double =>                    | CTy.C_long_double =>
179                    | CTy.C_unsigned isz =>                    | CTy.C_unsigned isz =>
180                          assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)
181                    | CTy.C_signed isz =>                    | CTy.C_signed isz =>
182                          assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)
183                    | CTy.C_PTR =>                    | CTy.C_PTR =>
184                          assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)
185                    | CTy.C_ARRAY _ =>                    | CTy.C_ARRAY _ =>
186                          assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)
187                    | CTy.C_STRUCT tys =>                    | CTy.C_STRUCT tys =>
188                  (* end case *))                  (* end case *))
189            and assignGPR (offset, sz, pad, availGPRs, availFPRs) = let          (* assign a GP register and memory for an integer/pointer argument. *)
190                  val offset' = offset + sz + pad            and assignGPR ({sz, pad}, args, offset, availGPRs, availFPRs, layout) = let
191                    val (loc, availGPRs) = (case (sz, availGPRs)
192                           of (8, _) => raise Fail "register pairs not yet supported"
193                            | (_, []) => (Stk(wordTy, offset), [])
194                            | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)
195                          (* end case *))
196                    val offset = offset + sz + pad
197                    in
198                      assign (args, offset, availGPRs, availFPRs, loc::layout)
199                    end
200            (* assign a FP register and memory/GPRs for double-precision argument. *)
201              and assignFPR (args, offset, availGPRs, availFPRs, layout) = let
202                    fun continue (availGPRs, availFPRs, loc) =
203                          assign (args, offset+8, availGPRs, availFPRs, loc::layout)
204                    fun freg fpr = FReg(dblTy, fpr, SOME offset)
205                  in                  in
206                    ({offset = offset, loc = loc}, offset')                    case (availGPRs, availFPRs)
207                       of (_::_::gprs, fpr::fprs) => continue (gprs, fprs, freg fpr)
208                        | (_, fpr::fprs) => continue ([], fprs, freg fpr)
209                        | ([], []) => continue ([], [], FStk(dblTy, offset))
210                      (* end case *)
211                  end                  end
             | assignGPR (args, offset, [], availFPRs) =  
           and assignFPR (offset, gpr::availGPRs, fpr::availFPRs) =  
             | assignFPR (offset, [], fpr::availFPRs) =  
             | assignFPR (offset, [], []) =  
212            in            in
213              assign (paramTys, 0, argGPRs, argFPRs, [])              { args = assign (paramTys, 0, argGPRs, argFPRs, []), res = resReg }
214            end            end
215    
216      datatype c_arg      datatype c_arg

Legend:
Removed from v.1521  
changed lines
  Added in v.1522

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