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

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

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

revision 986, Wed Nov 21 21:03:17 2001 UTC revision 1722, Sun Dec 12 05:49:04 2004 UTC
# Line 1  Line 1 
1  (*  (* ppc.sml
2     *
3     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4     *
5   * I've substantially modified this code generator to support the new MLTREE.   * I've substantially modified this code generator to support the new MLTREE.
6   * Please see the file README.hppa for the ugly details.   * Please see the file README.hppa for the ugly details.
7   *   *
# Line 42  Line 45 
45    val (intTy,naturalWidths) = if bit64mode then (64,[32,64]) else (32,[32])    val (intTy,naturalWidths) = if bit64mode then (64,[32,64]) else (32,[32])
46    structure Gen = MLTreeGen    structure Gen = MLTreeGen
47      (structure T = T      (structure T = T
48         structure Cells = C
49       val intTy = intTy       val intTy = intTy
50       val naturalWidths = naturalWidths       val naturalWidths = naturalWidths
51       datatype rep = SE | ZE | NEITHER       datatype rep = SE | ZE | NEITHER
# Line 58  Line 62 
62    fun SLLI32{r,i,d} =    fun SLLI32{r,i,d} =
63        I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp i,mb=0,me=SOME(31-i)}        I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp i,mb=0,me=SOME(31-i)}
64    fun SRLI32{r,i,d} =    fun SRLI32{r,i,d} =
65        I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp(32-i),mb=i,me=SOME(31)}        I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp(Int.mod(32-i,32)),mb=i,me=SOME(31)}
66      fun COPY{dst, src, tmp} =
67          I.COPY{k=CB.GP, sz=32, dst=dst, src=src, tmp=tmp}
68      fun FCOPY{dst, src, tmp} =
69          I.COPY{k=CB.FP, sz=64, dst=dst, src=src, tmp=tmp}
70    
71    (*    (*
72     * Integer multiplication     * Integer multiplication
# Line 71  Line 79 
79       type arg  = {r1:CB.cell,r2:CB.cell,d:CB.cell}       type arg  = {r1:CB.cell,r2:CB.cell,d:CB.cell}
80       type argi = {r:CB.cell,i:int,d:CB.cell}       type argi = {r:CB.cell,i:int,d:CB.cell}
81    
82       fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}       fun mov{r,d} = COPY{dst=[d],src=[r],tmp=NONE}
83       fun add{r1,r2,d}= I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}       fun add{r1,r2,d}= I.arith{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}
84       fun slli{r,i,d} = [SLLI32{r=r,i=i,d=d}]       fun slli{r,i,d} = [I.INSTR(SLLI32{r=r,i=i,d=d})]
85       fun srli{r,i,d} = [SRLI32{r=r,i=i,d=d}]       fun srli{r,i,d} = [I.INSTR(SRLI32{r=r,i=i,d=d})]
86       fun srai{r,i,d} = [I.ARITHI{oper=I.SRAWI,rt=d,ra=r,im=I.ImmedOp i}]       fun srai{r,i,d} = [I.arithi{oper=I.SRAWI,rt=d,ra=r,im=I.ImmedOp i}]
87      )      )
88    
89    structure Mulu32 = Multiply32    structure Mulu32 = Multiply32
90      (val trapping = false      (val trapping = false
91       val multCost = multCost       val multCost = multCost
92       fun addv{r1,r2,d}=[I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}]       fun addv{r1,r2,d}=[I.arith{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}]
93       fun subv{r1,r2,d}=[I.ARITH{oper=I.SUBF,ra=r2,rb=r1,rt=d,Rc=false,OE=false}]       fun subv{r1,r2,d}=[I.arith{oper=I.SUBF,ra=r2,rb=r1,rt=d,Rc=false,OE=false}]
94       val sh1addv = NONE       val sh1addv = NONE
95       val sh2addv = NONE       val sh2addv = NONE
96       val sh3addv = NONE       val sh3addv = NONE
97      )      )
98      (val signed = false)      (val signed = false)
99    
100      structure Muls32 = Multiply32
101        (val trapping = false
102         val multCost = multCost
103         fun addv{r1,r2,d}=[I.arith{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}]
104         fun subv{r1,r2,d}=[I.arith{oper=I.SUBF,ra=r2,rb=r1,rt=d,Rc=false,OE=false}]
105         val sh1addv = NONE
106         val sh2addv = NONE
107         val sh3addv = NONE
108        )
109        (val signed = true)
110    
111    structure Mult32 = Multiply32    structure Mult32 = Multiply32
112      (val trapping = true      (val trapping = true
113       val multCost = multCost       val multCost = multCost
# Line 101  Line 120 
120      (val signed = true)      (val signed = true)
121    
122    fun selectInstructions    fun selectInstructions
123        (TS.S.STREAM{emit,comment,getAnnotations,        (instrStream as
124           TS.S.STREAM{emit=emitInstruction,comment,getAnnotations,
125                  defineLabel,entryLabel,pseudoOp,annotation,                  defineLabel,entryLabel,pseudoOp,annotation,
126                  beginCluster,endCluster,exitBlock,...}) =                  beginCluster,endCluster,exitBlock,...}) =
127    let (* mark an instruction with annotations *)    let
128        fun mark'(instr,[]) = instr        val emit = emitInstruction o I.INSTR
129          | mark'(instr,a::an) = mark'(I.ANNOTATION{i=instr,a=a},an)  
130        fun mark(instr,an) = emit(mark'(instr,an))        (* mark an instruction with annotations *)
131          fun annotate(instr,[]) = instr
132            | annotate(instr,a::an) = annotate(I.ANNOTATION{i=instr,a=a},an)
133          fun mark'(instr, an) = emitInstruction(annotate(instr, an))
134          fun mark(instr,an) = emitInstruction(annotate(I.INSTR instr,an))
135    
136        (* Label where trap is generated.        (* Label where trap is generated.
137         * For overflow trapping instructions, we generate a branch         * For overflow trapping instructions, we generate a branch
# Line 121  Line 145 
145        val newCCreg = C.newCell CB.CC        val newCCreg = C.newCell CB.CC
146    
147    
       val int_0       = T.I.int_0  
       val int_m0x8000 = T.I.fromInt(32, ~32768)  
       val int_0x8000  = T.I.fromInt(32,  32768)  
       val int_m0x800  = T.I.fromInt(32, ~2048)  
       val int_0x800   = T.I.fromInt(32,  2048)  
148        fun LT (x,y)    = T.I.LT(32, x, y)        fun LT (x,y)    = T.I.LT(32, x, y)
149        fun LE (x,y)    = T.I.LE(32, x, y)        fun LE (x,y)    = T.I.LE(32, x, y)
150        fun toInt mi = T.I.toInt(32, mi)        fun toInt mi = T.I.toInt(32, mi)
151        fun LI i = T.I.fromInt(32, i)        fun LI i = T.I.fromInt(32, i)
152    
153        fun signed16 mi   = LE(int_m0x8000, mi) andalso LT(mi, int_0x8000)        fun signed16 mi   = LE(~0x8000, mi) andalso LT(mi, 0x8000)
154        fun signed12 mi   = LE(int_m0x800, mi) andalso LT(mi, int_0x800)        fun signed12 mi   = LE(~0x800, mi) andalso LT(mi, 0x800)
155        fun unsigned16 mi = LE(int_0, mi) andalso LT(mi, T.I.int_0x10000)        fun unsigned16 mi = LE(0, mi) andalso LT(mi, 0x10000)
156        fun unsigned5 mi  = LE(int_0, mi) andalso LT(mi, T.I.int_32)        fun unsigned5 mi  = LE(0, mi) andalso LT(mi, 32)
157        fun unsigned6 mi  = LE(int_0, mi) andalso LT(mi, T.I.int_64)        fun unsigned6 mi  = LE(0, mi) andalso LT(mi, 64)
158    
159        fun move(rs,rd,an) =        fun move(rs,rd,an) =
160          if CB.sameColor(rs,rd) then ()          if CB.sameColor(rs,rd) then ()
161          else mark(I.COPY{dst=[rd],src=[rs],impl=ref NONE,tmp=NONE},an)          else mark'(COPY{dst=[rd],src=[rs],tmp=NONE},an)
162    
163        fun fmove(fs,fd,an) =        fun fmove(fs,fd,an) =
164          if CB.sameColor(fs,fd) then ()          if CB.sameColor(fs,fd) then ()
165          else mark(I.FCOPY{dst=[fd],src=[fs],impl=ref NONE,tmp=NONE},an)          else mark'(FCOPY{dst=[fd],src=[fs],tmp=NONE},an)
166    
167        fun ccmove(ccs,ccd,an) =        fun ccmove(ccs,ccd,an) =
168          if CB.sameColor(ccd,ccs) then () else mark(I.MCRF{bf=ccd, bfa=ccs},an)          if CB.sameColor(ccd,ccs) then () else mark(I.MCRF{bf=ccd, bfa=ccs},an)
169    
170        fun copy(dst, src, an) =        fun copy(dst, src, an) =
171            mark(I.COPY{dst=dst, src=src, impl=ref NONE,            mark'(COPY{dst=dst, src=src,
172                        tmp=case dst of [_] => NONE                        tmp=case dst of [_] => NONE
173                                      | _ => SOME(I.Direct(newReg()))},an)                                      | _ => SOME(I.Direct(newReg()))},an)
174        fun fcopy(dst, src, an) =        fun fcopy(dst, src, an) =
175            mark(I.FCOPY{dst=dst, src=src, impl=ref NONE,            mark'(FCOPY{dst=dst, src=src,
176                         tmp=case dst of [_] => NONE                         tmp=case dst of [_] => NONE
177                                       | _ => SOME(I.FDirect(newFreg()))},an)                                       | _ => SOME(I.FDirect(newFreg()))},an)
178    
# Line 275  Line 294 
294          | stmt(T.FSTORE(ty,ea,data,mem),an) = fstore(ty,ea,data,mem,an)          | stmt(T.FSTORE(ty,ea,data,mem),an) = fstore(ty,ea,data,mem,an)
295          | stmt(T.BCC(cc, lab),an) = branch(cc,lab,an)          | stmt(T.BCC(cc, lab),an) = branch(cc,lab,an)
296          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
297            | stmt(T.LIVE S, an) = mark'(I.LIVE{regs=cellset S,spilled=C.empty},an)
298            | stmt(T.KILL S, an) = mark'(I.KILL{regs=cellset S,spilled=C.empty},an)
299          | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)          | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)
300            | stmt(T.EXT s,an) = ExtensionComp.compileSext(reducer()) {stm=s, an=an}
301          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
302    
303        and call(funct, targets, defs, uses, region, cutsTo, an, 0) =        and call(funct, targets, defs, uses, region, cutsTo, an, 0) =
# Line 286  Line 308 
308            end            end
309          | call _ = error "pops<>0 not implemented"          | call _ = error "pops<>0 not implemented"
310    
311        and branch(T.CMP(_, _, T.LI _, T.LI _), _, _) = error "branch"        and branch(T.CMP(_, _, T.LI _, T.LI _), _, _) = error "branch(LI,LI)"
312          | branch(T.CMP(ty, cc, e1 as T.LI _, e2), lab, an) =          | branch(T.CMP(ty, cc, e1 as T.LI _, e2), lab, an) =
313            let val cc' = T.Basis.swapCond cc            let val cc' = T.Basis.swapCond cc
314            in  branch(T.CMP(ty, cc', e2, e1), lab, an)            in  branch(T.CMP(ty, cc', e2, e1), lab, an)
# Line 304  Line 326 
326                  | T.LEU => (I.FALSE, I.GT)                  | T.LEU => (I.FALSE, I.GT)
327                  | T.GTU => (I.TRUE,  I.GT)                  | T.GTU => (I.TRUE,  I.GT)
328                  | T.GEU => (I.FALSE, I.LT)                  | T.GEU => (I.FALSE, I.LT)
329                    | (T.SETCC | T.MISC_COND _) => error "branch(CMP)"
330               (*esac*))               (*esac*))
331              val ccreg = if true then CR0 else newCCreg() (* XXX *)              val ccreg = if true then CR0 else newCCreg() (* XXX *)
332              val addr = I.LabelOp(T.LABEL lab)              val addr = I.LabelOp(T.LABEL lab)
# Line 313  Line 336 
336            in            in
337              case (e1, e2)              case (e1, e2)
338              of (T.ANDB(_, a1, a2), T.LI z) =>              of (T.ANDB(_, a1, a2), T.LI z) =>
339                  if T.I.isZero(z) then                  if z = 0 then
340                    (case commImmedOpnd unsigned16 (a1, a2)                    (case commImmedOpnd unsigned16 (a1, a2)
341                     of (ra, I.RegOp rb) =>                     of (ra, I.RegOp rb) =>
342                          emit(I.ARITH{oper=I.AND, ra=ra, rb=rb, rt=newReg(), Rc=true, OE=false})                          emit(I.ARITH{oper=I.AND, ra=ra, rb=rb, rt=newReg(), Rc=true, OE=false})
# Line 337  Line 360 
360                | (T.LE | T.LEU) => branch(I.FALSE, I.GT)                | (T.LE | T.LEU) => branch(I.FALSE, I.GT)
361                | (T.GE | T.GEU) => branch(I.FALSE, I.LT)                | (T.GE | T.GEU) => branch(I.FALSE, I.LT)
362                | (T.GT | T.GTU) => branch(I.TRUE, I.GT)                | (T.GT | T.GTU) => branch(I.TRUE, I.GT)
363                  | (T.SETCC | T.MISC_COND _) => error "branch(CC)"
364            end            end
365          | branch(cmp as T.FCMP(fty, cond, _, _), lab, an) =          | branch(cmp as T.FCMP(fty, cond, _, _), lab, an) =
366            let val ccreg = if true then CR0 else newCCreg() (* XXX *)            let val ccreg = if true then CR0 else newCCreg() (* XXX *)
# Line 366  Line 390 
390                | T.?<= => branch(I.FALSE,  ccreg, I.FG)                | T.?<= => branch(I.FALSE,  ccreg, I.FG)
391                | T.<>  => test2bits(I.FL, I.FG)                | T.<>  => test2bits(I.FL, I.FG)
392                | T.?=  => test2bits(I.FU, I.FE)                | T.?=  => test2bits(I.FU, I.FE)
393                  | (T.SETFCC | T.MISC_FCOND _) => error "branch(FCMP)"
394               (*esac*)               (*esac*)
395            end            end
396          | branch _ = error "branch"          | branch _ = error "branch"
# Line 482  Line 507 
507            (* Generate optimized multiplication code *)            (* Generate optimized multiplication code *)
508        and multiply(ty,oper,operi,genMult,e1,e2,rt,an) =        and multiply(ty,oper,operi,genMult,e1,e2,rt,an) =
509            let fun nonconst(e1,e2) =            let fun nonconst(e1,e2) =
510                    [mark'(                    [annotate(
511                       case commImmedOpnd signed16 (e1,e2) of                       case commImmedOpnd signed16 (e1,e2) of
512                         (ra,I.RegOp rb) =>                         (ra,I.RegOp rb) =>
513                           I.ARITH{oper=oper,ra=ra,rb=rb,rt=rt,OE=false,Rc=false}                           I.arith{oper=oper,ra=ra,rb=rb,rt=rt,OE=false,Rc=false}
514                       | (ra,im) => I.ARITHI{oper=operi,ra=ra,im=im,rt=rt},                       | (ra,im) => I.arithi{oper=operi,ra=ra,im=im,rt=rt},
515                       an)]                       an)]
516                fun const(e,i) =                fun const(e,i) =
517                    let val r = expr e                    let val r = expr e
# Line 498  Line 523 
523                     (_,T.LI i)   => const(e1,i)                     (_,T.LI i)   => const(e1,i)
524                   | (T.LI i,_)   => const(e2,i)                   | (T.LI i,_)   => const(e2,i)
525                   | _            => nonconst(e1,e2)                   | _            => nonconst(e1,e2)
526            in  app emit instrs end            in  app emitInstruction instrs end
527    
528        and divu32 x = Mulu32.divide{mode=T.TO_ZERO,stm=doStmt} x        and divu32 x = Mulu32.divide{mode=T.TO_ZERO,stm=doStmt} x
529    
530          and divs32 x = Muls32.divide{mode=T.TO_ZERO,stm=doStmt} x
531    
532        and divt32 x = Mult32.divide{mode=T.TO_ZERO,stm=doStmt} x        and divt32 x = Mult32.divide{mode=T.TO_ZERO,stm=doStmt} x
533    
534            (* Generate optimized division code *)            (* Generate optimized division code *)
# Line 513  Line 540 
540                    )                    )
541                fun const(e,i) =                fun const(e,i) =
542                    let val r = expr e                    let val r = expr e
543                    in  app emit (genDiv{r=r,i=toInt(i),d=rt})                    in  app emitInstruction (genDiv{r=r,i=toInt(i),d=rt})
544                        handle _ => nonconst(T.REG(ty,r),T.LI i)                        handle _ => nonconst(T.REG(ty,r),T.LI i)
545                    end                    end
546            in  case (e1,e2) of            in  case (e1,e2) of
# Line 582  Line 609 
609             | T.MULU(32, e1, e2) => multiply(32,I.MULLW,I.MULLI,             | T.MULU(32, e1, e2) => multiply(32,I.MULLW,I.MULLI,
610                                              Mulu32.multiply,e1,e2,rt,an)                                              Mulu32.multiply,e1,e2,rt,an)
611             | T.DIVU(32, e1, e2) => divide(32,I.DIVWU,divu32,e1,e2,rt,false,an)             | T.DIVU(32, e1, e2) => divide(32,I.DIVWU,divu32,e1,e2,rt,false,an)
612    
613               | T.MULS(32, e1, e2) => multiply(32,I.MULLW,I.MULLI,
614                                                Muls32.multiply,e1,e2,rt,an)
615               | T.DIVS(T.DIV_TO_ZERO, 32, e1, e2) =>
616                   (* On the PPC we turn overflow checking on despite this
617                    * being DIVS.  That's because divide-by-zero is also
618                    * indicated through "overflow" instead of causing a trap. *)
619                                       divide(32,I.DIVW,divs32,e1,e2,rt,
620                                              true (* !! *),
621                                              an)
622    
623             | T.ADDT(32, e1, e2) => arithTrapping(I.ADD, e1, e2, rt, an)             | T.ADDT(32, e1, e2) => arithTrapping(I.ADD, e1, e2, rt, an)
624             | T.SUBT(32, e1, e2) => arithTrapping(I.SUBF, e2, e1, rt, an)             | T.SUBT(32, e1, e2) => arithTrapping(I.SUBF, e2, e1, rt, an)
625             | T.MULT(32, e1, e2) => arithTrapping(I.MULLW, e1, e2, rt, an)             | T.MULT(32, e1, e2) => arithTrapping(I.MULLW, e1, e2, rt, an)
626             | T.DIVT(32, e1, e2) => divide(32,I.DIVW,divt32,e1,e2,rt,true,an)             | T.DIVT(T.DIV_TO_ZERO, 32, e1, e2) =>
627                                       divide(32,I.DIVW,divt32,e1,e2,rt,true,an)
628    
629             | T.SRA(32, e1, e2)  => sra(I.SRAW, I.SRAWI, e1, e2, rt, an)             | T.SRA(32, e1, e2)  => sra(I.SRAW, I.SRAWI, e1, e2, rt, an)
630             | T.SRL(32, e1, e2)  => srl32(e1, e2, rt, an)             | T.SRL(32, e1, e2)  => srl32(e1, e2, rt, an)
# Line 610  Line 649 
649             | T.LET(s,e) => (doStmt s; doExpr(e, rt, an))             | T.LET(s,e) => (doStmt s; doExpr(e, rt, an))
650             | T.MARK(e, A.MARKREG f) => (f rt; doExpr(e,rt,an))             | T.MARK(e, A.MARKREG f) => (f rt; doExpr(e,rt,an))
651             | T.MARK(e, a) => doExpr(e,rt,a::an)             | T.MARK(e, a) => doExpr(e,rt,a::an)
652               | T.REXT e => ExtensionComp.compileRext (reducer()) {e=e,rd=rt,an=an}
653             | e => doExpr(Gen.compileRexp e,rt,an)             | e => doExpr(Gen.compileRexp e,rt,an)
654    
655        (* Generate a floating point load *)        (* Generate a floating point load *)
# Line 686  Line 726 
726            | T.FMUL(64, e1, e2) => fbinary(I.FMUL, e1, e2, ft, an)            | T.FMUL(64, e1, e2) => fbinary(I.FMUL, e1, e2, ft, an)
727            | T.FDIV(64, e1, e2) => fbinary(I.FDIV, e1, e2, ft, an)            | T.FDIV(64, e1, e2) => fbinary(I.FDIV, e1, e2, ft, an)
728            | T.CVTI2F(64,_,e) =>            | T.CVTI2F(64,_,e) =>
729                 app emit (PseudoInstrs.cvti2d{reg=expr e,fd=ft})                 app emitInstruction (PseudoInstrs.cvti2d{reg=expr e,fd=ft})
730    
731              (* Single/double precision support *)              (* Single/double precision support *)
732            | T.FABS((32|64), e) => funary(I.FABS, e, ft, an)            | T.FABS((32|64), e) => funary(I.FABS, e, ft, an)
# Line 694  Line 734 
734            | T.FSQRT(32, e)     => funary(I.FSQRTS, e, ft, an)            | T.FSQRT(32, e)     => funary(I.FSQRTS, e, ft, an)
735            | T.FSQRT(64, e)     => funary(I.FSQRT, e, ft, an)            | T.FSQRT(64, e)     => funary(I.FSQRT, e, ft, an)
736    
737              | T.CVTF2F(64,32,e)  => doFexpr(e,ft,an) (* 32->64 is a no-op *)
738              | T.CVTF2F(32,32,e)  => doFexpr(e,ft,an)
739              | T.CVTF2F(64,64,e)  => doFexpr(e,ft,an)
740              | T.CVTF2F(32,64,e)  => funary(I.FRSP,e,ft,an)
741    
742              (* Misc *)              (* Misc *)
743            | T.FMARK(e, A.MARKREG f) => (f ft; doFexpr(e,ft,an))            | T.FMARK(e, A.MARKREG f) => (f ft; doFexpr(e,ft,an))
744            | T.FMARK(e, a) => doFexpr(e,ft,a::an)            | T.FMARK(e, a) => doFexpr(e,ft,a::an)
745              | T.FEXT e => ExtensionComp.compileFext (reducer()) {e=e,fd=ft,an=an}
746            | _ => error "doFexpr"            | _ => error "doFexpr"
747    
748         and ccExpr(T.CC(_,cc)) = cc         and ccExpr(T.CC(_,cc)) = cc
# Line 726  Line 772 
772            | T.CC(_,cc) => ccmove(cc,ccd,an)            | T.CC(_,cc) => ccmove(cc,ccd,an)
773            | T.CCMARK(cc,A.MARKREG f) => (f ccd; doCCexpr(cc,ccd,an))            | T.CCMARK(cc,A.MARKREG f) => (f ccd; doCCexpr(cc,ccd,an))
774            | T.CCMARK(cc,a) => doCCexpr(cc,ccd,a::an)            | T.CCMARK(cc,a) => doCCexpr(cc,ccd,a::an)
775              | T.CCEXT e =>
776                ExtensionComp.compileCCext (reducer()) {e=e, ccd=ccd, an=an}
777            | _ => error "doCCexpr: Not implemented"            | _ => error "doCCexpr: Not implemented"
778    
779        and emitTrap() = emit(I.TW{to=31,ra=zeroR,si=I.ImmedOp 0})        and emitTrap() = emit(I.TW{to=31,ra=zeroR,si=I.ImmedOp 0})
780    
781          val beginCluster = fn _ =>        and beginCluster _ =
782             (trapLabel := NONE; beginCluster 0)             (trapLabel := NONE; beginCluster 0)
783          val endCluster = fn a =>  
784          and endCluster a =
785             (case !trapLabel of             (case !trapLabel of
786                SOME label =>                SOME label =>
787                (defineLabel label; emitTrap(); trapLabel := NONE)                (defineLabel label; emitTrap(); trapLabel := NONE)
788              | NONE => ();              | NONE => ();
789             endCluster a)             endCluster a)
790    
791     in  TS.S.STREAM        and reducer() =
792              TS.REDUCER{reduceRexp    = expr,
793                         reduceFexp    = fexpr,
794                         reduceCCexp   = ccExpr,
795                         reduceStm     = stmt,
796                         operand       = (fn _ => error "operand"),
797                         reduceOperand = reduceOpn,
798                         addressOf     = (fn _ => error "addressOf"),
799                         emit          = emitInstruction o annotate,
800                         instrStream   = instrStream,
801                         mltreeStream  = self()
802              }
803           and self() =
804           TS.S.STREAM
805         { beginCluster  = beginCluster,         { beginCluster  = beginCluster,
806           endCluster    = endCluster,           endCluster    = endCluster,
807           emit          = doStmt,           emit          = doStmt,
# Line 751  Line 813 
813           getAnnotations=getAnnotations,           getAnnotations=getAnnotations,
814           exitBlock     = fn mlrisc => exitBlock(cellset mlrisc)           exitBlock     = fn mlrisc => exitBlock(cellset mlrisc)
815         }         }
816       in  self()
817     end     end
818    
819  end  end

Legend:
Removed from v.986  
changed lines
  Added in v.1722

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