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 247, Sat Apr 17 18:47:13 1999 UTC sml/trunk/src/compiler/CodeGen/alpha32/alpha32CG.sml revision 823, Tue May 8 21:25:15 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 : EMITTER_NEW  structure Alpha32CG =
5                      where I = Alpha32Instr    MachineGen
6                      where P = Alpha32PseudoOps) : MACHINE_GEN =    ( structure I          = Alpha32Instr
 struct  
   
   structure I = Alpha32Instr  
   structure C = Alpha32Cells  
   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
14    
15    structure Alpha32Rewrite = Alpha32Rewrite(Alpha32Instr)      structure CCalls     = DummyCCallsFn (Alpha32MLTree)
16        structure OmitFramePtr = struct
17          exception NotImplemented
18          structure F=Alpha32FlowGraph
19          structure I=Alpha32Instr
20          val vfp = CpsRegs.vfp
21          fun omitframeptr _ = raise NotImplemented
22        end
23    
   (* properties of instruction set *)  
   structure P =  
     Alpha32Props(structure Alpha32Instr= I  
                  structure Shuffle=Alpha32Shuffle)  
24    
25        structure MLTreeComp=
26           Alpha(structure AlphaInstr = Alpha32Instr
27                 structure AlphaMLTree = Alpha32MLTree
28                 structure PseudoInstrs = Alpha32PseudoInstrs
29                 structure ExtensionComp = SMLNJMLTreeExtComp
30                   (structure I = Alpha32Instr
31                    structure T = Alpha32MLTree
32                   )
33                 val mode32bit = true (* simulate 32 bit mode *)
34                 val multCost = ref 8 (* just guessing *)
35                 val useMultByConst = ref false (* just guessing *)
36                 val byteWordLoadStores = ref false
37                 val SMLNJfloatingPoint = true (* must be true for SML/NJ *)
38                )
39    
   (* Label backpatching and basic block scheduling *)  
   structure BBSched =  
     BBSched2(structure Flowgraph = F  
40               structure Jumps =               structure Jumps =
41                 Alpha32Jumps(structure Instr=Alpha32Instr         AlphaJumps(structure Instr=Alpha32Instr
42                              structure Shuffle=Alpha32Shuffle)                              structure Shuffle=Alpha32Shuffle)
              structure Emitter = Emitter)  
   
   (* flow graph pretty printing routine *)  
   structure PrintFlowGraph =  
      PrintFlowGraphFn (structure FlowGraph = F  
                        structure Emitter   = Asm)  
   
   val intSpillCnt = Ctrl.getInt "ra-int-spills"  
   val floatSpillCnt = Ctrl.getInt "ra-float-spills"  
   val intReloadCnt = Ctrl.getInt "ra-int-reloads"  
   val floatReloadCnt = Ctrl.getInt "ra-float-reloads"  
   
   (* register allocation *)  
   structure RegAllocation :  
     sig  
       val ra : F.cluster -> F.cluster  
       val cp : F.cluster -> F.cluster  
     end =  
   struct  
   
    (* spill area management *)  
     val initialSpillOffset = 128  
     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  
   
     (* get spill location for floating registers *)  
     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  
   
     fun mvInstr(rd, rs) = I.OPERATE{oper=I.BIS, ra=rs, rb=I.REGop 31, rc=rd}  
     fun fmvInstr(fd, fs) = I.FOPERATE{oper=I.CPYS, fa=fs, fb=fs, fc=fd}  
43    
44        structure BackPatch =
45           BBSched2(structure Flowgraph = Alpha32FlowGraph
46                    structure Jumps = Jumps
47                    structure Emitter = Alpha32MCEmitter)
48    
49        structure RA =
50           RISC_RA
51             (structure I         = Alpha32Instr
52              structure Flowgraph = Alpha32FlowGraph
53              structure InsnProps = InsnProps
54              structure Rewrite   = AlphaRewrite(Alpha32Instr)
55              structure Asm       = Alpha32AsmEmitter
56              structure SpillHeur = ChaitinSpillHeur
57              structure Spill     = RASpill(structure InsnProps = InsnProps
58                                            structure Asm = Alpha32AsmEmitter)
59    
60      fun spill (stClass, stOp, getLoc, newReg, rewrite, cnts)            val sp    = I.C.stackptrR
61                {regmap,instr,reg,id:B.name} = let            val spill = CPSRegions.spill
       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)            structure SpillTable = SpillTable(Alpha32Spec)
                {regmap,instr,reg,id:B.name} = let  
       val offset = I.IMMop (getLoc(reg))  
       fun reloadInstr(dst, rest) =  
         ldClass{ldOp=ldOp, r=dst, b=C.stackptrR, d=offset, mem=stack}::rest  
     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  
64    
65      fun spillInit () =            val architecture = Alpha32Spec.architecture
       (spillOffset := initialSpillOffset;  
        regSpills := Intmap.new(8, RegSpills);  
        fregSpills := Intmap.new(8, FregSpills))  
66    
67      structure GR = GetReg(val nRegs=32 val available=R.availR)            val beginRA = SpillTable.spillInit
     structure FR = GetReg(val nRegs=32 val available=R.availF)  
68    
69      structure Alpha32Ra =            fun pure _ = false
        Alpha32RegAlloc(structure P = P  
                        structure I = Alpha32Instr  
                        structure F = F  
                        structure Asm = Asm)  
70    
71      (* register allocation for general purpose registers *)            (* make copies *)
72      structure IntRa =            structure Int =
73        Alpha32Ra.IntRa            struct
74          (structure RaUser = struct                val avail     = Alpha32CpsRegs.availR
75             structure I = Alpha32Instr                val dedicated = Alpha32CpsRegs.dedicatedR
            structure B = B  
76    
77             val getreg = GR.getreg                fun copy((rds as [_], rss as [_]), _) =
78             val spill = spill(I.STORE, I.STL, getRegLoc, C.newReg,                    I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE}
79                               Alpha32Rewrite.rewriteDef, intSpillCnt)                  | copy((rds, rss), I.COPY{tmp, ...}) =
            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, ...}) =  
80               I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}               I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
          end)  
81    
82      (* register allocation for floating point registers *)                (* spill copy temp *)
83      structure FloatRa =                fun spillCopyTmp(an, I.COPY{tmp,dst,src,impl},loc) =
84        Alpha32Ra.FloatRa                    I.COPY{tmp=SOME(I.Displace{base=sp,
85          (structure RaUser = struct                                               disp=SpillTable.getRegLoc loc}),
86             structure I = Alpha32Instr                           dst=dst,src=src,impl=impl}
87             structure B = B  
88                  (* spill register *)
89             val getreg = FR.getreg                fun spillInstr{src,spilledCell,spillLoc,an} =
90             val spill = spill (I.FSTORE, I.STT, getFregLoc, C.newFreg,                    [I.STORE{stOp=I.STL, b=sp,
91                                Alpha32Rewrite.frewriteDef, floatSpillCnt)                             d=I.IMMop(SpillTable.getRegLoc spillLoc),
92             val reload = reload (I.FLOAD, I.LDT, getFregLoc, C.newFreg,                             r=src, mem=spill}]
93                                  Alpha32Rewrite.frewriteUse, floatReloadCnt)  
94             val nFreeRegs = length R.availF                (* reload register *)
95             val dedicated = R.dedicatedF                fun reloadInstr{dst,spilledCell,spillLoc,an} =
96             fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =                    [I.LOAD{ldOp=I.LDL, b=sp,
97               I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}                            d=I.IMMop(SpillTable.getRegLoc spillLoc),
98           end)                            r=dst, mem=spill}]
99    
100      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  
101      end      end
     val cp = fCopyProp o iCopyProp  
   end (* RegAllocation *)  
102    
103    val optimizerHook : (F.cluster->F.cluster) option ref = ref NONE            structure Float =
104              struct
105                  val avail     = Alpha32CpsRegs.availF
106                  val dedicated = Alpha32CpsRegs.dedicatedF
107    
108   (* primitives for generation of DEC alpha instruction flowgraphs *)                fun copy((fds as [_], fss as [_]), _) =
109    structure FlowGraphGen =                    I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE}
110       FlowGraphGen(structure Flowgraph = F                  | copy((fds, fss), I.FCOPY{tmp, ...}) =
111                    structure InsnProps = P                    I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
                   structure MLTree = MLTree  
                   val optimize = optimizerHook  
                   val output = BBSched.bbsched o RegAllocation.ra)  
   
   (* compilation of CPS to MLRISC *)  
   structure MLTreeGen =  
      MLRiscGen(structure MachineSpec=Alpha32Spec  
                structure MLTreeComp=  
                   Alpha32(structure Flowgen=FlowGraphGen  
                           structure Alpha32Instr=Alpha32Instr  
                           structure Alpha32MLTree=Alpha32MLTree  
                           structure PseudoInstrs=Alpha32PseudoInstrs)  
                structure Cells=Alpha32Cells  
                structure C=Alpha32CpsRegs  
                structure PseudoOp=Alpha32PseudoOps)  
   
   val copyProp = RegAllocation.cp  
   val codegen = MLTreeGen.codegen  
   val finish = BBSched.finish  
 end  
112    
113                  fun spillCopyTmp(an, I.FCOPY{tmp,dst,src,impl},loc) =
114                      I.FCOPY{tmp=SOME(I.Displace{base=sp,
115                                              disp=SpillTable.getFregLoc loc}),
116                              dst=dst,src=src,impl=impl}
117    
118                  fun spillInstr(_, r,loc) =
119                      [I.FSTORE{stOp=I.STT, b=sp,
120                                d=I.IMMop(SpillTable.getFregLoc loc),
121                                r=r, mem=spill}]
122    
123                  fun reloadInstr(_, r,loc) =
124                      [I.FLOAD{ldOp=I.LDT, b=sp,
125                               d=I.IMMop(SpillTable.getFregLoc loc),
126                               r=r, mem=spill}]
127    
128  (*                val mode = RACore.NO_OPTIMIZATION
129   * $Log: alpha32CG.sml,v $            end
130   * Revision 1.8  1999/03/22 21:06:15  george           )
131   *  new GC API (take II)    )
  *  
  * Revision 1.7  1999/03/22 17:22:11  george  
  *   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.247  
changed lines
  Added in v.823

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