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/compiler/CodeGen/alpha32/alpha32CG.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/CodeGen/alpha32/alpha32CG.sml

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

sml/branches/SMLNJ/src/compiler/CodeGen/alpha32/alpha32CG.sml revision 411, Fri Sep 3 00:25:03 1999 UTC sml/trunk/src/compiler/CodeGen/alpha32/alpha32CG.sml revision 796, Tue Mar 6 00:04:33 2001 UTC
# Line 1  Line 1 
1  (* alpha32CG.sml --- 32 bit DEC alpha code generator  (*
2   *   * Alpha32 specific backend
  * COPYRIGHT (c) 1996 Bell Laboratories.  
  *  
3   *)   *)
4  functor Alpha32CG(structure Emitter : INSTRUCTION_EMITTER  structure Alpha32CG =
5                      where I = Alpha32Instr    MachineGen
6                      where P = Alpha32PseudoOps    ( structure I          = Alpha32Instr
                     where S.B = Alpha32MLTree.BNames  
                   val alpha32x : bool (* the alpha32x backend or what? *)  
                  ) : MACHINE_GEN =  
 struct  
   
   structure I = Alpha32Instr  
   structure C = AlphaCells  
   structure R = Alpha32CpsRegs  
   structure B = Alpha32MLTree.BNames  
   structure F = Alpha32FlowGraph  
   structure Asm      = Alpha32AsmEmitter  
   structure MLTree   = Alpha32MLTree  
7    structure MachSpec = Alpha32Spec    structure MachSpec = Alpha32Spec
8    structure Ctrl = Control.MLRISC      structure PseudoOps  = Alpha32PseudoOps
9        structure Ext        = SMLNJMLTreeExt(* generic extension *)
10    fun error msg = ErrorMsg.impossible ("Alpha32CG." ^ msg)      structure CpsRegs    = Alpha32CpsRegs
11        structure InsnProps  = Alpha32Props
12    val stack = Alpha32Instr.Region.stack      structure Asm        = Alpha32AsmEmitter
13        structure Shuffle    = Alpha32Shuffle
   structure Alpha32Rewrite = AlphaRewrite(Alpha32Instr)  
14    
15    (* properties of instruction set *)      structure CCalls     = DummyCCallsFn (Alpha32MLTree)
   structure P = AlphaProps(Alpha32Instr)  
16    
17    structure FreqProps = FreqProps(P)      structure MLTreeComp=
18           Alpha(structure AlphaInstr = Alpha32Instr
19                 structure AlphaMLTree = Alpha32MLTree
20                 structure PseudoInstrs = Alpha32PseudoInstrs
21                 structure ExtensionComp = SMLNJMLTreeExtComp
22                   (structure I = Alpha32Instr
23                    structure T = Alpha32MLTree
24                   )
25                 val mode32bit = true (* simulate 32 bit mode *)
26                 val multCost = ref 8 (* just guessing *)
27                 val useMultByConst = ref false (* just guessing *)
28                 val byteWordLoadStores = ref false
29                 val SMLNJfloatingPoint = true (* must be true for SML/NJ *)
30                )
31    
   (* Label backpatching and basic block scheduling *)  
   structure BBSched =  
     BBSched2(structure Flowgraph = F  
32               structure Jumps =               structure Jumps =
33                 AlphaJumps(structure Instr=Alpha32Instr                 AlphaJumps(structure Instr=Alpha32Instr
34                            structure Shuffle=Alpha32Shuffle)                            structure Shuffle=Alpha32Shuffle)
              structure Emitter = Emitter)  
   
   (* flow graph pretty printing routine *)  
   (*  
   structure PrintFlowGraph =  
      PrintFlowGraphFn (structure FlowGraph = F  
                        structure Emitter   = Asm)  
    *)  
35    
36    val intSpillCnt = Ctrl.getInt "ra-int-spills"      structure BackPatch =
37    val floatSpillCnt = Ctrl.getInt "ra-float-spills"         BBSched2(structure Flowgraph = Alpha32FlowGraph
38    val intReloadCnt = Ctrl.getInt "ra-int-reloads"                  structure Jumps = Jumps
39    val floatReloadCnt = Ctrl.getInt "ra-float-reloads"                  structure Emitter = Alpha32MCEmitter)
40    
41    (* register allocation *)      structure RA =
42    structure RegAllocation :         RISC_RA
43      sig           (structure I         = Alpha32Instr
44        val ra : F.cluster -> F.cluster            structure Flowgraph = Alpha32FlowGraph
45        val cp : F.cluster -> F.cluster            structure InsnProps = InsnProps
46      end =            structure Rewrite   = AlphaRewrite(Alpha32Instr)
47    struct            structure Asm       = Alpha32AsmEmitter
48              structure SpillHeur = ChaitinSpillHeur
49              structure Spill     = RASpill(structure InsnProps = InsnProps
50                                            structure Asm = Alpha32AsmEmitter)
51    
52     (* spill area management *)            val sp    = I.C.stackptrR
53      val initialSpillOffset = 128            val spill = CPSRegions.spill
     val spillOffset = ref initialSpillOffset  
     fun newOffset n =  
         if n > 4096  
         then error "newOffset - spill area is too small"  
         else spillOffset := n  
     exception RegSpills and FregSpills  
   
     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))  
     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))  
   
     (* get spill location for general registers *)  
     fun getRegLoc reg = Intmap.map (!regSpills) reg  
       handle RegSpills => let  
           val offset = !spillOffset  
         in  
           newOffset(offset+4);  
           Intmap.add (!regSpills) (reg, offset);  
           offset  
         end  
54    
55      (* get spill location for floating registers *)            structure SpillTable = SpillTable(Alpha32Spec)
     fun getFregLoc freg = Intmap.map (!fregSpills) freg  
       handle FregSpills => let  
           val offset = !spillOffset  
           val fromInt = Word.fromInt  
           val aligned = Word.toIntX(Word.andb(fromInt offset+0w7, fromInt ~8))  
         in  
           newOffset(aligned+8);  
           Intmap.add (!fregSpills) (freg, aligned);  
           aligned  
         end  
56    
57      fun mvInstr(rd, rs) = I.OPERATE{oper=I.BIS, ra=rs, rb=I.REGop 31, rc=rd}            val architecture = Alpha32Spec.architecture
     fun fmvInstr(fd, fs) = I.FOPERATE{oper=I.CPYS, fa=fs, fb=fs, fc=fd}  
58    
59              val beginRA = SpillTable.spillInit
60    
61      fun spill (stClass, stOp, getLoc, newReg, rewrite, cnts)            fun pure _ = false
               {regmap,instr,reg,id:B.name} = let  
       val offset = I.IMMop (getLoc(reg))  
       fun spillInstr(src) =  
         [stClass{stOp=stOp, r=src, b=C.stackptrR, d=offset, mem=stack}]  
     in  
       cnts := !cnts + 1;  
       case instr  
       of I.COPY{dst as [rd], src as [rs], tmp, impl} =>  
           if rd=reg then  
             {code=spillInstr(rs),  instr=NONE,   proh=[]:int list}  
           else (case tmp  
              of SOME(I.Direct r) => let  
                   val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}  
                   val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}  
                 in {code=[], instr=SOME instr, proh=[]}  
                 end  
               | _ => error "spill: COPY"  
             (*esac*))  
        | I.FCOPY{dst as [fd], src as [fs], tmp, impl} =>         (* reg = fd *)  
           if reg=fd then  
             {code=spillInstr(fs),   instr=NONE,   proh=[]}  
           else (case tmp  
              of SOME(I.FDirect r) => let  
                   val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}  
                   val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}  
                 in {code=[], instr=SOME instr, proh=[]}  
                 end  
               | _ => error "spill: COPY"  
             (*esac*))  
        | _ => let  
             val newR = newReg()  
             val instr' = rewrite(regmap, instr, reg, newR)  
           in {code=spillInstr(newR),  instr=SOME instr',  proh=[newR]}  
           end  
     end  
62    
63      fun reload (ldClass, ldOp, getLoc, newReg, rewrite, cnts)            (* make copies *)
64                 {regmap,instr,reg,id:B.name} = let            structure Int =
65        val offset = I.IMMop (getLoc(reg))            struct
66        fun reloadInstr(dst, rest) =                val avail     = Alpha32CpsRegs.availR
67          ldClass{ldOp=ldOp, r=dst, b=C.stackptrR, d=offset, mem=stack}::rest                val dedicated = Alpha32CpsRegs.dedicatedR
     in  
       cnts := !cnts + 1;  
       case instr  
       of I.COPY{dst=[rd], src=[rs], ...} =>     (* reg = rs *)  
            {code=reloadInstr(rd, []),   proh=[]:int list}  
        | I.FCOPY{dst=[fd], src=[fs], ...} =>    (* reg = fs *)  
            {code=reloadInstr(fd, []), proh=[]}  
        | _ => let  
              val newR = newReg()  
              val instr' = rewrite(regmap, instr, reg, newR)  
            in {code=reloadInstr(newR, [instr']), proh=[newR]}  
            end  
     end  
68    
69      fun spillInit () =                fun copy((rds as [_], rss as [_]), _) =
70        (spillOffset := initialSpillOffset;                    I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE}
71         regSpills := Intmap.new(8, RegSpills);                  | copy((rds, rss), I.COPY{tmp, ...}) =
        fregSpills := Intmap.new(8, FregSpills))  
   
     structure GR = GetReg(val nRegs=32 val available=R.availR val first=0)  
     structure FR = GetReg(val nRegs=32 val available=R.availF val first=32)  
   
     structure Alpha32Ra =  
        AlphaRegAlloc(structure P = P  
                      structure I = Alpha32Instr  
                      structure F = F  
                      structure Asm = Asm)  
   
     (* register allocation for general purpose registers *)  
     structure IntRa =  
       Alpha32Ra.IntRa  
         (structure RaUser = struct  
            structure I = Alpha32Instr  
            structure B = B  
   
            val getreg = GR.getreg  
            val spill = spill(I.STORE, I.STL, getRegLoc, C.newReg,  
                              Alpha32Rewrite.rewriteDef, intSpillCnt)  
            val reload = reload(I.LOAD, I.LDL, getRegLoc, C.newReg,  
                                Alpha32Rewrite.rewriteUse, intReloadCnt)  
            val nFreeRegs = length R.availR  
            val dedicated = R.dedicatedR  
            fun copyInstr((rds, rss), I.COPY{tmp, ...}) =  
72               I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}               I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
          end)  
73    
74      (* register allocation for floating point registers *)                (* spill copy temp *)
75      structure FloatRa =                fun spillCopyTmp(an, I.COPY{tmp,dst,src,impl},loc) =
76        Alpha32Ra.FloatRa                    I.COPY{tmp=SOME(I.Displace{base=sp,
77          (structure RaUser = struct                                               disp=SpillTable.getRegLoc loc}),
78             structure I = Alpha32Instr                           dst=dst,src=src,impl=impl}
79             structure B = B  
80                  (* spill register *)
81             val getreg = FR.getreg                fun spillInstr{src,spilledCell,spillLoc,an} =
82             val spill = spill (I.FSTORE, I.STT, getFregLoc, C.newFreg,                    [I.STORE{stOp=I.STL, b=sp,
83                                Alpha32Rewrite.frewriteDef, floatSpillCnt)                             d=I.IMMop(SpillTable.getRegLoc spillLoc),
84             val reload = reload (I.FLOAD, I.LDT, getFregLoc, C.newFreg,                             r=src, mem=spill}]
85                                  Alpha32Rewrite.frewriteUse, floatReloadCnt)  
86             val nFreeRegs = length R.availF                (* reload register *)
87             val dedicated = R.dedicatedF                fun reloadInstr{dst,spilledCell,spillLoc,an} =
88             fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =                    [I.LOAD{ldOp=I.LDL, b=sp,
89               I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}                            d=I.IMMop(SpillTable.getRegLoc spillLoc),
90           end)                            r=dst, mem=spill}]
91    
92      val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION []                val mode = RACore.NO_OPTIMIZATION
     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION []  
     val iCopyProp = IntRa.ra IntRa.COPY_PROPAGATION []  
     val fCopyProp = FloatRa.ra FloatRa.COPY_PROPAGATION []  
   
     fun ra cluster = let  
       (* val pg = PrintFlowGraph.printCluster TextIO.stdOut *)  
       fun intRa cluster = (GR.reset(); iRegAlloc cluster)  
       fun floatRa cluster = (FR.reset(); fRegAlloc cluster)  
     in spillInit(); (floatRa o intRa) cluster  
93      end      end
     val cp = fCopyProp o iCopyProp  
   end (* RegAllocation *)  
94    
95    val optimizerHook : (F.cluster->F.cluster) option ref = ref NONE            structure Float =
96              struct
97                  val avail     = Alpha32CpsRegs.availF
98                  val dedicated = Alpha32CpsRegs.dedicatedF
99    
100   (* primitives for generation of DEC alpha instruction flowgraphs *)                fun copy((fds as [_], fss as [_]), _) =
101    structure FlowGraphGen =                    I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE}
102       ClusterGen(structure Flowgraph = F                  | copy((fds, fss), I.FCOPY{tmp, ...}) =
103                  structure InsnProps = P                    I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
                 structure MLTree = MLTree  
                 structure Stream = Emitter.S  
                 val optimize = optimizerHook  
                 val output = BBSched.bbsched o RegAllocation.ra)  
   
   (* compilation of CPS to MLRISC *)  
   structure MLTreeGen =  
      MLRiscGen(structure MachineSpec=Alpha32Spec  
                structure MLTreeComp=  
                   Alpha(structure AlphaInstr=Alpha32Instr  
                         structure AlphaMLTree=Alpha32MLTree  
                         structure Stream = Emitter.S  
                         structure PseudoInstrs=Alpha32PseudoInstrs  
                         val mode32bit = true (* simulate 32 bit mode *)  
                         val useSU = alpha32x  
                         val multCost = ref 8 (* just guessing *)  
                         val useMultByConst = ref false (* just guessing *)  
                        )  
                structure Flowgen=FlowGraphGen  
                structure Cells=AlphaCells  
                structure C=Alpha32CpsRegs  
                structure PseudoOp=Alpha32PseudoOps)  
   
   val copyProp = RegAllocation.cp  
   val codegen = MLTreeGen.codegen  
   val finish = BBSched.finish  
 end  
104    
105                  fun spillCopyTmp(an, I.FCOPY{tmp,dst,src,impl},loc) =
106                      I.FCOPY{tmp=SOME(I.Displace{base=sp,
107                                              disp=SpillTable.getFregLoc loc}),
108                              dst=dst,src=src,impl=impl}
109    
110                  fun spillInstr(_, r,loc) =
111                      [I.FSTORE{stOp=I.STT, b=sp,
112                                d=I.IMMop(SpillTable.getFregLoc loc),
113                                r=r, mem=spill}]
114    
115                  fun reloadInstr(_, r,loc) =
116                      [I.FLOAD{ldOp=I.LDT, b=sp,
117                               d=I.IMMop(SpillTable.getFregLoc loc),
118                               r=r, mem=spill}]
119    
120  (*                val mode = RACore.NO_OPTIMIZATION
121   * $Log: alpha32CG.sml,v $            end
122   * Revision 1.7  1999/03/22 17:22:11  george           )
123   *   Changes to support new GC API    )
  *  
  * Revision 1.6  1999/01/18 15:49:20  george  
  *   support of interactive loading of MLRISC optimizer  
  *  
  * Revision 1.5  1998/10/06 13:59:56  george  
  * Flowgraph has been removed from modules that do not need it -- [leunga]  
  *  
  * Revision 1.4  1998/07/25 03:05:32  george  
  *   changes to support block names in MLRISC  
  *  
  * Revision 1.3  1998/05/23 14:09:10  george  
  *   Fixed RCS keyword syntax  
  *  
  *)  

Legend:
Removed from v.411  
changed lines
  Added in v.796

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