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 1532, Tue Jul 13 03:49:10 2004 UTC revision 1565, Wed Jul 28 21:06:59 2004 UTC
# Line 105  Line 105 
105      val fltTy = 32      (* MLRISC type of float *)      val fltTy = 32      (* MLRISC type of float *)
106      val dblTy = 64      (* MLRISC type of double *)      val dblTy = 64      (* MLRISC type of double *)
107    
108      (* shorts and chars are promoted to 32-bits *)
109        val naturalIntSz = wordTy
110    
111    (* stack pointer *)    (* stack pointer *)
112      val spReg = T.REG(wordTy, C.GPReg 1)      val spReg = T.REG(wordTy, C.GPReg 1)
113    
# Line 141  Line 144 
144     * padding is based on the parameter-passing description on p. 35 of the     * padding is based on the parameter-passing description on p. 35 of the
145     * documentation and the alignment is from p. 31.     * documentation and the alignment is from p. 31.
146     *)     *)
147      fun sizeOf CTy.I_char = {sz = 1, pad = 3, align = 1}      fun sizeOfInt CTy.I_char = {sz = 1, pad = 3, align = 1}
148        | sizeOf CTy.I_short = {sz = 2, pad = 2, align = 2}        | sizeOfInt CTy.I_short = {sz = 2, pad = 2, align = 2}
149        | sizeOf CTy.I_int = {sz = 4, pad = 0, align = 4}        | sizeOfInt CTy.I_int = {sz = 4, pad = 0, align = 4}
150        | sizeOf CTy.I_long = {sz = 4, pad = 0, align = 4}        | sizeOfInt CTy.I_long = {sz = 4, pad = 0, align = 4}
151        | sizeOf CTy.I_long_long = {sz = 8, pad = 0, align = 8}        | sizeOfInt CTy.I_long_long = {sz = 8, pad = 0, align = 8}
152    
153    (* sizes of other C types *)    (* sizes of other C types *)
154      val sizeOfPtr = {sz = 4, pad = 0, align = 4}      val sizeOfPtr = {sz = 4, pad = 0, align = 4}
155    
   (* compute the size and alignment information for a struct; tys is the list  
    * of member types.  The alignment is what Apple calls the "embedding" alignment.  
    *)  
     fun sizeOfStruct tys = let  
156          (* align the address to the given alignment, which must be a power of 2 *)          (* align the address to the given alignment, which must be a power of 2 *)
157            fun alignAddr (addr, align) = let            fun alignAddr (addr, align) = let
158                  val mask = Word.fromInt(align-1)                  val mask = Word.fromInt(align-1)
159                  in                  in
160                    Word.toIntX(Word.andb(Word.fromInt addr + mask, Word.notb mask))                    Word.toIntX(Word.andb(Word.fromInt addr + mask, Word.notb mask))
161                  end                  end
162            fun sz CTy.C_void = error "unexpected void argument type"  
163              | sz CTy.C_float = {sz = 4, align = 4}    (* compute the size and alignment information for a struct; tys is the list
164              | sz CTy.C_double = {sz = 8, align = 8}     * of member types.  The alignment is what Apple calls the "embedding" alignment.
165              | sz CTy.C_long_double = {sz = 8, align = 8}     * The total size is padded to agree with the struct's alignment.
166              | sz (CTy.C_unsigned isz) = let     *)
167                  val {sz, align, ...} = sizeOf isz      fun sizeOfStruct tys = let
168                  in            fun ssz [] = {sz = 0, align = 4}
                   {sz = sz, align = align}  
                 end  
             | sz (CTy.C_signed isz) = let  
                 val {sz, align, ...} = sizeOf isz  
                 in  
                   {sz = sz, align = align}  
                 end  
             | sz CTy.C_PTR = {sz = 4, align = 4}  
             | sz (CTy.C_ARRAY(ty, n)) = let  
                 val {sz, align} = sz ty  
                 in  
                   {sz = n*sz, align = align}  
                 end  
             | sz (CTy.C_STRUCT tys) = ssz tys  
           and ssz [] = {sz = 0, align = 4}  
169              | ssz (first::rest) = let              | ssz (first::rest) = let
170                  fun f ([], maxAlign, offset) =                  fun f ([], maxAlign, offset) =
171                        {sz = alignAddr(offset, maxAlign), align = maxAlign}                        {sz = alignAddr(offset, maxAlign), align = maxAlign}
172                    | f (ty::tys, maxAlign, offset) = let                    | f (ty::tys, maxAlign, offset) = let
173                          val {sz, align} = sz ty                          val {sz, align} = sizeOfTy ty
174                          val align = Int.min(align, 4)                          val align = Int.min(align, 4)
175                          val offset = alignAddr(offset, align)                          val offset = alignAddr(offset, align)
176                          in                          in
177                            f (tys, Int.max(maxAlign, align), offset+sz)                            f (tys, Int.max(maxAlign, align), offset+sz)
178                          end                          end
179                  val {sz, align} = sz first                  val {sz, align} = sizeOfTy first
180                    in
181                      f (rest, align, sz)
182                    end
183              in
184                ssz tys
185              end
186    
187      (* the size alignment of a union type is the maximum of the sizes and alignments of the
188       * members.  The final size is padded to agree with the alignment.
189       *)
190        and sizeOfUnion tys = let
191              fun usz [] = {sz = 0, align = 4}
192                | usz (first::rest) = let
193                    fun f ([], maxAlign, maxSz) =
194                          {sz = alignAddr(maxSz, maxAlign), align = maxAlign}
195                      | f (ty::tys, maxAlign, maxSz) = let
196                            val {sz, align} = sizeOfTy ty
197                            in
198                              f (tys, Int.max(maxAlign, align), Int.max(align, maxAlign))
199                            end
200                    val {sz, align} = sizeOfTy first
201                  in                  in
202                    f (rest, align, sz)                    f (rest, align, sz)
203                  end                  end
204            in            in
205              #sz(ssz tys)              usz tys
206              end
207    
208        and sizeOfTy CTy.C_void = error "unexpected void argument type"
209          | sizeOfTy CTy.C_float = {sz = 4, align = 4}
210          | sizeOfTy CTy.C_double = {sz = 8, align = 8}
211          | sizeOfTy CTy.C_long_double = {sz = 8, align = 8}
212          | sizeOfTy (CTy.C_unsigned isz) = let
213              val {sz, align, ...} = sizeOfInt isz
214              in
215                {sz = sz, align = align}
216              end
217          | sizeOfTy (CTy.C_signed isz) = let
218              val {sz, align, ...} = sizeOfInt isz
219              in
220                {sz = sz, align = align}
221              end
222          | sizeOfTy CTy.C_PTR = {sz = 4, align = 4}
223          | sizeOfTy (CTy.C_ARRAY(ty, n)) = let
224              val {sz, align} = sizeOfTy ty
225              in
226                {sz = n*sz, align = align}
227            end            end
228          | sizeOfTy (CTy.C_STRUCT tys) = sizeOfStruct tys
229          | sizeOfTy (CTy.C_UNION tys) = sizeOfUnion tys
230    
231    (* compute the layout of a C call's arguments *)    (* compute the layout of a C call's arguments *)
232      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
233            fun gprRes isz = (case #sz(sizeOf isz)            fun gprRes isz = (case #sz(sizeOfInt isz)
234                   of 8 => raise Fail "register pairs not yet supported"                   of 8 => raise Fail "register pairs not yet supported"
235                    | _ => SOME resRegLoc                    | _ => SOME resRegLoc
236                  (* end case *))                  (* end case *))
# Line 216  Line 244 
244                    | CTy.C_PTR => (SOME resRegLoc, argGPRs, NONE)                    | CTy.C_PTR => (SOME resRegLoc, argGPRs, NONE)
245                    | CTy.C_ARRAY _ => error "array return type"                    | CTy.C_ARRAY _ => error "array return type"
246                    | CTy.C_STRUCT s => let                    | CTy.C_STRUCT s => let
247                        val sz = sizeOfStruct s                        val sz = #sz(sizeOfStruct s)
248                        in                        in
249                        (* Note that this is a place where the MacOS X and Linux ABIs differ.                        (* Note that this is a place where the MacOS X and Linux ABIs differ.
250                         * In Linux, GPR3/GPR4 are used to return composite values of 8 bytes.                         * In Linux, GPR3/GPR4 are used to return composite values of 8 bytes.
251                         *)                         *)
252                          if (sz > 4)                          (SOME resRegLoc, List.tl argGPRs, SOME{szb=sz, align=4})
253                            then (SOME resRegLoc, List.tl argGPRs, SOME{szb=sz, align=4})                        end
254                            else (SOME resRegLoc, argGPRs, NONE)                    | CTy.C_UNION u => let
255                          val sz = #sz(sizeOfUnion u)
256                          in
257                            (SOME resRegLoc, List.tl argGPRs, SOME{szb=sz, align=4})
258                        end                        end
259                  (* end case *))                  (* end case *))
260            fun assign ([], offset, _, _, layout) = List.rev layout            fun assign ([], offset, _, _, layout) = (offset, List.rev layout)
261              | assign (ty::tys, offset, availGPRs, availFPRs, layout) = (              | assign (ty::tys, offset, availGPRs, availFPRs, layout) = (
262                  case ty                  case ty
263                   of CTy.C_void => error "unexpected void tyument type"                   of CTy.C_void => error "unexpected void argument type"
264                    | CTy.C_float => (case (availGPRs, availFPRs)                    | CTy.C_float => (case (availGPRs, availFPRs)
265                         of (_::gprs, fpr::fprs) =>                         of (_::gprs, fpr::fprs) =>
266                              assign (tys, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)
# Line 237  Line 268 
268                              assign (tys, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)
269                          | ([], []) =>                          | ([], []) =>
270                              assign (tys, offset+4, [], [], FStk(fltTy, offset)::layout)                              assign (tys, offset+4, [], [], FStk(fltTy, offset)::layout)
271                            | _ => error "FPRs exhausted before GPRs"
272                        (* end case *))                        (* end case *))
273                    | CTy.C_double =>                    | CTy.C_double =>
274                        assignFPR (tys, offset, availGPRs, availFPRs, layout)                        assignFPR (tys, offset, availGPRs, availFPRs, layout)
275                    | CTy.C_long_double =>                    | CTy.C_long_double =>
276                        assignFPR (tys, offset, availGPRs, availFPRs, layout)                        assignFPR (tys, offset, availGPRs, availFPRs, layout)
277                    | CTy.C_unsigned isz =>                    | CTy.C_unsigned isz =>
278                        assignGPR(sizeOf isz, tys, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfInt isz, tys, offset, availGPRs, availFPRs, layout)
279                    | CTy.C_signed isz =>                    | CTy.C_signed isz =>
280                        assignGPR(sizeOf isz, tys, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfInt isz, tys, offset, availGPRs, availFPRs, layout)
281                    | CTy.C_PTR =>                    | CTy.C_PTR =>
282                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)
283                    | CTy.C_ARRAY _ =>                    | CTy.C_ARRAY _ =>
284                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)
285                    | CTy.C_STRUCT tys' => raise Fail "struct arguments not supported yet"                    | CTy.C_STRUCT tys' =>
286                          assignMem(sizeOfStruct tys', tys, offset, availGPRs, availFPRs, layout)
287                      | CTy.C_UNION tys' =>
288                          assignMem(sizeOfUnion tys', tys, offset, availGPRs, availFPRs, layout)
289                  (* end case *))                  (* end case *))
290          (* assign a GP register and memory for an integer/pointer argument. *)          (* assign a GP register and memory for an integer/pointer argument. *)
291            and assignGPR ({sz, pad, ...}, args, offset, availGPRs, availFPRs, layout) = let            and assignGPR ({sz, pad, ...}, args, offset, availGPRs, availFPRs, layout) = let
# Line 273  Line 308 
308                     of (_::_::gprs, fpr::fprs) => continue (gprs, fprs, freg fpr)                     of (_::_::gprs, fpr::fprs) => continue (gprs, fprs, freg fpr)
309                      | (_, fpr::fprs) => continue ([], fprs, freg fpr)                      | (_, fpr::fprs) => continue ([], fprs, freg fpr)
310                      | ([], []) => continue ([], [], FStk(dblTy, offset))                      | ([], []) => continue ([], [], FStk(dblTy, offset))
311                        | _ => error "FPRs exhausted before GPRs"
312                    (* end case *)                    (* end case *)
313                  end                  end
314            (* assign a argument locations to pass a composite argument (struct or union) *)
315              and assignMem ({sz, ...}, args, offset, availGPRs, availFPRs, layout) = let
316                    val sz = IntInf.fromInt sz
317                    fun assignMem (relOffset, availGPRs, fields) =
318                          if (relOffset < sz)
319                            then let
320                              val (loc, availGPRs) = (case availGPRs
321                                     of [] => (Stk(wordTy, offset+relOffset), [])
322                                      | r1::rs => (Reg(wordTy, r1, SOME(offset+relOffset)), rs)
323                                    (* end case *))
324                              in
325                                assignMem (relOffset+4, availGPRs, loc::fields)
326                              end
327                            else assign (args, offset+relOffset, availGPRs, availFPRs,
328                                Args(List.rev fields) :: layout)
329                    in
330                      assignMem (0, availGPRs, [])
331                    end
332              val (sz, argLocs) = assign (paramTys, 0, argGPRs, argFPRs, [])
333            in {            in {
334              argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),              argLocs = argLocs,
335                argMem = {szb = IntInf.toInt sz, align = 4},
336              resLoc = resLoc,              resLoc = resLoc,
337              structRetLoc = structRet              structRetLoc = structRet
338            } end            } end
# Line 298  Line 354 
354            callComment, args            callComment, args
355          } = let          } = let
356            val {conv, retTy, paramTys} = proto            val {conv, retTy, paramTys} = proto
357            val {argLocs, resLoc, structRetLoc} = layout proto            val {argLocs, argMem, resLoc, structRetLoc} = layout proto
358            (* inform the client of the size of the parameter area *)
359              val _ = if not(paramAlloc argMem)
360                    then raise Fail "parameter memory allocation not implemented yet"
361                    else ()
362          (* generate code to assign the arguments to their locations *)          (* generate code to assign the arguments to their locations *)
363            fun assignArgs ([], [], stms) = stms            fun assignArgs ([], [], stms) = stms
364              | assignArgs (Reg(ty, r, _) :: locs, ARG exp :: args, stms) =              | assignArgs (Reg(ty, r, _) :: locs, ARG exp :: args, stms) =
# Line 310  Line 370 
370              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =
371                  assignArgs (locs, args, T.FSTORE(ty, paramAddr off, fexp, stkRg) :: stms)                  assignArgs (locs, args, T.FSTORE(ty, paramAddr off, fexp, stkRg) :: stms)
372              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =
373                  assignArgs (locs, args, assignArgs(locs', args', stms))                  raise Fail "ARGS constructor is obsolete"
374                | assignArgs ((Args locs') :: locs, ARG exp :: args, stms) = let
375                  (* MLRISC expression for address inside the source struct *)
376                    fun addr 0 = T.LOAD(wordTy, exp, memRg)
377                      | addr offset = T.LOAD(wordTy, T.ADD(wordTy, exp, T.LI offset), memRg)
378                    fun copy ([], _, stms) = assignArgs(locs, args, stms)
379                      | copy (Reg(ty, r, _) :: locs, offset, stms) =
380                          copy (locs, offset+4, T.MV(ty, r, addr offset)::stms)
381                      | copy (Stk(ty, off) :: locs, offset, stms) = let
382                          val r = C.newReg()
383                          in
384                            copy (locs, offset+4,
385                              T.STORE(ty, paramAddr off, T.REG(wordTy, r), stkRg)
386                              :: T.MV(ty, r, addr offset) :: stms)
387                          end
388                      | copy _ = raise Fail "unexpected FReg/FStk/Args in location list"
389                    in
390                    (* copy data from memory specified by exp to locs' *)
391                      copy (locs', 0, stms)
392                    end
393              | assignArgs _ = error "argument/formal mismatch"              | assignArgs _ = error "argument/formal mismatch"
394            val argSetupCode = List.rev(assignArgs(argLocs, args, []))            val argSetupCode = List.rev(assignArgs(argLocs, args, []))
395          (* convert the result location to an MLRISC expression list *)          (* convert the result location to an MLRISC expression list *)
# Line 343  Line 422 
422                    | addArgReg ((Args locs')::locs, argRegs) =                    | addArgReg ((Args locs')::locs, argRegs) =
423                        addArgReg (locs, addArgReg(locs', argRegs))                        addArgReg (locs, addArgReg(locs', argRegs))
424                    | addArgReg (_::locs, argRegs) = addArgReg(locs, argRegs)                    | addArgReg (_::locs, argRegs) = addArgReg(locs, argRegs)
425                    | addArgReg ([], argRegs) = rev argRegs                    | addArgReg ([], argRegs) = argRegs
426                  val argRegs = addArgReg (locs, [])                  val argRegs = addArgReg (locs, [])
427                  in                  in
428                    (argRegs, linkReg :: callerSaveRegs)                    (argRegs, linkReg :: callerSaveRegs)

Legend:
Removed from v.1532  
changed lines
  Added in v.1565

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