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 1117, Wed Mar 6 15:29:24 2002 UTC
# Line 5  Line 5 
5   *   *
6   * -- Allen   * -- Allen
7   *   *
8   * Notes: places with optimizations are marked ***OPT***   * Notes: places with optimizations are marked ***OPT**n*
9   *)   *)
10    
11    
12  functor Alpha  functor Alpha
13     (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  
14      structure PseudoInstrs : ALPHA_PSEUDO_INSTR      structure PseudoInstrs : ALPHA_PSEUDO_INSTR
15         where I = AlphaInstr         where I = AlphaInstr
16        structure ExtensionComp : MLTREE_EXTENSION_COMP
17        (* When this flag is set:                          where I = AlphaInstr
18         * (1) 32 bit loads are always sign extended.                            and T = AlphaInstr.T
        *)  
     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 *)  
19    
20        (* Cost of multiplication in cycles *)        (* Cost of multiplication in cycles *)
21      val multCost : int ref      val multCost : int ref
22    
23        (* Should we just use the native multiply by a constant? *)        (* Should we just use the native multiply by a constant? *)
24      val useMultByConst : bool ref      val useMultByConst : bool ref
25    
26          (* Should we use SUD flags for floating point and generate DEFFREG?
27           * This should be set to false for C-like clients but true for SML/NJ.
28           *)
29        val SMLNJfloatingPoint : bool
30    
31          (* Should we use generate special byte/word load instructions
32           * like LDBU, LDWU, STB, STW.
33           *)
34        val byteWordLoadStores : bool ref
35     ) : MLTREECOMP =     ) : MLTREECOMP =
36  struct  struct
37    
   structure S   = Stream  
   structure T   = AlphaMLTree  
   structure R   = AlphaMLTree.Region  
38    structure I   = AlphaInstr    structure I   = AlphaInstr
39    structure C   = AlphaInstr.C    structure C   = I.C
40    structure LE  = LabelExp    structure T   = I.T
41      structure TS  = ExtensionComp.TS
42      structure R   = T.Region
43    structure W32 = Word32    structure W32 = Word32
44    structure U   = MLTreeUtil    structure P   = PseudoInstrs
45      structure A   = MLRiscAnnotations
46      structure CB  = CellsBasis
47      structure CFG = ExtensionComp.CFG
48    
49   (*********************************************************   (*********************************************************
50    
# Line 150  Line 141 
141    "OpenVMS Alpha Software" (Part II of the Alpha Architecture    "OpenVMS Alpha Software" (Part II of the Alpha Architecture
142    Manual).  This stuff should apply to Unix (OSF1) as well as VMS.    Manual).  This stuff should apply to Unix (OSF1) as well as VMS.
143    
144    
145    
146    
147    
148    
149    
150                    -------------------o*o----------------------
151                               LIVE/KILL instructions
152                                     Nov 28, 2001
153                                      Lal George
154    
155      The mechanism described above is now obsolete. We no longer use
156      the DEFFREG instruction but the zero length LIVE instruction.
157      Therefore the code that gets generated is something like;
158    
159            f1 := f2 + f3
160            trap
161            LIVE f1, f2, f3
162    
163      The live ranges for f1, f2, and f3 are extended by the LIVE
164      instruction, and are live simultaneously and therefore cannot
165      be allocated to the same register.
166    
167      Multiple floating point instructions should be surrounded
168      by parallel copies. That is to say, if we have:
169    
170            f1 := f2 + f3
171            trapb
172            LIVE f1, f2, f3
173    
174            f4 := f1 * f2
175            trapb
176            LIVE f1, f2, f4
177    
178      Then the sequence above should be transformed to:
179    
180            [f2', f3'] := [f1, f2] ; parallel copy
181            f1' := f2' + f3'
182            f4' := f1' * f2'
183            trapb
184            LIVE f1', f2', f3', f4'
185            [f4] := [f4']  ; copy assuming f4 is the only value live.
186    
187      The parallel copies are to ensure that the primed variables will
188      not spill, and there should never be more than K reigsters in the LIVE
189      instruction (K is the number of registers on the machine).
190    ****************************************************************)    ****************************************************************)
191    
192    fun error msg = MLRiscErrorMsg.error("Alpha",msg)    fun error msg = MLRiscErrorMsg.error("Alpha",msg)
193    
194      type instrStream = (I.instruction, C.cellset, CFG.cfg) TS.stream
195      type mltreeStream = (T.stm, T.mlrisc list, CFG.cfg) TS.stream
196    
197    (*    (*
198     * This module is used to simulate operations of non-standard widths.     * This module is used to simulate operations of non-standard widths.
199     *)     *)
200    structure Gen = MLTreeGen(structure T = T    structure Gen = MLTreeGen(structure T = T
201                                structure Cells = C
202                              val intTy = 64                              val intTy = 64
203                              val naturalWidths = [32,64]                              val naturalWidths = [32,64]
204                                datatype rep = SE | ZE | NEITHER
205                                val rep = SE
206                             )                             )
207    
208    val zeroR   = C.GPReg 31    val zeroR   = C.r31
209    val zeroOpn = I.REGop zeroR    val zeroOpn = I.REGop zeroR
210      fun LI i    = T.LI(T.I.fromInt(32, i))
211      fun toInt i = T.I.toInt(32, i)
212      val int_0   = T.I.int_0
213      val int_1   = T.I.int_1
214      fun EQ(x:IntInf.int,y) = x=y
215    
216    (*    (*
217     * Specialize the modules for multiplication/division     * Specialize the modules for multiplication/division
# Line 174  Line 220 
220    functor Multiply32 = MLTreeMult    functor Multiply32 = MLTreeMult
221      (structure I = I      (structure I = I
222       structure T = T       structure T = T
223         structure CB = CellsBasis
224    
225       val intTy = 32       val intTy = 32
226    
227       type arg  = {r1:C.register,r2:C.register,d:C.register}       type arg  = {r1:CB.cell,r2:CB.cell,d:CB.cell}
228       type argi = {r:C.register,i:int,d:C.register}       type argi = {r:CB.cell,i:int,d:CB.cell}
229    
230       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}       fun mov{r,d}    = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
231       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}
232       (*       (*
233        * How to left shift by a constant (32bits)        * How to left shift by a constant (32bits)
234        *)        *)
235       fun slli{r,i=1,d} = [I.OPERATE{oper=I.ADDL,ra=r,rb=I.REGop r,rc=d}]       fun slli{r,i=1,d} = [I.operate{oper=I.ADDL,ra=r,rb=I.REGop r,rc=d}]
236         | slli{r,i=2,d} = [I.OPERATE{oper=I.S4ADDL,ra=r,rb=zeroOpn,rc=d}]         | slli{r,i=2,d} = [I.operate{oper=I.S4ADDL,ra=r,rb=zeroOpn,rc=d}]
237         | slli{r,i=3,d} = [I.OPERATE{oper=I.S8ADDL,ra=r,rb=zeroOpn,rc=d}]         | slli{r,i=3,d} = [I.operate{oper=I.S8ADDL,ra=r,rb=zeroOpn,rc=d}]
238         | slli{r,i,d}   =         | slli{r,i,d}   =
239            let val tmp = C.newReg()            let val tmp = C.newReg()
240            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},
241                 I.OPERATE{oper=I.SGNXL,ra=tmp,rb=zeroOpn,rc=d}]                 I.operate{oper=I.ADDL,ra=tmp,rb=zeroOpn,rc=d}]
242            end            end
243    
244       (*       (*
# Line 199  Line 246 
246        *)        *)
247       fun srli{r,i,d} =       fun srli{r,i,d} =
248           let val tmp = C.newReg()           let val tmp = C.newReg()
249           in  [I.OPERATE{oper=I.ZAP,ra=r,rb=I.IMMop 0xf0,rc=tmp},           in  [I.operate{oper=I.ZAP,ra=r,rb=I.IMMop 0xf0,rc=tmp},
250                I.OPERATE{oper=I.SRL,ra=tmp,rb=I.IMMop i,rc=d}]                I.operate{oper=I.SRL,ra=tmp,rb=I.IMMop i,rc=d}]
251           end           end
252    
253       (*       (*
# Line 208  Line 255 
255        *)        *)
256       fun srai{r,i,d} =       fun srai{r,i,d} =
257           let val tmp = C.newReg()           let val tmp = C.newReg()
258           in  [I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=tmp},           in  [I.operate{oper=I.ADDL,ra=r,rb=zeroOpn,rc=tmp},
259                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}]
260           end           end
261      )      )
262    
263    functor Multiply64 = MLTreeMult    functor Multiply64 = MLTreeMult
264      (structure I = I      (structure I = I
265       structure T = T       structure T = T
266         structure CB = CellsBasis
267    
268       val intTy = 64       val intTy = 64
269    
270       type arg  = {r1:C.register,r2:C.register,d:C.register}       type arg  = {r1:CB.cell, r2:CB.cell, d:CB.cell}
271       type argi = {r:C.register,i:int,d:C.register}       type argi = {r:CB.cell, i:int, d:CB.cell}
272    
273       fun mov{r,d}    = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}       fun mov{r,d}    = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
274       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}
275       fun slli{r,i,d} = [I.OPERATE{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]       fun slli{r,i,d} = [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
276       fun srli{r,i,d} = [I.OPERATE{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]       fun srli{r,i,d} = [I.operate{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
277       fun srai{r,i,d} = [I.OPERATE{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]       fun srai{r,i,d} = [I.operate{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
278      )      )
279    
280    (* signed, trapping version of multiply and divide *)    (* signed, trapping version of multiply and divide *)
281    structure Mult32 = Multiply32    structure Mult32 = Multiply32
282      (val trapping = true      (val trapping = true
      val signed = true  
283       val multCost = multCost       val multCost = multCost
284       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}]
285       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}]
286       val sh1addv = NONE       val sh1addv = NONE
287       val sh2addv = NONE       val sh2addv = NONE
288       val sh3addv = NONE       val sh3addv = NONE
289      )      )
290        (val signed = true)
291    
292    (* unsigned, non-trapping version of multiply and divide *)    (* non-trapping version of multiply and divide *)
293    structure Mulu32 = Multiply32    functor Mul32 = Multiply32
294      (val trapping = false      (val trapping = false
      val signed = false  
295       val multCost = multCost       val multCost = multCost
296       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}]
297       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}]
298       val sh1addv = NONE       val sh1addv = NONE
299       val sh2addv = SOME(fn {r1,r2,d} =>       val sh2addv = SOME(fn {r1,r2,d} =>
300                      [I.OPERATE{oper=I.S4ADDL,ra=r1,rb=I.REGop r2,rc=d}])                      [I.operate{oper=I.S4ADDL,ra=r1,rb=I.REGop r2,rc=d}])
301       val sh3addv = SOME(fn {r1,r2,d} =>       val sh3addv = SOME(fn {r1,r2,d} =>
302                      [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}])
303      )      )
304      structure Mulu32 = Mul32(val signed = false)
305      structure Muls32 = Mul32(val signed = true)
306    
307    (* signed, trapping version of multiply and divide *)    (* signed, trapping version of multiply and divide *)
308    structure Mult64 = Multiply64    structure Mult64 = Multiply64
309      (val trapping = true      (val trapping = true
      val signed = true  
310       val multCost = multCost       val multCost = multCost
311       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}]
312       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}]
313       val sh1addv = NONE       val sh1addv = NONE
314       val sh2addv = NONE       val sh2addv = NONE
315       val sh3addv = NONE       val sh3addv = NONE
316      )      )
317        (val signed = true)
318    
319    (* unsigned, non-trapping version of multiply and divide *)    (* unsigned, non-trapping version of multiply and divide *)
320    structure Mulu64 = Multiply64    functor Mul64 = Multiply64
321      (val trapping = false      (val trapping = false
      val signed = false  
322       val multCost = multCost       val multCost = multCost
323       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}]
324       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}]
325       val sh1addv = NONE       val sh1addv = NONE
326       val sh2addv = SOME(fn {r1,r2,d} =>       val sh2addv = SOME(fn {r1,r2,d} =>
327                      [I.OPERATE{oper=I.S4ADDQ,ra=r1,rb=I.REGop r2,rc=d}])                      [I.operate{oper=I.S4ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
328       val sh3addv = SOME(fn {r1,r2,d} =>       val sh3addv = SOME(fn {r1,r2,d} =>
329                      [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}])
330      )      )
331      structure Mulu64 = Mul64(val signed = false)
332      structure Muls64 = Mul64(val signed = true)
333    
334    (*    (*
335     * The main stuff     * The main stuff
336     *)     *)
337    
338    datatype times4or8 = TIMES1    datatype times4or8 = TIMES1 | TIMES4 | TIMES8
                      | TIMES4  
                      | TIMES8  
339    datatype zeroOne   = ZERO | ONE | OTHER    datatype zeroOne   = ZERO | ONE | OTHER
340    datatype commutative = COMMUTE | NOCOMMUTE    datatype commutative = COMMUTE | NOCOMMUTE
341    
342      val zeroFR = C.f31
343      val zeroEA = I.Direct zeroR
344      val zeroT  = T.LI int_0
345      val trapb = [I.trapb]
346      val zeroImm = I.IMMop 0
347    
348    fun selectInstructions    fun selectInstructions
349          (S.STREAM{emit,init,finish,defineLabel,entryLabel,pseudoOp,annotation,          (instrStream as
350                    blockName,exitBlock,...}) =           TS.S.STREAM{emit=emitInstruction,beginCluster,endCluster,getAnnotations,
351                         defineLabel,entryLabel,pseudoOp,annotation,
352                         exitBlock,comment,...}) =
353    let    let
354    
355        infix || && << >> ~>>        infix || && << >> ~>>
356    
357        val op ||  = W32.orb        val op ||  = W32.orb
# Line 306  Line 363 
363        val itow = Word.fromInt        val itow = Word.fromInt
364        val wtoi = Word.toIntX        val wtoi = Word.toIntX
365    
366        val zeroFR = C.FPReg 31        val emit = emitInstruction o I.INSTR
       val zeroEA = I.Direct zeroR  
       val zeroT  = T.LI 0  
367    
368        val newReg = C.newReg        val newReg = C.newReg
369        val newFreg = C.newFreg        val newFreg = C.newFreg
       val emit = emit (fn _ => 0)  
   
       val trapb = [I.TRAPB]  
370    
371        (* Choose the appropriate rounding mode to generate.        (* Choose the appropriate rounding mode to generate.
372         * This stuff is used to support the alpha32x SML/NJ backend.         * This stuff is used to support the alpha32x SML/NJ backend.
373           *
374           *
375           * Floating point rounding mode.
376           * When this is set to true, we use the /SU rounding mode
377           * (chopped towards zero) for floating point arithmetic.
378           * This flag is only used to support the old alpha32x backend.
379           *
380           * Otherwise, we use /SUD.  This is the default for SML/NJ.
381           *
382         *)         *)
383        val (ADDT,SUBT,MULT,DIVT) =        val (ADDTX,SUBTX,MULTX,DIVTX) =
384             if useSU then (I.ADDTSU,I.SUBTSU,I.MULTSU,I.DIVTSU)             (I.ADDTSUD,I.SUBTSUD,I.MULTSUD,I.DIVTSUD)
385             else          (I.ADDTSUD,I.SUBTSUD,I.MULTSUD,I.DIVTSUD)        val (ADDSX,SUBSX,MULSX,DIVSX) =
386        val (ADDS,SUBS,MULS,DIVS) =              (I.ADDSSUD,I.SUBSSUD,I.MULSSUD,I.DIVSSUD)
387             if useSU then (I.ADDSSU,I.SUBSSU,I.MULSSU,I.DIVSSU)  
388             else          (I.ADDSSUD,I.SUBSSUD,I.MULSSUD,I.DIVSSUD)        fun annotate(i, an) = List.foldl (fn (a, i) => I.ANNOTATION{i=i,a=a}) i an
389          fun mark'(i, an) = emitInstruction(annotate(i,an))
390        fun mark'(i,[]) = i        fun mark(i,an) = emitInstruction(annotate(I.INSTR i,an))
         | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)  
       fun mark(i,an) = emit(mark'(i,an))  
391    
392        (* Fit within 16 bits? *)        (* Fit within 16 bits? *)
393        fun literal16 n = ~32768 <= n andalso n < 32768        fun literal16 n = ~32768 <= n andalso n < 32768
# Line 343  Line 402 
402              in  emit(I.LDA{r=r, b=base, d=offset}); r end              in  emit(I.LDA{r=r, b=base, d=offset}); r end
403    
404        (* emit load immed *)        (* emit load immed *)
405        fun loadImmed(n, base, rd, an) =        fun loadImmed(n, base, rd, an) = let
406        if ~32768 <= n andalso n < 32768 then          val n = T.I.toInt32(32, n)
407           mark(I.LDA{r=rd, b=base, d=I.IMMop n},an)        in
408        else          if n = 0 then move(base, rd, an)
409        let val w = itow n          else if ~32768 <= n andalso n < 32768 then
410            val hi = Word.~>>(w, 0w16)            mark(I.LDA{r=rd, b=base, d=I.IMMop(Int32.toInt n)}, an)
411            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)  
412        end        end
413    
414        (* loadImmed32 is used to load int32 and word32 constants.        (* loadImmed32 is used to load int32 and word32 constants.
415         * 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
416         * with LDL which sign extends a 32-bit valued memory location.         * with LDL which sign extends a 32-bit valued memory location.
417         *)         *)
418        fun loadImmed32(0w0, base, rd, an) =        (* TODO:
419             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.
420          | loadImmed32(n, base, rd, an) = let         *)
421              val low = W32.andb(n, 0w65535)  (* unsigned (0 .. 65535) *)        and loadImmed32(n, base, rd, an) = let
422              val high = W32.~>>(n, 0w16)     (* signed (~32768 .. 32768] *)          fun immed(0, high) =
             fun loadimmed(0, high) =  
423                   mark(I.LDAH{r=rd, b=base, d=I.IMMop(high)},an)                   mark(I.LDAH{r=rd, b=base, d=I.IMMop(high)},an)
424                | loadimmed(low, 0) =            | immed(low, 0) =
425                   mark(I.LDA{r=rd, b=base, d=I.IMMop(low)},an)                   mark(I.LDA{r=rd, b=base, d=I.IMMop(low)},an)
426                | loadimmed(low, high) =            | immed(low, high) =
427                   (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});                   (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});
428                    mark(I.LDAH{r=rd, b=rd, d=I.IMMop(high)},an))                 mark(I.LDAH{r=rd, b=rd, d=I.IMMop(high)}, an)
429                   )
430            val w = Word32.fromLargeInt(Int32.toLarge n)
431            val low = W32.andb(w, 0wxffff)
432            val high = W32.~>>(w, 0w16)
433            in            in
434              if W32.<(low, 0w32768) then          if W32.<(low, 0wx8000) then
435                 loadimmed(W32.toInt low, W32.toIntX high)            immed(W32.toInt low, W32.toIntX high)
436              else let (* low = (32768 .. 65535) *)          else let
437                 val lowsgn = W32.-(low, 0w65536) (* signed (~1 .. ~32768)  *)              val low = W32.toIntX(W32.-(low, 0wx10000))
438                 val highsgn = W32.+(high, 0w1)   (* (~32768 .. 32768) *)              val high = W32.toIntX(W32.+(high, 0w1))
                val ilow = W32.toIntX lowsgn  
                val ihigh = W32.toIntX highsgn  
439               in               in
440                 if ihigh <> 32768 then loadimmed(ilow, ihigh)              if high <> 0x8000 then immed(low, high)
441                 else              else let (* transition of high from pos to neg *)
442                 let val tmpR1 = newReg()                  val tmpR1 = newReg()
443                     val tmpR2 = newReg()                     val tmpR2 = newReg()
444                    val tmpR3=newReg()
445                 in                 in
446                   (* you gotta do what you gotta do! *)                  (* you just gotta do, what you gotta do! *)
447                   emit(I.LDA{r=rd, b=base, d=I.IMMop(ilow)});                  emit(I.LDA{r=tmpR3, b=base, d=I.IMMop(low)});
448                   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});
449                   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});
450                   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)
451                 end                 end
452               end               end
453             end             end
454    
       (* emit load immed *)  
       fun loadConst(c,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.CONSTop c},an)  
455    
456        (* emit load label *)        (* emit load label expression *)
457        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)
458    
459        (* emit a copy *)        (* emit a copy *)
460        fun copy(dst,src,an) =        and copy(dst,src,an) =
461            mark(I.COPY{dst=dst,src=src,impl=ref NONE,            mark'(I.COPY{k=CB.GP, sz=32, dst=dst,src=src,
462                        tmp=case dst of                        tmp=case dst of
463                             [_] => NONE | _ => SOME(I.Direct(newReg()))},an)                             [_] => NONE | _ => SOME(I.Direct(newReg()))},an)
464    
465        (* emit a floating point copy *)        (* emit a floating point copy *)
466        fun fcopy(dst,src,an) =        and fcopy(dst,src,an) =
467            mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,            mark'(I.COPY{k=CB.FP, sz=64, dst=dst,src=src,
468                        tmp=case dst of                        tmp=case dst of
469                             [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)                             [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)
470    
471        fun move(s,d,an) =        and move(s,d,an) =
472            if s = d orelse d = zeroR then () else            if CB.sameCell(s,d) orelse CB.sameCell(d,zeroR) then () else
473            mark(I.COPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)            mark'(I.COPY{k=CB.GP, sz=32, dst=[d],src=[s],tmp=NONE},an)
474    
475        fun fmove(s,d,an) =        and fmove(s,d,an) =
476            if s = d orelse d = zeroFR then () else            if CB.sameCell(s,d) orelse CB.sameCell(d,zeroFR) then () else
477            mark(I.FCOPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)            mark'(I.COPY{k=CB.FP, sz=64, dst=[d],src=[s],tmp=NONE},an)
478    
479         (* emit an sign extension op *)         (* emit an sign extension op *)
480        fun signExt32(r,d) =        and signExt32(r,d) =
481            emit(I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=d})            emit(I.OPERATE{oper=I.ADDL,ra=r,rb=zeroOpn,rc=d})
482    
483        (* emit an commutative arithmetic op *)        (* emit an commutative arithmetic op *)
484        fun commArith(opcode,a,b,d,an) =        and commArith(opcode,a,b,d,an) =
485            case (opn a,opn b) of            case (opn a,opn b) of
486              (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)
487            | (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 520 
520        (* convert an expression into an operand *)        (* convert an expression into an operand *)
521        and opn(T.REG(_,r)) = I.REGop r        and opn(T.REG(_,r)) = I.REGop r
522          | opn(e as T.LI n) =          | opn(e as T.LI n) =
523              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
524                  I.IMMop(toInt(n))
525              else let val tmpR = newReg()              else let val tmpR = newReg()
526                   in  loadImmed(n,zeroR,tmpR,[]); I.REGop tmpR end                   in  loadImmed(n,zeroR,tmpR,[]); I.REGop tmpR end
527          | opn(e as T.LI32 w) =          | opn(e as T.CONST _) = I.LABop e
528              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  
529          | opn e = I.REGop(expr e)          | opn e = I.REGop(expr e)
530    
531        (* compute base+displacement from an expression *)        (* compute base+displacement from an expression
532           *)
533        and addr exp =        and addr exp =
534            case exp of            let fun toLexp(I.IMMop i) = T.LI(IntInf.fromInt i)
535              T.ADD(_,e,T.LI n) => makeEA(expr e,n)                  | toLexp(I.LABop le) = le
536            | T.ADD(_,T.LI n,e) => makeEA(expr e,n)                  | toLexp _ = error "addr.toLexp"
537            | T.ADD(_,e,T.CONST c) => (expr e,I.CONSTop c)  
538            | T.ADD(_,T.CONST c,e) => (expr e,I.CONSTop c)                fun add(t,n,I.IMMop m)  =
539            | T.SUB(_,e,T.LI n) => makeEA(expr e,~n)                     I.IMMop(toInt(T.I.ADD(t,n,IntInf.fromInt m)))
540            | e => makeEA(expr e,0)                  | add(t,n,I.LABop le) = I.LABop(T.ADD(t,T.LI n,le))
541                    | add(t,n,_) = error "addr.add"
542    
543                  fun addLe(ty,le,I.IMMop 0) = I.LABop le
544                    | addLe(ty,le,disp) = I.LABop(T.ADD(ty,le,toLexp disp))
545    
546                  fun sub(t,n,I.IMMop m) =
547                      I.IMMop(toInt(T.I.SUB(t,IntInf.fromInt m,n)))
548                    | sub(t,n,I.LABop le) = I.LABop(T.SUB(t,le,T.LI n))
549                    | sub(t,n,_) = error "addr.sub"
550    
551                  fun subLe(ty,le,I.IMMop 0) = I.LABop le
552                    | subLe(ty,le,disp) = I.LABop(T.SUB(ty,le,toLexp disp))
553    
554                  (* Should really take into account of the address width XXX *)
555                  fun fold(T.ADD(t,e,T.LI n),disp) = fold(e,add(t,n,disp))
556                    | fold(T.ADD(t,e,x as T.CONST _),disp) = fold(e,addLe(t,x,disp))
557                    | fold(T.ADD(t,e,x as T.LABEL _),disp) = fold(e,addLe(t,x,disp))
558                    | fold(T.ADD(t,e,T.LABEXP l),disp) = fold(e,addLe(t,l,disp))
559                    | fold(T.ADD(t,T.LI n,e),disp) = fold(e, add(t,n,disp))
560                    | fold(T.ADD(t,x as T.CONST _,e),disp) = fold(e,addLe(t,x,disp))
561                    | fold(T.ADD(t,x as T.LABEL _,e),disp) = fold(e,addLe(t,x,disp))
562                    | fold(T.ADD(t,T.LABEXP l,e),disp) = fold(e,addLe(t,l,disp))
563                    | fold(T.SUB(t,e,T.LI n),disp) = fold(e,sub(t,n,disp))
564                    | fold(T.SUB(t,e,x as T.CONST _),disp) = fold(e,subLe(t,x,disp))
565                    | fold(T.SUB(t,e,x as T.LABEL _),disp) = fold(e,subLe(t,x,disp))
566                    | fold(T.SUB(t,e,T.LABEXP l),disp) = fold(e,subLe(t,l,disp))
567                    | fold(e,disp) = (expr e,disp)
568    
569              in  makeEA(fold(exp, zeroImm))
570              end
571    
572        (* compute base+displacement+small offset *)        (* compute base+displacement+small offset *)
573        and offset(base,disp as I.IMMop n,off) =        and offset(base,disp as I.IMMop n,off) =
# Line 495  Line 579 
579                     (tmp,I.IMMop off)                     (tmp,I.IMMop off)
580                 end                 end
581             end             end
582            | offset(base,disp as I.LABop le,off) =
583               (base, I.LABop(T.ADD(64,le,T.LI(IntInf.fromInt off))))
584          | offset(base,disp,off) =          | offset(base,disp,off) =
585             let val tmp = newReg()             let val tmp = newReg()
586             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});
587                 (tmp,I.IMMop off)                 (tmp,I.IMMop off)
588             end             end
589    
590        (* check if base offset *)        (* check if base offset fits within the field *)
591        and makeEA(base, offset) =        and makeEA(base, off as I.IMMop offset) =
592           if ~32768 <= offset andalso offset <= 32767 then (base, I.IMMop offset)           if ~32768 <= offset andalso offset <= 32767
593             then (base, off)
594           else           else
595           let val tmpR = newReg()           let val tmpR = newReg()
596                  (* unsigned low 16 bits *)                  (* unsigned low 16 bits *)
# Line 515  Line 602 
602               (emit(I.LDAH{r=tmpR, b=base, d=I.IMMop highsgn});               (emit(I.LDAH{r=tmpR, b=base, d=I.IMMop highsgn});
603               (tmpR, I.IMMop lowsgn))               (tmpR, I.IMMop lowsgn))
604           end           end
605           | makeEA(base, offset) = (base, offset)
606    
607        (* look for multiply by 4 and 8 of the given type *)        (* look for multiply by 4 and 8 of the given type *)
608        and times4or8(ty,e) =        and times4or8(ty,e) =
609            let fun f(t,a,n) = if t = ty then            let
610                                 if n = 4 then (TIMES4,a)                fun f(t,a,n) = if t = ty then
611                                 else if n = 8 then (TIMES8,a)                                 if EQ(n, T.I.int_4) then (TIMES4,a)
612                                 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)  
613                                 else (TIMES1,e)                                 else (TIMES1,e)
614                               else (TIMES1,e)                               else (TIMES1,e)
615    
616                fun u(t,a,n) = if t = ty then                fun u(t,a,n) = if t = ty then
617                                 if n = 2 then (TIMES4,a)                                 if EQ(n, T.I.int_2) then (TIMES4,a)
618                                 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)  
619                                 else (TIMES1,e)                                 else (TIMES1,e)
620                               else (TIMES1,e)                               else (TIMES1,e)
621            in  case e of            in  case e of
622                  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)  
623                | 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)  
624                | 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)  
625                | _                    => (TIMES1,e)                | _                    => (TIMES1,e)
626            end            end
627    
# Line 571  Line 648 
648                (TIMES4,a) => arith(s4sub,a,b,d,an)                (TIMES4,a) => arith(s4sub,a,b,d,an)
649             |  (TIMES8,a) => arith(s8sub,a,b,d,an)             |  (TIMES8,a) => arith(s8sub,a,b,d,an)
650             |  _          =>             |  _          =>
651                  if ty = 64 then
652                (case b of                (case b of
653                   (* use LDA to handle subtraction when possible                   (* use LDA to handle subtraction when possible
654                    * Note: this may have sign extension problems later.                    * Note: this may have sign extension problems later.
655                    *)                    *)
656                   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 _ =>
657                                arith(sub,a,b,d,an))                                arith(sub,a,b,d,an))
658                |  _ => arith(sub,a,b,d,an)                |  _ => arith(sub,a,b,d,an)
659                )                ) else arith(sub,a,b,d,an)
660            )            )
661    
662        (* look for special constants *)        (* look for special constants *)
663        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  
664          | wordOpn e = NONE          | wordOpn e = NONE
665    
666        (* look for special byte mask constants *)        (* look for special byte mask constants
667        and byteMask(_,SOME 0wx00000000) = SOME 0xff         * IMPORTANT: we must ALWAYS keep the sign bit!
668          | byteMask(_,SOME 0wx000000ff) = SOME 0xfe         *)
669          | byteMask(_,SOME 0wx0000ff00) = SOME 0xfd        and byteMask(_,SOME 0wx00000000) = 0xff
670          | byteMask(_,SOME 0wx0000ffff) = SOME 0xfc          | byteMask(_,SOME 0wx000000ff) = 0xfe
671          | byteMask(_,SOME 0wx00ff0000) = SOME 0xfb          | byteMask(_,SOME 0wx0000ff00) = 0xfd
672          | byteMask(_,SOME 0wx00ff00ff) = SOME 0xfa          | byteMask(_,SOME 0wx0000ffff) = 0xfc
673          | byteMask(_,SOME 0wx00ffff00) = SOME 0xf9          | byteMask(_,SOME 0wx00ff0000) = 0xfb
674          | byteMask(_,SOME 0wx00ffffff) = SOME 0xf8          | byteMask(_,SOME 0wx00ff00ff) = 0xfa
675            (* IMPORTANT:          | byteMask(_,SOME 0wx00ffff00) = 0xf9
676             * When ty is 64 then we assume the top 32 bits are all zeros.          | byteMask(_,SOME 0wx00ffffff) = 0xf8
677             * Otherwise, we must keep the sign bit!!!!          | byteMask(ty,SOME 0wxff000000) = if ty = 64 then 0xf7 else 0x07
678             *)          | byteMask(ty,SOME 0wxff0000ff) = if ty = 64 then 0xf6 else 0x06
679          | byteMask(ty,SOME 0wxff000000) = SOME(if ty = 64 then 0xf7 else 0x07)          | byteMask(ty,SOME 0wxff00ff00) = if ty = 64 then 0xf5 else 0x05
680          | byteMask(ty,SOME 0wxff0000ff) = SOME(if ty = 64 then 0xf6 else 0x06)          | byteMask(ty,SOME 0wxff00ffff) = if ty = 64 then 0xf4 else 0x04
681          | byteMask(ty,SOME 0wxff00ff00) = SOME(if ty = 64 then 0xf5 else 0x05)          | byteMask(ty,SOME 0wxffff0000) = if ty = 64 then 0xf3 else 0x03
682          | byteMask(ty,SOME 0wxff00ffff) = SOME(if ty = 64 then 0xf4 else 0x04)          | byteMask(ty,SOME 0wxffff00ff) = if ty = 64 then 0xf2 else 0x02
683          | byteMask(ty,SOME 0wxffff0000) = SOME(if ty = 64 then 0xf3 else 0x03)          | byteMask(ty,SOME 0wxffffff00) = if ty = 64 then 0xf1 else 0x01
684          | byteMask(ty,SOME 0wxffff00ff) = SOME(if ty = 64 then 0xf2 else 0x02)          | byteMask(ty,SOME 0wxffffffff) = if ty = 64 then 0xf0 else 0x00
685          | 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  
686    
687        (* generate an and instruction        (* generate an and instruction
688         * look for special masks.         * look for special masks.
689         *)         *)
690        and andb(ty,a,b,d,an) =        and andb(ty,a,b,d,an) =
691            case byteMask(ty,wordOpn a) of            case byteMask(ty,wordOpn a) of
692               SOME mask => arith(I.ZAP,b,T.LI mask,d,an)              ~1 => (case byteMask(ty,wordOpn b) of
693            |  _ =>                      ~1 => commArith(I.AND,a,b,d,an)
694            case byteMask(ty,wordOpn b) of                    | mask => arith(I.ZAP,a,LI mask,d,an)
695               SOME mask => arith(I.ZAP,a,T.LI mask,d,an)                    )
696            | _ => commArith(I.AND,a,b,d,an)            | mask => arith(I.ZAP,b,LI mask,d,an)
697    
698        (* generate sll/sra/srl *)        (* generate sll/sra/srl *)
699        and sll32(a,b,d,an) =        and sll32(a,b,d,an) =
# Line 642  Line 717 
717            | SOME 0w3 => arith(I.S8ADDQ,a,zeroT,d,an)            | SOME 0w3 => arith(I.S8ADDQ,a,zeroT,d,an)
718            | _        => arith(I.SLL,a,b,d,an)            | _        => arith(I.SLL,a,b,d,an)
719    
720        and sra32(a,b,d,an) =         (* On the alpha, all 32 bit values are already sign extended.
721            let val ra = expr a          * So no sign extension is necessary.  We do the same for
722                val rb = opn b          * sra32 and sra64
723                val t  = newReg()          *)
724            in  signExt32(ra,t);        and sra(a,b,d,an) =
               mark(I.OPERATE{oper=I.SRA,ra=t,rb=rb,rc=d},an)  
           end  
   
       and sra64(a,b,d,an) =  
725            mark(I.OPERATE{oper=I.SRA,ra=expr a,rb=opn b,rc=d},an)            mark(I.OPERATE{oper=I.SRA,ra=expr a,rb=opn b,rc=d},an)
726    
727        and srl32(a,b,d,an) =        and srl32(a,b,d,an) =
# Line 675  Line 746 
746                    (i,I.REGop r) => gen{ra=r,rb=i,rc=rd}                    (i,I.REGop r) => gen{ra=r,rb=i,rc=rd}
747                  | (I.REGop r,i) => gen{ra=r,rb=i,rc=rd}                  | (I.REGop r,i) => gen{ra=r,rb=i,rc=rd}
748                  | (r,i)         => gen{ra=reduceOpn r,rb=i,rc=rd}                  | (r,i)         => gen{ra=reduceOpn r,rb=i,rc=rd}
749                in mark'(instr,an)::trapb end                in annotate(instr,an)::trapb end
750                fun const(e,i) =                fun const(e,i) =
751                    let val r = expr e                    let val r = expr e
752                    in  if !useMultByConst andalso i >= 0 andalso i < 256 then                    in  if !useMultByConst andalso
753                           mark'(gen{ra=r,rb=I.IMMop i,rc=rd},an)::trapb                             IntInf.>=(i, T.I.int_0) andalso
754                               IntInf.<(i, T.I.int_0x100) then
755                             annotate(gen{ra=r,rb=I.IMMop(toInt i),rc=rd},an)::trapb
756                        else                        else
757                           (genConst{r=r,i=i,d=rd}@trapb                           (genConst{r=r,i=toInt i,d=rd}@trapb
758                            handle _ => nonconst(T.REG(ty,r),T.LI i))                            handle _ => nonconst(T.REG(ty,r),T.LI i))
759                    end                    end
               fun constw(e,i) = const(e,Word32.toInt i)  
                                   handle _ => nonconst(e,T.LI32 i)  
760                val instrs =                val instrs =
761                    case (e1,e2) of                  case (e1, e2)
762                       (e1,T.LI i)   => const(e1,i)                  of (_, T.LI i) => const(e1, i)
763                     | (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)  
764                     | _             => nonconst(e1,e2)                     | _             => nonconst(e1,e2)
765            in  app emit instrs            in  app emitInstruction instrs
766            end            end
767    
768            (* Round r towards zero.            (* Round r towards zero.
# Line 703  Line 772 
772             * d <- r + i;             * d <- r + i;
773             * d <- if (r > 0) then r else d             * d <- if (r > 0) then r else d
774             *)             *)
775          (*
776        and roundToZero{ty,r,i,d} =        and roundToZero{ty,r,i,d} =
777            (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)));
778             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),
779                                     T.REG(ty,r),T.REG(ty,d))))                                     T.REG(ty,r),T.REG(ty,d))))
780            )            )
781           *)
782    
783        (*        (*
784         * Generic division.         * Generic division.
# Line 719  Line 790 
790    
791                fun const(e,i) =                fun const(e,i) =
792                    let val r = expr e                    let val r = expr e
793                    in  genDiv{mode=T.TO_ZERO,roundToZero=roundToZero}                    in  genDiv{mode=T.TO_ZERO,stm=doStmt}
794                              {r=r,i=i,d=rd}                              {r=r,i=toInt i,d=rd}
795                        handle _ => nonconst(T.REG(ty,r),T.LI i)                        handle _ => nonconst(T.REG(ty,r),T.LI i)
796                    end                    end
               fun constw(e,i) = const(e,Word32.toInt i)  
                                   handle _ => nonconst(e,T.LI32 i)  
797                val instrs =                val instrs =
798                    case e2 of                    case e2 of
799                       T.LI i   => const(e1,i)                       T.LI i   => const(e1,i)
                    | T.LI32 i => constw(e1,i)  
800                     | _        => nonconst(e1,e2)                     | _        => nonconst(e1,e2)
801            in  app emit instrs            in  app emitInstruction instrs
802            end            end
803    
804    
# Line 782  Line 850 
850    
851        (* generate pseudo instruction *)        (* generate pseudo instruction *)
852        and pseudo(instr,e1,e2,rc) =        and pseudo(instr,e1,e2,rc) =
853             app emit (instr({ra=expr e1,rb=opn e2,rc=rc}, reduceOpn))             app emitInstruction (instr({ra=expr e1,rb=opn e2,rc=rc}, reduceOpn))
854    
855        (* generate a load *)        (* generate a load *)
856        and load(ldOp,ea,d,mem,an) =        and load(ldOp,ea,d,mem,an) =
# Line 811  Line 879 
879            end            end
880    
881        (* generate a load byte with zero extension (page 4-48) *)        (* generate a load byte with zero extension (page 4-48) *)
882        and load8(ea,rd,mem,an) = loadZext(ea,rd,mem,I.EXTBL,an)        and load8(ea,rd,mem,an) =
883              if !byteWordLoadStores then load(I.LDBU,ea,rd,mem,an)
884              else loadZext(ea,rd,mem,I.EXTBL,an)
885    
886        (* generate a load byte with sign extension (page 4-48) *)        (* generate a load byte with sign extension (page 4-48) *)
887        and load8s(ea,rd,mem,an) = loadSext(ea,rd,mem,1,I.EXTQH,56,an)        and load8s(ea,rd,mem,an) =
888              if !byteWordLoadStores then load(I.LDB,ea,rd,mem,an)
889              else loadSext(ea,rd,mem,1,I.EXTQH,56,an)
890    
891        (* generate a load 16 bit *)        (* generate a load 16 bit *)
892        and load16(ea,rd,mem,an) = loadZext(ea,rd,mem,I.EXTWL,an)        and load16(ea,rd,mem,an) =
893              if !byteWordLoadStores then load(I.LDWU,ea,rd,mem,an)
894              else loadZext(ea,rd,mem,I.EXTWL,an)
895    
896        (* generate a load 16 bit with sign extension *)        (* generate a load 16 bit with sign extension *)
897        and load16s(ea,rd,mem,an) = loadSext(ea,rd,mem,2,I.EXTQH,48,an)        and load16s(ea,rd,mem,an) =
898              if !byteWordLoadStores then load(I.LDW,ea,rd,mem,an)
899        (* 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  
900    
901        (* generate a load 32 bit with sign extension *)        (* generate a load 32 bit with sign extension *)
902        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 929 
929    
930        (* generate a store byte *)        (* generate a store byte *)
931        and store8(ea,data,mem,an) =        and store8(ea,data,mem,an) =
932            storeUnaligned(ea,data,mem,I.INSBL,I.MSKBL,an)            if !byteWordLoadStores then store(I.STB, ea, data, mem, an)
933              else storeUnaligned(ea,data,mem,I.INSBL,I.MSKBL,an)
934    
935        (* generate a store16 *)        (* generate a store16 *)
936        and store16(ea,data,mem,an) =        and store16(ea,data,mem,an) =
937            storeUnaligned(ea,data,mem,I.INSWL,I.MSKWL,an)            if !byteWordLoadStores then store(I.STW, ea, data, mem, an)
938              else storeUnaligned(ea,data,mem,I.INSWL,I.MSKWL,an)
939    
940          (* generate conversion from floating point to integer *)
941          and cvtf2i(pseudo,rounding,e,rd,an) =
942              app emitInstruction (pseudo{mode=rounding, fs=fexpr e, rd=rd})
943    
944        (* generate an expression and return the register that holds the result *)        (* generate an expression and return the register that holds the result *)
945        and expr(T.REG(_,r)) = r        and expr(e) = let
946          | expr(T.LI 0) = zeroR          fun comp() = let
947          | expr(T.LI32 0w0) = zeroR            val r = newReg()
948          | expr e = let val r = newReg()          in doExpr(e, r, []); r
949                     in  doExpr(e,r,[]); r end          end
950          in
951            case e
952            of T.REG(_, r) => r
953             | T.LI z => if T.I.isZero(z) then zeroR else comp()
954                (* On the alpha: all 32 bit values are already sign extended.
955                 * So no sign extension is necessary
956                 *)
957             | T.SX(64, 32, e) => expr e
958             | T.ZX(64, 32, e) => expr e
959             | _ => comp()
960          end
961    
962        (* generate an expression that targets register d *)        (* generate an expression that targets register d *)
963        and doExpr(e,d,an) =        and doExpr(exp,d,an) =
964            case e of            case exp of
965              T.REG(_,r) => move(r,d,an)              T.REG(_,r) => move(r,d,an)
966            | T.LI n     => loadImmed(n,zeroR,d,an)            | T.LI n     => loadImmed(n,zeroR,d,an)
967            | T.LI32 w   => loadImmed32(w,zeroR,d,an)            | T.LABEL l  => loadLabexp(exp,d,an)
968            | T.LABEL l  => loadLabel(l,d,an)            | T.CONST c  => loadLabexp(exp,d,an)
969            | T.CONST c  => loadConst(c,d,an)            | T.LABEXP le => loadLabexp(le,d,an)
970    
971              (* special optimizations for additions and subtraction              (* special optimizations for additions and subtraction
972               * Question: using LDA for all widths is not really correct               * Question: using LDA for all widths is not really correct
973               * since the result may not fit into the sign extension scheme.               * since the result may not fit into the sign extension scheme.
974               *)               *)
975            | 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)
976            | 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)
977            | 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 _))  =>
978            | 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)
979            | T.ADD(_,e,T.LI i)     => loadImmed(i, expr e, d, an)            | T.ADD(64,x as (T.CONST _ | T.LABEL _),e)  =>
980            | 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)
981            | 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)
982            | 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)
983            | T.SUB(_,a,(T.LI 0 | T.LI32 0w0)) => doExpr(a,d,an)            | T.SUB(sz, a, b as T.LI z)    =>
984                  if T.I.isZero(z) then
985                    doExpr(a,d,an)
986                  else (case sz
987                    of 32 => minus(32,I.SUBL,I.S4SUBL,I.S8SUBL,a,b,d,an)
988                     | 64 => minus(64,I.SUBQ,I.S4SUBQ,I.S8SUBQ,a,b,d,an)
989                     | _ =>  doExpr(Gen.compileRexp exp,d,an)
990                    (*esac*))
991    
992              (* 32-bit support *)              (* 32-bit support *)
993            | 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)
994            | 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)
995            | T.ADDT(32,a,b) => commArithTrap(I.ADDLV,a,b,d,an)            | T.ADDT(32,a,b) => commArithTrap(I.ADDLV,a,b,d,an)
996            | T.SUBT(32,a,b) => arithTrap(I.SUBLV,a,b,d,an)            | T.SUBT(32,a,b) => arithTrap(I.SUBLV,a,b,d,an)
997            | T.MULT(32,a,b) => (* multTrap(I.MULLV,I.ADDL,I.ADDLV,a,b,d,an) *)            | T.MULT(32,a,b) =>
998                 multiply(32,                 multiply(32,
999                   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},
1000                   Mult32.multiply,a,b,d,trapb,an)                   Mult32.multiply,a,b,d,trapb,an)
1001            | T.MULU(32,a,b) => (* mulu(I.MULL,I.ADDL,a,b,d,an) *)            | T.MULU(32,a,b) =>
1002                 multiply(32,                 multiply(32,
1003                   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},
1004                   Mulu32.multiply,a,b,d,[],an)                   Mulu32.multiply,a,b,d,[],an)
1005            | T.DIVT(32,a,b) => (* pseudo(PseudoInstrs.divl,a,b,d) *)            | T.MULS(32,a,b) =>
1006                 divide(32,PseudoInstrs.divl,Mult32.divide,a,b,d,an)                 multiply(32,
1007            | 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},
1008                 divide(32,PseudoInstrs.divlu,Mulu32.divide,a,b,d,an)                   Muls32.multiply,a,b,d,[],an)
1009              | T.DIVT(32,a,b) => divide(32,P.divlv,Mult32.divide,a,b,d,an)
1010              | T.DIVU(32,a,b) => divide(32,P.divlu,Mulu32.divide,a,b,d,an)
1011              | T.DIVS(32,a,b) => divide(32,P.divl,Muls32.divide,a,b,d,an)
1012              | T.REMT(32,a,b) => pseudo(P.remlv,a,b,d)
1013              | T.REMU(32,a,b) => pseudo(P.remlu,a,b,d)
1014              | T.REMS(32,a,b) => pseudo(P.reml,a,b,d)
1015    
1016            | T.SLL(32,a,b) => sll32(a,b,d,an)            | T.SLL(32,a,b) => sll32(a,b,d,an)
1017            | T.SRA(32,a,b) => sra32(a,b,d,an)            | T.SRA(32,a,b) => sra(a,b,d,an)
1018            | T.SRL(32,a,b) => srl32(a,b,d,an)            | T.SRL(32,a,b) => srl32(a,b,d,an)
1019    
1020              (* 64 bit support *)              (* 64 bit support *)
# Line 924  Line 1022 
1022            | 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)
1023            | T.ADDT(64,a,b) => commArithTrap(I.ADDQV,a,b,d,an)            | T.ADDT(64,a,b) => commArithTrap(I.ADDQV,a,b,d,an)
1024            | T.SUBT(64,a,b) => arithTrap(I.SUBQV,a,b,d,an)            | T.SUBT(64,a,b) => arithTrap(I.SUBQV,a,b,d,an)
1025            | T.MULT(64,a,b) => (* multTrap(I.MULQV,I.ADDQ,I.ADDQV,a,b,d,an) *)            | T.MULT(64,a,b) =>
1026                 multiply(64,                 multiply(64,
1027                   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},
1028                   Mult64.multiply,a,b,d,trapb,an)                   Mult64.multiply,a,b,d,trapb,an)
1029            | T.MULU(64,a,b) => (* mulu(I.MULQ,I.ADDQ,a,b,d,an) *)            | T.MULU(64,a,b) =>
1030                 multiply(64,                 multiply(64,
1031                   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},
1032                   Mulu64.multiply,a,b,d,[],an)                   Mulu64.multiply,a,b,d,[],an)
1033            | T.DIVT(64,a,b) => (* pseudo(PseudoInstrs.divq,a,b,d) *)            | T.MULS(64,a,b) =>
1034                 divide(64,PseudoInstrs.divq,Mult64.divide,a,b,d,an)                 multiply(64,
1035            | 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},
1036                 divide(64,PseudoInstrs.divqu,Mulu64.divide,a,b,d,an)                   Muls64.multiply,a,b,d,[],an)
1037              | T.DIVT(64,a,b) => divide(64,P.divqv,Mult64.divide,a,b,d,an)
1038              | T.DIVU(64,a,b) => divide(64,P.divqu,Mulu64.divide,a,b,d,an)
1039              | T.DIVS(64,a,b) => divide(64,P.divq,Muls64.divide,a,b,d,an)
1040              | T.REMT(64,a,b) => pseudo(P.remqv,a,b,d)
1041              | T.REMU(64,a,b) => pseudo(P.remqu,a,b,d)
1042              | T.REMS(64,a,b) => pseudo(P.remq,a,b,d)
1043    
1044            | T.SLL(64,a,b) => sll64(a,b,d,an)            | T.SLL(64,a,b) => sll64(a,b,d,an)
1045            | T.SRA(64,a,b) => sra64(a,b,d,an)            | T.SRA(64,a,b) => sra(a,b,d,an)
1046            | T.SRL(64,a,b) => srl64(a,b,d,an)            | T.SRL(64,a,b) => srl64(a,b,d,an)
1047    
1048              (* special bit operations with complement *)              (* special bit operations with complement *)
# Line 955  Line 1060 
1060            | T.ORB(_,a,b) => commArith(I.BIS,a,b,d,an)            | T.ORB(_,a,b) => commArith(I.BIS,a,b,d,an)
1061            | T.NOTB(_,e) => arith(I.ORNOT,zeroT,e,d,an)            | T.NOTB(_,e) => arith(I.ORNOT,zeroT,e,d,an)
1062    
           | T.CVTI2I(_,T.ZERO_EXTEND,e) => doExpr(e,d,an)  
   
1063              (* loads *)              (* loads *)
1064            | 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)
1065            | 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)
1066            | 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)
1067              | T.ZX((8|16|32|64),_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
1068              | T.ZX((16|32|64),_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
1069              | T.ZX(64,_,T.LOAD(64,ea,mem)) => load(I.LDQ,ea,d,mem,an)
1070            | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)            | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)
1071            | T.LOAD(16,ea,mem) => load16(ea,d,mem,an)            | T.LOAD(16,ea,mem) => load16(ea,d,mem,an)
1072            | T.LOAD(32,ea,mem) => load32(ea,d,mem,an)            | T.LOAD(32,ea,mem) => load32s(ea,d,mem,an)
1073            | T.LOAD(64,ea,mem) => load(I.LDQ,ea,d,mem,an)            | T.LOAD(64,ea,mem) => load(I.LDQ,ea,d,mem,an)
1074    
1075               (* floating -> int conversion *)
1076              | T.CVTF2I(ty,rounding,fty,e) =>
1077                (case (fty,ty) of
1078                   (32,32) => cvtf2i(P.cvtsl,rounding,e,d,an)
1079                 | (32,64) => cvtf2i(P.cvtsq,rounding,e,d,an)
1080                 | (64,32) => cvtf2i(P.cvttl,rounding,e,d,an)
1081                 | (64,64) => cvtf2i(P.cvttq,rounding,e,d,an)
1082                 | _       => doExpr(Gen.compileRexp exp,d,an) (* other cases *)
1083                )
1084    
1085             (* 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)  
1086            | T.COND(_,T.CMP(ty,cond,e1,e2),x,y) =>            | T.COND(_,T.CMP(ty,cond,e1,e2),x,y) =>
1087                 (case (x, y)
1088                  of (T.LI n, T.LI m) =>
1089                    if EQ(n, int_1) andalso EQ(m, int_0) then
1090                      compare(ty,cond,e1,e2,d,an)
1091                    else if EQ(n, int_0) andalso EQ(m, int_1) then
1092                      compare(ty,T.Basis.negateCond cond,e1,e2,d,an)
1093                    else
1094                 cmove(ty,cond,e1,e2,x,y,d,an)                 cmove(ty,cond,e1,e2,x,y,d,an)
1095                  | _ => cmove(ty,cond,e1,e2,x,y,d,an)
1096                 (*esac*))
1097    
1098            | T.SEQ(s,e) => (doStmt s; doExpr(e,d,an))            | T.LET(s,e) => (doStmt s; doExpr(e, d, an))
1099              | T.MARK(e,A.MARKREG f) => (f d; doExpr(e,d,an))
1100            | T.MARK(e,a) => doExpr(e,d,a::an)            | T.MARK(e,a) => doExpr(e,d,a::an)
1101            | e => doExpr(Gen.compile e,d,an)              (* On the alpha: all 32 bit values are already sign extended.
1102                 * So no sign extension is necessary
1103                 *)
1104              | T.SX(64, 32, e) => doExpr(e, d, an)
1105              | T.ZX(64, 32, e) => doExpr(e, d, an)
1106    
1107              | T.PRED(e, c) => doExpr(e, d, A.CTRLUSE c::an)
1108              | T.REXT e => ExtensionComp.compileRext (reducer()) {e=e, an=an, rd=d}
1109    
1110               (* Defaults *)
1111              | e => doExpr(Gen.compileRexp e,d,an)
1112    
1113         (* Hmmm...  this is the funky thing described in the comments         (* Hmmm...  this is the funky thing described in the comments
1114          * in at the top of the file.  This should be made parametrizable          * in at the top of the file.  This should be made parametrizable
1115          * for other backends.          * for other backends.
1116          *)          *)
1117        and farith(opcode,a,b,d,an) =        and farith(opcode,opcodeSMLNJ,a,b,d,an) =
1118            let val fa = fexpr a            let val fa = fexpr a
1119                val fb = fexpr b                val fb = fexpr b
1120            in  emit(I.DEFFREG d);            in  if SMLNJfloatingPoint then
1121                mark(I.FOPERATEV{oper=opcode,fa=fa,fb=fb,fc=d},an);                     ((* emit(I.DEFFREG d); *)
1122                emit(I.TRAPB)                      mark(I.FOPERATEV{oper=opcodeSMLNJ,fa=fa,fb=fb,fc=d},an);
1123                        emit(I.TRAPB);
1124                        emitInstruction(I.LIVE{regs=List.foldl C.addFreg C.empty [fa,fb,d],
1125                                               spilled=[]})
1126    
1127                       )
1128                  else mark(I.FOPERATE{oper=opcode,fa=fa,fb=fb,fc=d},an)
1129            end            end
1130    
1131          and farith'(opcode,a,b,d,an) =
1132                mark(I.FOPERATE{oper=opcode,fa=fexpr a,fb=fexpr b,fc=d},an)
1133    
1134          and funary(opcode,e,d,an) = mark(I.FUNARY{oper=opcode,fb=fexpr e,fc=d},an)
1135    
1136    
1137        (* generate an floating point expression        (* generate an floating point expression
1138         * return the register that holds the result         * return the register that holds the result
1139         *)         *)
# Line 997  Line 1141 
1141          | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end          | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end
1142    
1143        (* generate an external floating point operation *)        (* generate an external floating point operation *)
1144        and fcvti2f(gen,e,fd,an) =        and fcvti2f(pseudo,e,fd,an) =
1145            let val opnd = opn e            let val opnd = opn e
1146            in  app emit (gen({opnd=opnd, fd=fd}, reduceOpn))            in  app emitInstruction (pseudo({opnd=opnd, fd=fd}, reduceOpn))
1147            end            end
1148    
1149        (* generate a floating point store *)        (* generate a floating point store *)
# Line 1014  Line 1158 
1158              T.FREG(_,f)    => fmove(f,d,an)              T.FREG(_,f)    => fmove(f,d,an)
1159    
1160              (* single precision support *)              (* single precision support *)
1161            | T.FADD(32,a,b) => farith(ADDS,a,b,d,an)            | T.FADD(32,a,b) => farith(I.ADDS,ADDSX,a,b,d,an)
1162            | T.FSUB(32,a,b) => farith(SUBS,a,b,d,an)            | T.FSUB(32,a,b) => farith(I.SUBS,SUBSX,a,b,d,an)
1163            | T.FMUL(32,a,b) => farith(MULS,a,b,d,an)            | T.FMUL(32,a,b) => farith(I.MULS,MULSX,a,b,d,an)
1164            | 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)  
1165    
1166              (* double precision support *)              (* double precision support *)
1167            | T.FADD(64,a,b) => farith(ADDT,a,b,d,an)            | T.FADD(64,a,b) => farith(I.ADDT,ADDTX,a,b,d,an)
1168            | T.FSUB(64,a,b) => farith(SUBT,a,b,d,an)            | T.FSUB(64,a,b) => farith(I.SUBT,SUBTX,a,b,d,an)
1169            | T.FMUL(64,a,b) => farith(MULT,a,b,d,an)            | T.FMUL(64,a,b) => farith(I.MULT,MULTX,a,b,d,an)
1170            | T.FDIV(64,a,b) => farith(DIVT,a,b,d,an)            | T.FDIV(64,a,b) => farith(I.DIVT,DIVTX,a,b,d,an)
1171            | T.CVTI2F(64,_,e) => fcvti2f(PseudoInstrs.cvti2d,e,d,an)  
1172                (* copy sign (correct?) XXX *)
1173              | T.FCOPYSIGN(_,T.FNEG(_,a),b) => farith'(I.CPYSN,a,b,d,an)
1174              | T.FCOPYSIGN(_,a,T.FNEG(_,b)) => farith'(I.CPYSN,a,b,d,an)
1175              | T.FNEG(_,T.FCOPYSIGN(_,a,b)) => farith'(I.CPYSN,a,b,d,an)
1176              | T.FCOPYSIGN(_,a,b)           => farith'(I.CPYS,a,b,d,an)
1177    
1178              (* generic *)              (* generic *)
1179            | T.FABS(_,a)   =>            | T.FABS(_,a)   =>
# Line 1039  Line 1187 
1187            | T.FLOAD(32,ea,mem) => fload(I.LDS,ea,d,mem,an)            | T.FLOAD(32,ea,mem) => fload(I.LDS,ea,d,mem,an)
1188            | T.FLOAD(64,ea,mem) => fload(I.LDT,ea,d,mem,an)            | T.FLOAD(64,ea,mem) => fload(I.LDT,ea,d,mem,an)
1189    
1190              (* misc *)              (* floating/floating conversion
1191            | T.FSEQ(s,e) => (doStmt s; doFexpr(e,d,an))               * Note: it is not necessary to convert single precision
1192            | T.FMARK(e,a) => doFexpr(e,d,a::an)               * to double on the alpha.
1193                 *)
1194              | T.CVTF2F(fty,fty',e) => (* ignore rounding mode for now *)
1195                (case (fty,fty') of
1196                   (64,64) => doFexpr(e,d,an)
1197                 | (64,32) => doFexpr(e,d,an)
1198                 | (32,32) => doFexpr(e,d,an)
1199                 | (32,64) => funary(I.CVTTS,e,d,an) (* use normal rounding *)
1200                 | _       => error "CVTF2F"
1201                )
1202    
1203                (* integer -> floating point conversion *)
1204              | T.CVTI2F(fty,ty,e) =>
1205                let val pseudo =
1206                    case (ty,fty) of
1207                      (ty,32) => if ty <= 32 then P.cvtls else P.cvtqs
1208                    | (ty,64) => if ty <= 32 then P.cvtlt else P.cvtqt
1209                    | _       => error "CVTI2F"
1210                in  fcvti2f(pseudo,e,d,an) end
1211    
1212              | T.FMARK(e,A.MARKREG f) => (f d; doFexpr(e,d,an))
1213              | T.FMARK(e,a) => doFexpr(e,d,a::an)
1214              | T.FPRED(e,c) => doFexpr(e, d, A.CTRLUSE c::an)
1215              | T.FEXT e => ExtensionComp.compileFext (reducer()) {e=e, fd=d, an=an}
1216            | _ => error "doFexpr"            | _ => error "doFexpr"
1217    
1218            (* check whether an expression is andb(e,1) *)            (* check whether an expression is andb(e,1) *)
1219        and isAndb1(T.ANDB(_,e,T.LI 1))     = (true,e)        and isAndb1(e as T.ANDB(_, e1, e2)) = let
1220          | isAndb1(T.ANDB(_,e,T.LI32 0w1)) = (true,e)              fun isOne(n, ei) =
1221          | isAndb1(T.ANDB(_,T.LI 1,e))     = (true,e)                if EQ(n, int_1) then (true, ei) else (false, e)
1222          | isAndb1(T.ANDB(_,T.LI32 0w1,e)) = (true,e)            in
1223                case(e1, e2)
1224                of (T.LI n, _) => isOne(n, e2)
1225                 | (_, T.LI n) => isOne(n, e1)
1226                 | _ => (false, e)
1227              end
1228          | isAndb1 e                       = (false,e)          | isAndb1 e                       = (false,e)
1229    
1230        and zeroOrOne(T.LI 0)     = ZERO        and zeroOrOne(T.LI n) =
1231          | zeroOrOne(T.LI32 0w0) = ZERO          if T.I.isZero n then ZERO
1232          | zeroOrOne(T.LI 1)     = ONE          else if EQ(n, int_1) then ONE
1233          | zeroOrOne(T.LI32 0w1) = ONE               else OTHER
1234          | zeroOrOne _           = OTHER          | zeroOrOne _           = OTHER
1235    
1236        (* compile a branch *)        (* compile a branch *)
1237        and branch(c,e,lab,an) =        and branch(e,lab,an) =
1238            case e of            case e of
1239              T.CMP(ty,cc,e1 as T.LI _,e2) =>              T.CMP(ty,cc,e1 as T.LI _,e2) =>
1240                 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)  
1241            | 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)
1242            | e => mark(I.BRANCH(I.BNE,ccExpr e,lab),an)              (* generate an floating point branch *)
1243              | T.FCMP(fty,cc,e1,e2) =>
1244                let val f1 = fexpr e1
1245                    val f2 = fexpr e2
1246                    fun bcc(cmp,br) =
1247                    let val tmpR = C.newFreg()
1248                    in  (*emit(I.DEFFREG(tmpR));*)
1249                        emit(I.FOPERATE{oper=cmp,fa=f1,fb=f2,fc=tmpR});
1250                        emit(I.TRAPB);
1251                        emitInstruction(I.LIVE{regs=List.foldl C.addFreg C.empty [f1,f2,tmpR],
1252                                    spilled=[]});
1253                        mark(I.FBRANCH{b=br,f=tmpR,lab=lab},an)
1254                    end
1255                    fun fall(cmp1, br1, cmp2, br2) =
1256                    let val tmpR1 = newFreg()
1257                        val tmpR2 = newFreg()
1258                        val fallLab = Label.anon()
1259                    in  (*emit(I.DEFFREG(tmpR1));*)
1260                        emit(I.FOPERATE{oper=cmp1, fa=f1, fb=f2, fc=tmpR1});
1261                        emit(I.TRAPB);
1262                        emitInstruction(I.LIVE{regs=List.foldl C.addFreg C.empty [f1,f2,tmpR1],
1263                                    spilled=[]});
1264                        mark(I.FBRANCH{b=br1, f=tmpR1, lab=fallLab},an);
1265                        (* emit(I.DEFFREG(tmpR2)); *)
1266                        emit(I.FOPERATE{oper=cmp2, fa=f1, fb=f2, fc=tmpR2});
1267                        emit(I.TRAPB);
1268                        emitInstruction(I.LIVE{regs=List.foldl C.addFreg C.empty [f1,f2,tmpR2],
1269                                    spilled=[]});
1270                        mark(I.FBRANCH{b=br2, f=tmpR2, lab=lab},an);
1271                        defineLabel fallLab
1272                    end
1273                    fun bcc2(cmp1, br1, cmp2, br2) =
1274                         (bcc(cmp1, br1); bcc(cmp2, br2))
1275                in  case cc of
1276                      T.==  => bcc(I.CMPTEQSU, I.FBNE)
1277                    | T.?<> => bcc(I.CMPTEQSU, I.FBEQ)
1278                    | T.?   => bcc(I.CMPTUNSU, I.FBNE)
1279                    | T.<=> => bcc(I.CMPTUNSU, I.FBEQ)
1280                    | T.>   => fall(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1281                    | T.>=  => fall(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1282                    | T.?>  => bcc(I.CMPTLESU, I.FBEQ)
1283                    | T.?>= => bcc(I.CMPTLTSU, I.FBEQ)
1284                    | T.<   => bcc(I.CMPTLTSU, I.FBNE)
1285                    | T.<=  => bcc(I.CMPTLESU, I.FBNE)
1286                    | T.?<  => bcc2(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1287                    | T.?<= => bcc2(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBNE)
1288                    | T.<>  => fall(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1289                    | T.?=  => bcc2(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1290                    | _     => error "branch"
1291                end
1292              | e => mark(I.BRANCH{b=I.BNE,r=ccExpr e,lab=lab},an)
1293    
1294        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)
1295    
1296              (* Use the branch on bit set/clear instruction when possible *)              (* Use the branch on bit set/clear instruction when possible *)
1297        and branchBS(ty,cc,a,b,lab,an)  =        and branchBS(ty,cc,a,b,lab,an)  =
# Line 1083  Line 1306 
1306            (* generate a branch instruction.            (* generate a branch instruction.
1307             * Check for branch on zero as a special case             * Check for branch on zero as a special case
1308             *)             *)
1309        and branchIt(ty,cc,e,T.LI 0,lab,an) = branchIt0(cc,e,lab,an)  
1310          | 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) =
1311               if T.I.isZero z then branchIt0(cc,e1,lab,an)
1312               else branchItOther(ty,cc,e1,e2,lab,an)
1313          | 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)
1314    
1315            (* generate a branch instruction.            (* generate a branch instruction.
# Line 1100  Line 1325 
1325          | branchIt0(T.GEU,e,lab,an) = (* always true! *) goto(lab,an)          | branchIt0(T.GEU,e,lab,an) = (* always true! *) goto(lab,an)
1326          | branchIt0(T.LTU,e,lab,an) = (* always false! *) ()          | branchIt0(T.LTU,e,lab,an) = (* always false! *) ()
1327          | 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! *)
1328            | branchIt0 _               = error "brnachIt0"
1329    
1330          (* Generate the operands for unsigned comparisons          (* Generate the operands for unsigned comparisons
1331           * Mask out high order bits whenever necessary.           * Mask out high order bits whenever necessary.
# Line 1129  Line 1355 
1355            let val tmpR = newReg()            let val tmpR = newReg()
1356                fun signedCmp(cmp,br) =                fun signedCmp(cmp,br) =
1357                    (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});
1358                     mark(I.BRANCH(br, tmpR, lab),an)                     mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1359                    )                    )
1360                fun unsignedCmp(ty,cmp,br) =                fun unsignedCmp(ty,cmp,br) =
1361                    let val (x,y) = unsignedCmpOpnds(ty,e1,e2)                    let val (x,y) = unsignedCmpOpnds(ty,e1,e2)
1362                    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});
1363                        mark(I.BRANCH(br, tmpR, lab),an)                        mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1364                    end                    end
1365            in  case cond of            in  case cond of
1366                  T.LT  => signedCmp(I.CMPLT,I.BNE)                  T.LT  => signedCmp(I.CMPLT,I.BNE)
# Line 1147  Line 1373 
1373                | T.LEU => unsignedCmp(ty,I.CMPULE,I.BNE)                | T.LEU => unsignedCmp(ty,I.CMPULE,I.BNE)
1374                | T.GTU => unsignedCmp(ty,I.CMPULE,I.BEQ)                | T.GTU => unsignedCmp(ty,I.CMPULE,I.BEQ)
1375                | T.GEU => unsignedCmp(ty,I.CMPULT,I.BEQ)                | T.GEU => unsignedCmp(ty,I.CMPULT,I.BEQ)
1376                  | _     => error "branchItOther"
1377            end            end
1378    
1379           (* This function generates a conditional move:           (* This function generates a conditional move:
# Line 1155  Line 1382 
1382            * are supported on the alpha.            * are supported on the alpha.
1383            *)            *)
1384        and cmove(ty,cond,a,b,x,y,d,an) =        and cmove(ty,cond,a,b,x,y,d,an) =
1385            let val _ = doExpr(y,d,[]) (* evaluate false case *)            let val tmp = newReg()
1386                  val _ = doExpr(y,tmp,[]) (* evaluate false case *)
1387    
1388                val (cond,a,b) =                val (cond,a,b) =
1389                  (* move the immed operand to b *)                  (* move the immed operand to b *)
1390                  case a of                  case a of
1391                    (T.LI _ | T.LI32 _ | T.CONST _) =>                    (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
1392                         (MLTreeUtil.swapCond cond,b,a)                      (T.Basis.swapCond cond,b,a)
1393                  | _ => (cond,a,b)                  | _ => (cond,a,b)
1394    
1395                fun sub(a,(T.LI 0 | T.LI32 0w0)) = expr a                fun sub(a, T.LI z) =
1396                       if T.I.isZero z then expr a else expr(T.SUB(ty,a,b))
1397                  | sub(a,b)                     = expr(T.SUB(ty,a,b))                  | sub(a,b)                     = expr(T.SUB(ty,a,b))
1398    
1399                fun cmp(cond,e1,e2) =                fun cmp(cond,e1,e2) =
1400                    let val d = newReg()                    let val flag = newReg()
1401                    in  compare(ty,cond,e1,e2,d,[]); d end                    in  compare(ty,cond,e1,e2,flag,[]); flag end
1402    
1403                val (oper,ra,x,y) =                val (oper,ra,x,y) =
1404                  case (cond,isAndb1 a,zeroOrOne b) of                  case (cond,isAndb1 a,zeroOrOne b) of
# Line 1180  Line 1409 
1409                  | (T.NE,(true,e),ONE)  => (I.CMOVLBC,expr e,x,y)                  | (T.NE,(true,e),ONE)  => (I.CMOVLBC,expr e,x,y)
1410                       (* signed  *)                       (* signed  *)
1411                  | (T.EQ,_,_)           => (I.CMOVEQ,sub(a,b),x,y)                  | (T.EQ,_,_)           => (I.CMOVEQ,sub(a,b),x,y)
1412                  | (T.NE,_,_)           => (I.CMOVEQ,cmp(T.EQ,a,b),y,x)                  | (T.NE,_,_)           => (I.CMOVNE,sub(a,b),x,y)
1413                  | (T.GT,_,_)           => (I.CMOVGT,sub(a,b),x,y)                  | (T.GT,_,_)           => (I.CMOVGT,sub(a,b),x,y)
1414                  | (T.GE,_,_)           => (I.CMOVGE,sub(a,b),x,y)                  | (T.GE,_,_)           => (I.CMOVGE,sub(a,b),x,y)
1415                  | (T.LT,_,_)           => (I.CMOVLT,sub(a,b),x,y)                  | (T.LT,_,_)           => (I.CMOVLT,sub(a,b),x,y)
# Line 1191  Line 1420 
1420                  | (T.LEU,_,_)          => (I.CMOVEQ,cmp(T.GTU,a,b),x,y)                  | (T.LEU,_,_)          => (I.CMOVEQ,cmp(T.GTU,a,b),x,y)
1421                  | (T.GTU,_,_)          => (I.CMOVEQ,cmp(T.LEU,a,b),x,y)                  | (T.GTU,_,_)          => (I.CMOVEQ,cmp(T.LEU,a,b),x,y)
1422                  | (T.GEU,_,_)          => (I.CMOVEQ,cmp(T.LTU,a,b),x,y)                  | (T.GEU,_,_)          => (I.CMOVEQ,cmp(T.LTU,a,b),x,y)
1423            in  mark(I.CMOVE{oper=oper,ra=ra,rb=opn x,rc=d},an) (* true case *)                  | _                    => error "cmove"
1424              in  mark(I.CMOVE{oper=oper,ra=ra,rb=opn x,rc=tmp},an); (* true case *)
1425                  move(tmp, d, [])
1426            end            end
1427    
1428    
# Line 1221  Line 1452 
1452                    end                    end
1453                val (cond,e1,e2) =                val (cond,e1,e2) =
1454                    case e1 of                    case e1 of
1455                      (T.LI _ | T.LI32 _ | T.CONST _) =>                      (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
1456                         (MLTreeUtil.swapCond cond,e2,e1)                         (T.Basis.swapCond cond,e2,e1)
1457                    | _ => (cond,e1,e2)                    | _ => (cond,e1,e2)
1458            in  case cond of            in  case cond of
1459                  T.EQ  => eq(e1,e2,d)                  T.EQ  => eq(e1,e2,d)
# Line 1235  Line 1466 
1466                | T.GEU => unsignedCmp(ty,I.CMPULE,e2,e1,d)                | T.GEU => unsignedCmp(ty,I.CMPULE,e2,e1,d)
1467                | T.LTU => unsignedCmp(ty,I.CMPULT,e1,e2,d)                | T.LTU => unsignedCmp(ty,I.CMPULT,e1,e2,d)
1468                | T.LEU => unsignedCmp(ty,I.CMPULE,e1,e2,d)                | T.LEU => unsignedCmp(ty,I.CMPULE,e1,e2,d)
1469                  | _     => error "compare"
1470            end            end
1471    
1472           (* generate an unconditional branch *)           (* generate an unconditional branch *)
1473        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)
1474    
1475           (* generate an call instruction *)           (* generate an call instruction *)
1476        and call(ea,def,use,mem,an) =        and call(ea,flow,defs,uses,mem,cutTo,an,0) =
1477         let val pv = expr ea            let val defs=cellset defs
1478             val returnPtrR = 26                val uses=cellset uses
1479             fun live([],acc) = acc                val instr =
1480               | live(T.GPR(T.REG(_,r))::regs,acc) = live(regs, C.addReg(r,acc))                    case (ea, flow) of
1481               | live(T.CCR(T.CC cc)::regs,acc) = live(regs, C.addReg(cc,acc))                        (T.LABEL lab, [_]) =>
1482               | 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,
1483               | live(_::regs, acc) = live(regs, acc)                              cutsTo=cutTo,mem=mem}
1484         in  mark(I.JSR({r=returnPtrR, b=pv, d=0},                      | _ => I.JSR{r=C.returnAddr,b=expr ea,
1485                        live(def, C.addReg(returnPtrR, C.empty)),                                   d=0,defs=defs,uses=uses,cutsTo=cutTo,mem=mem}
1486                        live(use, C.addReg(pv, C.empty)),mem),an)            in  mark(instr,an)
        end  
   
          (* generate an floating point branch *)  
       and fbranch(_,T.FCMP(fty,cc,e1,e2),lab,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)  
1487            end            end
1488          | fbranch _ = error "fbranch"          | call _ = error "pops<>0 not implemented"
1489    
1490           (* generate an floating point branch *)        and doCCexpr(T.CC(_,r),d,an) = move(r,d,an)
1491        and doCCexpr(T.CC r,d,an) = move(r,d,an)          | doCCexpr(T.FCC(_,r),d,an) = fmove(r,d,an)
1492          | 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)
1493          | doCCexpr(T.FCMP(fty,cond,e1,e2),d,an) = error "doCCexpr"          | doCCexpr(T.FCMP(fty,cond,e1,e2),d,an) = error "doCCexpr"
1494            | doCCexpr(T.CCMARK(e,A.MARKREG f),d,an) = (f d; doCCexpr(e,d,an))
1495          | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)          | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)
1496            | doCCexpr(T.CCEXT e,d,an) =
1497                 ExtensionComp.compileCCext (reducer()) {e=e, ccd=d, an=an}
1498            | doCCexpr _ = error "doCCexpr"
1499    
1500        and ccExpr(T.CC r) = r        and ccExpr(T.CC(_,r)) = r
1501            | ccExpr(T.FCC(_,r)) = r
1502          | ccExpr e = let val d = newReg()          | ccExpr e = let val d = newReg()
1503                       in  doCCexpr(e,d,[]); d end                       in  doCCexpr(e,d,[]); d end
1504    
# Line 1316  Line 1510 
1510            | T.CCMV(r,e) => doCCexpr(e,r,an)            | T.CCMV(r,e) => doCCexpr(e,r,an)
1511            | T.COPY(ty,dst,src) => copy(dst,src,an)            | T.COPY(ty,dst,src) => copy(dst,src,an)
1512            | T.FCOPY(ty,dst,src) => fcopy(dst,src,an)            | T.FCOPY(ty,dst,src) => fcopy(dst,src,an)
1513            | T.JMP(T.LABEL(LE.LABEL lab),_) => goto(lab,an)            | T.JMP(T.LABEL lab,_) => goto(lab,an)
1514            | 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)
1515            | T.BCC(cond,e,lab) => branch(cond,e,lab,an)            | T.BCC(cc,lab) => branch(cc,lab,an)
1516            | T.FBCC(cond,e,lab) => fbranch(cond,e,lab,an)            | T.CALL{funct,targets,defs,uses,region,pops,...} =>
1517            | T.CALL(e,def,use,mem) => call(e,def,use,mem,an)                call(funct,targets,defs,uses,region,[],an,pops)
1518            | T.RET => mark(I.RET{r=zeroR,b=26,d=0},an)            | T.FLOW_TO(T.CALL{funct,targets,defs,uses,region,pops,...},cutTo) =>
1519                  call(funct,targets,defs,uses,region,cutTo,an,pops)
1520              | T.RET _ => mark(I.RET{r=zeroR,b=C.returnAddr,d=0},an)
1521            | T.STORE(8,ea,data,mem) => store8(ea,data,mem,an)            | T.STORE(8,ea,data,mem) => store8(ea,data,mem,an)
1522            | T.STORE(16,ea,data,mem) => store16(ea,data,mem,an)            | T.STORE(16,ea,data,mem) => store16(ea,data,mem,an)
1523            | 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)
1524            | 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)
1525            | 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)
1526            | 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)
1527              | T.DEFINE l => defineLabel l
1528            | T.ANNOTATION(s,a) => stmt(s,a::an)            | T.ANNOTATION(s,a) => stmt(s,a::an)
1529            | _ => error "stmt"            | T.EXT s => ExtensionComp.compileSext (reducer()) {stm=s,an=an}
1530              | T.LIVE rs => mark'(I.LIVE{regs=cellset rs, spilled=[]}, an)
1531              | T.KILL rs => mark'(I.KILL{regs=cellset rs, spilled=[]}, an)
1532              | s => doStmts (Gen.compileStm s)
1533    
1534          and reducer() =
1535              TS.REDUCER{reduceRexp    = expr,
1536                         reduceFexp    = fexpr,
1537                         reduceCCexp   = ccExpr,
1538                         reduceStm     = stmt,
1539                         operand       = opn,
1540                         reduceOperand = reduceOpn,
1541                         addressOf     = addr,
1542                         emit          = emitInstruction o annotate,
1543                         instrStream   = instrStream,
1544                         mltreeStream  = self()
1545                        }
1546    
1547        and doStmt s = stmt(s,[])        and doStmt s = stmt(s,[])
1548          and doStmts ss = app doStmt ss
1549    
1550        fun mltreeComp mltree =         (* convert mlrisc to cellset:
1551        let (* condition code registers are mapped onto general registers *)          * condition code registers are mapped onto general registers
1552            fun cc(T.CCR(T.CC cc)) = T.GPR(T.REG(32,cc))          *)
1553              | cc r = r        and cellset mlrisc =
1554            fun comp(T.PSEUDO_OP pOp)    = pseudoOp pOp            let fun g([],acc) = acc
1555              | comp(T.DEFINELABEL lab)  = defineLabel lab                  | g(T.GPR(T.REG(_,r))::regs,acc)  = g(regs,C.addReg(r,acc))
1556              | comp(T.ENTRYLABEL lab)   = entryLabel lab                  | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
1557              | comp(T.BEGINCLUSTER)     = init 0                  | g(T.CCR(T.CC(_,cc))::regs,acc)  = g(regs,C.addReg(cc,acc))
1558              | comp(T.CODE stms)        = app doStmt stms                  | g(T.CCR(T.FCC(_,cc))::regs,acc) = g(regs,C.addReg(cc,acc))
1559              | comp(T.BLOCK_NAME name)  = blockName name                  | g(_::regs, acc) = g(regs, acc)
1560              | comp(T.BLOCK_ANNOTATION a) = annotation a            in  g(mlrisc, C.empty) end
1561              | comp(T.ENDCLUSTER regmap)= finish regmap  
1562              | comp(T.ESCAPEBLOCK regs) = exitBlock (map cc regs)        and self() =
1563              | comp _ = error "mltreeComp"            TS.S.STREAM
1564        in  comp mltree           { beginCluster   = beginCluster,
1565        end             endCluster     = endCluster,
1566               emit           = doStmt,
1567     in { mltreeComp = mltreeComp,             pseudoOp       = pseudoOp,
1568          mlriscComp = doStmt,             defineLabel    = defineLabel,
1569          emitInstr  = emit             entryLabel     = entryLabel,
1570               comment        = comment,
1571               annotation     = annotation,
1572               getAnnotations = getAnnotations,
1573               exitBlock      = fn regs => exitBlock(cellset regs)
1574        }        }
1575       in  self()
1576     end     end
1577    
1578  end  end

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

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