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

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

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

revision 409, Fri Sep 3 00:21:52 1999 UTC revision 788, Wed Feb 28 04:09:48 2001 UTC
# Line 10  Line 10 
10    
11  functor Alpha  functor Alpha
12     (structure AlphaInstr : ALPHAINSTR     (structure AlphaInstr : ALPHAINSTR
     structure AlphaMLTree : MLTREE  
        where Region   = AlphaInstr.Region  
        and   Constant = AlphaInstr.Constant  
        where type cond = MLTreeBasis.cond  
        and   type fcond = MLTreeBasis.fcond  
        and   type rounding_mode = MLTreeBasis.rounding_mode  
     structure Stream : INSTRUCTION_STREAM  
        where B = AlphaMLTree.BNames  
        and   P = AlphaMLTree.PseudoOp  
13      structure PseudoInstrs : ALPHA_PSEUDO_INSTR      structure PseudoInstrs : ALPHA_PSEUDO_INSTR
14        structure ExtensionComp : MLTREE_EXTENSION_COMP
15         where I = AlphaInstr         where I = AlphaInstr
16           sharing PseudoInstrs.I = AlphaInstr
       (* When this flag is set:  
        * (1) 32 bit loads are always sign extended.  
        *)  
     val mode32bit : bool  
   
       (*  
        * Floating point rounding mode.  
        * When this is set to true, we use the /SU rounding mode  
        * (chopped towards zero) for floating point arithmetic.  
        * This flag is only used to support the old alpha32x backend.  
        *  
        * Otherwise, we use /SUD.  This is the default for SML/NJ.  
        *  
        *)  
     val useSU : bool (* use false for SML/NJ *)  
17    
18        (* Cost of multiplication in cycles *)        (* Cost of multiplication in cycles *)
19      val multCost : int ref      val multCost : int ref
20    
21        (* Should we just use the native multiply by a constant? *)        (* Should we just use the native multiply by a constant? *)
22      val useMultByConst : bool ref      val useMultByConst : bool ref
23    
24          (* Should we use SUD flags for floating point and generate DEFFREG?
25           * This should be set to false for C-like clients but true for SML/NJ.
26           *)
27        val SMLNJfloatingPoint : bool
28    
29          (* Should we use generate special byte/word load instructions
30           * like LDBU, LDWU, STB, STW.
31           *)
32        val byteWordLoadStores : bool ref
33     ) : MLTREECOMP =     ) : MLTREECOMP =
34  struct  struct
35    
   structure S   = Stream  
   structure T   = AlphaMLTree  
   structure R   = AlphaMLTree.Region  
36    structure I   = AlphaInstr    structure I   = AlphaInstr
37    structure C   = AlphaInstr.C    structure C   = I.C
38    structure LE  = LabelExp    structure T   = I.T
39      structure S   = T.Stream
40      structure R   = T.Region
41    structure W32 = Word32    structure W32 = Word32
42    structure U   = MLTreeUtil    structure P   = PseudoInstrs
43      structure A   = MLRiscAnnotations
44    
45   (*********************************************************   (*********************************************************
46    
# Line 154  Line 141 
141    
142    fun error msg = MLRiscErrorMsg.error("Alpha",msg)    fun error msg = MLRiscErrorMsg.error("Alpha",msg)
143    
144      type instrStream = (I.instruction,C.cellset) T.stream
145      type mltreeStream = (T.stm,T.mlrisc list) T.stream
146    
147    (*    (*
148     * This module is used to simulate operations of non-standard widths.     * This module is used to simulate operations of non-standard widths.
# Line 161  Line 150 
150    structure Gen = MLTreeGen(structure T = T    structure Gen = MLTreeGen(structure T = T
151                              val intTy = 64                              val intTy = 64
152                              val naturalWidths = [32,64]                              val naturalWidths = [32,64]
153                                datatype rep = SE | ZE | NEITHER
154                                val rep = SE
155                             )                             )
156    
157    val zeroR   = C.GPReg 31    val zeroR   = C.r31
158    val zeroOpn = I.REGop zeroR    val zeroOpn = I.REGop zeroR
159      fun LI i    = T.LI(T.I.fromInt(32, i))
160      fun toInt i = T.I.toInt(32, i)
161      val int_0   = T.I.int_0
162      val int_1   = T.I.int_1
163      fun EQ(x:IntInf.int,y) = x=y
164    
165    (*    (*
166     * Specialize the modules for multiplication/division     * Specialize the modules for multiplication/division
# Line 177  Line 172 
172    
173       val intTy = 32       val intTy = 32
174    
175       type arg  = {r1:C.register,r2:C.register,d:C.register}       type arg  = {r1:C.cell,r2:C.cell,d:C.cell}
176       type argi = {r:C.register,i:int,d:C.register}       type argi = {r:C.cell,i:int,d:C.cell}
177    
178       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
179       fun add{r1,r2,d} = I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}       fun add{r1,r2,d} = I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}
# Line 191  Line 186 
186         | slli{r,i,d}   =         | slli{r,i,d}   =
187            let val tmp = C.newReg()            let val tmp = C.newReg()
188            in  [I.OPERATE{oper=I.SLL,ra=r,rb=I.IMMop i,rc=tmp},            in  [I.OPERATE{oper=I.SLL,ra=r,rb=I.IMMop i,rc=tmp},
189                 I.OPERATE{oper=I.SGNXL,ra=tmp,rb=zeroOpn,rc=d}]                 I.OPERATE{oper=I.ADDL,ra=tmp,rb=zeroOpn,rc=d}]
190            end            end
191    
192       (*       (*
# Line 208  Line 203 
203        *)        *)
204       fun srai{r,i,d} =       fun srai{r,i,d} =
205           let val tmp = C.newReg()           let val tmp = C.newReg()
206           in  [I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=tmp},           in  [I.OPERATE{oper=I.ADDL,ra=r,rb=zeroOpn,rc=tmp},
207                I.OPERATE{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]                I.OPERATE{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
208           end           end
209      )      )
# Line 219  Line 214 
214    
215       val intTy = 64       val intTy = 64
216    
217       type arg  = {r1:C.register,r2:C.register,d:C.register}       type arg  = {r1:C.cell,r2:C.cell,d:C.cell}
218       type argi = {r:C.register,i:int,d:C.register}       type argi = {r:C.cell,i:int,d:C.cell}
219    
220       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
221       fun add{r1,r2,d}= I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}       fun add{r1,r2,d}= I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
# Line 232  Line 227 
227    (* signed, trapping version of multiply and divide *)    (* signed, trapping version of multiply and divide *)
228    structure Mult32 = Multiply32    structure Mult32 = Multiply32
229      (val trapping = true      (val trapping = true
      val signed = true  
230       val multCost = multCost       val multCost = multCost
231       fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDLV,ra=r1,rb=I.REGop r2,rc=d}]       fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDLV,ra=r1,rb=I.REGop r2,rc=d}]
232       fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBLV,ra=r1,rb=I.REGop r2,rc=d}]       fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBLV,ra=r1,rb=I.REGop r2,rc=d}]
# Line 240  Line 234 
234       val sh2addv = NONE       val sh2addv = NONE
235       val sh3addv = NONE       val sh3addv = NONE
236      )      )
237        (val signed = true)
238    
239    (* unsigned, non-trapping version of multiply and divide *)    (* non-trapping version of multiply and divide *)
240    structure Mulu32 = Multiply32    functor Mul32 = Multiply32
241      (val trapping = false      (val trapping = false
      val signed = false  
242       val multCost = multCost       val multCost = multCost
243       fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]       fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]
244       fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBL,ra=r1,rb=I.REGop r2,rc=d}]       fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBL,ra=r1,rb=I.REGop r2,rc=d}]
# Line 254  Line 248 
248       val sh3addv = SOME(fn {r1,r2,d} =>       val sh3addv = SOME(fn {r1,r2,d} =>
249                      [I.OPERATE{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])                      [I.OPERATE{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])
250      )      )
251      structure Mulu32 = Mul32(val signed = false)
252      structure Muls32 = Mul32(val signed = true)
253    
254    (* signed, trapping version of multiply and divide *)    (* signed, trapping version of multiply and divide *)
255    structure Mult64 = Multiply64    structure Mult64 = Multiply64
256      (val trapping = true      (val trapping = true
      val signed = true  
257       val multCost = multCost       val multCost = multCost
258       fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDQV,ra=r1,rb=I.REGop r2,rc=d}]       fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDQV,ra=r1,rb=I.REGop r2,rc=d}]
259       fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBQV,ra=r1,rb=I.REGop r2,rc=d}]       fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBQV,ra=r1,rb=I.REGop r2,rc=d}]
# Line 266  Line 261 
261       val sh2addv = NONE       val sh2addv = NONE
262       val sh3addv = NONE       val sh3addv = NONE
263      )      )
264        (val signed = true)
265    
266    (* unsigned, non-trapping version of multiply and divide *)    (* unsigned, non-trapping version of multiply and divide *)
267    structure Mulu64 = Multiply64    functor Mul64 = Multiply64
268      (val trapping = false      (val trapping = false
      val signed = false  
269       val multCost = multCost       val multCost = multCost
270       fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]       fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]
271       fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBQ,ra=r1,rb=I.REGop r2,rc=d}]       fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBQ,ra=r1,rb=I.REGop r2,rc=d}]
# Line 280  Line 275 
275       val sh3addv = SOME(fn {r1,r2,d} =>       val sh3addv = SOME(fn {r1,r2,d} =>
276                      [I.OPERATE{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])                      [I.OPERATE{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
277      )      )
278      structure Mulu64 = Mul64(val signed = false)
279      structure Muls64 = Mul64(val signed = true)
280    
281    (*    (*
282     * The main stuff     * The main stuff
283     *)     *)
284    
285    datatype times4or8 = TIMES1    datatype times4or8 = TIMES1 | TIMES4 | TIMES8
                      | TIMES4  
                      | TIMES8  
286    datatype zeroOne   = ZERO | ONE | OTHER    datatype zeroOne   = ZERO | ONE | OTHER
287    datatype commutative = COMMUTE | NOCOMMUTE    datatype commutative = COMMUTE | NOCOMMUTE
288    
289      val zeroFR = C.f31
290      val zeroEA = I.Direct zeroR
291      val zeroT  = T.LI int_0
292      val trapb = [I.TRAPB]
293      val zeroImm = I.IMMop 0
294    
295    fun selectInstructions    fun selectInstructions
296          (S.STREAM{emit,init,finish,defineLabel,entryLabel,pseudoOp,annotation,          (instrStream as
297                    blockName,exitBlock,...}) =           S.STREAM{emit,beginCluster,endCluster,
298                      defineLabel,entryLabel,pseudoOp,annotation,
299                      exitBlock,comment,...}) =
300    let    let
301        infix || && << >> ~>>        infix || && << >> ~>>
302    
# Line 306  Line 309 
309        val itow = Word.fromInt        val itow = Word.fromInt
310        val wtoi = Word.toIntX        val wtoi = Word.toIntX
311    
       val zeroFR = C.FPReg 31  
       val zeroEA = I.Direct zeroR  
       val zeroT  = T.LI 0  
   
312        val newReg = C.newReg        val newReg = C.newReg
313        val newFreg = C.newFreg        val newFreg = C.newFreg
       val emit = emit (fn _ => 0)  
   
       val trapb = [I.TRAPB]  
314    
315        (* Choose the appropriate rounding mode to generate.        (* Choose the appropriate rounding mode to generate.
316         * This stuff is used to support the alpha32x SML/NJ backend.         * This stuff is used to support the alpha32x SML/NJ backend.
317           *
318           *
319           * Floating point rounding mode.
320           * When this is set to true, we use the /SU rounding mode
321           * (chopped towards zero) for floating point arithmetic.
322           * This flag is only used to support the old alpha32x backend.
323           *
324           * Otherwise, we use /SUD.  This is the default for SML/NJ.
325           *
326         *)         *)
327        val (ADDT,SUBT,MULT,DIVT) =        val (ADDTX,SUBTX,MULTX,DIVTX) =
328             if useSU then (I.ADDTSU,I.SUBTSU,I.MULTSU,I.DIVTSU)             (I.ADDTSUD,I.SUBTSUD,I.MULTSUD,I.DIVTSUD)
329             else          (I.ADDTSUD,I.SUBTSUD,I.MULTSUD,I.DIVTSUD)        val (ADDSX,SUBSX,MULSX,DIVSX) =
330        val (ADDS,SUBS,MULS,DIVS) =              (I.ADDSSUD,I.SUBSSUD,I.MULSSUD,I.DIVSSUD)
            if useSU then (I.ADDSSU,I.SUBSSU,I.MULSSU,I.DIVSSU)  
            else          (I.ADDSSUD,I.SUBSSUD,I.MULSSUD,I.DIVSSUD)  
331    
332        fun mark'(i,[]) = i        fun mark'(i,[]) = i
333          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
# Line 343  Line 346 
346              in  emit(I.LDA{r=r, b=base, d=offset}); r end              in  emit(I.LDA{r=r, b=base, d=offset}); r end
347    
348        (* emit load immed *)        (* emit load immed *)
349        fun loadImmed(n, base, rd, an) =        fun loadImmed(n, base, rd, an) = let
350        if ~32768 <= n andalso n < 32768 then          val n = T.I.toInt32(32, n)
351           mark(I.LDA{r=rd, b=base, d=I.IMMop n},an)        in
352        else          if n = 0 then move(base, rd, an)
353        let val w = itow n          else if ~32768 <= n andalso n < 32768 then
354            val hi = Word.~>>(w, 0w16)            mark(I.LDA{r=rd, b=base, d=I.IMMop(Int32.toInt n)}, an)
355            val lo = Word.andb(w, 0w65535)          else loadImmed32(n, base, rd, an)
           val (hi', lo') =  
              if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)  
           val t = lda(base,I.IMMop(wtoi lo'))  
       in  mark(I.LDAH{r=rd, b=t, d=I.IMMop(wtoi hi')},an)  
356        end        end
357    
358        (* loadImmed32 is used to load int32 and word32 constants.        (* loadImmed32 is used to load int32 and word32 constants.
359         * In either case we sign extend the 32-bit value. This is compatible         * In either case we sign extend the 32-bit value. This is compatible
360         * with LDL which sign extends a 32-bit valued memory location.         * with LDL which sign extends a 32-bit valued memory location.
361         *)         *)
362        fun loadImmed32(0w0, base, rd, an) =        (* TODO:
363             mark(I.OPERATE{oper=I.ADDL, ra=base, rb=zeroOpn, rc=rd},an)         *  Should handle 64 bits if immediate is not in the 32 bit range.
364          | loadImmed32(n, base, rd, an) = let         *)
365              val low = W32.andb(n, 0w65535)  (* unsigned (0 .. 65535) *)        and loadImmed32(n, base, rd, an) = let
366              val high = W32.~>>(n, 0w16)     (* signed (~32768 .. 32768] *)          fun immed(0, high) =
             fun loadimmed(0, high) =  
367                   mark(I.LDAH{r=rd, b=base, d=I.IMMop(high)},an)                   mark(I.LDAH{r=rd, b=base, d=I.IMMop(high)},an)
368                | loadimmed(low, 0) =            | immed(low, 0) =
369                   mark(I.LDA{r=rd, b=base, d=I.IMMop(low)},an)                   mark(I.LDA{r=rd, b=base, d=I.IMMop(low)},an)
370                | loadimmed(low, high) =            | immed(low, high) =
371                   (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});                   (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});
372                    mark(I.LDAH{r=rd, b=rd, d=I.IMMop(high)},an))                 mark(I.LDAH{r=rd, b=rd, d=I.IMMop(high)}, an)
373                   )
374            val w = Word32.fromLargeInt(Int32.toLarge n)
375            val low = W32.andb(w, 0wxffff)
376            val high = W32.~>>(w, 0w16)
377            in            in
378              if W32.<(low, 0w32768) then          if W32.<(low, 0wx8000) then
379                 loadimmed(W32.toInt low, W32.toIntX high)            immed(W32.toInt low, W32.toIntX high)
380              else let (* low = (32768 .. 65535) *)          else let
381                 val lowsgn = W32.-(low, 0w65536) (* signed (~1 .. ~32768)  *)              val low = W32.toIntX(W32.-(low, 0wx10000))
382                 val highsgn = W32.+(high, 0w1)   (* (~32768 .. 32768) *)              val high = W32.toIntX(W32.+(high, 0w1))
                val ilow = W32.toIntX lowsgn  
                val ihigh = W32.toIntX highsgn  
383               in               in
384                 if ihigh <> 32768 then loadimmed(ilow, ihigh)              if high <> 0x8000 then immed(low, high)
385                 else              else let (* transition of high from pos to neg *)
386                 let val tmpR1 = newReg()                  val tmpR1 = newReg()
387                     val tmpR2 = newReg()                     val tmpR2 = newReg()
388                    val tmpR3=newReg()
389                 in                 in
390                   (* you gotta do what you gotta do! *)                  (* you just gotta do, what you gotta do! *)
391                   emit(I.LDA{r=rd, b=base, d=I.IMMop(ilow)});                  emit(I.LDA{r=tmpR3, b=base, d=I.IMMop(low)});
392                   emit(I.OPERATE{oper=I.ADDL, ra=zeroR, rb=I.IMMop 1, rc=tmpR1});                  emit(I.OPERATE{oper=I.ADDQ, ra=zeroR, rb=I.IMMop 1, rc=tmpR1});
393                   emit(I.OPERATE{oper=I.SLL, ra=tmpR1, rb=I.IMMop 31, rc=tmpR2});                   emit(I.OPERATE{oper=I.SLL, ra=tmpR1, rb=I.IMMop 31, rc=tmpR2});
394                   mark(I.OPERATE{oper=I.ADDL, ra=tmpR2, rb=I.REGop rd, rc=rd},an)                  mark(I.OPERATE{oper=I.ADDQ, ra=tmpR2, rb=I.REGop tmpR3, rc=rd},an)
395                 end                 end
396               end               end
397             end             end
398    
       (* emit load immed *)  
       fun loadConst(c,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.CONSTop c},an)  
399    
400        (* emit load label *)        (* emit load label expression *)
401        fun loadLabel(l,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.LABop l},an)        and loadLabexp(le,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.LABop le},an)
402    
403        (* emit a copy *)        (* emit a copy *)
404        fun copy(dst,src,an) =        and copy(dst,src,an) =
405            mark(I.COPY{dst=dst,src=src,impl=ref NONE,            mark(I.COPY{dst=dst,src=src,impl=ref NONE,
406                        tmp=case dst of                        tmp=case dst of
407                             [_] => NONE | _ => SOME(I.Direct(newReg()))},an)                             [_] => NONE | _ => SOME(I.Direct(newReg()))},an)
408    
409        (* emit a floating point copy *)        (* emit a floating point copy *)
410        fun fcopy(dst,src,an) =        and fcopy(dst,src,an) =
411            mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,            mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,
412                        tmp=case dst of                        tmp=case dst of
413                             [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)                             [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)
414    
415        fun move(s,d,an) =        and move(s,d,an) =
416            if s = d orelse d = zeroR then () else            if C.sameCell(s,d) orelse C.sameCell(d,zeroR) then () else
417            mark(I.COPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)            mark(I.COPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)
418    
419        fun fmove(s,d,an) =        and fmove(s,d,an) =
420            if s = d orelse d = zeroFR then () else            if C.sameCell(s,d) orelse C.sameCell(d,zeroFR) then () else
421            mark(I.FCOPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)            mark(I.FCOPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)
422    
423         (* emit an sign extension op *)         (* emit an sign extension op *)
424        fun signExt32(r,d) =        and signExt32(r,d) =
425            emit(I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=d})            emit(I.OPERATE{oper=I.ADDL,ra=r,rb=zeroOpn,rc=d})
426    
427        (* emit an commutative arithmetic op *)        (* emit an commutative arithmetic op *)
428        fun commArith(opcode,a,b,d,an) =        and commArith(opcode,a,b,d,an) =
429            case (opn a,opn b) of            case (opn a,opn b) of
430              (I.REGop r,i) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)              (I.REGop r,i) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)
431            | (i,I.REGop r) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)            | (i,I.REGop r) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)
# Line 465  Line 464 
464        (* convert an expression into an operand *)        (* convert an expression into an operand *)
465        and opn(T.REG(_,r)) = I.REGop r        and opn(T.REG(_,r)) = I.REGop r
466          | opn(e as T.LI n) =          | opn(e as T.LI n) =
467              if n <= 255 andalso n >= 0 then I.IMMop n              if IntInf.<=(n, T.I.int_0xff) andalso IntInf.>=(n, T.I.int_0) then
468                  I.IMMop(toInt(n))
469              else let val tmpR = newReg()              else let val tmpR = newReg()
470                   in  loadImmed(n,zeroR,tmpR,[]); I.REGop tmpR end                   in  loadImmed(n,zeroR,tmpR,[]); I.REGop tmpR end
471          | opn(e as T.LI32 w) =          | opn(e as (T.CONST _ | T.LABEL _)) = I.LABop e
472              if w <= 0w255 then I.IMMop(W32.toIntX w)          | opn(T.LABEXP x) = I.LABop x
             else let val tmpR = newReg()  
                  in  loadImmed32(w,zeroR,tmpR,[]); I.REGop tmpR end  
         | opn(T.CONST c) = I.CONSTop c  
473          | opn e = I.REGop(expr e)          | opn e = I.REGop(expr e)
474    
475        (* compute base+displacement from an expression *)        (* compute base+displacement from an expression
476           *)
477        and addr exp =        and addr exp =
478            case exp of            let fun toLexp(I.IMMop i) = T.LI(IntInf.fromInt i)
479              T.ADD(_,e,T.LI n) => makeEA(expr e,n)                  | toLexp(I.LABop le) = le
480            | T.ADD(_,T.LI n,e) => makeEA(expr e,n)                  | toLexp _ = error "addr.toLexp"
481            | T.ADD(_,e,T.CONST c) => (expr e,I.CONSTop c)  
482            | T.ADD(_,T.CONST c,e) => (expr e,I.CONSTop c)                fun add(t,n,I.IMMop m)  =
483            | T.SUB(_,e,T.LI n) => makeEA(expr e,~n)                     I.IMMop(toInt(T.I.ADD(t,n,IntInf.fromInt m)))
484            | e => makeEA(expr e,0)                  | add(t,n,I.LABop le) = I.LABop(T.ADD(t,T.LI n,le))
485                    | add(t,n,_) = error "addr.add"
486    
487                  fun addLe(ty,le,I.IMMop 0) = I.LABop le
488                    | addLe(ty,le,disp) = I.LABop(T.ADD(ty,le,toLexp disp))
489    
490                  fun sub(t,n,I.IMMop m) =
491                      I.IMMop(toInt(T.I.SUB(t,IntInf.fromInt m,n)))
492                    | sub(t,n,I.LABop le) = I.LABop(T.SUB(t,le,T.LI n))
493                    | sub(t,n,_) = error "addr.sub"
494    
495                  fun subLe(ty,le,I.IMMop 0) = I.LABop le
496                    | subLe(ty,le,disp) = I.LABop(T.SUB(ty,le,toLexp disp))
497    
498                  (* Should really take into account of the address width XXX *)
499                  fun fold(T.ADD(t,e,T.LI n),disp) = fold(e,add(t,n,disp))
500                    | fold(T.ADD(t,e,x as T.CONST _),disp) = fold(e,addLe(t,x,disp))
501                    | fold(T.ADD(t,e,x as T.LABEL _),disp) = fold(e,addLe(t,x,disp))
502                    | fold(T.ADD(t,e,T.LABEXP l),disp) = fold(e,addLe(t,l,disp))
503                    | fold(T.ADD(t,T.LI n,e),disp) = fold(e, add(t,n,disp))
504                    | fold(T.ADD(t,x as T.CONST _,e),disp) = fold(e,addLe(t,x,disp))
505                    | fold(T.ADD(t,x as T.LABEL _,e),disp) = fold(e,addLe(t,x,disp))
506                    | fold(T.ADD(t,T.LABEXP l,e),disp) = fold(e,addLe(t,l,disp))
507                    | fold(T.SUB(t,e,T.LI n),disp) = fold(e,sub(t,n,disp))
508                    | fold(T.SUB(t,e,x as T.CONST _),disp) = fold(e,subLe(t,x,disp))
509                    | fold(T.SUB(t,e,x as T.LABEL _),disp) = fold(e,subLe(t,x,disp))
510                    | fold(T.SUB(t,e,T.LABEXP l),disp) = fold(e,subLe(t,l,disp))
511                    | fold(e,disp) = (expr e,disp)
512    
513              in  makeEA(fold(exp, zeroImm))
514              end
515    
516        (* compute base+displacement+small offset *)        (* compute base+displacement+small offset *)
517        and offset(base,disp as I.IMMop n,off) =        and offset(base,disp as I.IMMop n,off) =
# Line 495  Line 523 
523                     (tmp,I.IMMop off)                     (tmp,I.IMMop off)
524                 end                 end
525             end             end
526            | offset(base,disp as I.LABop le,off) =
527               (base, I.LABop(T.ADD(64,le,T.LI(IntInf.fromInt off))))
528          | offset(base,disp,off) =          | offset(base,disp,off) =
529             let val tmp = newReg()             let val tmp = newReg()
530             in  emit(I.OPERATE{oper=I.ADDQ,ra=base,rb=disp,rc=tmp});             in  emit(I.OPERATE{oper=I.ADDQ,ra=base,rb=disp,rc=tmp});
531                 (tmp,I.IMMop off)                 (tmp,I.IMMop off)
532             end             end
533    
534        (* check if base offset *)        (* check if base offset fits within the field *)
535        and makeEA(base, offset) =        and makeEA(base, off as I.IMMop offset) =
536           if ~32768 <= offset andalso offset <= 32767 then (base, I.IMMop offset)           if ~32768 <= offset andalso offset <= 32767
537             then (base, off)
538           else           else
539           let val tmpR = newReg()           let val tmpR = newReg()
540                  (* unsigned low 16 bits *)                  (* unsigned low 16 bits *)
# Line 515  Line 546 
546               (emit(I.LDAH{r=tmpR, b=base, d=I.IMMop highsgn});               (emit(I.LDAH{r=tmpR, b=base, d=I.IMMop highsgn});
547               (tmpR, I.IMMop lowsgn))               (tmpR, I.IMMop lowsgn))
548           end           end
549           | makeEA(base, offset) = (base, offset)
550    
551        (* look for multiply by 4 and 8 of the given type *)        (* look for multiply by 4 and 8 of the given type *)
552        and times4or8(ty,e) =        and times4or8(ty,e) =
553            let fun f(t,a,n) = if t = ty then            let
554                                 if n = 4 then (TIMES4,a)                fun f(t,a,n) = if t = ty then
555                                 else if n = 8 then (TIMES8,a)                                 if EQ(n, T.I.int_4) then (TIMES4,a)
556                                 else (TIMES1,e)                                 else if EQ(n, T.I.int_8) then (TIMES8,a)
                              else (TIMES1,e)  
               fun g(t,a,n) = if t = ty then  
                                if n = 0w4 then (TIMES4,a)  
                                else if n = 0w8 then (TIMES8,a)  
557                                 else (TIMES1,e)                                 else (TIMES1,e)
558                               else (TIMES1,e)                               else (TIMES1,e)
559    
560                fun u(t,a,n) = if t = ty then                fun u(t,a,n) = if t = ty then
561                                 if n = 2 then (TIMES4,a)                                 if EQ(n, T.I.int_2) then (TIMES4,a)
562                                 else if n = 3 then (TIMES8,a)                                 else if EQ(n, T.I.int_3) then (TIMES8,a)
                                else (TIMES1,e)  
                              else (TIMES1,e)  
               fun v(t,a,n) = if t = ty then  
                                if n = 0w2 then (TIMES4,a)  
                                else if n = 0w3 then (TIMES8,a)  
563                                 else (TIMES1,e)                                 else (TIMES1,e)
564                               else (TIMES1,e)                               else (TIMES1,e)
565            in  case e of            in  case e of
566                  T.MULU(t,a,T.LI n)   => f(t,a,n)                  T.MULU(t,a,T.LI n)   => f(t,a,n)
               | T.MULU(t,a,T.LI32 n) => g(t,a,n)  
567                | T.MULS(t,T.LI n,a)   => f(t,a,n)                | T.MULS(t,T.LI n,a)   => f(t,a,n)
               | T.MULS(t,T.LI32 n,a) => g(t,a,n)  
568                | T.SLL(t,a,T.LI n)    => u(t,a,n)                | T.SLL(t,a,T.LI n)    => u(t,a,n)
               | T.SLL(t,a,T.LI32 n)  => v(t,a,n)  
569                | _                    => (TIMES1,e)                | _                    => (TIMES1,e)
570            end            end
571    
# Line 571  Line 592 
592                (TIMES4,a) => arith(s4sub,a,b,d,an)                (TIMES4,a) => arith(s4sub,a,b,d,an)
593             |  (TIMES8,a) => arith(s8sub,a,b,d,an)             |  (TIMES8,a) => arith(s8sub,a,b,d,an)
594             |  _          =>             |  _          =>
595                  if ty = 64 then
596                (case b of                (case b of
597                   (* use LDA to handle subtraction when possible                   (* use LDA to handle subtraction when possible
598                    * Note: this may have sign extension problems later.                    * Note: this may have sign extension problems later.
599                    *)                    *)
600                   T.LI i => (loadImmed(~i,expr a,d,an) handle Overflow =>                   T.LI i => (loadImmed(T.I.NEGT(32,i),expr a,d,an) handle _ =>
601                                arith(sub,a,b,d,an))                                arith(sub,a,b,d,an))
602                |  _ => arith(sub,a,b,d,an)                |  _ => arith(sub,a,b,d,an)
603                )                ) else arith(sub,a,b,d,an)
604            )            )
605    
606        (* look for special constants *)        (* look for special constants *)
607        and wordOpn(T.LI n) = SOME(W32.fromInt n)        and wordOpn(T.LI n) = SOME(T.I.toWord32(32, n))
         | wordOpn(T.LI32 w) = SOME w  
608          | wordOpn e = NONE          | wordOpn e = NONE
609    
610        (* look for special byte mask constants *)        (* look for special byte mask constants
611        and byteMask(_,SOME 0wx00000000) = SOME 0xff         * IMPORTANT: we must ALWAYS keep the sign bit!
612          | byteMask(_,SOME 0wx000000ff) = SOME 0xfe         *)
613          | byteMask(_,SOME 0wx0000ff00) = SOME 0xfd        and byteMask(_,SOME 0wx00000000) = 0xff
614          | byteMask(_,SOME 0wx0000ffff) = SOME 0xfc          | byteMask(_,SOME 0wx000000ff) = 0xfe
615          | byteMask(_,SOME 0wx00ff0000) = SOME 0xfb          | byteMask(_,SOME 0wx0000ff00) = 0xfd
616          | byteMask(_,SOME 0wx00ff00ff) = SOME 0xfa          | byteMask(_,SOME 0wx0000ffff) = 0xfc
617          | byteMask(_,SOME 0wx00ffff00) = SOME 0xf9          | byteMask(_,SOME 0wx00ff0000) = 0xfb
618          | byteMask(_,SOME 0wx00ffffff) = SOME 0xf8          | byteMask(_,SOME 0wx00ff00ff) = 0xfa
619            (* IMPORTANT:          | byteMask(_,SOME 0wx00ffff00) = 0xf9
620             * When ty is 64 then we assume the top 32 bits are all zeros.          | byteMask(_,SOME 0wx00ffffff) = 0xf8
621             * Otherwise, we must keep the sign bit!!!!          | byteMask(ty,SOME 0wxff000000) = if ty = 64 then 0xf7 else 0x07
622             *)          | byteMask(ty,SOME 0wxff0000ff) = if ty = 64 then 0xf6 else 0x06
623          | byteMask(ty,SOME 0wxff000000) = SOME(if ty = 64 then 0xf7 else 0x07)          | byteMask(ty,SOME 0wxff00ff00) = if ty = 64 then 0xf5 else 0x05
624          | byteMask(ty,SOME 0wxff0000ff) = SOME(if ty = 64 then 0xf6 else 0x06)          | byteMask(ty,SOME 0wxff00ffff) = if ty = 64 then 0xf4 else 0x04
625          | byteMask(ty,SOME 0wxff00ff00) = SOME(if ty = 64 then 0xf5 else 0x05)          | byteMask(ty,SOME 0wxffff0000) = if ty = 64 then 0xf3 else 0x03
626          | byteMask(ty,SOME 0wxff00ffff) = SOME(if ty = 64 then 0xf4 else 0x04)          | byteMask(ty,SOME 0wxffff00ff) = if ty = 64 then 0xf2 else 0x02
627          | byteMask(ty,SOME 0wxffff0000) = SOME(if ty = 64 then 0xf3 else 0x03)          | byteMask(ty,SOME 0wxffffff00) = if ty = 64 then 0xf1 else 0x01
628          | byteMask(ty,SOME 0wxffff00ff) = SOME(if ty = 64 then 0xf2 else 0x02)          | byteMask(ty,SOME 0wxffffffff) = if ty = 64 then 0xf0 else 0x00
629          | byteMask(ty,SOME 0wxffffff00) = SOME(if ty = 64 then 0xf1 else 0x01)          | byteMask _ = ~1
         | byteMask(ty,SOME 0wxffffffff) = SOME(if ty = 64 then 0xf0 else 0x00)  
         | byteMask _ = NONE  
630    
631        (* generate an and instruction        (* generate an and instruction
632         * look for special masks.         * look for special masks.
633         *)         *)
634        and andb(ty,a,b,d,an) =        and andb(ty,a,b,d,an) =
635            case byteMask(ty,wordOpn a) of            case byteMask(ty,wordOpn a) of
636               SOME mask => arith(I.ZAP,b,T.LI mask,d,an)              ~1 => (case byteMask(ty,wordOpn b) of
637            |  _ =>                      ~1 => commArith(I.AND,a,b,d,an)
638            case byteMask(ty,wordOpn b) of                    | mask => arith(I.ZAP,a,LI mask,d,an)
639               SOME mask => arith(I.ZAP,a,T.LI mask,d,an)                    )
640            | _ => commArith(I.AND,a,b,d,an)            | mask => arith(I.ZAP,b,LI mask,d,an)
641    
642        (* generate sll/sra/srl *)        (* generate sll/sra/srl *)
643        and sll32(a,b,d,an) =        and sll32(a,b,d,an) =
# Line 646  Line 665 
665            let val ra = expr a            let val ra = expr a
666                val rb = opn b                val rb = opn b
667                val t  = newReg()                val t  = newReg()
668            in  signExt32(ra,t);            in  (* On the alpha, all 32 bit values are already sign extended.
669                mark(I.OPERATE{oper=I.SRA,ra=t,rb=rb,rc=d},an)                 * So no sign extension is necessary.
670                   * signExt32(ra,t);
671                   * mark(I.OPERATE{oper=I.SRA,ra=t,rb=rb,rc=d},an)
672                   *)
673                  mark(I.OPERATE{oper=I.SRA,ra=ra,rb=rb,rc=d},an)
674            end            end
675    
676        and sra64(a,b,d,an) =        and sra64(a,b,d,an) =
# Line 678  Line 701 
701                in mark'(instr,an)::trapb end                in mark'(instr,an)::trapb end
702                fun const(e,i) =                fun const(e,i) =
703                    let val r = expr e                    let val r = expr e
704                    in  if !useMultByConst andalso i >= 0 andalso i < 256 then                    in  if !useMultByConst andalso
705                           mark'(gen{ra=r,rb=I.IMMop i,rc=rd},an)::trapb                             IntInf.>=(i, T.I.int_0) andalso
706                               IntInf.<(i, T.I.int_0x100) then
707                             mark'(gen{ra=r,rb=I.IMMop(toInt i),rc=rd},an)::trapb
708                        else                        else
709                           (genConst{r=r,i=i,d=rd}@trapb                           (genConst{r=r,i=toInt i,d=rd}@trapb
710                            handle _ => nonconst(T.REG(ty,r),T.LI i))                            handle _ => nonconst(T.REG(ty,r),T.LI i))
711                    end                    end
               fun constw(e,i) = const(e,Word32.toInt i)  
                                   handle _ => nonconst(e,T.LI32 i)  
712                val instrs =                val instrs =
713                    case (e1,e2) of                  case (e1, e2)
714                       (e1,T.LI i)   => const(e1,i)                  of (_, T.LI i) => const(e1, i)
715                     | (e1,T.LI32 i) => constw(e1,i)                   | (T.LI i, _) => const(e2, i)
                    | (T.LI i,e2)   => const(e2,i)  
                    | (T.LI32 i,e2) => constw(e2,i)  
716                     | _             => nonconst(e1,e2)                     | _             => nonconst(e1,e2)
717            in  app emit instrs            in  app emit instrs
718            end            end
# Line 703  Line 724 
724             * d <- r + i;             * d <- r + i;
725             * d <- if (r > 0) then r else d             * d <- if (r > 0) then r else d
726             *)             *)
727          (*
728        and roundToZero{ty,r,i,d} =        and roundToZero{ty,r,i,d} =
729            (doStmt(T.MV(ty,d,T.ADD(ty,T.REG(ty,r),T.LI i)));            (doStmt(T.MV(ty,d,T.ADD(ty,T.REG(ty,r),T.LI i)));
730             doStmt(T.MV(ty,d,T.COND(ty,T.CMP(ty,T.GE,T.REG(ty,r),T.LI 0),             doStmt(T.MV(ty,d,T.COND(ty,T.CMP(ty,T.GE,T.REG(ty,r),T.LI 0),
731                                     T.REG(ty,r),T.REG(ty,d))))                                     T.REG(ty,r),T.REG(ty,d))))
732            )            )
733           *)
734    
735        (*        (*
736         * Generic division.         * Generic division.
# Line 719  Line 742 
742    
743                fun const(e,i) =                fun const(e,i) =
744                    let val r = expr e                    let val r = expr e
745                    in  genDiv{mode=T.TO_ZERO,roundToZero=roundToZero}                    in  genDiv{mode=T.TO_ZERO,stm=doStmt}
746                              {r=r,i=i,d=rd}                              {r=r,i=toInt i,d=rd}
747                        handle _ => nonconst(T.REG(ty,r),T.LI i)                        handle _ => nonconst(T.REG(ty,r),T.LI i)
748                    end                    end
               fun constw(e,i) = const(e,Word32.toInt i)  
                                   handle _ => nonconst(e,T.LI32 i)  
749                val instrs =                val instrs =
750                    case e2 of                    case e2 of
751                       T.LI i   => const(e1,i)                       T.LI i   => const(e1,i)
                    | T.LI32 i => constw(e1,i)  
752                     | _        => nonconst(e1,e2)                     | _        => nonconst(e1,e2)
753            in  app emit instrs            in  app emit instrs
754            end            end
# Line 811  Line 831 
831            end            end
832    
833        (* generate a load byte with zero extension (page 4-48) *)        (* generate a load byte with zero extension (page 4-48) *)
834        and load8(ea,rd,mem,an) = loadZext(ea,rd,mem,I.EXTBL,an)        and load8(ea,rd,mem,an) =
835              if !byteWordLoadStores then load(I.LDBU,ea,rd,mem,an)
836              else loadZext(ea,rd,mem,I.EXTBL,an)
837    
838        (* generate a load byte with sign extension (page 4-48) *)        (* generate a load byte with sign extension (page 4-48) *)
839        and load8s(ea,rd,mem,an) = loadSext(ea,rd,mem,1,I.EXTQH,56,an)        and load8s(ea,rd,mem,an) =
840              if !byteWordLoadStores then load(I.LDB,ea,rd,mem,an)
841              else loadSext(ea,rd,mem,1,I.EXTQH,56,an)
842    
843        (* generate a load 16 bit *)        (* generate a load 16 bit *)
844        and load16(ea,rd,mem,an) = loadZext(ea,rd,mem,I.EXTWL,an)        and load16(ea,rd,mem,an) =
845              if !byteWordLoadStores then load(I.LDWU,ea,rd,mem,an)
846              else loadZext(ea,rd,mem,I.EXTWL,an)
847    
848        (* generate a load 16 bit with sign extension *)        (* generate a load 16 bit with sign extension *)
849        and load16s(ea,rd,mem,an) = loadSext(ea,rd,mem,2,I.EXTQH,48,an)        and load16s(ea,rd,mem,an) =
850              if !byteWordLoadStores then load(I.LDW,ea,rd,mem,an)
851        (* generate a load 32 bit with zero extension *)            else loadSext(ea,rd,mem,2,I.EXTQH,48,an)
       and load32(ea,rd,mem,an) =  
           if mode32bit then load(I.LDL,ea,rd,mem,an)  
           else let val (base,disp) = addr ea  
                    val tmp   = newReg()  
                in  mark(I.LOAD{ldOp=I.LDL,r=tmp,b=base,d=disp,mem=mem},an);  
                    emit(I.OPERATE{oper=I.ZAP,ra=tmp,rb=I.IMMop 0xf0,rc=rd})  
                end  
852    
853        (* generate a load 32 bit with sign extension *)        (* generate a load 32 bit with sign extension *)
854        and load32s(ea,rd,mem,an) = load(I.LDL,ea,rd,mem,an)        and load32s(ea,rd,mem,an) = load(I.LDL,ea,rd,mem,an)
# Line 862  Line 881 
881    
882        (* generate a store byte *)        (* generate a store byte *)
883        and store8(ea,data,mem,an) =        and store8(ea,data,mem,an) =
884            storeUnaligned(ea,data,mem,I.INSBL,I.MSKBL,an)            if !byteWordLoadStores then store(I.STB, ea, data, mem, an)
885              else storeUnaligned(ea,data,mem,I.INSBL,I.MSKBL,an)
886    
887        (* generate a store16 *)        (* generate a store16 *)
888        and store16(ea,data,mem,an) =        and store16(ea,data,mem,an) =
889            storeUnaligned(ea,data,mem,I.INSWL,I.MSKWL,an)            if !byteWordLoadStores then store(I.STW, ea, data, mem, an)
890              else storeUnaligned(ea,data,mem,I.INSWL,I.MSKWL,an)
891    
892          (* generate conversion from floating point to integer *)
893          and cvtf2i(pseudo,rounding,e,rd,an) =
894              app emit (pseudo{mode=rounding, fs=fexpr e, rd=rd})
895    
896        (* generate an expression and return the register that holds the result *)        (* generate an expression and return the register that holds the result *)
897        and expr(T.REG(_,r)) = r        and expr(e) = let
898          | expr(T.LI 0) = zeroR          fun comp() = let
899          | expr(T.LI32 0w0) = zeroR            val r = newReg()
900          | expr e = let val r = newReg()          in doExpr(e, r, []); r
901                     in  doExpr(e,r,[]); r end          end
902          in
903            case e
904            of T.REG(_, r) => r
905             | T.LI z => if T.I.isZero(z) then zeroR else comp()
906                (* On the alpha: all 32 bit values are already sign extended.
907                 * So no sign extension is necessary
908                 *)
909             | T.SX(64, 32, e) => expr e
910             | T.ZX(64, 32, e) => expr e
911             | _ => comp()
912          end
913    
914        (* generate an expression that targets register d *)        (* generate an expression that targets register d *)
915        and doExpr(e,d,an) =        and doExpr(exp,d,an) =
916            case e of            case exp of
917              T.REG(_,r) => move(r,d,an)              T.REG(_,r) => move(r,d,an)
918            | T.LI n     => loadImmed(n,zeroR,d,an)            | T.LI n     => loadImmed(n,zeroR,d,an)
919            | T.LI32 w   => loadImmed32(w,zeroR,d,an)            | T.LABEL l  => loadLabexp(exp,d,an)
920            | T.LABEL l  => loadLabel(l,d,an)            | T.CONST c  => loadLabexp(exp,d,an)
921            | T.CONST c  => loadConst(c,d,an)            | T.LABEXP le => loadLabexp(le,d,an)
922    
923              (* special optimizations for additions and subtraction              (* special optimizations for additions and subtraction
924               * Question: using LDA for all widths is not really correct               * Question: using LDA for all widths is not really correct
925               * since the result may not fit into the sign extension scheme.               * since the result may not fit into the sign extension scheme.
926               *)               *)
927            | T.ADD(_,e,T.LABEL le) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)            | T.ADD(64,e,T.LABEXP le) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
928            | T.ADD(_,T.LABEL le,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)            | T.ADD(64,T.LABEXP le,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
929            | T.ADD(_,e,T.CONST c)  => mark(I.LDA{r=d,b=expr e,d=I.CONSTop c},an)            | T.ADD(64,e,x as (T.CONST _ | T.LABEL _))  =>
930            | T.ADD(_,T.CONST c,e)  => mark(I.LDA{r=d,b=expr e,d=I.CONSTop c},an)                 mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
931            | T.ADD(_,e,T.LI i)     => loadImmed(i, expr e, d, an)            | T.ADD(64,x as (T.CONST _ | T.LABEL _),e)  =>
932            | T.ADD(_,T.LI i,e)     => loadImmed(i, expr e, d, an)                 mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
933            | T.ADD(_,e,T.LI32 i)   => loadImmed32(i, expr e, d, an)            | T.ADD(64,e,T.LI i)     => loadImmed(i, expr e, d, an)
934            | T.ADD(_,T.LI32 i,e)   => loadImmed32(i, expr e, d, an)            | T.ADD(64,T.LI i,e)     => loadImmed(i, expr e, d, an)
935            | T.SUB(_,a,(T.LI 0 | T.LI32 0w0)) => doExpr(a,d,an)            | T.SUB(sz, a, b as T.LI z)    =>
936                  if T.I.isZero(z) then
937                    doExpr(a,d,an)
938                  else (case sz
939                    of 32 => minus(32,I.SUBL,I.S4SUBL,I.S8SUBL,a,b,d,an)
940                     | 64 => minus(64,I.SUBQ,I.S4SUBQ,I.S8SUBQ,a,b,d,an)
941                     | _ =>  doExpr(Gen.compileRexp exp,d,an)
942                    (*esac*))
943    
944              (* 32-bit support *)              (* 32-bit support *)
945            | T.ADD(32,a,b) => plus(32,I.ADDL,I.S4ADDL,I.S8ADDL,a,b,d,an)            | T.ADD(32,a,b) => plus(32,I.ADDL,I.S4ADDL,I.S8ADDL,a,b,d,an)
946            | T.SUB(32,a,b) => minus(32,I.SUBL,I.S4SUBL,I.S8SUBL,a,b,d,an)            | T.SUB(32,a,b) => minus(32,I.SUBL,I.S4SUBL,I.S8SUBL,a,b,d,an)
947            | T.ADDT(32,a,b) => commArithTrap(I.ADDLV,a,b,d,an)            | T.ADDT(32,a,b) => commArithTrap(I.ADDLV,a,b,d,an)
948            | T.SUBT(32,a,b) => arithTrap(I.SUBLV,a,b,d,an)            | T.SUBT(32,a,b) => arithTrap(I.SUBLV,a,b,d,an)
949            | T.MULT(32,a,b) => (* multTrap(I.MULLV,I.ADDL,I.ADDLV,a,b,d,an) *)            | T.MULT(32,a,b) =>
950                 multiply(32,                 multiply(32,
951                   fn{ra,rb,rc} => I.OPERATEV{oper=I.MULLV,ra=ra,rb=rb,rc=rc},                   fn{ra,rb,rc} => I.OPERATEV{oper=I.MULLV,ra=ra,rb=rb,rc=rc},
952                   Mult32.multiply,a,b,d,trapb,an)                   Mult32.multiply,a,b,d,trapb,an)
953            | T.MULU(32,a,b) => (* mulu(I.MULL,I.ADDL,a,b,d,an) *)            | T.MULU(32,a,b) =>
954                 multiply(32,                 multiply(32,
955                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULL,ra=ra,rb=rb,rc=rc},                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULL,ra=ra,rb=rb,rc=rc},
956                   Mulu32.multiply,a,b,d,[],an)                   Mulu32.multiply,a,b,d,[],an)
957            | T.DIVT(32,a,b) => (* pseudo(PseudoInstrs.divl,a,b,d) *)            | T.MULS(32,a,b) =>
958                 divide(32,PseudoInstrs.divl,Mult32.divide,a,b,d,an)                 multiply(32,
959            | T.DIVU(32,a,b) => (* pseudo(PseudoInstrs.divlu,a,b,d) *)                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULL,ra=ra,rb=rb,rc=rc},
960                 divide(32,PseudoInstrs.divlu,Mulu32.divide,a,b,d,an)                   Muls32.multiply,a,b,d,[],an)
961              | T.DIVT(32,a,b) => divide(32,P.divlv,Mult32.divide,a,b,d,an)
962              | T.DIVU(32,a,b) => divide(32,P.divlu,Mulu32.divide,a,b,d,an)
963              | T.DIVS(32,a,b) => divide(32,P.divl,Muls32.divide,a,b,d,an)
964              | T.REMT(32,a,b) => pseudo(P.remlv,a,b,d)
965              | T.REMU(32,a,b) => pseudo(P.remlu,a,b,d)
966              | T.REMS(32,a,b) => pseudo(P.reml,a,b,d)
967    
968            | T.SLL(32,a,b) => sll32(a,b,d,an)            | T.SLL(32,a,b) => sll32(a,b,d,an)
969            | T.SRA(32,a,b) => sra32(a,b,d,an)            | T.SRA(32,a,b) => sra32(a,b,d,an)
970            | T.SRL(32,a,b) => srl32(a,b,d,an)            | T.SRL(32,a,b) => srl32(a,b,d,an)
# Line 924  Line 974 
974            | T.SUB(64,a,b) => minus(64,I.SUBQ,I.S4SUBQ,I.S8SUBQ,a,b,d,an)            | T.SUB(64,a,b) => minus(64,I.SUBQ,I.S4SUBQ,I.S8SUBQ,a,b,d,an)
975            | T.ADDT(64,a,b) => commArithTrap(I.ADDQV,a,b,d,an)            | T.ADDT(64,a,b) => commArithTrap(I.ADDQV,a,b,d,an)
976            | T.SUBT(64,a,b) => arithTrap(I.SUBQV,a,b,d,an)            | T.SUBT(64,a,b) => arithTrap(I.SUBQV,a,b,d,an)
977            | T.MULT(64,a,b) => (* multTrap(I.MULQV,I.ADDQ,I.ADDQV,a,b,d,an) *)            | T.MULT(64,a,b) =>
978                 multiply(64,                 multiply(64,
979                   fn{ra,rb,rc} => I.OPERATEV{oper=I.MULQV,ra=ra,rb=rb,rc=rc},                   fn{ra,rb,rc} => I.OPERATEV{oper=I.MULQV,ra=ra,rb=rb,rc=rc},
980                   Mult64.multiply,a,b,d,trapb,an)                   Mult64.multiply,a,b,d,trapb,an)
981            | T.MULU(64,a,b) => (* mulu(I.MULQ,I.ADDQ,a,b,d,an) *)            | T.MULU(64,a,b) =>
982                 multiply(64,                 multiply(64,
983                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULQ,ra=ra,rb=rb,rc=rc},                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULQ,ra=ra,rb=rb,rc=rc},
984                   Mulu64.multiply,a,b,d,[],an)                   Mulu64.multiply,a,b,d,[],an)
985            | T.DIVT(64,a,b) => (* pseudo(PseudoInstrs.divq,a,b,d) *)            | T.MULS(64,a,b) =>
986                 divide(64,PseudoInstrs.divq,Mult64.divide,a,b,d,an)                 multiply(64,
987            | T.DIVU(64,a,b) => (* pseudo(PseudoInstrs.divqu,a,b,d) *)                   fn{ra,rb,rc} => I.OPERATE{oper=I.MULQ,ra=ra,rb=rb,rc=rc},
988                 divide(64,PseudoInstrs.divqu,Mulu64.divide,a,b,d,an)                   Muls64.multiply,a,b,d,[],an)
989              | T.DIVT(64,a,b) => divide(64,P.divqv,Mult64.divide,a,b,d,an)
990              | T.DIVU(64,a,b) => divide(64,P.divqu,Mulu64.divide,a,b,d,an)
991              | T.DIVS(64,a,b) => divide(64,P.divq,Muls64.divide,a,b,d,an)
992              | T.REMT(64,a,b) => pseudo(P.remqv,a,b,d)
993              | T.REMU(64,a,b) => pseudo(P.remqu,a,b,d)
994              | T.REMS(64,a,b) => pseudo(P.remq,a,b,d)
995    
996            | T.SLL(64,a,b) => sll64(a,b,d,an)            | T.SLL(64,a,b) => sll64(a,b,d,an)
997            | T.SRA(64,a,b) => sra64(a,b,d,an)            | T.SRA(64,a,b) => sra64(a,b,d,an)
998            | T.SRL(64,a,b) => srl64(a,b,d,an)            | T.SRL(64,a,b) => srl64(a,b,d,an)
# Line 955  Line 1012 
1012            | T.ORB(_,a,b) => commArith(I.BIS,a,b,d,an)            | T.ORB(_,a,b) => commArith(I.BIS,a,b,d,an)
1013            | T.NOTB(_,e) => arith(I.ORNOT,zeroT,e,d,an)            | T.NOTB(_,e) => arith(I.ORNOT,zeroT,e,d,an)
1014    
           | T.CVTI2I(_,T.ZERO_EXTEND,e) => doExpr(e,d,an)  
   
1015              (* loads *)              (* loads *)
1016            | T.CVTI2I(_,T.SIGN_EXTEND,T.LOAD(8,ea,mem)) => load8s(ea,d,mem,an)            | T.SX(_,_,T.LOAD(8,ea,mem)) => load8s(ea,d,mem,an)
1017            | T.CVTI2I(_,T.SIGN_EXTEND,T.LOAD(16,ea,mem)) => load16s(ea,d,mem,an)            | T.SX(_,_,T.LOAD(16,ea,mem))=> load16s(ea,d,mem,an)
1018            | T.CVTI2I(_,T.SIGN_EXTEND,T.LOAD(32,ea,mem)) => load32s(ea,d,mem,an)            | T.SX(_,_,T.LOAD(32,ea,mem))=> load32s(ea,d,mem,an)
1019              | T.ZX((8|16|32|64),_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
1020              | T.ZX((16|32|64),_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
1021              | T.ZX(64,_,T.LOAD(64,ea,mem)) => load(I.LDQ,ea,d,mem,an)
1022            | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)            | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)
1023            | T.LOAD(16,ea,mem) => load16(ea,d,mem,an)            | T.LOAD(16,ea,mem) => load16(ea,d,mem,an)
1024            | T.LOAD(32,ea,mem) => load32(ea,d,mem,an)            | T.LOAD(32,ea,mem) => load32s(ea,d,mem,an)
1025            | T.LOAD(64,ea,mem) => load(I.LDQ,ea,d,mem,an)            | T.LOAD(64,ea,mem) => load(I.LDQ,ea,d,mem,an)
1026    
1027               (* floating -> int conversion *)
1028              | T.CVTF2I(ty,rounding,fty,e) =>
1029                (case (fty,ty) of
1030                   (32,32) => cvtf2i(P.cvtsl,rounding,e,d,an)
1031                 | (32,64) => cvtf2i(P.cvtsq,rounding,e,d,an)
1032                 | (64,32) => cvtf2i(P.cvttl,rounding,e,d,an)
1033                 | (64,64) => cvtf2i(P.cvttq,rounding,e,d,an)
1034                 | _       => doExpr(Gen.compileRexp exp,d,an) (* other cases *)
1035                )
1036    
1037             (* conversion to boolean *)             (* conversion to boolean *)
           | T.COND(_,T.CMP(ty,cond,e1,e2),T.LI 1,T.LI 0) =>  
                compare(ty,cond,e1,e2,d,an)  
           | T.COND(_,T.CMP(ty,cond,e1,e2),T.LI 0,T.LI 1) =>  
                compare(ty,U.negateCond cond,e1,e2,d,an)  
1038            | T.COND(_,T.CMP(ty,cond,e1,e2),x,y) =>            | T.COND(_,T.CMP(ty,cond,e1,e2),x,y) =>
1039                 (case (x, y)
1040                  of (T.LI n, T.LI m) =>
1041                    if EQ(n, int_1) andalso EQ(m, int_0) then
1042                      compare(ty,cond,e1,e2,d,an)
1043                    else if EQ(n, int_0) andalso EQ(m, int_1) then
1044                      compare(ty,T.Basis.negateCond cond,e1,e2,d,an)
1045                    else
1046                 cmove(ty,cond,e1,e2,x,y,d,an)                 cmove(ty,cond,e1,e2,x,y,d,an)
1047                  | _ => cmove(ty,cond,e1,e2,x,y,d,an)
1048                 (*esac*))
1049    
1050            | T.SEQ(s,e) => (doStmt s; doExpr(e,d,an))            | T.LET(s,e) => (doStmt s; doExpr(e, d, an))
1051              | T.MARK(e,A.MARKREG f) => (f d; doExpr(e,d,an))
1052            | T.MARK(e,a) => doExpr(e,d,a::an)            | T.MARK(e,a) => doExpr(e,d,a::an)
1053            | e => doExpr(Gen.compile e,d,an)              (* On the alpha: all 32 bit values are already sign extended.
1054                 * So no sign extension is necessary
1055                 *)
1056              | T.SX(64, 32, e) => doExpr(e, d, an)
1057              | T.ZX(64, 32, e) => doExpr(e, d, an)
1058    
1059              | T.PRED(e, c) => doExpr(e, d, A.CTRLUSE c::an)
1060              | T.REXT e => ExtensionComp.compileRext (reducer()) {e=e, an=an, rd=d}
1061    
1062               (* Defaults *)
1063              | e => doExpr(Gen.compileRexp e,d,an)
1064    
1065         (* Hmmm...  this is the funky thing described in the comments         (* Hmmm...  this is the funky thing described in the comments
1066          * in at the top of the file.  This should be made parametrizable          * in at the top of the file.  This should be made parametrizable
1067          * for other backends.          * for other backends.
1068          *)          *)
1069        and farith(opcode,a,b,d,an) =        and farith(opcode,opcodeSMLNJ,a,b,d,an) =
1070            let val fa = fexpr a            let val fa = fexpr a
1071                val fb = fexpr b                val fb = fexpr b
1072            in  emit(I.DEFFREG d);            in  if SMLNJfloatingPoint then
1073                mark(I.FOPERATEV{oper=opcode,fa=fa,fb=fb,fc=d},an);                     (emit(I.DEFFREG d);
1074                        mark(I.FOPERATEV{oper=opcodeSMLNJ,fa=fa,fb=fb,fc=d},an);
1075                emit(I.TRAPB)                emit(I.TRAPB)
1076                       )
1077                  else mark(I.FOPERATE{oper=opcode,fa=fa,fb=fb,fc=d},an)
1078            end            end
1079    
1080          and farith'(opcode,a,b,d,an) =
1081                mark(I.FOPERATE{oper=opcode,fa=fexpr a,fb=fexpr b,fc=d},an)
1082    
1083          and funary(opcode,e,d,an) = mark(I.FUNARY{oper=opcode,fb=fexpr e,fc=d},an)
1084    
1085    
1086        (* generate an floating point expression        (* generate an floating point expression
1087         * return the register that holds the result         * return the register that holds the result
1088         *)         *)
# Line 997  Line 1090 
1090          | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end          | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end
1091    
1092        (* generate an external floating point operation *)        (* generate an external floating point operation *)
1093        and fcvti2f(gen,e,fd,an) =        and fcvti2f(pseudo,e,fd,an) =
1094            let val opnd = opn e            let val opnd = opn e
1095            in  app emit (gen({opnd=opnd, fd=fd}, reduceOpn))            in  app emit (pseudo({opnd=opnd, fd=fd}, reduceOpn))
1096            end            end
1097    
1098        (* generate a floating point store *)        (* generate a floating point store *)
# Line 1014  Line 1107 
1107              T.FREG(_,f)    => fmove(f,d,an)              T.FREG(_,f)    => fmove(f,d,an)
1108    
1109              (* single precision support *)              (* single precision support *)
1110            | T.FADD(32,a,b) => farith(ADDS,a,b,d,an)            | T.FADD(32,a,b) => farith(I.ADDS,ADDSX,a,b,d,an)
1111            | T.FSUB(32,a,b) => farith(SUBS,a,b,d,an)            | T.FSUB(32,a,b) => farith(I.SUBS,SUBSX,a,b,d,an)
1112            | T.FMUL(32,a,b) => farith(MULS,a,b,d,an)            | T.FMUL(32,a,b) => farith(I.MULS,MULSX,a,b,d,an)
1113            | T.FDIV(32,a,b) => farith(DIVS,a,b,d,an)            | T.FDIV(32,a,b) => farith(I.DIVS,DIVSX,a,b,d,an)
           | T.CVTI2F(32,_,e) => fcvti2f(PseudoInstrs.cvti2s,e,d,an)  
1114    
1115              (* double precision support *)              (* double precision support *)
1116            | T.FADD(64,a,b) => farith(ADDT,a,b,d,an)            | T.FADD(64,a,b) => farith(I.ADDT,ADDTX,a,b,d,an)
1117            | T.FSUB(64,a,b) => farith(SUBT,a,b,d,an)            | T.FSUB(64,a,b) => farith(I.SUBT,SUBTX,a,b,d,an)
1118            | T.FMUL(64,a,b) => farith(MULT,a,b,d,an)            | T.FMUL(64,a,b) => farith(I.MULT,MULTX,a,b,d,an)
1119            | T.FDIV(64,a,b) => farith(DIVT,a,b,d,an)            | T.FDIV(64,a,b) => farith(I.DIVT,DIVTX,a,b,d,an)
1120            | T.CVTI2F(64,_,e) => fcvti2f(PseudoInstrs.cvti2d,e,d,an)  
1121                (* copy sign (correct?) XXX *)
1122              | T.FCOPYSIGN(_,T.FNEG(_,a),b) => farith'(I.CPYSN,a,b,d,an)
1123              | T.FCOPYSIGN(_,a,T.FNEG(_,b)) => farith'(I.CPYSN,a,b,d,an)
1124              | T.FNEG(_,T.FCOPYSIGN(_,a,b)) => farith'(I.CPYSN,a,b,d,an)
1125              | T.FCOPYSIGN(_,a,b)           => farith'(I.CPYS,a,b,d,an)
1126    
1127              (* generic *)              (* generic *)
1128            | T.FABS(_,a)   =>            | T.FABS(_,a)   =>
# Line 1039  Line 1136 
1136            | T.FLOAD(32,ea,mem) => fload(I.LDS,ea,d,mem,an)            | T.FLOAD(32,ea,mem) => fload(I.LDS,ea,d,mem,an)
1137            | T.FLOAD(64,ea,mem) => fload(I.LDT,ea,d,mem,an)            | T.FLOAD(64,ea,mem) => fload(I.LDT,ea,d,mem,an)
1138    
1139              (* misc *)              (* floating/floating conversion
1140            | T.FSEQ(s,e) => (doStmt s; doFexpr(e,d,an))               * Note: it is not necessary to convert single precision
1141            | T.FMARK(e,a) => doFexpr(e,d,a::an)               * to double on the alpha.
1142                 *)
1143              | T.CVTF2F(fty,fty',e) => (* ignore rounding mode for now *)
1144                (case (fty,fty') of
1145                   (64,64) => doFexpr(e,d,an)
1146                 | (64,32) => doFexpr(e,d,an)
1147                 | (32,32) => doFexpr(e,d,an)
1148                 | (32,64) => funary(I.CVTTS,e,d,an) (* use normal rounding *)
1149                 | _       => error "CVTF2F"
1150                )
1151    
1152                (* integer -> floating point conversion *)
1153              | T.CVTI2F(fty,ty,e) =>
1154                let val pseudo =
1155                    case (ty,fty) of
1156                      (ty,32) => if ty <= 32 then P.cvtls else P.cvtqs
1157                    | (ty,64) => if ty <= 32 then P.cvtlt else P.cvtqt
1158                    | _       => error "CVTI2F"
1159                in  fcvti2f(pseudo,e,d,an) end
1160    
1161              | T.FMARK(e,A.MARKREG f) => (f d; doFexpr(e,d,an))
1162              | T.FMARK(e,a) => doFexpr(e,d,a::an)
1163              | T.FPRED(e,c) => doFexpr(e, d, A.CTRLUSE c::an)
1164              | T.FEXT e => ExtensionComp.compileFext (reducer()) {e=e, fd=d, an=an}
1165            | _ => error "doFexpr"            | _ => error "doFexpr"
1166    
1167            (* check whether an expression is andb(e,1) *)            (* check whether an expression is andb(e,1) *)
1168        and isAndb1(T.ANDB(_,e,T.LI 1))     = (true,e)        and isAndb1(e as T.ANDB(_, e1, e2)) = let
1169          | isAndb1(T.ANDB(_,e,T.LI32 0w1)) = (true,e)              fun isOne(n, ei) =
1170          | isAndb1(T.ANDB(_,T.LI 1,e))     = (true,e)                if EQ(n, int_1) then (true, ei) else (false, e)
1171          | isAndb1(T.ANDB(_,T.LI32 0w1,e)) = (true,e)            in
1172                case(e1, e2)
1173                of (T.LI n, _) => isOne(n, e2)
1174                 | (_, T.LI n) => isOne(n, e1)
1175                 | _ => (false, e)
1176              end
1177          | isAndb1 e                       = (false,e)          | isAndb1 e                       = (false,e)
1178    
1179        and zeroOrOne(T.LI 0)     = ZERO        and zeroOrOne(T.LI n) =
1180          | zeroOrOne(T.LI32 0w0) = ZERO          if T.I.isZero n then ZERO
1181          | zeroOrOne(T.LI 1)     = ONE          else if EQ(n, int_1) then ONE
1182          | zeroOrOne(T.LI32 0w1) = ONE               else OTHER
1183          | zeroOrOne _           = OTHER          | zeroOrOne _           = OTHER
1184    
1185        (* compile a branch *)        (* compile a branch *)
1186        and branch(c,e,lab,an) =        and branch(e,lab,an) =
1187            case e of            case e of
1188              T.CMP(ty,cc,e1 as T.LI _,e2) =>              T.CMP(ty,cc,e1 as T.LI _,e2) =>
1189                 branchBS(ty,U.swapCond cc,e2,e1,lab,an)                 branchBS(ty,T.Basis.swapCond cc,e2,e1,lab,an)
           | T.CMP(ty,cc,e1 as T.LI32 _,e2) =>  
                branchBS(ty,U.swapCond cc,e2,e1,lab,an)  
1190            | T.CMP(ty,cc,e1,e2) => branchBS(ty,cc,e1,e2,lab,an)            | T.CMP(ty,cc,e1,e2) => branchBS(ty,cc,e1,e2,lab,an)
1191            | e => mark(I.BRANCH(I.BNE,ccExpr e,lab),an)              (* generate an floating point branch *)
1192              | T.FCMP(fty,cc,e1,e2) =>
1193                let val f1 = fexpr e1
1194                    val f2 = fexpr e2
1195                    fun bcc(cmp,br) =
1196                    let val tmpR = C.newFreg()
1197                    in  emit(I.DEFFREG(tmpR));
1198                        emit(I.FOPERATE{oper=cmp,fa=f1,fb=f2,fc=tmpR});
1199                        emit(I.TRAPB);
1200                        mark(I.FBRANCH{b=br,f=tmpR,lab=lab},an)
1201                    end
1202                    fun fall(cmp1, br1, cmp2, br2) =
1203                    let val tmpR1 = newFreg()
1204                        val tmpR2 = newFreg()
1205                        val fallLab = Label.newLabel ""
1206                    in  emit(I.DEFFREG(tmpR1));
1207                        emit(I.FOPERATE{oper=cmp1, fa=f1, fb=f2, fc=tmpR1});
1208                        emit(I.TRAPB);
1209                        mark(I.FBRANCH{b=br1, f=tmpR1, lab=fallLab},an);
1210                        emit(I.DEFFREG(tmpR2));
1211                        emit(I.FOPERATE{oper=cmp2, fa=f1, fb=f2, fc=tmpR2});
1212                        emit(I.TRAPB);
1213                        mark(I.FBRANCH{b=br2, f=tmpR2, lab=lab},an);
1214                        defineLabel fallLab
1215                    end
1216                    fun bcc2(cmp1, br1, cmp2, br2) =
1217                         (bcc(cmp1, br1); bcc(cmp2, br2))
1218                in  case cc of
1219                      T.==  => bcc(I.CMPTEQSU, I.FBNE)
1220                    | T.?<> => bcc(I.CMPTEQSU, I.FBEQ)
1221                    | T.?   => bcc(I.CMPTUNSU, I.FBNE)
1222                    | T.<=> => bcc(I.CMPTUNSU, I.FBEQ)
1223                    | T.>   => fall(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1224                    | T.>=  => fall(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1225                    | T.?>  => bcc(I.CMPTLESU, I.FBEQ)
1226                    | T.?>= => bcc(I.CMPTLTSU, I.FBEQ)
1227                    | T.<   => bcc(I.CMPTLTSU, I.FBNE)
1228                    | T.<=  => bcc(I.CMPTLESU, I.FBNE)
1229                    | T.?<  => bcc2(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1230                    | T.?<= => bcc2(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBNE)
1231                    | T.<>  => fall(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1232                    | T.?=  => bcc2(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1233                    | _     => error "branch"
1234                end
1235              | e => mark(I.BRANCH{b=I.BNE,r=ccExpr e,lab=lab},an)
1236    
1237        and br(opcode,exp,lab,an) = mark(I.BRANCH(opcode,expr exp,lab),an)        and br(opcode,exp,lab,an) = mark(I.BRANCH{b=opcode,r=expr exp,lab=lab},an)
1238    
1239              (* Use the branch on bit set/clear instruction when possible *)              (* Use the branch on bit set/clear instruction when possible *)
1240        and branchBS(ty,cc,a,b,lab,an)  =        and branchBS(ty,cc,a,b,lab,an)  =
# Line 1083  Line 1249 
1249            (* generate a branch instruction.            (* generate a branch instruction.
1250             * Check for branch on zero as a special case             * Check for branch on zero as a special case
1251             *)             *)
1252        and branchIt(ty,cc,e,T.LI 0,lab,an) = branchIt0(cc,e,lab,an)  
1253          | branchIt(ty,cc,e,T.LI32 0w0,lab,an) = branchIt0(cc,e,lab,an)        and branchIt(ty,cc,e1,e2 as T.LI z,lab,an) =
1254               if T.I.isZero z then branchIt0(cc,e1,lab,an)
1255               else branchItOther(ty,cc,e1,e2,lab,an)
1256          | branchIt(ty,cc,e1,e2,lab,an) = branchItOther(ty,cc,e1,e2,lab,an)          | branchIt(ty,cc,e1,e2,lab,an) = branchItOther(ty,cc,e1,e2,lab,an)
1257    
1258            (* generate a branch instruction.            (* generate a branch instruction.
# Line 1100  Line 1268 
1268          | branchIt0(T.GEU,e,lab,an) = (* always true! *) goto(lab,an)          | branchIt0(T.GEU,e,lab,an) = (* always true! *) goto(lab,an)
1269          | branchIt0(T.LTU,e,lab,an) = (* always false! *) ()          | branchIt0(T.LTU,e,lab,an) = (* always false! *) ()
1270          | branchIt0(T.LEU,e,lab,an) = br(I.BEQ,e,lab,an)  (* never < 0! *)          | branchIt0(T.LEU,e,lab,an) = br(I.BEQ,e,lab,an)  (* never < 0! *)
1271            | branchIt0 _               = error "brnachIt0"
1272    
1273          (* Generate the operands for unsigned comparisons          (* Generate the operands for unsigned comparisons
1274           * Mask out high order bits whenever necessary.           * Mask out high order bits whenever necessary.
# Line 1129  Line 1298 
1298            let val tmpR = newReg()            let val tmpR = newReg()
1299                fun signedCmp(cmp,br) =                fun signedCmp(cmp,br) =
1300                    (emit(I.OPERATE{oper=cmp, ra=expr e1, rb=opn e2, rc=tmpR});                    (emit(I.OPERATE{oper=cmp, ra=expr e1, rb=opn e2, rc=tmpR});
1301                     mark(I.BRANCH(br, tmpR, lab),an)                     mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1302                    )                    )
1303                fun unsignedCmp(ty,cmp,br) =                fun unsignedCmp(ty,cmp,br) =
1304                    let val (x,y) = unsignedCmpOpnds(ty,e1,e2)                    let val (x,y) = unsignedCmpOpnds(ty,e1,e2)
1305                    in  emit(I.OPERATE{oper=cmp,ra=reduceOpn x,rb=y,rc=tmpR});                    in  emit(I.OPERATE{oper=cmp,ra=reduceOpn x,rb=y,rc=tmpR});
1306                        mark(I.BRANCH(br, tmpR, lab),an)                        mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1307                    end                    end
1308            in  case cond of            in  case cond of
1309                  T.LT  => signedCmp(I.CMPLT,I.BNE)                  T.LT  => signedCmp(I.CMPLT,I.BNE)
# Line 1147  Line 1316 
1316                | T.LEU => unsignedCmp(ty,I.CMPULE,I.BNE)                | T.LEU => unsignedCmp(ty,I.CMPULE,I.BNE)
1317                | T.GTU => unsignedCmp(ty,I.CMPULE,I.BEQ)                | T.GTU => unsignedCmp(ty,I.CMPULE,I.BEQ)
1318                | T.GEU => unsignedCmp(ty,I.CMPULT,I.BEQ)                | T.GEU => unsignedCmp(ty,I.CMPULT,I.BEQ)
1319                  | _     => error "branchItOther"
1320            end            end
1321    
1322           (* This function generates a conditional move:           (* This function generates a conditional move:
# Line 1155  Line 1325 
1325            * are supported on the alpha.            * are supported on the alpha.
1326            *)            *)
1327        and cmove(ty,cond,a,b,x,y,d,an) =        and cmove(ty,cond,a,b,x,y,d,an) =
1328            let val _ = doExpr(y,d,[]) (* evaluate false case *)            let val tmp = newReg()
1329                  val _ = doExpr(y,tmp,[]) (* evaluate false case *)
1330    
1331                val (cond,a,b) =                val (cond,a,b) =
1332                  (* move the immed operand to b *)                  (* move the immed operand to b *)
1333                  case a of                  case a of
1334                    (T.LI _ | T.LI32 _ | T.CONST _) =>                    (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
1335                         (MLTreeUtil.swapCond cond,b,a)                      (T.Basis.swapCond cond,b,a)
1336                  | _ => (cond,a,b)                  | _ => (cond,a,b)
1337    
1338                fun sub(a,(T.LI 0 | T.LI32 0w0)) = expr a                fun sub(a, T.LI z) =
1339                       if T.I.isZero z then expr a else expr(T.SUB(ty,a,b))
1340                  | sub(a,b)                     = expr(T.SUB(ty,a,b))                  | sub(a,b)                     = expr(T.SUB(ty,a,b))
1341    
1342                fun cmp(cond,e1,e2) =                fun cmp(cond,e1,e2) =
1343                    let val d = newReg()                    let val flag = newReg()
1344                    in  compare(ty,cond,e1,e2,d,[]); d end                    in  compare(ty,cond,e1,e2,flag,[]); flag end
1345    
1346                val (oper,ra,x,y) =                val (oper,ra,x,y) =
1347                  case (cond,isAndb1 a,zeroOrOne b) of                  case (cond,isAndb1 a,zeroOrOne b) of
# Line 1180  Line 1352 
1352                  | (T.NE,(true,e),ONE)  => (I.CMOVLBC,expr e,x,y)                  | (T.NE,(true,e),ONE)  => (I.CMOVLBC,expr e,x,y)
1353                       (* signed  *)                       (* signed  *)
1354                  | (T.EQ,_,_)           => (I.CMOVEQ,sub(a,b),x,y)                  | (T.EQ,_,_)           => (I.CMOVEQ,sub(a,b),x,y)
1355                  | (T.NE,_,_)           => (I.CMOVEQ,cmp(T.EQ,a,b),y,x)                  | (T.NE,_,_)           => (I.CMOVNE,sub(a,b),x,y)
1356                  | (T.GT,_,_)           => (I.CMOVGT,sub(a,b),x,y)                  | (T.GT,_,_)           => (I.CMOVGT,sub(a,b),x,y)
1357                  | (T.GE,_,_)           => (I.CMOVGE,sub(a,b),x,y)                  | (T.GE,_,_)           => (I.CMOVGE,sub(a,b),x,y)
1358                  | (T.LT,_,_)           => (I.CMOVLT,sub(a,b),x,y)                  | (T.LT,_,_)           => (I.CMOVLT,sub(a,b),x,y)
# Line 1191  Line 1363 
1363                  | (T.LEU,_,_)          => (I.CMOVEQ,cmp(T.GTU,a,b),x,y)                  | (T.LEU,_,_)          => (I.CMOVEQ,cmp(T.GTU,a,b),x,y)
1364                  | (T.GTU,_,_)          => (I.CMOVEQ,cmp(T.LEU,a,b),x,y)                  | (T.GTU,_,_)          => (I.CMOVEQ,cmp(T.LEU,a,b),x,y)
1365                  | (T.GEU,_,_)          => (I.CMOVEQ,cmp(T.LTU,a,b),x,y)                  | (T.GEU,_,_)          => (I.CMOVEQ,cmp(T.LTU,a,b),x,y)
1366            in  mark(I.CMOVE{oper=oper,ra=ra,rb=opn x,rc=d},an) (* true case *)                  | _                    => error "cmove"
1367              in  mark(I.CMOVE{oper=oper,ra=ra,rb=opn x,rc=tmp},an); (* true case *)
1368                  move(tmp, d, [])
1369            end            end
1370    
1371    
# Line 1221  Line 1395 
1395                    end                    end
1396                val (cond,e1,e2) =                val (cond,e1,e2) =
1397                    case e1 of                    case e1 of
1398                      (T.LI _ | T.LI32 _ | T.CONST _) =>                      (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
1399                         (MLTreeUtil.swapCond cond,e2,e1)                         (T.Basis.swapCond cond,e2,e1)
1400                    | _ => (cond,e1,e2)                    | _ => (cond,e1,e2)
1401            in  case cond of            in  case cond of
1402                  T.EQ  => eq(e1,e2,d)                  T.EQ  => eq(e1,e2,d)
# Line 1235  Line 1409 
1409                | T.GEU => unsignedCmp(ty,I.CMPULE,e2,e1,d)                | T.GEU => unsignedCmp(ty,I.CMPULE,e2,e1,d)
1410                | T.LTU => unsignedCmp(ty,I.CMPULT,e1,e2,d)                | T.LTU => unsignedCmp(ty,I.CMPULT,e1,e2,d)
1411                | T.LEU => unsignedCmp(ty,I.CMPULE,e1,e2,d)                | T.LEU => unsignedCmp(ty,I.CMPULE,e1,e2,d)
1412                  | _     => error "compare"
1413            end            end
1414    
1415           (* generate an unconditional branch *)           (* generate an unconditional branch *)
1416        and goto(lab,an) = mark(I.BRANCH(I.BR,zeroR,lab),an)        and goto(lab,an) = mark(I.BRANCH{b=I.BR,r=zeroR,lab=lab},an)
1417    
1418           (* generate an call instruction *)           (* generate an call instruction *)
1419        and call(ea,def,use,mem,an) =        and call(ea,flow,defs,uses,mem,an) =
1420         let val pv = expr ea         let val defs=cellset defs
1421             val returnPtrR = 26             val uses=cellset uses
1422             fun live([],acc) = acc             val instr =
1423               | live(T.GPR(T.REG(_,r))::regs,acc) = live(regs, C.addReg(r,acc))                 case (ea, flow) of
1424               | live(T.CCR(T.CC cc)::regs,acc) = live(regs, C.addReg(cc,acc))                   (T.LABEL lab, [_]) =>
1425               | live(T.FPR(T.FREG(_,f))::regs,acc) = live(regs, C.addFreg(f,acc))                     I.BSR{lab=lab,r=C.returnAddr,defs=defs,uses=uses,mem=mem}
1426               | live(_::regs, acc) = live(regs, acc)                 | _ => I.JSR{r=C.returnAddr,b=expr ea,
1427         in  mark(I.JSR({r=returnPtrR, b=pv, d=0},                              d=0,defs=defs,uses=uses,mem=mem}
1428                        live(def, C.addReg(returnPtrR, C.empty)),         in  mark(instr,an)
                       live(use, C.addReg(pv, C.empty)),mem),an)  
1429         end         end
1430    
1431           (* generate an floating point branch *)        and doCCexpr(T.CC(_,r),d,an) = move(r,d,an)
1432        and fbranch(_,T.FCMP(fty,cc,e1,e2),lab,an) =          | doCCexpr(T.FCC(_,r),d,an) = fmove(r,d,an)
           let val f1 = fexpr e1  
               val f2 = fexpr e2  
               fun bcc(cmp,br) =  
               let val tmpR = C.newFreg()  
               in  emit(I.DEFFREG(tmpR));  
                   emit(I.FOPERATE{oper=cmp,fa=f1,fb=f2,fc=tmpR});  
                   emit(I.TRAPB);  
                   mark(I.FBRANCH(br,tmpR,lab),an)  
               end  
               fun fall(cmp1, br1, cmp2, br2) =  
               let val tmpR1 = newFreg()  
                   val tmpR2 = newFreg()  
                   val fallLab = Label.newLabel ""  
               in  emit(I.DEFFREG(tmpR1));  
                   emit(I.FOPERATE{oper=cmp1, fa=f1, fb=f2, fc=tmpR1});  
                   emit(I.TRAPB);  
                   mark(I.FBRANCH(br1, tmpR1, fallLab),an);  
                   emit(I.DEFFREG(tmpR2));  
                   emit(I.FOPERATE{oper=cmp2, fa=f1, fb=f2, fc=tmpR2});  
                   emit(I.TRAPB);  
                   mark(I.FBRANCH(br2, tmpR2, lab),an);  
                   defineLabel fallLab  
               end  
               fun bcc2(cmp1, br1, cmp2, br2) = (bcc(cmp1, br1); bcc(cmp2, br2))  
           in  case cc of  
                 T.==  => bcc(I.CMPTEQSU, I.FBNE)  
               | T.?<> => bcc(I.CMPTEQSU, I.FBEQ)  
               | T.?   => bcc(I.CMPTUNSU, I.FBNE)  
               | T.<=> => bcc(I.CMPTUNSU, I.FBEQ)  
               | T.>   => fall(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBEQ)  
               | T.>=  => fall(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBEQ)  
               | T.?>  => bcc(I.CMPTLESU, I.FBEQ)  
               | T.?>= => bcc(I.CMPTLTSU, I.FBEQ)  
               | T.<   => bcc(I.CMPTLTSU, I.FBNE)  
               | T.<=  => bcc(I.CMPTLESU, I.FBNE)  
               | T.?<  => bcc2(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBNE)  
               | T.?<=  => bcc2(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBNE)  
               | T.<> => fall(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBEQ)  
               | T.?= => bcc2(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBNE)  
           end  
         | fbranch _ = error "fbranch"  
   
          (* generate an floating point branch *)  
       and doCCexpr(T.CC r,d,an) = move(r,d,an)  
1433          | doCCexpr(T.CMP(ty,cond,e1,e2),d,an)  = compare(ty,cond,e1,e2,d,an)          | doCCexpr(T.CMP(ty,cond,e1,e2),d,an)  = compare(ty,cond,e1,e2,d,an)
1434          | doCCexpr(T.FCMP(fty,cond,e1,e2),d,an) = error "doCCexpr"          | doCCexpr(T.FCMP(fty,cond,e1,e2),d,an) = error "doCCexpr"
1435            | doCCexpr(T.CCMARK(e,A.MARKREG f),d,an) = (f d; doCCexpr(e,d,an))
1436          | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)          | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)
1437            | doCCexpr(T.CCEXT e,d,an) =
1438                 ExtensionComp.compileCCext (reducer()) {e=e, ccd=d, an=an}
1439            | doCCexpr _ = error "doCCexpr"
1440    
1441        and ccExpr(T.CC r) = r        and ccExpr(T.CC(_,r)) = r
1442            | ccExpr(T.FCC(_,r)) = r
1443          | ccExpr e = let val d = newReg()          | ccExpr e = let val d = newReg()
1444                       in  doCCexpr(e,d,[]); d end                       in  doCCexpr(e,d,[]); d end
1445    
# Line 1316  Line 1451 
1451            | T.CCMV(r,e) => doCCexpr(e,r,an)            | T.CCMV(r,e) => doCCexpr(e,r,an)
1452            | T.COPY(ty,dst,src) => copy(dst,src,an)            | T.COPY(ty,dst,src) => copy(dst,src,an)
1453            | T.FCOPY(ty,dst,src) => fcopy(dst,src,an)            | T.FCOPY(ty,dst,src) => fcopy(dst,src,an)
1454            | T.JMP(T.LABEL(LE.LABEL lab),_) => goto(lab,an)            | T.JMP(T.LABEL lab,_) => goto(lab,an)
1455            | T.JMP(e,labs) => mark(I.JMPL({r=zeroR,b=expr e,d=0},labs),an)            | T.JMP(e,labs) => mark(I.JMPL({r=zeroR,b=expr e,d=0},labs),an)
1456            | T.BCC(cond,e,lab) => branch(cond,e,lab,an)            | T.BCC(cc,lab) => branch(cc,lab,an)
1457            | T.FBCC(cond,e,lab) => fbranch(cond,e,lab,an)            | T.CALL{funct,targets,defs,uses,region,...} =>
1458            | T.CALL(e,def,use,mem) => call(e,def,use,mem,an)                call(funct,targets,defs,uses,region,an)
1459            | T.RET => mark(I.RET{r=zeroR,b=26,d=0},an)            | T.RET _ => mark(I.RET{r=zeroR,b=C.returnAddr,d=0},an)
1460            | T.STORE(8,ea,data,mem) => store8(ea,data,mem,an)            | T.STORE(8,ea,data,mem) => store8(ea,data,mem,an)
1461            | T.STORE(16,ea,data,mem) => store16(ea,data,mem,an)            | T.STORE(16,ea,data,mem) => store16(ea,data,mem,an)
1462            | T.STORE(32,ea,data,mem) => store(I.STL,ea,data,mem,an)            | T.STORE(32,ea,data,mem) => store(I.STL,ea,data,mem,an)
1463            | T.STORE(64,ea,data,mem) => store(I.STQ,ea,data,mem,an)            | T.STORE(64,ea,data,mem) => store(I.STQ,ea,data,mem,an)
1464            | T.FSTORE(32,ea,data,mem) => fstore(I.STS,ea,data,mem,an)            | T.FSTORE(32,ea,data,mem) => fstore(I.STS,ea,data,mem,an)
1465            | T.FSTORE(64,ea,data,mem) => fstore(I.STT,ea,data,mem,an)            | T.FSTORE(64,ea,data,mem) => fstore(I.STT,ea,data,mem,an)
1466              | T.DEFINE l => defineLabel l
1467            | T.ANNOTATION(s,a) => stmt(s,a::an)            | T.ANNOTATION(s,a) => stmt(s,a::an)
1468            | _ => error "stmt"            | T.EXT s => ExtensionComp.compileSext (reducer()) {stm=s,an=an}
1469              | s => doStmts (Gen.compileStm s)
1470    
1471          and reducer() =
1472              T.REDUCER{reduceRexp    = expr,
1473                        reduceFexp    = fexpr,
1474                        reduceCCexp   = ccExpr,
1475                        reduceStm     = stmt,
1476                        operand       = opn,
1477                        reduceOperand = reduceOpn,
1478                        addressOf     = addr,
1479                        emit          = mark,
1480                        instrStream   = instrStream,
1481                        mltreeStream  = self()
1482                       }
1483    
1484        and doStmt s = stmt(s,[])        and doStmt s = stmt(s,[])
1485          and doStmts ss = app doStmt ss
1486    
1487        fun mltreeComp mltree =         (* convert mlrisc to cellset:
1488        let (* condition code registers are mapped onto general registers *)          * condition code registers are mapped onto general registers
1489            fun cc(T.CCR(T.CC cc)) = T.GPR(T.REG(32,cc))          *)
1490              | cc r = r        and cellset mlrisc =
1491            fun comp(T.PSEUDO_OP pOp)    = pseudoOp pOp            let fun g([],acc) = acc
1492              | comp(T.DEFINELABEL lab)  = defineLabel lab                  | g(T.GPR(T.REG(_,r))::regs,acc)  = g(regs,C.addReg(r,acc))
1493              | comp(T.ENTRYLABEL lab)   = entryLabel lab                  | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
1494              | comp(T.BEGINCLUSTER)     = init 0                  | g(T.CCR(T.CC(_,cc))::regs,acc)  = g(regs,C.addReg(cc,acc))
1495              | comp(T.CODE stms)        = app doStmt stms                  | g(T.CCR(T.FCC(_,cc))::regs,acc) = g(regs,C.addReg(cc,acc))
1496              | comp(T.BLOCK_NAME name)  = blockName name                  | g(_::regs, acc) = g(regs, acc)
1497              | comp(T.BLOCK_ANNOTATION a) = annotation a            in  g(mlrisc, C.empty) end
1498              | comp(T.ENDCLUSTER regmap)= finish regmap  
1499              | comp(T.ESCAPEBLOCK regs) = exitBlock (map cc regs)        and self() =
1500              | comp _ = error "mltreeComp"            S.STREAM
1501        in  comp mltree           { beginCluster= beginCluster,
1502        end             endCluster  = endCluster,
1503               emit        = doStmt,
1504     in { mltreeComp = mltreeComp,             pseudoOp    = pseudoOp,
1505          mlriscComp = doStmt,             defineLabel = defineLabel,
1506          emitInstr  = emit             entryLabel  = entryLabel,
1507               comment     = comment,
1508               annotation  = annotation,
1509               exitBlock   = fn regs => exitBlock(cellset regs)
1510        }        }
1511       in  self()
1512     end     end
1513    
1514  end  end

Legend:
Removed from v.409  
changed lines
  Added in v.788

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