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 1524, Tue Jul 6 19:48:34 2004 UTC revision 1532, Tue Jul 13 03:49:10 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 107  Line 106 
106      val dblTy = 64      (* MLRISC type of double *)      val dblTy = 64      (* MLRISC type of double *)
107    
108    (* stack pointer *)    (* stack pointer *)
109      val sp = C.GPReg 1      val spReg = T.REG(wordTy, C.GPReg 1)
     val spR = T.REG(wordTy, sp)  
110    
111    (* registers used for parameter passing *)    (* registers used for parameter passing *)
112      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]
113      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]
114      val resGPR = C.GPReg 3      val resGPR = C.GPReg 3
115        val resRegLoc = Reg(wordTy, resGPR, NONE)
116      val resFPR = C.FPReg 1      val resFPR = C.FPReg 1
117    
118    (* C callee-save registers *)    (* C callee-save registers *)
# Line 128  Line 127 
127    
128    (* C caller-save registers (including argument registers) *)    (* C caller-save registers (including argument registers) *)
129      val callerSaveRegs =      val callerSaveRegs =
130  (* FIXME: also need link register *)            T.FPR(T.FREG(dblTy, C.FPReg 0)) ::
131            (List.map C.GPReg [2, 11, 12]) @ argGPRs @ (List.map C.FPReg [0]) @ argFPRs              (List.map (fn r => T.GPR(T.REG(wordTy, C.GPReg r))) [2, 11, 12])
132    
133        val linkReg = T.GPR(T.REG(wordTy, C.lr))
134    
135      (* the parameter area lies just above the linkage area in the caller's frame.
136       * The linkage area is 24 bytes, so the first parameter is at 24(sp).
137       *)
138        val paramAreaOffset = 24
139    
140    (* size and padding for integer types.  Note that the padding is based on the    (* size, padding, and natural alignment for integer types.  Note that the
141     * parameter-passing description on p. 35 of the documentation.     * padding is based on the parameter-passing description on p. 35 of the
142       * documentation and the alignment is from p. 31.
143     *)     *)
144      fun sizeOf CTy.I_char = {sz = 1, pad = 3}      fun sizeOf CTy.I_char = {sz = 1, pad = 3, align = 1}
145        | sizeOf CTy.I_short = {sz = 2, pad = 2}        | sizeOf CTy.I_short = {sz = 2, pad = 2, align = 2}
146        | sizeOf CTy.I_int = {sz = 4, pad = 0}        | sizeOf CTy.I_int = {sz = 4, pad = 0, align = 4}
147        | sizeOf CTy.I_long = {sz = 4, pad = 0}        | sizeOf CTy.I_long = {sz = 4, pad = 0, align = 4}
148        | sizeOf CTy.I_long_long = {sz = 8, pad = 0}        | sizeOf 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}      val sizeOfPtr = {sz = 4, pad = 0, align = 4}
152    
153      fun sizeOfStruct tys = ?    (* compute the size and alignment information for a struct; tys is the list
154       * of member types.  The alignment is what Apple calls the "embedding" alignment.
155       *)
156        fun sizeOfStruct tys = let
157            (* align the address to the given alignment, which must be a power of 2 *)
158              fun alignAddr (addr, align) = let
159                    val mask = Word.fromInt(align-1)
160                    in
161                      Word.toIntX(Word.andb(Word.fromInt addr + mask, Word.notb mask))
162                    end
163              fun sz CTy.C_void = error "unexpected void argument type"
164                | sz CTy.C_float = {sz = 4, align = 4}
165                | sz CTy.C_double = {sz = 8, align = 8}
166                | sz CTy.C_long_double = {sz = 8, align = 8}
167                | sz (CTy.C_unsigned isz) = let
168                    val {sz, align, ...} = sizeOf isz
169                    in
170                      {sz = sz, align = align}
171                    end
172                | sz (CTy.C_signed isz) = let
173                    val {sz, align, ...} = sizeOf isz
174                    in
175                      {sz = sz, align = align}
176                    end
177                | sz CTy.C_PTR = {sz = 4, align = 4}
178                | sz (CTy.C_ARRAY(ty, n)) = let
179                    val {sz, align} = sz ty
180                    in
181                      {sz = n*sz, align = align}
182                    end
183                | sz (CTy.C_STRUCT tys) = ssz tys
184              and ssz [] = {sz = 0, align = 4}
185                | ssz (first::rest) = let
186                    fun f ([], maxAlign, offset) =
187                          {sz = alignAddr(offset, maxAlign), align = maxAlign}
188                      | f (ty::tys, maxAlign, offset) = let
189                            val {sz, align} = sz ty
190                            val align = Int.min(align, 4)
191                            val offset = alignAddr(offset, align)
192                            in
193                              f (tys, Int.max(maxAlign, align), offset+sz)
194                            end
195                    val {sz, align} = sz first
196                    in
197                      f (rest, align, sz)
198                    end
199              in
200                #sz(ssz tys)
201              end
202    
203    (* compute the layout of a C call's arguments *)    (* compute the layout of a C call's arguments *)
204      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
205            fun gprRes isz = (case sizeOf isz            fun gprRes isz = (case #sz(sizeOf isz)
206                   of 8 => raise Fail "register pairs not yet supported"                   of 8 => raise Fail "register pairs not yet supported"
207                    | _ => SOME resGPR                    | _ => SOME resRegLoc
208                  (* end case *))                  (* end case *))
209            val (resReg, availGPRs) = (case retTy            val (resLoc, argGPRs, structRet) = (case retTy
210                   of CTy.C_void => (NONE, availGPRs)                   of CTy.C_void => (NONE, argGPRs, NONE)
211                    | CTy.C_float => (SOME resFPR, availGPRs)                    | CTy.C_float => (SOME(FReg(fltTy, resFPR, NONE)), argGPRs, NONE)
212                    | CTy.C_double => (SOME resFPR, availGPRs)                    | CTy.C_double => (SOME(FReg(dblTy, resFPR, NONE)), argGPRs, NONE)
213                    | CTy.C_long_double => (SOME resFPR, availGPRs)                    | CTy.C_long_double => (SOME(FReg(dblTy, resFPR, NONE)), argGPRs, NONE)
214                    | CTy.C_unsigned isz => (gprRes isz, availGPRs)                    | CTy.C_unsigned isz => (gprRes isz, argGPRs, NONE)
215                    | CTy.C_signed isz => (gprRes isz, availGPRs)                    | CTy.C_signed isz => (gprRes isz, argGPRs, NONE)
216                    | CTy.C_PTR => (SOME resGPR, availGPRs)                    | CTy.C_PTR => (SOME resRegLoc, argGPRs, NONE)
217                    | CTy.C_ARRAY _ => error "array return type"                    | CTy.C_ARRAY _ => error "array return type"
218                    | CTy.C_STRUCT s => let                    | CTy.C_STRUCT s => let
219                        val sz = sizeOfStruct s                        val sz = sizeOfStruct s
# Line 167  Line 222 
222                         * 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.
223                         *)                         *)
224                          if (sz > 4)                          if (sz > 4)
225                            then (SOME resGPR, List.tl availGPRs)                            then (SOME resRegLoc, List.tl argGPRs, SOME{szb=sz, align=4})
226                            else (SOME resGPR, availGPRs)                            else (SOME resRegLoc, argGPRs, NONE)
227                        end                        end
228                  (* end case *))                  (* end case *))
229            fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}            fun assign ([], offset, _, _, layout) = List.rev layout
230              | assign (arg::args, offset, availGPRs, availFPRs, layout) = (              | assign (ty::tys, offset, availGPRs, availFPRs, layout) = (
231                  case arg                  case ty
232                   of CTy.C_void => error "unexpected void argument type"                   of CTy.C_void => error "unexpected void tyument type"
233                    | CTy.C_float => (case (availGPRs, availFPRs)                    | CTy.C_float => (case (availGPRs, availFPRs)
234                         of (_:gprs, fpr::fprs) =>                         of (_::gprs, fpr::fprs) =>
235                              assign (args, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)
236                          | ([], fpr::fprs) =>                          | ([], fpr::fprs) =>
237                              assign (args, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)                              assign (tys, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)
238                          | ([], []) =>                          | ([], []) =>
239                              assign (args, offset+4, [], [], FStk(fltTy, offset)::layout)                              assign (tys, offset+4, [], [], FStk(fltTy, offset)::layout)
240                        (* end case *))                        (* end case *))
241                    | CTy.C_double =>                    | CTy.C_double =>
242                          assignFPR (tys, offset, availGPRs, availFPRs, layout)
243                    | CTy.C_long_double =>                    | CTy.C_long_double =>
244                          assignFPR (tys, offset, availGPRs, availFPRs, layout)
245                    | CTy.C_unsigned isz =>                    | CTy.C_unsigned isz =>
246                        assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOf isz, tys, offset, availGPRs, availFPRs, layout)
247                    | CTy.C_signed isz =>                    | CTy.C_signed isz =>
248                        assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOf isz, tys, offset, availGPRs, availFPRs, layout)
249                    | CTy.C_PTR =>                    | CTy.C_PTR =>
250                        assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)
251                    | CTy.C_ARRAY _ =>                    | CTy.C_ARRAY _ =>
252                        assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)                        assignGPR(sizeOfPtr, tys, offset, availGPRs, availFPRs, layout)
253                    | CTy.C_STRUCT tys =>                    | CTy.C_STRUCT tys' => raise Fail "struct arguments not supported yet"
254                  (* end case *))                  (* end case *))
255          (* assign a GP register and memory for an integer/pointer argument. *)          (* assign a GP register and memory for an integer/pointer argument. *)
256            and assignGPR ({sz, pad}, args, offset, availGPRs, availFPRs, layout) = let            and assignGPR ({sz, pad, ...}, args, offset, availGPRs, availFPRs, layout) = let
257                  val (loc, availGPRs) = (case (sz, availGPRs)                  val (loc, availGPRs) = (case (sz, availGPRs)
258                         of (8, _) => raise Fail "register pairs not yet supported"                         of (8, _) => raise Fail "register pairs not yet supported"
259                          | (_, []) => (Stk(wordTy, offset), [])                          | (_, []) => (Stk(wordTy, offset), [])
260                          | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)                          | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)
261                        (* end case *))                        (* end case *))
262                  val offset = offset + sz + pad                  val offset = offset + IntInf.fromInt(sz + pad)
263                  in                  in
264                    assign (args, offset, availGPRs, availFPRs, loc::layout)                    assign (args, offset, availGPRs, availFPRs, loc::layout)
265                  end                  end
# Line 220  Line 277 
277                  end                  end
278            in {            in {
279              argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),              argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),
280              resLoc = resReg,              resLoc = resLoc,
281              structRet = ?              structRetLoc = structRet
282            } end            } end
283    
284      datatype c_arg      datatype c_arg
# Line 232  Line 289 
289      val memRg = T.Region.memory      val memRg = T.Region.memory
290      val stkRg = T.Region.memory      val stkRg = T.Region.memory
291    
292      (* SP-based address of parameter at given offset *)
293        fun paramAddr off =
294              T.ADD(wordTy, spReg, T.LI(off + IntInf.fromInt paramAreaOffset))
295    
296      fun genCall {      fun genCall {
297            name, proto, paramAlloc, structRet, saveRestoreDedicated,            name, proto, paramAlloc, structRet, saveRestoreDedicated,
298            callComment, args            callComment, args
299          } = let          } = let
300            val {conv, retTy, paramTys} = proto            val {conv, retTy, paramTys} = proto
301            val {argLocs, resLoc, structRet} = layout proto            val {argLocs, resLoc, structRetLoc} = layout proto
302          (* generate code to assign the arguments to their locations *)          (* generate code to assign the arguments to their locations *)
303            fun assignArgs ([], [], stms) = stms            fun assignArgs ([], [], stms) = stms
304              | assignArgs (Reg(ty, r, _) :: locs, ARG exp :: args, stms) =              | assignArgs (Reg(ty, r, _) :: locs, ARG exp :: args, stms) =
305                  assignArgs (locs, args, T.MV(ty, r, exp) :: stms)                  assignArgs (locs, args, T.MV(ty, r, exp) :: stms)
306              | assignArgs (Stk(ty, off) :: locs, ARG exp :: args, stms) =              | assignArgs (Stk(ty, off) :: locs, ARG exp :: args, stms) =
307                  assignArgs (locs, args, T.STORE(ty, ?, exp, stkRg) :: stms)                  assignArgs (locs, args, T.STORE(ty, paramAddr off, exp, stkRg) :: stms)
308              | assignArgs (FReg(ty, r, _) :: locs, FARG fexp :: args) =              | assignArgs (FReg(ty, r, _) :: locs, FARG fexp :: args, stms) =
309                  assignArgs (locs, args, T.FMV(ty, r, fexp) :: stms)                  assignArgs (locs, args, T.FMV(ty, r, fexp) :: stms)
310              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =              | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =
311                  assignArgs (locs, args, T.FSTORE(ty, ?, fexp, stkRg) :: stms)                  assignArgs (locs, args, T.FSTORE(ty, paramAddr off, fexp, stkRg) :: stms)
312              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =              | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =
313                  assignArgs (locs, args, assignArgs(locs', args', stms))                  assignArgs (locs, args, assignArgs(locs', args', stms))
314              | assignArgs _ = error "argument/formal mismatch"              | assignArgs _ = error "argument/formal mismatch"
315            val argsetupCode = List.rev(assignArgs(args, args, []))            val argSetupCode = List.rev(assignArgs(argLocs, args, []))
316          (* convert the result location to an MLRISC expression list *)          (* convert the result location to an MLRISC expression list *)
317            val result = (case resLoc            val result = (case resLoc
318                   of NONE => []                   of NONE => []
319                    | SOME(Reg(ty, r, _)) => [T.REG(ty, r)]                    | SOME(Reg(ty, r, _)) => [T.GPR(T.REG(ty, r))]
320                    | SOME(FReg(ty, r, _)) => [T.FREG(ty, r)]                    | SOME(FReg(ty, r, _)) => [T.FPR(T.FREG(ty, r))]
321                    | SOME _ => raise Fail "bogus result location"                    | SOME _ => raise Fail "bogus result location"
322                  (* end case *))                  (* end case *))
323            (* make struct return-area setup (if necessary) *)
324              val setupStructRet = (case structRetLoc
325                     of NONE => []
326                      | SOME loc => let
327                          val structAddr = structRet loc
328                          in
329                            [T.MV(wordTy, resGPR, structAddr)]
330                          end
331                    (* end case *))
332          (* determine the registers used and defined by this call *)          (* determine the registers used and defined by this call *)
333            val (uses, defs) = let            val (uses, defs) = let
334                  val locs = (case resLoc                  val locs = (case resLoc
# Line 273  Line 343 
343                    | addArgReg ((Args locs')::locs, argRegs) =                    | addArgReg ((Args locs')::locs, argRegs) =
344                        addArgReg (locs, addArgReg(locs', argRegs))                        addArgReg (locs, addArgReg(locs', argRegs))
345                    | addArgReg (_::locs, argRegs) = addArgReg(locs, argRegs)                    | addArgReg (_::locs, argRegs) = addArgReg(locs, argRegs)
346                      | addArgReg ([], argRegs) = rev argRegs
347                  val argRegs = addArgReg (locs, [])                  val argRegs = addArgReg (locs, [])
348                  in                  in
349                    (argRegs, callerSaveRegs)                    (argRegs, linkReg :: callerSaveRegs)
350                  end                  end
351          (* the actual call instruction *)          (* the actual call instruction *)
352            val callStm = T.CALL {            val callStm = T.CALL {
# Line 288  Line 359 
359                   of NONE => callStm                   of NONE => callStm
360                    | SOME c => T.ANNOTATION(callStm, #create MLRiscAnnotations.COMMENT c)                    | SOME c => T.ANNOTATION(callStm, #create MLRiscAnnotations.COMMENT c)
361                  (* end case *))                  (* end case *))
362            (* take care of dedicated client registers *)
363              val {save, restore} = saveRestoreDedicated defs
364            val callseq = List.concat [            val callseq = List.concat [
365                    ??,                    setupStructRet,
366                    argSetupCode,                    argSetupCode,
367                      save,
368                    [callStm],                    [callStm],
369                    ??                    restore
370                  ]                  ]
371            in            in
372            (* check calling convention *)            (* check calling convention *)

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

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