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

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

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