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 /MLRISC/trunk/amd64/staged-allocation/amd64-vararg-ccall-fn.sml
ViewVC logotype

Diff of /MLRISC/trunk/amd64/staged-allocation/amd64-vararg-ccall-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3042, Wed May 28 23:40:21 2008 UTC revision 3049, Fri May 30 00:58:55 2008 UTC
# Line 15  Line 15 
15      structure CB = CellsBasis      structure CB = CellsBasis
16      structure CTy = CTypes      structure CTy = CTypes
17      structure SVID = AMD64SVIDFn(structure T = T)      structure SVID = AMD64SVIDFn(structure T = T)
18      structure CCall = SVID.CCall      structure VarargCCall = VarargCCallFn(
19                                  structure T = T
20                                  structure CCall = SVID
21                                  val gprParams = List.map #2 SVID.CCs.gprParams
22                                  val fprParams = List.map #2 SVID.CCs.fprParams
23                                  val spReg = SVID.spReg
24                                  val wordTy = 64
25                                  val newReg = C.newReg
26                                )
27      structure SA = SVID.SA      structure SA = SVID.SA
28    
     datatype argument = I of int | R of real | B of bool | S of string  
   
29      val wordTy = 64      val wordTy = 64
     val wordSzB = 8  
     val mem = T.Region.memory  
     val stack = T.Region.stack  
   
30      fun lit i = T.LI (T.I.fromInt (wordTy, i))      fun lit i = T.LI (T.I.fromInt (wordTy, i))
     fun gpr r = T.GPR (T.REG (wordTy, r))  
     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))  
   
     val GPR = 0  
     val FPR = 1  
     val STK = 2  
   
     val intTy = wordTy  
   
   (* offsets into the triplet *)  
     val argOff = 0  
     val kindOff = 1  
     val locOff = 2  
   
     fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)  
     fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)  
   
31      val regToInt = CB.physicalRegisterNum      val regToInt = CB.physicalRegisterNum
     fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))  
     val labelOfStk = Label.global "stk"  
     val interpLab = Label.global "interp"  
     fun chooseRegsLab k = Label.global ("chooseRegs"^k)  
     val chooseStkLab = Label.global "chooseStk"  
     val chooseKindsLab = Label.global "chooseKinds"  
   
   (* store the argument at the stack offset *)  
     fun genStoreStk arg = [  
            T.DEFINE chooseStkLab,  
            T.STORE(wordTy, T.ADD (wordTy, SVID.CCs.spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),  
            T.JMP (T.LABEL interpLab, [])  
         ]  
   
   (* place the argument into the parameter register and jump back to the interpreter *)  
     fun genPutGpr arg r = [  
            T.DEFINE (labelOfReg ("gpr", r)),  
            T.MV (intTy, r, offTrip (arg, argOff)),  
            T.JMP (T.LABEL interpLab, [])  
         ]  
   
   (* place the argument into the parameter register and jump back to the interpreter *)  
     fun genPutFpr arg r = [  
            T.DEFINE (labelOfReg ("fpr", r)),  
            T.FMV (64, r, offTripF (arg, argOff)),  
            T.JMP (T.LABEL interpLab, [])  
         ]  
   
   (* choose the function for loading the register *)  
     fun genChooseReg arg k (r, instrs) = let  
            val cmp = T.CMP(wordTy, T.EQ, offTrip(arg, locOff), lit (regToInt r))  
            in  
               T.BCC(cmp, labelOfReg (k, r)) :: instrs  
            end  
   
   (* choose registers for loading function arguments *)  
     fun genChooseRegs arg k regs = let  
            val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)  
            in  
               T.DEFINE (chooseRegsLab k) :: instrs  
            end  
   
   (* choose the kind of argument *)  
     fun genChooseKinds arg = [  
            T.DEFINE chooseKindsLab,  
            T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),  
            T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),  
            T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab)  
         ]  
   
     val NIL = 0  
   
     fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)  
       | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*8)), mem)  
   
     val gotoCLab = Label.label "gotoC" ()  
   
   (* call the varargs C function *)  
     fun genCallC cFun = let  
            val defs = List.map (gpr o #2) SVID.CCs.callerSaveRegs @ List.map fpr SVID.CCs.callerSaveFRegs  
            val uses = List.map (gpr o #2) SVID.CCs.gprParams @ List.map ((fn r => fpr(64, r)) o #2) SVID.CCs.fprParams  
            in  
               [  
                T.DEFINE gotoCLab,  
                T.CALL {funct=cFun, targets=[], defs=defs, uses=uses, region=mem, pops=0}  
               ]  
            end  
   
   (* interpreter for varargs *)  
     fun genInterp (args, argReg) = [  
            T.DEFINE interpLab,  
          (* loop through the args *)  
            T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),  
            T.MV (wordTy, argReg, offArgs args 0),  
            T.MV(wordTy, args, offArgs args 1),  
            T.JMP (T.LABEL chooseKindsLab, [])  
         ]  
   
   (* generate instructions for making a varargs call *)  
     fun genVarArgs (cFun, args, initInstrs) = let  
            val argReg = C.newReg ()  
            val interpInstrs = genInterp(args, argReg)  
            val arg = T.REG(wordTy, argReg)  
            val ckInstrs = genChooseKinds arg  
            val chooseGprs = genChooseRegs arg "gpr" (List.map #2 SVID.CCs.gprParams)  
            val chooseFprs = genChooseRegs arg "fpr" (List.map #2 SVID.CCs.fprParams)  
            val loadGprs = List.concat (List.map (genPutGpr arg) (List.map #2 SVID.CCs.gprParams))  
            val loadFprs = List.concat (List.map (genPutFpr arg) (List.map #2 SVID.CCs.fprParams))  
            val storeStk = genStoreStk arg  
            in  
               List.concat [  
                  initInstrs,  
                  interpInstrs,  
                  ckInstrs,  
                  chooseGprs,  
                  chooseFprs,  
                  loadGprs,  
                  loadFprs,  
                  storeStk,  
                  genCallC cFun  
               ]  
            end  
   
     fun argToCTy (I _) = CTy.C_signed CTy.I_int  
       | argToCTy (R _) = CTy.C_double  
       | argToCTy (B _) = CTy.C_signed CTy.I_int  
       | argToCTy (S _) = CTy.C_PTR  
32    
33    (* one step of staged allocation *)    (* one step of staged allocation *)
34      fun allocateArg step (arg, (str, locs)) = let      fun allocateArg step (arg, (str, locs)) = let
35             val slot = SVID.slotOfCTy(argToCTy arg)             val slot = SVID.slotOfCTy(VarargCCall.argToCTy arg)
36             val (str', [loc]) = SA.doStagedAllocation(str, step, [slot])             val (str', [loc]) = SA.doStagedAllocation(str, step, [slot])
37             in             in
38               (str', loc :: locs)               (str', loc :: locs)
39             end             end
40    
41      fun encodeLoc (_, SA.REG (_, r), SVID.K_GPR) = (GPR, regToInt r)      fun encodeLoc (_, SA.REG (_, r), SVID.K_GPR) = (VarargCCall.GPR, regToInt r)
42        | encodeLoc (_, SA.REG (_, r), SVID.K_FPR) = (FPR, regToInt r)        | encodeLoc (_, SA.REG (_, r), SVID.K_FPR) = (VarargCCall.FPR, regToInt r)
43        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_GPR) = (STK, offB)        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_GPR) = (VarargCCall.STK, offB)
44        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_FPR) = (STK, offB)        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_FPR) = (VarargCCall.STK, offB)
45        | encodeLoc (_, SA.NARROW (loc, w', k), _) = encodeLoc (w', loc, k)        | encodeLoc (_, SA.NARROW (loc, w', k), _) = encodeLoc (w', loc, k)
46    
47    (* takes a vararg and a location and returns the vararg triplet *)    (* takes a vararg and a location and returns the vararg triplet *)
# Line 187  Line 65 
65                raise Fail "jump to the interpreter"                raise Fail "jump to the interpreter"
66             end             end
67    
68        fun genVarargs (cFun, args) =
69                T.MV(wordTy, C.rax, lit (List.length SVID.CCs.fprParams)) :: VarargCCall.genVarargs(cFun, args)
70    
71    end (* AMD64VarargCCallFn *)    end (* AMD64VarargCCallFn *)

Legend:
Removed from v.3042  
changed lines
  Added in v.3049

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