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/x86/mltree/x86.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/x86/mltree/x86.sml

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

revision 247, Sat Apr 17 18:47:13 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 8  Line 8 
8     structure X86MLTree : MLTREE     structure X86MLTree : MLTREE
9       where Region = X86Instr.Region       where Region = X86Instr.Region
10         and Constant = X86Instr.Constant         and Constant = X86Instr.Constant
11     structure Flowgen : FLOWGRAPH_GEN         and type cond = MLTreeBasis.cond
12       where I = X86Instr  and T = X86MLTree and B = X86MLTree.BNames         and type fcond = MLTreeBasis.fcond
13       structure Stream : INSTRUCTION_STREAM
14         where B = X86MLTree.BNames
15           and P = X86MLTree.PseudoOp
16     val tempMem : X86Instr.operand) : MLTREECOMP =     val tempMem : X86Instr.operand) : MLTREECOMP =
17  struct  struct
   structure F = Flowgen  
18    structure T = X86MLTree    structure T = X86MLTree
19    structure I = X86Instr    structure I = X86Instr
20    structure C = X86Cells    structure C = X86Cells
21      structure S = Stream
22    
23    structure W32 = Word32    structure W32 = Word32
24    structure LE = LabelExp    structure LE = LabelExp
25    
26    fun error msg = MLRiscErrorMsg.impossible ("X86." ^ msg)    fun error msg = MLRiscErrorMsg.error("X86",msg)
27    
28    (* label where a trap is generated -- one per cluster *)    (* label where a trap is generated -- one per cluster *)
29    val trapLabel = ref (NONE: Label.label option)    val trapLabel = ref (NONE: Label.label option)
30    
31    val emitInstr = F.emitInstr    fun selectInstructions
32    val emit    = F.emitInstr         (S.STREAM{emit,defineLabel,entryLabel,blockName,pseudoOp,annotation,
33                     init,finish,exitBlock,...}) =
34      let
35    
36      val emit    = emit(fn _ => 0)
37    val newReg  = C.newReg    val newReg  = C.newReg
38    val newFreg = C.newFreg    val newFreg = C.newFreg
39    
40      (* annotations *)
41      fun mark'(i,[]) = i
42        | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
43    
44      fun mark(i,an) = emit(mark'(i,an))
45    
46    (* conversions *)    (* conversions *)
47    val itow = Word.fromInt    val itow = Word.fromInt
48    val wtoi = Word.toInt    val wtoi = Word.toInt
# Line 46  Line 59 
59    fun immed8 n = Int32.>=(n, ~256) andalso Int32.<(n,256)    fun immed8 n = Int32.>=(n, ~256) andalso Int32.<(n,256)
60    fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)    fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)
61    
62    fun move(src as I.Direct s, dst as I.Direct d) =    fun move(src as I.Direct s, dst as I.Direct d, an) =
63        if s=d then ()        if s=d then ()
64        else emit(I.COPY{dst=[d], src=[s], tmp=NONE})        else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)
65      | move(src, dst) =  emit(I.MOVE{mvOp=I.MOVL, src=src, dst=dst})      | move(src, dst, an) = mark(I.MOVE{mvOp=I.MOVL, src=src, dst=dst}, an)
66    
67    fun moveToReg opnd = let    fun moveToReg(opnd) =
68      val dst = I.Direct(newReg())    let val dst = I.Direct(newReg())
69    in move(opnd, dst); dst    in  move(opnd, dst, []); dst
70    end    end
71    
72    (* ensure that the operand is either an immed or register *)    (* ensure that the operand is either an immed or register *)
# Line 73  Line 86 
86    fun regOrMem opnd = if isImmediate opnd then moveToReg opnd else opnd    fun regOrMem opnd = if isImmediate opnd then moveToReg opnd else opnd
87    
88    
89  fun rexp(T.REG r) = ["r" ^ Int.toString r]  fun rexp(T.REG(_,r)) = ["r" ^ Int.toString r]
90    | rexp(T.LI i)  = ["LI"]    | rexp(T.LI i)  = ["LI"]
91    | rexp(T.LI32 i32) = ["LI32"]    | rexp(T.LI32 i32) = ["LI32"]
92    | rexp(T.LABEL  le) = ["LABEL"]    | rexp(T.LABEL  le) = ["LABEL"]
93    | rexp(T.CONST  c) = ["CONST"]    | rexp(T.CONST  c) = ["CONST"]
94    
95    | rexp(T.ADD  (e1, e2)) = ["ADD("] @ rexp e1 @ (","::rexp e2) @ [")"]    | rexp(T.ADD  (_, e1, e2)) = ["ADD("] @ rexp e1 @ (","::rexp e2) @ [")"]
96    | rexp(T.SUB  (e1, e2, _)) = ["SUB"]    | rexp(T.SUB  (_, e1, e2)) = ["SUB"]
97    | rexp(T.MULU (e1, e2)) = ["MULU"]    | rexp(T.MULU (_, e1, e2)) = ["MULU"]
98    | rexp(T.DIVU   (e1, e2, _)) =  ["DIVU"]    | rexp(T.DIVU (_, e1, e2)) =  ["DIVU"]
99    
100    | rexp(T.ADDT  (e1, e2)) =   ["ADDT"]    | rexp(T.ADDT (_, e1, e2)) =   ["ADDT"]
101    | rexp(T.MULT   (e1, e2)) =  ["MULT"]    | rexp(T.MULT (_, e1, e2)) =  ["MULT"]
102    | rexp(T.SUBT    (e1, e2, _)) = ["SUBT"]    | rexp(T.SUBT (_, e1, e2)) = ["SUBT"]
103    | rexp(T.DIVT    (e1, e2, _)) = ["DIVT"]    | rexp(T.DIVT (_, e1, e2)) = ["DIVT"]
104    
105    | rexp(T.LOAD8  (e, _)) = ["LOAD8("] @ rexp e @ [")"]    | rexp(T.LOAD (8, e, _)) = ["LOAD8("] @ rexp e @ [")"]
106    | rexp(T.LOAD32  (e, _)) = ["LOAD32"]    | rexp(T.LOAD (32, e, _)) = ["LOAD32"]
107    
108    | rexp(T.ANDB   (e1, e2)) =  ["AND"]    | rexp(T.ANDB (_, e1, e2)) =  ["AND"]
109    | rexp(T.ORB     (e1, e2)) = ["OR"]    | rexp(T.ORB  (_, e1, e2)) = ["OR"]
110    | rexp(T.XORB    (e1, e2)) = ["XOR"]    | rexp(T.XORB (_, e1, e2)) = ["XOR"]
111    
112    | rexp(T.SRA    (e1, e2, _)) = ["SRA("] @ rexp e1 @ (","::rexp e2) @ [")"]    | rexp(T.SRA  (_, e1, e2)) = ["SRA("] @ rexp e1 @ (","::rexp e2) @ [")"]
113    | rexp(T.SRL    (e1, e2, _)) = ["SRL"]    | rexp(T.SRL  (_, e1, e2)) = ["SRL"]
114    | rexp(T.SLL    (e1, e2, _)) = ["SLL"]    | rexp(T.SLL  (_, e1, e2)) = ["SLL"]
115    
116    | rexp(T.SEQ(s, e)) = ["SEQ("] @ stm s @ ("," :: rexp e) @ [")"]    | rexp(T.SEQ(s, e)) = ["SEQ("] @ stm s @ ("," :: rexp e) @ [")"]
117    
118  and stm s =  and stm s =
119   (case s   (case s
120    of T.MV(r, e) => ["MV(", Int.toString r] @ (",":: rexp e) @ [")"]    of T.MV(_, r, e) => ["MV(", Int.toString r] @ (",":: rexp e) @ [")"]
121     | T.FMV _ => ["FMV"]     | T.FMV _ => ["FMV"]
122     | T.COPY _  => ["COPY"]     | T.COPY _  => ["COPY"]
123     | T.FCOPY _ => ["FCOPY"]     | T.FCOPY _ => ["FCOPY"]
124     | T.JMP _ => ["JMP"]     | T.JMP _ => ["JMP"]
125     | T.CALL _ => ["CALL"]     | T.CALL _ => ["CALL"]
126     | T.RET  => ["RET"]     | T.RET  => ["RET"]
127     | T.STORE8 _ => ["STORE8"]     | T.STORE _ => ["STORE"]
128     | T.STORE32 _ => ["STORE32"]     | T.FSTORE _ => ["FSTORE"]
    | T.STORED _ => ["STORED"]  
    | T.STORECC _ => ["STORECC"]  
129     | T.BCC    _ => ["BCC"]     | T.BCC    _ => ["BCC"]
130     | T.FBCC   _ => ["FBCC"]     | T.FBCC   _ => ["FBCC"]
131    (*esac*))    (*esac*))
# Line 126  Line 137 
137    exception EA    exception EA
138    
139    (* return an index computation *)    (* return an index computation *)
140    fun index(arg as (T.SLL(t, T.LI n, _))) =    fun index(arg as (T.SLL(_, t, T.LI n))) =
141        if n > 0 andalso n <= 3 then {index=reduceReg t, scale=n}        if n > 0 andalso n <= 3 then {index=reduceReg t, scale=n}
142        else {index=reduceReg arg, scale=0}        else {index=reduceReg arg, scale=0}
143      | index t = {index=reduceReg t, scale=0}      | index t = {index=reduceReg t, scale=0}
144    
145    (* return effective address *)    (* return effective address *)
146    and ea eatree = let    and ea(eatree,mem) =
147      let
148      (* Need to ensure that the scale register is never %esp *)      (* Need to ensure that the scale register is never %esp *)
149      fun doImmed(n, I.Immed(k)) = (I.Immed(k+toInt32 n) handle Overflow => raise EA)      fun doImmed(n, I.Immed(k)) = (I.Immed(k+toInt32 n)
150                                         handle Overflow => raise EA)
151        | doImmed(n, I.ImmedLabel le) = I.ImmedLabel(LE.PLUS(le, LE.CONST n))        | doImmed(n, I.ImmedLabel le) = I.ImmedLabel(LE.PLUS(le, LE.CONST n))
152        | doImmed(n, I.Const c) =        | doImmed(n, I.Const c) =
153            I.Displace{base=reduceReg(T.CONST c), disp=I.Immed(toInt32 n)}            I.Displace{base=reduceReg(T.CONST c),disp=I.Immed(toInt32 n),mem=mem}
154    
155      fun doConst(c, I.Immed(0)) = I.Const c      fun doConst(c, I.Immed(0)) = I.Const c
156        | doConst(c, d) = I.Displace{base=reduceReg(T.CONST c), disp=d}        | doConst(c, d) = I.Displace{base=reduceReg(T.CONST c), disp=d, mem=mem}
157    
158      fun doLabel(le, I.Immed(0)) = I.ImmedLabel le      fun doLabel(le, I.Immed(0)) = I.ImmedLabel le
159        | doLabel(le, I.Immed(n)) = I.ImmedLabel(LE.PLUS(le, LE.CONST(Int32.toInt n)))        | doLabel(le, I.Immed(n)) = I.ImmedLabel(LE.PLUS(le, LE.CONST(Int32.toInt n)))
160        | doLabel(le, I.Const c) =        | doLabel(le, I.Const c) =
161            I.Displace{base=reduceReg(T.CONST c), disp=I.ImmedLabel le}            I.Displace{base=reduceReg(T.CONST c), disp=I.ImmedLabel le,
162                         mem=mem}
163    
164      fun newDisp(n, combine, I.Displace{base, disp}) =      fun newDisp(n, combine, I.Displace{base, disp, mem}) =
165            I.Displace{base=base, disp=combine(n, disp)}            I.Displace{base=base, disp=combine(n, disp), mem=mem}
166        | newDisp(n, combine, I.Indexed{base, index, scale, disp}) =        | newDisp(n, combine, I.Indexed{base, index, scale, disp, mem}) =
167            I.Indexed{base=base, index=index, scale=scale, disp=combine(n, disp)}            I.Indexed{base=base, index=index, scale=scale,
168                        disp=combine(n, disp), mem=mem}
169        | newDisp(n, combine, disp) = combine(n, disp)        | newDisp(n, combine, disp) = combine(n, disp)
170    
171      fun combineBase(tree, base) =      fun combineBase(tree, base) =
172        SOME(case base        SOME(case base
173             of NONE => reduceReg tree             of NONE => reduceReg tree
174              | SOME base => reduceReg(T.ADD(T.REG base, tree))              | SOME base => reduceReg(T.ADD(32, T.REG(32,base), tree))
175             (*esac*))             (*esac*))
176    
177      (* keep building a bigger and bigger effective address expressions *)      (* keep building a bigger and bigger effective address expressions *)
178      fun doEA(T.LI n, mode) = newDisp(n, doImmed, mode)      fun doEA(T.LI n, mode) = newDisp(n, doImmed, mode)
179        | doEA(T.LABEL le, mode) = newDisp(le, doLabel, mode)        | doEA(T.LABEL le, mode) = newDisp(le, doLabel, mode)
180        | doEA(T.CONST c, mode) = newDisp(c, doConst, mode)        | doEA(T.CONST c, mode) = newDisp(c, doConst, mode)
181        | doEA(t0 as T.SLL(t, T.LI scale, _), mode) =        | doEA(t0 as T.SLL(_, t, T.LI scale), mode) =
182          if scale >= 1 andalso scale <= 3 then          if scale >= 1 andalso scale <= 3 then
183           (case mode           (case mode
184            of I.Displace{base, disp} =>            of I.Displace{base, disp, mem} =>
185                I.Indexed                I.Indexed
186                  {base=SOME base, index=reduceReg t, scale=scale, disp=disp}                  {base=SOME base, index=reduceReg t, scale=scale,
187             | I.Indexed{base, index, scale, disp} =>                   disp=disp, mem=mem}
188               | I.Indexed{base, index, scale, disp, mem} =>
189                I.Indexed{base=combineBase(t0,base),                I.Indexed{base=combineBase(t0,base),
190                          index=index, scale=scale, disp=disp}                          index=index, scale=scale, disp=disp, mem=mem}
191             | disp =>             | disp =>
192                I.Indexed{base=NONE, index=reduceReg t, scale=scale, disp=disp}                I.Indexed{base=NONE, index=reduceReg t, scale=scale,
193                            disp=disp, mem=mem}
194           (*esac*))           (*esac*))
195          else          else
196           (case mode           (case mode
197            of I.Displace{base, disp} =>            of I.Displace{base, disp, mem} =>
198                 I.Displace{base=Option.valOf(combineBase(t0, SOME base)), disp=disp}                 I.Displace{base=Option.valOf(combineBase(t0, SOME base)),
199             | I.Indexed{base, index, scale, disp} =>                            disp=disp, mem=mem}
200               | I.Indexed{base, index, scale, disp, mem} =>
201                 I.Indexed{base=combineBase(t0, base),                 I.Indexed{base=combineBase(t0, base),
202                           index=index, scale=scale, disp=disp}                           index=index, scale=scale, disp=disp, mem=mem}
203             | disp => I.Displace{base=reduceReg(t0), disp=disp}             | disp => I.Displace{base=reduceReg(t0), disp=disp, mem=mem}
204           (*esac*))           (*esac*))
205        | doEA(T.ADD(t1, t2 as T.REG _), mode) = doEA(t1, doEA(t2, mode))        | doEA(T.ADD(_, t1, t2 as T.REG _), mode) = doEA(t1, doEA(t2, mode))
206        | doEA(T.ADD(t1, t2), mode) = doEA(t2, doEA(t1, mode))        | doEA(T.ADD(_, t1, t2), mode) = doEA(t2, doEA(t1, mode))
207        | doEA(T.SUB(t1, T.LI n, _), mode) = doEA(T.ADD(t1, T.LI (~n)), mode)        | doEA(T.SUB(ty, t1, T.LI n), mode) = doEA(T.ADD(ty, t1, T.LI (~n)), mode)
208        | doEA(t, I.Indexed{base, index, scale, disp}) =        | doEA(t, I.Indexed{base, index, scale, disp, mem}) =
209            I.Indexed{base=combineBase(t, base), index=index, scale=scale, disp=disp}            I.Indexed{base=combineBase(t, base), index=index, scale=scale,
210        | doEA(T.REG r, I.Displace{base, disp}) =                      disp=disp, mem=mem}
211            I.Indexed{base=SOME base, index=r, scale=0, disp=disp}        | doEA(T.REG(_,r), I.Displace{base, disp, mem}) =
212        | doEA(t, I.Displace{base, disp}) =            I.Indexed{base=SOME base, index=r, scale=0, disp=disp, mem=mem}
213            I.Indexed{base=SOME base, index=reduceReg t, scale=0, disp=disp}        | doEA(t, I.Displace{base, disp, mem}) =
214        | doEA(t, immed) = I.Displace{base=reduceReg t, disp=immed}            I.Indexed{base=SOME base, index=reduceReg t, scale=0,
215                        disp=disp, mem=mem}
216          | doEA(t, immed) = I.Displace{base=reduceReg t, disp=immed, mem=mem}
217    in    in
218      case doEA(eatree, I.Immed 0)      case doEA(eatree, I.Immed 0)
219      of I.Immed _ => raise EA      of I.Immed _ => raise EA
# Line 205  Line 225 
225      | operand(T.LI32 w) = I.Immed(wToInt32 w)      | operand(T.LI32 w) = I.Immed(wToInt32 w)
226      | operand(T.CONST c) = I.Const c      | operand(T.CONST c) = I.Const c
227      | operand(T.LABEL lab) = I.ImmedLabel lab      | operand(T.LABEL lab) = I.ImmedLabel lab
228      | operand(T.REG r) = I.Direct r      | operand(T.REG(_,r)) = I.Direct r
229      | operand(T.LOAD32(t, _)) = ea t      | operand(T.LOAD(32,t,mem)) = ea(t,mem)
230      | operand(t) = I.Direct(reduceReg(t))      | operand(t) = I.Direct(reduceReg(t))
231    
232    (* operand with preferred target *)    (* operand with preferred target *)
233    and operandRd(T.LI i, _) = I.Immed (toInt32 i)    and operandRd(T.LI i, _) = I.Immed (toInt32 i)
234      | operandRd(T.LI32 w, _) = I.Immed(wToInt32 w)      | operandRd(T.LI32 w, _) = I.Immed(wToInt32 w)
235      | operandRd(T.REG r, _)  = I.Direct r      | operandRd(T.REG(_,r), _)  = I.Direct r
236      | operandRd(T.LOAD32(t,_), _) = ea t      | operandRd(T.LOAD(32,t,mem), _) = ea(t,mem)
237      | operandRd(t, rd) = I.Direct(reduceRegRd(t, rd))      | operandRd(t, rd) = I.Direct(reduceRegRd(t, rd, []))
   
   (* evaluate left-to-right or right-to-left *)  
   and ordered(e1, e2, T.LR) = (operand e1, operand e2)  
     | ordered(e1, e2, T.RL) = let  
         val opnd2 = operand e2  
       in (operand e1, opnd2)  
       end  
238    
239    and cond T.LT = I.LT  | cond T.LTU = I.B    and cond T.LT = I.LT  | cond T.LTU = I.B
240      | cond T.LE = I.LE  | cond T.LEU = I.BE      | cond T.LE = I.LE  | cond T.LEU = I.BE
241      | cond T.EQ = I.EQ  | cond T.NEQ = I.NE      | cond T.EQ = I.EQ        | cond T.NE = I.NE
242      | cond T.GE = I.GE  | cond T.GEU = I.AE      | cond T.GE = I.GE  | cond T.GEU = I.AE
243      | cond T.GT = I.GT  | cond T.GTU = I.A      | cond T.GT = I.GT  | cond T.GTU = I.A
244    
245   (* reduce an MLRISC statement tree *)   (* reduce an MLRISC statement tree *)
246    and reduceStm(T.MV(rd, exp)) = let    and reduceStm(T.MV(_, rd, exp),an) =
247          fun mv src = emit(I.MOVE{mvOp=I.MOVL, src=src, dst=I.Direct rd})        let fun mv src = mark(I.MOVE{mvOp=I.MOVL, src=src, dst=I.Direct rd},an)
248        in        in  case operandRd(exp, rd)
         case operandRd(exp, rd)  
249           of opnd as I.Direct rd' => if rd'=rd then () else mv opnd           of opnd as I.Direct rd' => if rd'=rd then () else mv opnd
250            | opnd => mv opnd            | opnd => mv opnd
251        end        end
252      | reduceStm(T.FMV(fd, T.FREG fs)) =      | reduceStm(T.FMV(_, fd, T.FREG(_,fs)),an) =
253         if fs=fd then () else emit(I.COPY{dst=[fd], src=[fs], tmp=NONE})         if fs=fd then () else mark(I.COPY{dst=[fd], src=[fs], tmp=NONE},an)
254      | reduceStm(T.FMV(fd, T.LOADD(t, _))) =      | reduceStm(T.FMV(_, fd, T.FLOAD(_, t, mem)),an) =
255         (emit(I.FLD(ea t)); emit(I.FSTP(I.FDirect fd)))         (mark(I.FLD(ea(t,mem)),an); emit(I.FSTP(I.FDirect fd)))
256      | reduceStm(T.FMV(fd, e)) = (reduceFexp e; emit(I.FSTP(I.FDirect fd)))      | reduceStm(T.FMV(_, fd, e),an) =
257      | reduceStm(T.CCMV(0, exp)) = reduceCC(exp, 0)         (reduceFexp(e,an); emit(I.FSTP(I.FDirect fd)))
258      | reduceStm(T.CCMV _) = error "reduceStm: CCMV"      | reduceStm(T.CCMV(0, exp),an) = reduceCC(exp, 0, an)
259      | reduceStm(T.COPY(dst as [_], src)) =      | reduceStm(T.CCMV _,_) = error "reduceStm: CCMV"
260          emit(I.COPY{dst=dst, src=src, tmp=NONE})      | reduceStm(T.COPY(_, dst as [_], src),an) =
261      | reduceStm(T.COPY(dst, src)) =          mark(I.COPY{dst=dst, src=src, tmp=NONE},an)
262          emit(I.COPY{dst=dst, src=src, tmp=SOME(I.Direct(newReg()))})      | reduceStm(T.COPY(_, dst, src),an) =
263      | reduceStm(T.FCOPY(dst, src)) =          mark(I.COPY{dst=dst, src=src, tmp=SOME(I.Direct(newReg()))},an)
264          emit(I.FCOPY{dst=dst, src=src, tmp=SOME(I.FDirect(newFreg()))})      | reduceStm(T.FCOPY(_, dst, src),an) =
265      | reduceStm(T.JMP(T.LABEL lexp, labs)) = emit(I.JMP(I.ImmedLabel lexp, labs))          mark(I.FCOPY{dst=dst, src=src, tmp=SOME(I.FDirect(newFreg()))},an)
266      | reduceStm(T.JMP(exp, labs)) = emit(I.JMP (operand exp, labs))      | reduceStm(T.JMP(T.LABEL lexp, labs),an) =
267      | reduceStm(T.CALL(t,def,use)) = let          mark(I.JMP(I.ImmedLabel lexp, labs),an)
268         val addCCreg = C.addCell C.CC      | reduceStm(T.JMP(exp, labs),an) = mark(I.JMP (operand exp, labs),an)
269        | reduceStm(T.CALL(t,def,use,mem),an) =
270          let val addCCreg = C.addCell C.CC
271         fun addList([], acc) = acc         fun addList([], acc) = acc
272           | addList(T.GPR(T.REG r)::regs, acc) = addList(regs, C.addReg(r, acc))              | addList(T.GPR(T.REG(_,r))::regs, acc) =
273           | addList(T.FPR(T.FREG r)::regs, acc) = addList(regs, C.addFreg(r, acc))                   addList(regs, C.addReg(r, acc))
274           | addList(T.CCR(T.CC cc)::regs, acc) = addList(regs, addCCreg(cc, acc))              | addList(T.FPR(T.FREG(_,r))::regs, acc) =
275                     addList(regs, C.addFreg(r, acc))
276                | addList(T.CCR(T.CC cc)::regs, acc) =
277                     addList(regs, addCCreg(cc, acc))
278           | addList(_::regs, acc) = addList(regs, acc)           | addList(_::regs, acc) = addList(regs, acc)
279        in        in  mark(I.CALL(operand t,
280          emit(I.CALL(operand t, addList(def,C.empty), addList(use,C.empty)))                        addList(def,C.empty),addList(use,C.empty),mem),an)
281        end        end
282      | reduceStm(T.RET) = emit(I.RET)      | reduceStm(T.RET,an) = mark(I.RET,an)
283      | reduceStm(T.STORE8(t1, t2, ord)) = let      | reduceStm(T.STORE(8, t1, t2, mem),an) =
284         val opnd = immedOrReg(operand t2)        let val opnd = immedOrReg(operand t2)
285         val src =         val src =
286           (case opnd           (case opnd
287            of I.Direct r => if r = C.eax then opnd else (move(opnd, eax); eax)               of I.Direct r =>
288                      if r = C.eax then opnd else (move(opnd,eax,[]); eax)
289             | _ => opnd             | _ => opnd
290            (*esac*))            (*esac*))
291        in emit(I.MOVE{mvOp=I.MOVB, src=src, dst=ea t1})        in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=ea(t1,mem)},an)
292        end        end
293      | reduceStm(T.STORE32(t1, t2, _)) = move(immedOrReg(operand t2), ea t1)      | reduceStm(T.STORE(32, t1, t2, mem),an) =
294      | reduceStm(T.STORED(t1, t2, _)) =          move(immedOrReg(operand t2), ea(t1,mem), an)
295        | reduceStm(T.FSTORE(64, t1, t2, mem),an) =
296         (case t2         (case t2
297           of T.FREG fs => emit(I.FLD(I.FDirect fs))           of T.FREG(_,fs) => emit(I.FLD(I.FDirect fs))
298            | e => reduceFexp e            | e => reduceFexp(e,[])
299          (*esac*);          (*esac*);
300          emit(I.FSTP(ea t1)))          mark(I.FSTP(ea(t1,mem)),an))
301      | reduceStm(T.STORECC _) = error "stmAction: STORECC"      | reduceStm(T.BCC(_, T.CMP(ty, cc as (T.EQ | T.NE), t1, T.LI 0),
302      | reduceStm(T.BCC(_, T.CMP(cc as (T.EQ | T.NEQ), t1, T.LI 0, _), lab)) = let                        lab), an) =
303          val opnd1 = operand t1        let val opnd1 = operand t1
304          fun jcc() = emit(I.JCC{cond=cond cc, opnd=immedLabel lab})            fun jcc() = mark(I.JCC{cond=cond cc, opnd=immedLabel lab},an)
305        in        in  case t1
         case t1  
306          of T.ANDB _ => jcc()          of T.ANDB _ => jcc()
307           | T.ORB _ =>  jcc()           | T.ORB _ =>  jcc()
308           | T.XORB _ => jcc()           | T.XORB _ => jcc()
# Line 293  Line 311 
311           | T.SLL _ =>  jcc()           | T.SLL _ =>  jcc()
312           | _ => (emit(I.CMP{lsrc=opnd1, rsrc=I.Immed 0}); jcc())           | _ => (emit(I.CMP{lsrc=opnd1, rsrc=I.Immed 0}); jcc())
313        end        end
314      | reduceStm(T.BCC(_, T.CMP(cc, t1, t2, ord), lab)) = let      | reduceStm(T.BCC(_, T.CMP(ty, cc, t1, t2), lab), an) =
315          fun swapcc T.LT = T.GT  | swapcc T.LTU = T.GTU        let fun cmpAndBranch(cc, opnd1, opnd2) =
           | swapcc T.LE = T.GE  | swapcc T.LEU = T.GEU  
           | swapcc T.EQ = T.EQ  | swapcc T.NEQ = T.NEQ  
           | swapcc T.GE = T.LE  | swapcc T.GEU = T.LEU  
           | swapcc T.GT = T.LT  | swapcc T.GTU = T.LTU  
   
         fun cmpAndBranch(cc, opnd1, opnd2) =  
316            (emit(I.CMP{lsrc=opnd1, rsrc=opnd2});            (emit(I.CMP{lsrc=opnd1, rsrc=opnd2});
317             emit(I.JCC{cond=cond cc, opnd=immedLabel lab}))               mark(I.JCC{cond=cond cc, opnd=immedLabel lab},an))
318    
319              val (opnd1, opnd2) = (operand t1, operand t2)
320          val (opnd1, opnd2) = ordered(t1, t2, ord)        in  if isImmediate opnd1 andalso isImmediate opnd2 then
       in  
         if isImmediate opnd1 andalso isImmediate opnd2 then  
321            cmpAndBranch(cc, moveToReg opnd1, opnd2)            cmpAndBranch(cc, moveToReg opnd1, opnd2)
322          else if isImmediate opnd1 then          else if isImmediate opnd1 then
323            cmpAndBranch(swapcc cc, opnd2, opnd1)              cmpAndBranch(MLTreeUtil.swapCond cc, opnd2, opnd1)
324          else if isImmediate opnd2 then          else if isImmediate opnd2 then
325            cmpAndBranch(cc, opnd1, opnd2)            cmpAndBranch(cc, opnd1, opnd2)
326          else case (opnd1, opnd2)          else case (opnd1, opnd2)
# Line 319  Line 329 
329            | _ => cmpAndBranch(cc, moveToReg opnd1, opnd2)            | _ => cmpAndBranch(cc, moveToReg opnd1, opnd2)
330           (*esac*)           (*esac*)
331        end        end
332      | reduceStm(T.BCC(cc, T.CC(0), lab)) =      | reduceStm(T.BCC(cc, T.CC(0), lab), an) =
333          emit(I.JCC{cond=cond cc, opnd=immedLabel lab})          mark(I.JCC{cond=cond cc, opnd=immedLabel lab},an)
334      | reduceStm(T.BCC _) = error "reduceStm: BCC"      | reduceStm(T.BCC _,_) = error "reduceStm: BCC"
335      | reduceStm(T.FBCC(_, T.FCMP(fcc, t1, t2, ord), lab)) = let      | reduceStm(T.FBCC(_, T.FCMP(fty, fcc, t1, t2), lab),an) =
336          fun compare() = let        let fun compare() =
337            fun ignoreOrder (T.FREG _) = true            let fun ignoreOrder (T.FREG _) = true
338              | ignoreOrder (T.LOADD _) = true                  | ignoreOrder (T.FLOAD _) = true
339              | ignoreOrder _ = false              | ignoreOrder _ = false
340            fun t2t1 () = (reduceFexp t2; reduceFexp t1)                fun t2t1 () = (reduceFexp(t2,[]); reduceFexp(t1,[]))
341          in            in  if ignoreOrder t1 orelse ignoreOrder t2 then t2t1()
342            if ignoreOrder t1 orelse ignoreOrder t2 then t2t1()                else (reduceFexp(t1,[]); reduceFexp(t2,[]); emit(I.FXCH))
343            else                ;
             (case ord  
               of T.RL => t2t1()  
                | T.LR => (reduceFexp t1; reduceFexp t2; emit(I.FXCH))  
             (*esac*));  
344            emit(I.FUCOMPP)            emit(I.FUCOMPP)
345          end          end
346          fun branch() = let            fun branch() =
347            val eax = I.Direct C.eax            let val eax = I.Direct C.eax
348            fun andil i = emit(I.BINARY{binOp=I.AND, src=I.Immed(i), dst=eax})            fun andil i = emit(I.BINARY{binOp=I.AND, src=I.Immed(i), dst=eax})
349            fun xoril i = emit(I.BINARY{binOp=I.XOR, src=I.Immed(i), dst=eax})            fun xoril i = emit(I.BINARY{binOp=I.XOR, src=I.Immed(i), dst=eax})
350            fun cmpil i = emit(I.CMP{rsrc=I.Immed(i), lsrc=eax})            fun cmpil i = emit(I.CMP{rsrc=I.Immed(i), lsrc=eax})
351            fun j(cc, lab) = emit(I.JCC{cond=cc, opnd=immedLabel lab})                fun j(cc, lab) = mark(I.JCC{cond=cc, opnd=immedLabel lab},an)
352            fun sahf() = emit(I.SAHF)            fun sahf() = emit(I.SAHF)
353          in            in  case fcc
           case fcc  
354            of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))            of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
355             | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))             | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
356             | T.?    => (sahf(); j(I.P,lab))             | T.?    => (sahf(); j(I.P,lab))
# Line 365  Line 370 
370          end          end
371        in compare(); emit I.FNSTSW; branch()        in compare(); emit I.FNSTSW; branch()
372        end        end
373      | reduceStm(T.FBCC _) = error "reduceStm: FBCC"      | reduceStm(T.FBCC _,_) = error "reduceStm: FBCC"
374        | reduceStm(T.ANNOTATION(s,a),an) = reduceStm(s,a::an)
375    
376    and reduceCC(T.CMP(_, t1, t2, ord), 0) = let    and reduceCC(T.CMP(ty, _, t1, t2), 0, an) =
377          val (opnd1, opnd2) = ordered(t1, t2, ord)        let val (opnd1, opnd2) = (operand t1, operand t2)
378        in        in mark(I.CMP(
         emit(I.CMP(  
379            case (opnd1, opnd2)            case (opnd1, opnd2)
380            of (I.Immed _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}            of (I.Immed _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
381             | (I.ImmedLabel _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}             | (I.ImmedLabel _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
382             | (I.Const _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}             | (I.Const _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
383             | (I.Direct _, _) => {lsrc=opnd1, rsrc=opnd2}             | (I.Direct _, _) => {lsrc=opnd1, rsrc=opnd2}
384             | (_, I.Direct _) => {lsrc=opnd1, rsrc=opnd2}             | (_, I.Direct _) => {lsrc=opnd1, rsrc=opnd2}
385             | _ => {lsrc=moveToReg opnd1, rsrc=opnd2}))               | _ => {lsrc=moveToReg opnd1, rsrc=opnd2}),an)
386        end        end
387        | reduceCC(T.CCMARK(e,a),rd,an) = reduceCC(e,rd,a::an)
388      | reduceCC _ = error "reduceCC"      | reduceCC _ = error "reduceCC"
389    
390    
391    and reduceReg(T.REG rd) = rd    and reduceReg(T.REG(_,rd)) = rd
392      | reduceReg(exp) = reduceRegRd(exp, newReg())      | reduceReg(exp) = reduceRegRd(exp, newReg(), [])
393    
394   (* reduce to the register rd where possible.*)   (* reduce to the register rd where possible.*)
395    and reduceRegRd(exp, rd) = let    and reduceRegRd(exp, rd, an) = let
396      val opndRd = I.Direct(rd)      val opndRd = I.Direct(rd)
397    
398      fun binary(comm, oper, e1, e2, order) = let      fun binary(comm, oper, e1, e2, an) = let
399        fun emit2addr (opnd1, opnd2) =        fun emit2addr (opnd1, opnd2) =
400          (move(opnd1, opndRd);          (move(opnd1, opndRd, []);
401           emit(I.BINARY{binOp=oper, dst=opndRd, src=opnd2});           mark(I.BINARY{binOp=oper, dst=opndRd, src=opnd2},an);
402           rd)           rd)
403        fun commute(opnd1 as I.Immed _, opnd2) = (opnd2, opnd1)        fun commute(opnd1 as I.Immed _, opnd2) = (opnd2, opnd1)
404          | commute(opnd1 as I.ImmedLabel _, opnd2) = (opnd2, opnd1)          | commute(opnd1 as I.ImmedLabel _, opnd2) = (opnd2, opnd1)
# Line 400  Line 406 
406          | commute(opnd1, opnd2 as I.Direct _) = (opnd2, opnd1)          | commute(opnd1, opnd2 as I.Direct _) = (opnd2, opnd1)
407          | commute arg = arg          | commute arg = arg
408    
409        val opnds = ordered(e1, e2, order)        val opnds = (operand e1, operand e2)
410      in emit2addr(if comm then commute opnds else opnds)      in emit2addr(if comm then commute opnds else opnds)
411      end (*binary*)      end (*binary*)
412    
413      fun unary(oper, exp) =      fun unary(oper, exp, an) =
414        (move(operand exp, opndRd);        (move(operand exp, opndRd, []);
415         emit(I.UNARY{unOp=oper, opnd=opndRd});         mark(I.UNARY{unOp=oper, opnd=opndRd},an);
416         rd)         rd)
417    
418     (* The shift count can be either an immediate or the ECX register *)     (* The shift count can be either an immediate or the ECX register *)
419      fun shift(oper, e1, e2, order) = let      fun shift(oper, e1, e2, an) = let
420        val (opnd1, opnd2) = ordered(e1, e2, order)        val (opnd1, opnd2) = (operand e1, operand e2)
421      in      in
422        move(opnd1, opndRd);        move(opnd1, opndRd, []);
423        case opnd2        case opnd2
424         of I.Immed _ => emit(I.BINARY{binOp=oper, src=opnd2, dst=opndRd})         of I.Immed _ => mark(I.BINARY{binOp=oper, src=opnd2, dst=opndRd},an)
425          | _ => (move(opnd2, ecx);          | _ => (move(opnd2, ecx, []);
426                  emit(I.BINARY{binOp=oper, src=ecx, dst=opndRd}))                  mark(I.BINARY{binOp=oper, src=ecx, dst=opndRd},an))
427        (*esac*);        (*esac*);
428        rd        rd
429      end (* shift *)      end (* shift *)
430    
431      (* Divisor must be in EDX:EAX *)      (* Divisor must be in EDX:EAX *)
432      fun divide(oper, signed, e1, e2, order) = let      fun divide(oper, signed, e1, e2, an) =
433        val (opnd1, opnd2) = ordered(e1, e2, order)      let val (opnd1, opnd2) = (operand e1, operand e2)
434      in      in  move(opnd1, eax, []);
435        move(opnd1, eax);          if signed then emit(I.CDQ) else move(I.Immed(0), edx, []);
436        if signed then emit(I.CDQ) else move(I.Immed(0), edx);          mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
437        emit(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2});          move(eax, opndRd, []);
       move(eax, opndRd);  
438        rd        rd
439      end      end
440    
441      (* unsigned integer multiplication *)      (* unsigned integer multiplication *)
442      fun uMultiply(e1, e2) =      fun uMultiply(e1, e2, an) =
443        (* note e2 can never be (I.Direct edx) *)        (* note e2 can never be (I.Direct edx) *)
444        (move(operand e1, eax);        (move(operand e1, eax, []);
445         emit(I.MULTDIV{multDivOp=I.UMUL, src=regOrMem(operand e2)});         mark(I.MULTDIV{multDivOp=I.UMUL, src=regOrMem(operand e2)},an);
446         move(eax, opndRd);         move(eax, opndRd, []);
447         rd)         rd)
448    
449      (* signed integer multiplication *)      (* signed integer multiplication *)
# Line 450  Line 455 
455       *      imul r32, imm8       *      imul r32, imm8
456       *      imul r32, imm32       *      imul r32, imm32
457       *)       *)
458      fun multiply(e1, e2) = let      fun multiply(e1, e2, an) = let
459        fun doit(i1 as I.Immed _, i2 as I.Immed _) =        fun doit(i1 as I.Immed _, i2 as I.Immed _) =
460             (move(i1, opndRd);              (move(i1, opndRd, []);
461              emit(I.MUL3{dst=rd, src1=i2, src2=NONE}))              mark(I.MUL3{dst=rd, src1=i2, src2=NONE},an))
462          | doit(rm, i2 as I.Immed _) = doit(i2, rm)          | doit(rm, i2 as I.Immed _) = doit(i2, rm)
463          | doit(imm as I.Immed(i), rm) =          | doit(imm as I.Immed(i), rm) =
464               emit(I.MUL3{dst=rd, src1=rm, src2=SOME i})               mark(I.MUL3{dst=rd, src1=rm, src2=SOME i},an)
465          | doit(r1 as I.Direct _, r2 as I.Direct _) =          | doit(r1 as I.Direct _, r2 as I.Direct _) =
466              (move(r1, opndRd);              (move(r1, opndRd, []);
467               emit(I.MUL3{dst=rd, src1=r2, src2=NONE}))               mark(I.MUL3{dst=rd, src1=r2, src2=NONE},an))
468          | doit(r1 as I.Direct _, rm) =          | doit(r1 as I.Direct _, rm) =
469              (move(r1, opndRd);              (move(r1, opndRd, []);
470               emit(I.MUL3{dst=rd, src1=rm, src2=NONE}))               mark(I.MUL3{dst=rd, src1=rm, src2=NONE},an))
471          | doit(rm, r as I.Direct _) = doit(r, rm)          | doit(rm, r as I.Direct _) = doit(r, rm)
472          | doit(rm1, rm2) =          | doit(rm1, rm2) =
473             (move(rm1, opndRd);             (move(rm1, opndRd, []);
474              emit(I.MUL3{dst=rd, src1=rm2, src2=NONE}))              mark(I.MUL3{dst=rd, src1=rm2, src2=NONE},an))
475      in doit(ordered(e1, e2, T.LR))      in doit(operand e1, operand e2)
476      end      end
477    
478      fun trap() =      fun trap() =
# Line 477  Line 482 
482        (*esac*))        (*esac*))
483    in    in
484      case exp      case exp
485       of T.REG rs => (move(I.Direct rs, opndRd); rd)       of T.REG(_,rs) => (move(I.Direct rs, opndRd, an); rd)
486        | T.LI n   => (move(I.Immed(toInt32 n), opndRd); rd)        | T.LI n         => (move(I.Immed(toInt32 n), opndRd, an); rd)
487        | T.LI32 w => (move(I.Immed(wToInt32 w), opndRd); rd)        | T.LI32 w => (move(I.Immed(wToInt32 w), opndRd, an); rd)
488        | T.CONST c => (move(I.Const c, opndRd); rd)        | T.CONST c => (move(I.Const c, opndRd, an); rd)
489        | T.LABEL lab => (move(I.ImmedLabel lab, opndRd); rd)        | T.LABEL lab => (move(I.ImmedLabel lab, opndRd, an); rd)
490        | T.ADD(e, T.LI 1) => unary(I.INC, e)        | T.ADD(32, e, T.LI 1) => unary(I.INC, e, an)
491        | T.ADD(e, T.LI32 0w1) => unary(I.INC, e)        | T.ADD(32, e, T.LI32 0w1) => unary(I.INC, e, an)
492        | T.ADD(e, T.LI ~1) => unary(I.DEC, e)        | T.ADD(32, e, T.LI ~1) => unary(I.DEC, e, an)
493        | T.ADD(e1, e2) =>        | T.ADD(32, e1, e2) =>
494            ((emit(I.LEA{r32=rd, addr=ea(exp)}); rd)            ((mark(I.LEA{r32=rd, addr=ea(exp,I.Region.readonly)}, an); rd)
495              handle EA => binary(true, I.ADD, e1, e2, T.LR))              handle EA => binary(true, I.ADD, e1, e2, an))
496        | T.SUB(e, T.LI 1, _) => unary(I.DEC, e)        | T.SUB(32, e, T.LI 1) => unary(I.DEC, e, an)
497        | T.SUB(e, T.LI32 0w1, _) => unary(I.DEC, e)        | T.SUB(32, e, T.LI32 0w1)        => unary(I.DEC, e, an)
498        | T.SUB(e, T.LI ~1, _) => unary(I.INC, e)        | T.SUB(32, e, T.LI ~1) => unary(I.INC, e, an)
499        | T.SUB(e1, e2, ord) => binary(false, I.SUB, e1, e2, ord)        | T.SUB(32, e1, e2) => binary(false, I.SUB, e1, e2, an)
500        | T.MULU(e1, e2) => uMultiply(e1, e2)        | T.MULU(32, e1, e2) => uMultiply(e1, e2, an)
501        | T.DIVU(e1, e2, ord) => (divide(I.UDIV, false, e1, e2, ord))        | T.DIVU(32, e1, e2) => (divide(I.UDIV, false, e1, e2, an))
502        | T.ADDT(e1, e2) => (binary(true,I.ADD,e1,e2,T.LR); trap(); rd)        | T.ADDT(32, e1, e2) => (binary(true,I.ADD,e1,e2, an); trap(); rd)
503        | T.MULT(e1, e2) => (multiply(e1, e2); trap(); rd)        | T.MULT(32, e1, e2) => (multiply(e1, e2, an); trap(); rd)
504        | T.SUBT(e1, e2, ord) =>        | T.SUBT(32, e1, e2) =>
505           (binary(false,I.SUB,e1,e2,ord); trap(); rd)           (binary(false,I.SUB,e1,e2, an); trap(); rd)
506        | T.DIVT(e1, e2, ord) =>        | T.DIVT(32, e1, e2) =>
507            (divide(I.IDIV, true, e1, e2, ord); trap(); rd)            (divide(I.IDIV, true, e1, e2, an); trap(); rd)
508        | T.LOAD32(exp, _) => (move(ea exp, opndRd); rd)        | T.LOAD(32, exp, mem) => (move(ea(exp,mem), opndRd, an); rd)
509        | T.LOAD8(exp, _) =>        | T.LOAD(8, exp, mem) =>
510            (emit(I.MOVE{mvOp=I.MOVZX, src=ea exp, dst=opndRd}); rd)            (mark(I.MOVE{mvOp=I.MOVZX, src=ea(exp,mem), dst=opndRd}, an); rd)
511        | T.ANDB(e1, e2) => binary(true, I.AND, e1, e2, T.LR)        | T.ANDB(32, e1, e2) => binary(true, I.AND, e1, e2, an)
512        | T.ORB(e1, e2) => binary(true, I.OR, e1, e2, T.LR)        | T.ORB(32, e1, e2) => binary(true, I.OR, e1, e2, an)
513        | T.XORB(e1, e2) => binary(true, I.XOR, e1, e2, T.LR)        | T.XORB(32, e1, e2) => binary(true, I.XOR, e1, e2, an)
514        | T.SRA(e1, e2, ord) => shift(I.SAR, e1, e2, ord)        | T.SRA(32, e1, e2) => shift(I.SAR, e1, e2, an)
515        | T.SRL(e1, e2, ord) => shift(I.SHR, e1, e2, ord)        | T.SRL(32, e1, e2) => shift(I.SHR, e1, e2, an)
516        | T.SLL(e1, e2, ord) => shift(I.SHL, e1, e2, ord)        | T.SLL(32, e1, e2) => shift(I.SHL, e1, e2, an)
517        | T.SEQ(stm, rexp)  => (reduceStm stm; reduceRegRd(rexp, rd))        | T.SEQ(stm, rexp)  => (reduceStm(stm,[]); reduceRegRd(rexp, rd, an))
518          | T.MARK(e,a) => reduceRegRd(e,rd,a::an)
519    end (* reduceRegRd *)    end (* reduceRegRd *)
520    
521    and reduceFexp(fexp) = let    and reduceFexp(fexp, an) = let
522      val ST = I.FDirect 0      val ST = I.FDirect(C.FPReg 0)
523      val ST1 = I.FDirect 1      val ST1 = I.FDirect(C.FPReg 1)
524    
525      datatype su_numbers =      datatype su_numbers =
526         LEAF of int         LEAF of int
# Line 543  Line 549 
549    
550      and suNumbering(T.FREG _, LEFT) = LEAF 1      and suNumbering(T.FREG _, LEFT) = LEAF 1
551        | suNumbering(T.FREG _, RIGHT) = LEAF 0        | suNumbering(T.FREG _, RIGHT) = LEAF 0
552        | suNumbering(T.LOADD _, LEFT) = LEAF 1        | suNumbering(T.FLOAD _, LEFT) = LEAF 1
553        | suNumbering(T.LOADD _, RIGHT) = LEAF 0        | suNumbering(T.FLOAD _, RIGHT) = LEAF 0
554        | suNumbering(T.FADDD(t1, t2), _) = suBinary(t1, t2)        | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)
555        | suNumbering(T.FMULD(t1, t2), _) = suBinary(t1, t2)        | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)
556        | suNumbering(T.FSUBD(t1, t2, _), _) = suBinary(t1, t2)        | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)
557        | suNumbering(T.FDIVD(t1, t2, _), _) = suBinary(t1, t2)        | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)
558        | suNumbering(T.FABSD t, _) = suUnary(t)        | suNumbering(T.FABS(_,t), _) = suUnary(t)
559        | suNumbering(T.FNEGD t, _) = suUnary(t)        | suNumbering(T.FNEG(_,t), _) = suUnary(t)
560        | suNumbering(T.CVTI2D t, _) = UNARY(1, LEAF 0)        | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)
561          | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)
562    
563      fun leafEA(T.FREG f) = I.FDirect f      fun leafEA(T.FREG(_,f)) = I.FDirect f
564        | leafEA(T.LOADD(t, _)) = ea t        | leafEA(T.FLOAD(_, t, mem)) = ea(t,mem)
565        | leafEA _ = error "leafEA"        | leafEA _ = error "leafEA"
566    
567      fun cvti2d(t) = let      fun cvti2d(t,an) = let
568        val opnd = operand t        val opnd = operand t
569        fun doMemOpnd () =        fun doMemOpnd () =
570          (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});          (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});
571           emit(I.FILD tempMem))           mark(I.FILD tempMem,an))
572      in      in
573        case opnd        case opnd
574        of I.Direct _ => doMemOpnd()        of I.Direct _ => doMemOpnd()
575         | I.Immed _ => doMemOpnd()         | I.Immed _ => doMemOpnd()
576         | _ => emit(I.FILD opnd)         | _ => mark(I.FILD opnd, an)
577      end      end
578    
579      (* traverse expression and su-number tree *)      (* traverse expression and su-number tree *)
580      fun gencode(_, LEAF 0) = ()      fun gencode(_, LEAF 0, an) = ()
581        | gencode(f, LEAF 1) = emit(I.FLD(leafEA f))        | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)
582        | gencode(t, BINARY(_, su1, LEAF 0)) = let        | gencode(f, LEAF 1, an) = mark(I.FLD(leafEA f), an)
583          | gencode(t, BINARY(_, su1, LEAF 0), an) = let
584            fun doit(oper, t1, t2) =            fun doit(oper, t1, t2) =
585              (gencode(t1, su1);              (gencode(t1, su1, []);
586               emit(I.FBINARY{binOp=oper, src=leafEA t2, dst=ST}))               mark(I.FBINARY{binOp=oper, src=leafEA t2, dst=ST},an))
587          in          in
588            case t            case t
589            of T.FADDD(t1, t2) => doit(I.FADD, t1, t2)            of T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)
590             | T.FMULD(t1, t2) => doit(I.FMUL, t1, t2)             | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)
591             | T.FSUBD(t1, t2, _) => doit(I.FSUB, t1, t2)             | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)
592             | T.FDIVD(t1, t2, _) => doit(I.FDIV, t1, t2)             | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)
593          end          end
594        | gencode(fexp, BINARY(_, su1, su2)) = let        | gencode(fexp, BINARY(_, su1, su2), an) = let
595            fun doit(t1, t2, oper, operP, operRP) = let            fun doit(t1, t2, oper, operP, operRP) = let
596             (* oper[P] =>  ST(1) := ST oper ST(1); [pop]             (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
597              * operR[P] => ST(1) := ST(1) oper ST; [pop]              * operR[P] => ST(1) := ST(1) oper ST; [pop]
# Line 592  Line 600 
600              val n2 = label su2              val n2 = label su2
601            in            in
602              if n1 < n2 andalso n1 <= 7 then              if n1 < n2 andalso n1 <= 7 then
603                (gencode(t2, su2);                (gencode(t2, su2, []);
604                 gencode(t1, su1);                 gencode(t1, su1, []);
605                 emit(I.FBINARY{binOp=operP, src=ST, dst=ST1}))                 mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
606              else if n2 <= n1 andalso n2 <= 7 then              else if n2 <= n1 andalso n2 <= 7 then
607                (gencode(t1, su1);                (gencode(t1, su1, []);
608                 gencode(t2, su2);                 gencode(t2, su2, []);
609                 emit(I.FBINARY{binOp=operRP, src=ST, dst=ST1}))                 mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
610              else let (* both labels > 7 *)              else let (* both labels > 7 *)
611                  val fs = I.FDirect(newFreg())                  val fs = I.FDirect(newFreg())
612                in                in
613                  gencode (t2, su2);                  gencode (t2, su2, []);
614                  emit(I.FSTP fs);                  emit(I.FSTP fs);
615                  gencode (t1, su1);                  gencode (t1, su1, []);
616                  emit(I.FBINARY{binOp=oper, src=fs, dst=ST})                  mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
617                end                end
618            end            end
619          in          in
620            case fexp            case fexp
621            of T.FADDD(t1, t2) => doit(t1, t2, I.FADD, I.FADDP, I.FADDP)            of T.FADD(_, t1, t2) => doit(t1, t2, I.FADD, I.FADDP, I.FADDP)
622             | T.FMULD(t1, t2) => doit(t1, t2, I.FMUL, I.FMULP, I.FMULP)             | T.FMUL(_, t1, t2) => doit(t1, t2, I.FMUL, I.FMULP, I.FMULP)
623             | T.FSUBD(t1, t2, _) => doit(t1, t2, I.FSUB, I.FSUBP, I.FSUBRP)             | T.FSUB(_, t1, t2) => doit(t1, t2, I.FSUB, I.FSUBP, I.FSUBRP)
624             | T.FDIVD(t1, t2, _) => doit(t1, t2, I.FDIV, I.FDIVP, I.FDIVRP)             | T.FDIV(_, t1, t2) => doit(t1, t2, I.FDIV, I.FDIVP, I.FDIVRP)
625          end          end
626        | gencode(fexp, UNARY(_, LEAF 0)) =        | gencode(fexp, UNARY(_, LEAF 0), an) =
627          (case fexp          (case fexp
628            of T.FABSD t => (emit(I.FLD(leafEA t)); emit(I.FUNARY(I.FABS)))            of T.FABS(_, t) => (emit(I.FLD(leafEA t)); mark(I.FUNARY(I.FABS),an))
629             | T.FNEGD t => (emit(I.FLD(leafEA t)); emit(I.FUNARY(I.FCHS)))             | T.FNEG(_, t) => (emit(I.FLD(leafEA t)); mark(I.FUNARY(I.FCHS),an))
630             | T.CVTI2D t => cvti2d(t)             | T.CVTI2F(_,_,t) => cvti2d(t,an)
631           (*esac*))           (*esac*))
632        | gencode(fexp, UNARY(_, su)) = let        | gencode(fexp, UNARY(_, su), an) = let
633            fun doit(oper, t) = (gencode(t, su); emit(I.FUNARY(oper)))            fun doit(oper, t) = (gencode(t, su, []); mark(I.FUNARY(oper),an))
634          in          in
635            case fexp            case fexp
636             of T.FABSD t => doit(I.FABS, t)             of T.FABS(_, t) => doit(I.FABS, t)
637              | T.FNEGD t => doit(I.FCHS, t)              | T.FNEG(_, t) => doit(I.FCHS, t)
638              | T.CVTI2D _ => error "gencode:UNARY:cvti2d"              | T.CVTI2F _ => error "gencode:UNARY:cvti2f"
639          end          end
640    
641      val labels = suNumbering(fexp, LEFT)      val labels = suNumbering(fexp, LEFT)
642    in gencode(fexp, labels)    in gencode(fexp, labels, an)
643    end (*reduceFexp*)    end (*reduceFexp*)
644    
645      fun doStm s = reduceStm(s,[])
646    
647    fun mltreeComp mltree = let    fun mltreeComp mltree = let
648      fun mltc(T.PSEUDO_OP pOp)     = F.pseudoOp pOp      fun mltc(T.PSEUDO_OP pOp)     = pseudoOp pOp
649        | mltc(T.DEFINELABEL lab)   = F.defineLabel lab        | mltc(T.DEFINELABEL lab)   = defineLabel lab
650        | mltc(T.ENTRYLABEL lab)    = F.entryLabel lab        | mltc(T.ENTRYLABEL lab)    = entryLabel lab
651        | mltc(T.ORDERED mlts)      = F.ordered mlts        | mltc(T.BEGINCLUSTER)      = (init 0; trapLabel := NONE)
652        | mltc(T.BEGINCLUSTER)      = (F.beginCluster(); trapLabel := NONE)        | mltc(T.CODE stms)         = app doStm stms
653        | mltc(T.CODE stms)         = app reduceStm stms        | mltc(T.BLOCK_NAME name)   = blockName name
654        | mltc(T.BLOCK_NAME name)   = F.blockName name        | mltc(T.BLOCK_ANNOTATION a)= annotation a
655        | mltc(T.ENDCLUSTER regmap) =        | mltc(T.ENDCLUSTER regmap) =
656           (case !trapLabel           (case !trapLabel
657            of NONE => ()            of NONE => ()
658             | SOME lab => (F.defineLabel lab; emit(I.INTO))             | SOME lab => (defineLabel lab; emit(I.INTO))
659            (*esac*);            (*esac*);
660            F.endCluster regmap)            finish regmap)
661        | mltc(T.ESCAPEBLOCK regs)  = F.exitBlock regs        | mltc(T.ESCAPEBLOCK regs)  = exitBlock regs
662    in mltc mltree    in mltc mltree
663    end    end
664    
665    val mlriscComp  = reduceStm    in
666          { mltreeComp = mltreeComp,
667            mlriscComp = doStm,
668            emitInstr  = emit
669          }
670      end
671    
672  end  end

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

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