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 3041, Wed May 28 18:39:35 2008 UTC revision 3042, Wed May 28 23:40:21 2008 UTC
# Line 14  Line 14 
14      structure C = AMD64Cells      structure C = AMD64Cells
15      structure CB = CellsBasis      structure CB = CellsBasis
16      structure CTy = CTypes      structure CTy = CTypes
17      structure SVID = SVIDFn(structure T = T)      structure SVID = AMD64SVIDFn(structure T = T)
18      structure CCall = SVID.CCall      structure CCall = SVID.CCall
19      structure SA = SVID.SA      structure SA = SVID.SA
20    
21      datatype argument = I of int | R of real | B of bool | S of string      datatype argument = I of int | R of real | B of bool | S of string
22    
23      val wordTy = 64      val wordTy = 64
24        val wordSzB = 8
25      val mem = T.Region.memory      val mem = T.Region.memory
26      val stack = T.Region.stack      val stack = T.Region.stack
27    
28      fun lit i = T.LI (T.I.fromInt (wordTy, i))      fun lit i = T.LI (T.I.fromInt (wordTy, i))
29        fun gpr r = T.GPR (T.REG (wordTy, r))
30        fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
31    
32      val GPR = 0      val GPR = 0
33      val FPR = 1      val FPR = 1
34      val STK = 2      val STK = 2
35    
36        val intTy = wordTy
37    
38      (* offsets into the triplet *)
39        val argOff = 0
40        val kindOff = 1
41        val locOff = 2
42    
43        fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
44        fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
45    
46        val regToInt = CB.physicalRegisterNum
47        fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))
48        val labelOfStk = Label.global "stk"
49        val interpLab = Label.global "interp"
50        fun chooseRegsLab k = Label.global ("chooseRegs"^k)
51        val chooseStkLab = Label.global "chooseStk"
52        val chooseKindsLab = Label.global "chooseKinds"
53    
54      (* store the argument at the stack offset *)
55        fun genStoreStk arg = [
56               T.DEFINE chooseStkLab,
57               T.STORE(wordTy, T.ADD (wordTy, SVID.CCs.spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),
58               T.JMP (T.LABEL interpLab, [])
59            ]
60    
61      (* place the argument into the parameter register and jump back to the interpreter *)
62        fun genPutGpr arg r = [
63               T.DEFINE (labelOfReg ("gpr", r)),
64               T.MV (intTy, r, offTrip (arg, argOff)),
65               T.JMP (T.LABEL interpLab, [])
66            ]
67    
68      (* place the argument into the parameter register and jump back to the interpreter *)
69        fun genPutFpr arg r = [
70               T.DEFINE (labelOfReg ("fpr", r)),
71               T.FMV (64, r, offTripF (arg, argOff)),
72               T.JMP (T.LABEL interpLab, [])
73            ]
74    
75      (* choose the function for loading the register *)
76        fun genChooseReg arg k (r, instrs) = let
77               val cmp = T.CMP(wordTy, T.EQ, offTrip(arg, locOff), lit (regToInt r))
78               in
79                  T.BCC(cmp, labelOfReg (k, r)) :: instrs
80               end
81    
82      (* choose registers for loading function arguments *)
83        fun genChooseRegs arg k regs = let
84               val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)
85               in
86                  T.DEFINE (chooseRegsLab k) :: instrs
87               end
88    
89      (* choose the kind of argument *)
90        fun genChooseKinds arg = [
91               T.DEFINE chooseKindsLab,
92               T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),
93               T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),
94               T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab)
95            ]
96    
97        val NIL = 0
98    
99        fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)
100          | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*8)), mem)
101    
102        val gotoCLab = Label.label "gotoC" ()
103    
104      (* call the varargs C function *)
105        fun genCallC cFun = let
106               val defs = List.map (gpr o #2) SVID.CCs.callerSaveRegs @ List.map fpr SVID.CCs.callerSaveFRegs
107               val uses = List.map (gpr o #2) SVID.CCs.gprParams @ List.map ((fn r => fpr(64, r)) o #2) SVID.CCs.fprParams
108               in
109                  [
110                   T.DEFINE gotoCLab,
111                   T.CALL {funct=cFun, targets=[], defs=defs, uses=uses, region=mem, pops=0}
112                  ]
113               end
114    
115      (* interpreter for varargs *)
116        fun genInterp (args, argReg) = [
117               T.DEFINE interpLab,
118             (* loop through the args *)
119               T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),
120               T.MV (wordTy, argReg, offArgs args 0),
121               T.MV(wordTy, args, offArgs args 1),
122               T.JMP (T.LABEL chooseKindsLab, [])
123            ]
124    
125      (* generate instructions for making a varargs call *)
126        fun genVarArgs (cFun, args, initInstrs) = let
127               val argReg = C.newReg ()
128               val interpInstrs = genInterp(args, argReg)
129               val arg = T.REG(wordTy, argReg)
130               val ckInstrs = genChooseKinds arg
131               val chooseGprs = genChooseRegs arg "gpr" (List.map #2 SVID.CCs.gprParams)
132               val chooseFprs = genChooseRegs arg "fpr" (List.map #2 SVID.CCs.fprParams)
133               val loadGprs = List.concat (List.map (genPutGpr arg) (List.map #2 SVID.CCs.gprParams))
134               val loadFprs = List.concat (List.map (genPutFpr arg) (List.map #2 SVID.CCs.fprParams))
135               val storeStk = genStoreStk arg
136               in
137                  List.concat [
138                     initInstrs,
139                     interpInstrs,
140                     ckInstrs,
141                     chooseGprs,
142                     chooseFprs,
143                     loadGprs,
144                     loadFprs,
145                     storeStk,
146                     genCallC cFun
147                  ]
148               end
149    
150      fun argToCTy (I _) = CTy.C_signed CTy.I_int      fun argToCTy (I _) = CTy.C_signed CTy.I_int
151        | argToCTy (R _) = CTy.C_double        | argToCTy (R _) = CTy.C_double
152        | argToCTy (B _) = CTy.C_signed CTy.I_int        | argToCTy (B _) = CTy.C_signed CTy.I_int
# Line 43  Line 160 
160               (str', loc :: locs)               (str', loc :: locs)
161             end             end
162    
163      fun encodeLoc (_, SA.REG (_, r), SVID.K_GPR) = (GPR, CB.physicalRegisterNum r)      fun encodeLoc (_, SA.REG (_, r), SVID.K_GPR) = (GPR, regToInt r)
164        | encodeLoc (_, SA.REG (_, r), SVID.K_FPR) = (FPR, CB.physicalRegisterNum r)        | encodeLoc (_, SA.REG (_, r), SVID.K_FPR) = (FPR, regToInt r)
165        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_GPR) = (STK, offB)        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_GPR) = (STK, offB)
166        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_FPR) = (STK, offB)        | encodeLoc (_, SA.BLOCK_OFFSET offB, SVID.K_FPR) = (STK, offB)
167          | encodeLoc (_, SA.NARROW (loc, w', k), _) = encodeLoc (w', loc, k)
168    
169    (* takes a vararg and a location and returns the vararg triplet *)    (* takes a vararg and a location and returns the vararg triplet *)
170      fun varArgTriplet (arg, loc) = let      fun varArgTriplet (arg, loc) = let

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

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