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 1526, Fri Jul 9 03:48:36 2004 UTC revision 1527, Fri Jul 9 22:42:16 2004 UTC
# Line 80  Line 80 
80  functor PPCMacOSX_CCalls (  functor PPCMacOSX_CCalls (
81    
82      structure T : MLTREE      structure T : MLTREE
     val ix : (T.stm, T.rexp, T.fexp, T.ccexp) PPCInstrExt.sext -> T.sext  
83    
84    ): PPC_MACOSX_C_CALLS = struct    ): C_CALLS = struct
85    
86      structure T  = T      structure T  = T
87      structure CTy = CTypes      structure CTy = CTypes
88      structure C = PPCCells      structure C = PPCCells
     structure IX = PPCInstrExt  
89    
90      fun error msg = MLRiscErrorMsg.error ("PPCCompCCalls", msg)      fun error msg = MLRiscErrorMsg.error ("PPCCompCCalls", msg)
91    
# Line 166  Line 165 
165    
166    (* compute the layout of a C call's arguments *)    (* compute the layout of a C call's arguments *)
167      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
168            fun gprRes isz = (case sizeOf isz            fun gprRes isz = (case #sz(sizeOf isz)
169                   of 8 => raise Fail "register pairs not yet supported"                   of 8 => raise Fail "register pairs not yet supported"
170                    | _ => SOME resGPR                    | _ => SOME(Reg(wordTy, resGPR, NONE))
171                  (* end case *))                  (* end case *))
172            val (resReg, availGPRs, structRet) = (case retTy            val (resLoc, argGPRs, structRet) = (case retTy
173                   of CTy.C_void => (NONE, availGPRs, NONE)                   of CTy.C_void => (NONE, argGPRs, NONE)
174                    | CTy.C_float => (SOME resFPR, availGPRs, NONE)                    | CTy.C_float => (SOME(FReg(fltTy, resFPR, NONE)), argGPRs, NONE)
175                    | CTy.C_double => (SOME resFPR, availGPRs, NONE)                    | CTy.C_double => (SOME(FReg(dblTy, resFPR, NONE)), argGPRs, NONE)
176                    | CTy.C_long_double => (SOME resFPR, availGPRs, NONE)                    | CTy.C_long_double => (SOME(FReg(dblTy, resFPR, NONE)), argGPRs, NONE)
177                    | CTy.C_unsigned isz => (gprRes isz, availGPRs, NONE)                    | CTy.C_unsigned isz => (gprRes isz, argGPRs, NONE)
178                    | CTy.C_signed isz => (gprRes isz, availGPRs, NONE)                    | CTy.C_signed isz => (gprRes isz, argGPRs, NONE)
179                    | CTy.C_PTR => (SOME resGPR, availGPRs, NONE)                    | CTy.C_PTR => (SOME(Reg(wordTy, resGPR, NONE)), argGPRs, NONE)
180                    | CTy.C_ARRAY _ => error "array return type"                    | CTy.C_ARRAY _ => error "array return type"
181                    | CTy.C_STRUCT s => let                    | CTy.C_STRUCT s => let
182                        val sz = sizeOfStruct s                        val sz = sizeOfStruct s
# Line 186  Line 185 
185                         * 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.
186                         *)                         *)
187                          if (sz > 4)                          if (sz > 4)
188                            then (SOME resGPR, List.tl availGPRs, SOME{szb=sz, align=4})                            then (SOME resGPR, List.tl argGPRs, SOME{szb=sz, align=4})
189                            else (SOME resGPR, availGPRs, NONE)                            else (SOME resGPR, argGPRs, NONE)
190                        end                        end
191                  (* end case *))                  (* end case *))
192            fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}            fun assign ([], offset, _, _, layout) = List.rev layout
193              | assign (ty::tys, offset, availGPRs, availFPRs, layout) = (              | assign (ty::tys, offset, availGPRs, availFPRs, layout) = (
194                  case ty                  case ty
195                   of CTy.C_void => error "unexpected void tyument type"                   of CTy.C_void => error "unexpected void tyument type"
196                    | CTy.C_float => (case (availGPRs, availFPRs)                    | CTy.C_float => (case (availGPRs, availFPRs)
197                         of (_:gprs, fpr::fprs) =>                         of (_::gprs, fpr::fprs) =>
198                              assign (tys, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)
199                          | ([], fpr::fprs) =>                          | ([], fpr::fprs) =>
200                              assign (tys, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)
# Line 223  Line 222 
222                          | (_, []) => (Stk(wordTy, offset), [])                          | (_, []) => (Stk(wordTy, offset), [])
223                          | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)                          | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)
224                        (* end case *))                        (* end case *))
225                  val offset = offset + sz + pad                  val offset = offset + IntInf.fromInt(sz + pad)
226                  in                  in
227                    assign (args, offset, availGPRs, availFPRs, loc::layout)                    assign (args, offset, availGPRs, availFPRs, loc::layout)
228                  end                  end
# Line 241  Line 240 
240                  end                  end
241            in {            in {
242              argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),              argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),
243              resLoc = resReg,              resLoc = resLoc,
244              structRet = structRet              structRet = structRet
245            } end            } end
246    
# Line 254  Line 253 
253      val stkRg = T.Region.memory      val stkRg = T.Region.memory
254    
255    (* SP-based address of parameter at given offset *)    (* SP-based address of parameter at given offset *)
256      fun paramAddr off = T.ADD(wordSz, spR, T.LI(off + IntInf.fromInt paramAreaOffset))      fun paramAddr off = T.ADD(wordTy, spR, T.LI(off + IntInf.fromInt paramAreaOffset))
257    
258      fun genCall {      fun genCall {
259            name, proto, paramAlloc, structRet, saveRestoreDedicated,            name, proto, paramAlloc, structRet, saveRestoreDedicated,
# Line 268  Line 267 
267                  assignArgs (locs, args, T.MV(ty, r, exp) :: stms)                  assignArgs (locs, args, T.MV(ty, r, exp) :: stms)
268              | assignArgs (Stk(ty, off) :: locs, ARG exp :: args, stms) =              | assignArgs (Stk(ty, off) :: locs, ARG exp :: args, stms) =
269                  assignArgs (locs, args, T.STORE(ty, paramAddr off, exp, stkRg) :: stms)                  assignArgs (locs, args, T.STORE(ty, paramAddr off, exp, stkRg) :: stms)
270              | assignArgs (FReg(ty, r, _) :: locs, FARG fexp :: args) =              | assignArgs (FReg(ty, r, _) :: locs, FARG fexp :: args, stms) =
271                  assignArgs (locs, args, T.FMV(ty, r, fexp) :: stms)                  assignArgs (locs, args, T.FMV(ty, r, fexp) :: stms)
272              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =
273                  assignArgs (locs, args, T.FSTORE(ty, paramAddr off, fexp, stkRg) :: stms)                  assignArgs (locs, args, T.FSTORE(ty, paramAddr off, fexp, stkRg) :: stms)
274              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =
275                  assignArgs (locs, args, assignArgs(locs', args', stms))                  assignArgs (locs, args, assignArgs(locs', args', stms))
276              | assignArgs _ = error "argument/formal mismatch"              | assignArgs _ = error "argument/formal mismatch"
277            val argsetupCode = List.rev(assignArgs(args, args, []))            val argSetupCode = List.rev(assignArgs(argLocs, args, []))
278          (* convert the result location to an MLRISC expression list *)          (* convert the result location to an MLRISC expression list *)
279            val result = (case resLoc            val result = (case resLoc
280                   of NONE => []                   of NONE => []
281                    | SOME(Reg(ty, r, _)) => [T.REG(ty, r)]                    | SOME(Reg(ty, r, _)) => [T.GPR(T.REG(ty, r))]
282                    | SOME(FReg(ty, r, _)) => [T.FREG(ty, r)]                    | SOME(FReg(ty, r, _)) => [T.FPR(T.FREG(ty, r))]
283                    | SOME _ => raise Fail "bogus result location"                    | SOME _ => raise Fail "bogus result location"
284                  (* end case *))                  (* end case *))
285          (* determine the registers used and defined by this call *)          (* determine the registers used and defined by this call *)

Legend:
Removed from v.1526  
changed lines
  Added in v.1527

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