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/compiler/CodeGen/main/mlriscGen.sml
ViewVC logotype

Diff of /sml/trunk/compiler/CodeGen/main/mlriscGen.sml

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

revision 4549, Tue May 1 13:07:26 2018 UTC revision 4550, Tue May 1 17:14:02 2018 UTC
# Line 169  Line 169 
169    val two  = M.LI 2    val two  = M.LI 2
170    val mlZero = one (* tagged zero *)    val mlZero = one (* tagged zero *)
171    val offp0 = CPS.OFFp 0    val offp0 = CPS.OFFp 0
172    fun LI i = M.LI (M.I.fromInt(ity, i))    val LI = M.LI
173    fun LW w = M.LI (M.I.fromWord32(ity, w))    fun LI' i = LI (M.I.fromInt(ity, i))
174    fun LW' w = M.LI (M.I.fromWord(ity, w))    fun LW w = LI (M.I.fromWord32(ity, w))
175    val constBaseRegOffset = LI MachineSpec.constBaseRegOffset    fun LW' w = LI (M.I.fromWord(ity, w))
176    
177      val constBaseRegOffset = LI' MachineSpec.constBaseRegOffset
178    
179    (*    (*
180     * The allocation pointer.  This must be a register     * The allocation pointer.  This must be a register
# Line 487  Line 489 
489             *             *
490             * Note: For GC safety, we considered this to be an object reference             * Note: For GC safety, we considered this to be an object reference
491             *)             *)
492            fun laddr(lab, k) =            fun laddr (lab, k) = let
493            let val e =                  val e = M.ADD(addrTy, C.baseptr vfp,
               M.ADD(addrTy, C.baseptr(vfp),  
494                      M.LABEXP(M.ADD(addrTy,M.LABEL lab,                      M.LABEXP(M.ADD(addrTy,M.LABEL lab,
495                               M.LI(IntInf.fromInt                              LI'(k - MachineSpec.constBaseRegOffset))))
496                                    (k-MachineSpec.constBaseRegOffset)))))                  in
497            in  markPTR e end                    markPTR e
498                    end
499    
500            (*            (*
501             * The following function looks up the MLTREE expression associated             * The following function looks up the MLTREE expression associated
# Line 509  Line 511 
511            fun resolveHpOffset(M.CONST(absoluteHpOffset)) =            fun resolveHpOffset(M.CONST(absoluteHpOffset)) =
512                let val tmpR = newReg PTR                let val tmpR = newReg PTR
513                    val offset = absoluteHpOffset - !advancedHP                    val offset = absoluteHpOffset - !advancedHP
514                in  emit(M.MV(pty, tmpR, M.ADD(addrTy, C.allocptr, LI offset)));                in  emit(M.MV(pty, tmpR, M.ADD(addrTy, C.allocptr, LI' offset)));
515                    M.REG(pty, tmpR)                    M.REG(pty, tmpR)
516                end                end
517              | resolveHpOffset(e) = e              | resolveHpOffset(e) = e
518    
519            fun regbind (CPS.VAR v) = resolveHpOffset(lookupGpRegTbl v)            fun regbind (CPS.VAR v) = resolveHpOffset(lookupGpRegTbl v)
520              | regbind (CPS.INT i) = LI (i+i+1)              | regbind (CPS.INT i) = LI' (i+i+1)
521              | regbind (CPS.INT32 w) = LW w              | regbind (CPS.INT32 w) = LW w
522              | regbind (CPS.LABEL v) =              | regbind (CPS.LABEL v) =
523                  laddr(functionLabel(if splitEntry then ~v-1 else v), 0)                  laddr(functionLabel(if splitEntry then ~v-1 else v), 0)
# Line 526  Line 528 
528             *)             *)
529            fun resolveHpOffset'(M.CONST(absoluteHpOffset)) =            fun resolveHpOffset'(M.CONST(absoluteHpOffset)) =
530                let val offset = absoluteHpOffset - !advancedHP                let val offset = absoluteHpOffset - !advancedHP
531                in  markPTR(M.ADD(addrTy, C.allocptr, LI offset))                in  markPTR(M.ADD(addrTy, C.allocptr, LI' offset))
532                end                end
533              | resolveHpOffset'(e) = e              | resolveHpOffset'(e) = e
534    
535            fun regbind' (CPS.VAR v) = resolveHpOffset'(lookupGpRegTbl v)            fun regbind' (CPS.VAR v) = resolveHpOffset'(lookupGpRegTbl v)
536              | regbind' (CPS.INT i) = LI (i+i+1)              | regbind' (CPS.INT i) = LI' (i+i+1)
537              | regbind' (CPS.INT32 w) = LW w              | regbind' (CPS.INT32 w) = LW w
538              | regbind' (CPS.LABEL v) =              | regbind' (CPS.LABEL v) =
539                    laddr(functionLabel(if splitEntry then ~v-1 else v), 0)                    laddr(functionLabel(if splitEntry then ~v-1 else v), 0)
# Line 609  Line 611 
611            fun updtHeapPtr(hp) =            fun updtHeapPtr(hp) =
612            let fun advBy hp =            let fun advBy hp =
613                 (advancedHP := !advancedHP + hp;                 (advancedHP := !advancedHP + hp;
614                  emit(M.MV(pty, allocptrR, M.ADD(addrTy, C.allocptr, LI hp))))                  emit(M.MV(pty, allocptrR, M.ADD(addrTy, C.allocptr, LI' hp))))
615            in  if hp = 0 then ()            in  if hp = 0 then ()
616                else if Word.andb(Word.fromInt hp, Word.fromInt ws) <> 0w0 then advBy(hp+ws)                else if Word.andb(Word.fromInt hp, Word.fromInt ws) <> 0w0 then advBy(hp+ws)
617                else advBy(hp)                else advBy(hp)
# Line 631  Line 633 
633             *   x <- [descriptor ... fields]             *   x <- [descriptor ... fields]
634             *)             *)
635            fun ea(r, 0) = r            fun ea(r, 0) = r
636              | ea(r, n) = M.ADD(addrTy, r, LI n)              | ea(r, n) = M.ADD(addrTy, r, LI' n)
637            fun indexEA(r, 0) = r            fun indexEA(r, 0) = r
638              | indexEA(r, n) = M.ADD(addrTy, r, LI(n*ws))              | indexEA(r, n) = M.ADD(addrTy, r, LI'(n*ws))
639    
640            fun allocRecord(markComp, mem, desc, fields, hp) =            fun allocRecord(markComp, mem, desc, fields, hp) =
641            let fun getField(v, e, CPS.OFFp 0) = e            let fun getField(v, e, CPS.OFFp 0) = e
642                  | getField(v, e, CPS.OFFp n) = M.ADD(addrTy, e, LI(ws*n))                  | getField(v, e, CPS.OFFp n) = M.ADD(addrTy, e, LI'(ws*n))
643                  | getField(v, e, p) = getPath(getRegion v, e, p)                  | getField(v, e, p) = getPath(getRegion v, e, p)
644    
645                and getPath(mem, e, CPS.OFFp n) = indexEA(e, n)                and getPath(mem, e, CPS.OFFp n) = indexEA(e, n)
# Line 650  Line 652 
652    
653                fun storeFields([], hp, elem) = hp                fun storeFields([], hp, elem) = hp
654                  | storeFields((v, p)::fields, hp, elem) =                  | storeFields((v, p)::fields, hp, elem) =
655                    (emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI hp),                    (emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI' hp),
656                             getField(v, regbind' v, p), pi(mem, elem)));                             getField(v, regbind' v, p), pi(mem, elem)));
657                     storeFields(fields, hp+ws, elem+1)                     storeFields(fields, hp+ws, elem+1)
658                    )                    )
# Line 666  Line 668 
668             *)             *)
669            fun allocFrecord(mem, desc, fields, hp) =            fun allocFrecord(mem, desc, fields, hp) =
670            let fun fea(r, 0) = r            let fun fea(r, 0) = r
671                  | fea(r, n) = M.ADD(addrTy, r, LI(n*8))                  | fea(r, n) = M.ADD(addrTy, r, LI'(n*8))
672                fun fgetField(v, CPS.OFFp 0) = fregbind v                fun fgetField(v, CPS.OFFp 0) = fregbind v
673                  | fgetField(v, CPS.OFFp _) = error "allocFrecord.fgetField"                  | fgetField(v, CPS.OFFp _) = error "allocFrecord.fgetField"
674                  | fgetField(v, p) = fgetPath(getRegion v, regbind' v, p)                  | fgetField(v, p) = fgetPath(getRegion v, regbind' v, p)
# Line 681  Line 683 
683    
684                fun fstoreFields([], hp, elem) = hp                fun fstoreFields([], hp, elem) = hp
685                  | fstoreFields((v, p)::fields, hp, elem) =                  | fstoreFields((v, p)::fields, hp, elem) =
686                    (emit(M.FSTORE(fty, M.ADD(addrTy, C.allocptr, LI hp),                    (emit(M.FSTORE(fty, M.ADD(addrTy, C.allocptr, LI' hp),
687                                   fgetField(v, p), pi(mem, elem)));                                   fgetField(v, p), pi(mem, elem)));
688                     fstoreFields(fields, hp+8, elem+1)                     fstoreFields(fields, hp+8, elem+1)
689                    )                    )
# Line 692  Line 694 
694    
695          (* Allocate a header pair for a known-length vector or array *)          (* Allocate a header pair for a known-length vector or array *)
696            fun allocHeaderPair (hdrDesc, mem, dataPtr, len, hp) = (            fun allocHeaderPair (hdrDesc, mem, dataPtr, len, hp) = (
697                  emit(M.STORE(ity, ea(C.allocptr, hp), M.LI hdrDesc, pi(mem,~1)));                  emit(M.STORE(ity, ea(C.allocptr, hp), LI hdrDesc, pi(mem,~1)));
698                  emit(M.STORE(ity, ea(C.allocptr, hp+ws), M.REG(ity, dataPtr),pi(mem, 0)));                  emit(M.STORE(ity, ea(C.allocptr, hp+ws), M.REG(ity, dataPtr),pi(mem, 0)));
699                  emit(M.STORE(ity, ea(C.allocptr, hp+2*ws), LI(len+len+1), pi(mem, 1)));                  emit(M.STORE(ity, ea(C.allocptr, hp+2*ws), LI'(len+len+1), pi(mem, 1)));
700                  hp+ws)                  hp+ws)
701    
702            (*            (*
# Line 729  Line 731 
731    
732            fun untag (true, e) = untagSigned e            fun untag (true, e) = untagSigned e
733              | untag (false, e) = untagUnsigned e              | untag (false, e) = untagUnsigned e
734            and untagUnsigned (CPS.INT i) = LI i            and untagUnsigned (CPS.INT i) = LI' i
735              | untagUnsigned v = M.SRL(ity, regbind v, one)              | untagUnsigned v = M.SRL(ity, regbind v, one)
736            and untagSigned (CPS.INT i) = LI i            and untagSigned (CPS.INT i) = LI' i
737              | untagSigned v = M.SRA(ity, regbind v, one)              | untagSigned v = M.SRA(ity, regbind v, one)
738    
739            (*            (*
740             * Tagged integer operators             * Tagged integer operators
741             *)             *)
742            fun int31add (addOp, CPS.INT k, w) = addOp(ity, LI(k+k), regbind w)            fun int31add (addOp, CPS.INT k, w) = addOp(ity, LI'(k+k), regbind w)
743              | int31add (addOp, w, v as CPS.INT _) = int31add(addOp, v, w)              | int31add (addOp, w, v as CPS.INT _) = int31add(addOp, v, w)
744              | int31add (addOp, v, w) = addOp(ity,regbind v,stripTag(regbind w))              | int31add (addOp, v, w) = addOp(ity,regbind v,stripTag(regbind w))
745    
746            fun int31sub (subOp, CPS.INT k, w) = subOp(ity, LI(k+k+2), regbind w)            fun int31sub (subOp, CPS.INT k, w) = subOp(ity, LI'(k+k+2), regbind w)
747              | int31sub (subOp, v, CPS.INT k) = subOp(ity, regbind v, LI(k+k))              | int31sub (subOp, v, CPS.INT k) = subOp(ity, regbind v, LI'(k+k))
748              | int31sub (subOp, v, w) = addTag(subOp(ity, regbind v, regbind w))              | int31sub (subOp, v, w) = addTag(subOp(ity, regbind v, regbind w))
749    
750            fun int31xor (CPS.INT k, w) = M.XORB(ity, LI(k+k), regbind w)            fun int31xor (CPS.INT k, w) = M.XORB(ity, LI'(k+k), regbind w)
751              | int31xor (w, v as CPS.INT _) = int31xor (v,w)              | int31xor (w, v as CPS.INT _) = int31xor (v,w)
752              | int31xor (v, w) = addTag (M.XORB(ity, regbind v, regbind w))              | int31xor (v, w) = addTag (M.XORB(ity, regbind v, regbind w))
753    
754            fun int31mul (signed, mulOp, v, w) = let            fun int31mul (signed, mulOp, v, w) = let
755                  fun f (CPS.INT k, CPS.INT j) = (LI(k+k), LI j)                  fun f (CPS.INT k, CPS.INT j) = (LI'(k+k), LI' j)
756                    | f (CPS.INT k, w) = (untag(signed,w), LI(k+k))                    | f (CPS.INT k, w) = (untag(signed,w), LI'(k+k))
757                    | f (v, w as CPS.INT _) = f(w, v)                    | f (v, w as CPS.INT _) = f(w, v)
758                    | f (v, w) = (stripTag(regbind v), untag(signed,w))                    | f (v, w) = (stripTag(regbind v), untag(signed,w))
759                  val (v, w) = f(v, w)                  val (v, w) = f(v, w)
# Line 761  Line 763 
763    
764            fun int31div (signed, drm, v, w) = let            fun int31div (signed, drm, v, w) = let
765                  val (v, w) = (case (v, w)                  val (v, w) = (case (v, w)
766                         of (CPS.INT k, CPS.INT j) => (LI k, LI j)                         of (CPS.INT k, CPS.INT j) => (LI' k, LI' j)
767                          | (CPS.INT k, w) => (LI k, untag(signed, w))                          | (CPS.INT k, w) => (LI' k, untag(signed, w))
768                          | (v, CPS.INT k) => (untag(signed, v), LI(k))                          | (v, CPS.INT k) => (untag(signed, v), LI' k)
769                          | (v, w) => (untag(signed, v), untag(signed, w))                          | (v, w) => (untag(signed, v), untag(signed, w))
770                        (* end case *))                        (* end case *))
771                  in                  in
# Line 776  Line 778 
778    
779            fun int31rem (signed, drm, v, w) = let            fun int31rem (signed, drm, v, w) = let
780                  val (v, w) = (case (v, w)                  val (v, w) = (case (v, w)
781                         of (CPS.INT k, CPS.INT j) => (LI k, LI j)                         of (CPS.INT k, CPS.INT j) => (LI' k, LI' j)
782                          | (CPS.INT k, w) => (LI k, untag(signed, w))                          | (CPS.INT k, w) => (LI' k, untag(signed, w))
783                          | (v, CPS.INT k) => (untag(signed, v), LI(k))                          | (v, CPS.INT k) => (untag(signed, v), LI' k)
784                          | (v, w) => (untag(signed, v), untag(signed, w))                          | (v, w) => (untag(signed, v), untag(signed, w))
785                        (* end case *))                        (* end case *))
786                  in                  in
# Line 787  Line 789 
789                  end                  end
790    
791            fun int31lshift (CPS.INT k, w) =            fun int31lshift (CPS.INT k, w) =
792                  addTag (M.SLL(ity, LI(k+k), untagUnsigned(w)))                  addTag (M.SLL(ity, LI'(k+k), untagUnsigned(w)))
793              | int31lshift (v, CPS.INT k) =              | int31lshift (v, CPS.INT k) =
794                  addTag(M.SLL(ity,stripTag(regbind v), LI(k)))                  addTag(M.SLL(ity,stripTag(regbind v), LI' k))
795              | int31lshift (v,w) =              | int31lshift (v,w) =
796                  addTag(M.SLL(ity,stripTag(regbind v), untagUnsigned(w)))                  addTag(M.SLL(ity,stripTag(regbind v), untagUnsigned(w)))
797    
798            fun int31rshift (rshiftOp, v, CPS.INT k) =            fun int31rshift (rshiftOp, v, CPS.INT k) =
799                  orTag(rshiftOp(ity, regbind v, LI k))                  orTag(rshiftOp(ity, regbind v, LI' k))
800              | int31rshift (rshiftOp, v, w) =              | int31rshift (rshiftOp, v, w) =
801                  orTag(rshiftOp(ity, regbind v, untagUnsigned(w)))                  orTag(rshiftOp(ity, regbind v, untagUnsigned(w)))
802    
803            fun getObjDescriptor v =            fun getObjDescriptor v =
804                  M.LOAD(ity, M.SUB(pty, regbind v, LI ws), getRegionPi(v, ~1))                  M.LOAD(ity, M.SUB(pty, regbind v, LI' ws), getRegionPi(v, ~1))
805    
806            fun getObjLength v =            fun getObjLength v =
807                  M.SRL(ity, getObjDescriptor v, LW'(D.tagWidth - 0w1))                  M.SRL(ity, getObjDescriptor v, LW'(D.tagWidth - 0w1))
# Line 855  Line 857 
857    
858            (* scale-and-add *)            (* scale-and-add *)
859            fun scale1 (a, CPS.INT 0) = a            fun scale1 (a, CPS.INT 0) = a
860              | scale1 (a, CPS.INT k) = M.ADD(ity, a, LI k)              | scale1 (a, CPS.INT k) = M.ADD(ity, a, LI' k)
861              | scale1 (a, i) = M.ADD(ity, a, untagSigned(i))              | scale1 (a, i) = M.ADD(ity, a, untagSigned(i))
862    
863            fun scale4 (a, CPS.INT 0) = a            fun scale4 (a, CPS.INT 0) = a
864              | scale4 (a, CPS.INT i) = M.ADD(ity, a, LI(i*4))              | scale4 (a, CPS.INT i) = M.ADD(ity, a, LI'(i*4))
865              | scale4 (a, i) = M.ADD(ity, a, M.SLL(ity, untagSigned(i), two))              | scale4 (a, i) = M.ADD(ity, a, M.SLL(ity, untagSigned(i), two))
866    
867            fun scale8 (a, CPS.INT 0) = a            fun scale8 (a, CPS.INT 0) = a
868              | scale8 (a, CPS.INT i) = M.ADD(ity, a, LI(i*8))              | scale8 (a, CPS.INT i) = M.ADD(ity, a, LI'(i*8))
869              | scale8 (a, i) = M.ADD(ity, a, M.SLL(ity, stripTag(regbind i), two))              | scale8 (a, i) = M.ADD(ity, a, M.SLL(ity, stripTag(regbind i), two))
870    
871            val scaleWord = (case ws            val scaleWord = (case ws
# Line 880  Line 882 
882    
883            (* add to storelist, the address where a boxed update has occured *)            (* add to storelist, the address where a boxed update has occured *)
884            fun recordStore (tmp, hp) = (            fun recordStore (tmp, hp) = (
885                  emit (M.STORE(pty, M.ADD(addrTy, C.allocptr, LI hp), tmp, R.storelist));                  emit (M.STORE(pty, M.ADD(addrTy, C.allocptr, LI' hp), tmp, R.storelist));
886                  emit (M.STORE(pty, M.ADD(addrTy, C.allocptr, LI(hp+ws)),                  emit (M.STORE(pty, M.ADD(addrTy, C.allocptr, LI'(hp+ws)),
887                                C.storeptr(vfp), R.storelist));                                C.storeptr(vfp), R.storelist));
888                  emit (assign(C.storeptr(vfp), M.ADD(addrTy, C.allocptr, LI hp))))                  emit (assign(C.storeptr(vfp), M.ADD(addrTy, C.allocptr, LI' hp))))
889    
890            fun unsignedCmp oper =            fun unsignedCmp oper =
891                case oper                case oper
# Line 921  Line 923 
923    
924            local            local
925              open CPS              open CPS
926              (* evaluate a comparison of constants. *)
927                fun evalCmp (nk, cmpOp, a, b) = (case (nk, cmpOp)
928                     of (P.UINT sz, P.>) => ConstArith.uLess(sz, b, a)
929                      | (P.INT _, P.>) => (a > b)
930                      | (P.UINT sz, P.>=) => ConstArith.uLessEq(sz, b, a)
931                      | (P.INT _, P.>=) => (a >= b)
932                      | (P.UINT sz, P.<) => ConstArith.uLess(sz, a, b)
933                      | (P.INT _, P.<) => (a < b)
934                      | (P.UINT sz, P.<=) => ConstArith.uLessEq(sz, a, b)
935                      | (P.INT _, P.<=) => (a <= b)
936                      | (_, P.eql) => (a = b)
937                      | (_, P.neq) => (a <> b)
938                      | _ => error "evalCmp: bogus numkind"
939                    (* end case *))
940            in            in
941    
942            (*            (*
# Line 1063  Line 1079 
1079    
1080                (* Align the allocation pointer if necessary *)                (* Align the allocation pointer if necessary *)
1081                if !hasFloats                if !hasFloats
1082                  then emit(M.MV(pty, allocptrR, M.ORB(pty, C.allocptr, LI ws)))                  then emit(M.MV(pty, allocptrR, M.ORB(pty, C.allocptr, LI' ws)))
1083                  else ();                  else ();
1084    
1085                (* Generate code *)                (* Generate code *)
# Line 1116  Line 1132 
1132             * If x is only used once, we try to propagate that to its use.             * If x is only used once, we try to propagate that to its use.
1133             *)             *)
1134            and defAlloc (x, offset, k, hp) =            and defAlloc (x, offset, k, hp) =
1135                  defBoxed(x, M.ADD(addrTy, C.allocptr, LI offset), k, hp)                  defBoxed(x, M.ADD(addrTy, C.allocptr, LI' offset), k, hp)
1136    
1137            (* Generate code for            (* Generate code for
1138             *    x := allocptr + offset; k             *    x := allocptr + offset; k
# Line 1206  Line 1222 
1222                              M.LOAD(ity,M.ADD(ity,M.REG(ity, r2),i),R.readonly))                              M.LOAD(ity,M.ADD(ity,M.REG(ity, r2),i),R.readonly))
1223                    fun unroll i =                    fun unroll i =
1224                        if i=n' then ()                        if i=n' then ()
1225                        else (emit(M.BCC(cmpWord(LI(i)), false_lab));                        else (emit(M.BCC(cmpWord(LI' i), false_lab));
1226                              unroll (i+4))                              unroll (i+4))
1227                in  emit(M.MV(ity, r1, M.LOAD(ity, regbind v, R.readonly)));                in  emit(M.MV(ity, r1, M.LOAD(ity, regbind v, R.readonly)));
1228                    emit(M.MV(ity, r2, M.LOAD(ity, regbind w, R.readonly)));                    emit(M.MV(ity, r2, M.LOAD(ity, regbind w, R.readonly)));
# Line 1285  Line 1301 
1301                  val desc = D.makeDesc' (len, D.tag_record)                  val desc = D.makeDesc' (len, D.tag_record)
1302                  in                  in
1303                    treeifyAlloc(w,                    treeifyAlloc(w,
1304                      allocRecord(markPTR, memDisambig w, M.LI desc, vl, hp),                      allocRecord(markPTR, memDisambig w, LI desc, vl, hp),
1305                        e, hp+ws+len*ws)                        e, hp+ws+len*ws)
1306                  end                  end
1307    
# Line 1295  Line 1311 
1311                  val desc = D.makeDesc' (len, D.tag_raw32)                  val desc = D.makeDesc' (len, D.tag_raw32)
1312                  in                  in
1313                    treeifyAlloc(w,                    treeifyAlloc(w,
1314                      allocRecord(markI32, memDisambig w, M.LI desc, vl, hp),                      allocRecord(markI32, memDisambig w, LI desc, vl, hp),
1315                        e, hp+ws+len*ws)                        e, hp+ws+len*ws)
1316                  end                  end
1317    
# Line 1313  Line 1329 
1329                          else hp                          else hp
1330                  in  (* The components are floating point *)                  in  (* The components are floating point *)
1331                    treeifyAlloc(w,                    treeifyAlloc(w,
1332                      allocFrecord(memDisambig w, M.LI desc, vl, hp),                      allocFrecord(memDisambig w, LI desc, vl, hp),
1333                        e, hp+ws+len*8)                        e, hp+ws+len*8)
1334                  end                  end
1335    
# Line 1327  Line 1343 
1343                  val hp' = hp + ws + len*ws                  val hp' = hp + ws + len*ws
1344                  in  (* The components are boxed *)                  in  (* The components are boxed *)
1345                    (* Allocate the data *)                    (* Allocate the data *)
1346                    allocRecord(markPTR, mem, M.LI dataDesc, vl, hp);                    allocRecord(markPTR, mem, LI dataDesc, vl, hp);
1347                    emit(M.MV(pty, dataPtr, ea(C.allocptr, hp+ws)));                    emit(M.MV(pty, dataPtr, ea(C.allocptr, hp+ws)));
1348                    (* Now allocate the header pair *)                    (* Now allocate the header pair *)
1349                    treeifyAlloc(w,                    treeifyAlloc(w,
# Line 1366  Line 1382 
1382                      executed; its semantics is completely screwed up !                      executed; its semantics is completely screwed up !
1383                    *)                    *)
1384                in  if isFlt t then fallocSp(x, e, hp)                in  if isFlt t then fallocSp(x, e, hp)
1385                    else defI32(x, LI k, e, hp)(* BOGUS *)                    else defI32(x, LI' k, e, hp)(* BOGUS *)
1386                end                end
1387    
1388            (*            (*
# Line 1608  Line 1624 
1624              | gen (PURE(P.pure_arith{oper=P.notb, kind}, [v], x, _, e), hp) =              | gen (PURE(P.pure_arith{oper=P.notb, kind}, [v], x, _, e), hp) =
1625                 (case kind                 (case kind
1626                  of (P.UINT 32 | P.INT 32) =>                  of (P.UINT 32 | P.INT 32) =>
1627                       defI32(x, M.XORB(ity, regbind v, LW 0wxFFFFFFFF), e, hp)                       defI32(x, M.XORB(ity, regbind v, LI 0xFFFFFFFF), e, hp)
1628                   | (P.UINT 31 | P.INT 31) =>                   | (P.UINT 31 | P.INT 31) =>
1629                       defI31(x, M.SUB(ity, zero, regbind v), e, hp)                       defI31(x, M.SUB(ity, zero, regbind v), e, hp)
1630                   | _ => error "unexpected numkind in pure notb arithop"                   | _ => error "unexpected numkind in pure notb arithop"
# Line 1690  Line 1706 
1706                end                end
1707              | gen (PURE(P.gettag, [v], x, _, e), hp) =              | gen (PURE(P.gettag, [v], x, _, e), hp) =
1708                  defI31(x, tagUnsigned(M.ANDB(ity,                  defI31(x, tagUnsigned(M.ANDB(ity,
1709                               getObjDescriptor(v), M.LI(D.powTagWidth-1))),                               getObjDescriptor(v), LI(D.powTagWidth-1))),
1710                        e, hp)                        e, hp)
1711              | gen (PURE(P.mkspecial, [i, v], x, _, e), hp) =              | gen (PURE(P.mkspecial, [i, v], x, _, e), hp) =
1712                let val desc = case i                let val desc = case i
1713                    of INT n => M.LI(D.makeDesc'(n, D.tag_special))                    of INT n => LI(D.makeDesc'(n, D.tag_special))
1714                     | _ => M.ORB(ity, M.SLL(ity, untagSigned i, LW' D.tagWidth),                     | _ => M.ORB(ity, M.SLL(ity, untagSigned i, LW' D.tagWidth),
1715                                  M.LI D.desc_special)                                  LI D.desc_special)
1716                in  (* What gc types are the components? *)                in  (* What gc types are the components? *)
1717                    treeifyAlloc(x,                    treeifyAlloc(x,
1718                      allocRecord(markNothing, memDisambig x,                      allocRecord(markNothing, memDisambig x,
# Line 1704  Line 1720 
1720                      e, hp+8)                      e, hp+8)
1721                end                end
1722              | gen (PURE(P.makeref, [v], x, _, e), hp) =              | gen (PURE(P.makeref, [v], x, _, e), hp) =
1723                let val tag = M.LI D.desc_ref                let val tag = LI D.desc_ref
1724                    val mem = memDisambig x                    val mem = memDisambig x
1725                in  emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI hp), tag, mem));                in  emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI' hp), tag, mem));
1726                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI(hp+ws)),                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI'(hp+ws)),
1727                                 regbind' v, mem));                                 regbind' v, mem));
1728                    treeifyAlloc(x, hp+ws, e, hp+2*ws)                    treeifyAlloc(x, hp+ws, e, hp+2*ws)
1729                end                end
# Line 1748  Line 1764 
1764                    val hdrM = memDisambig x                    val hdrM = memDisambig x
1765                    val (tagM, valM) = (hdrM, hdrM) (* Allen *)                    val (tagM, valM) = (hdrM, hdrM) (* Allen *)
1766                in  (* gen code to allocate "ref()" for array data *)                in  (* gen code to allocate "ref()" for array data *)
1767                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI hp),                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI' hp),
1768                                 M.LI dataDesc, tagM));                                 LI dataDesc, tagM));
1769                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI(hp+ws)),                    emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, LI'(hp+ws)),
1770                                 mlZero, valM));                                 mlZero, valM));
1771                    emit(M.MV(pty, dataPtr, M.ADD(addrTy,C.allocptr,LI(hp+ws))));                    emit(M.MV(pty, dataPtr, M.ADD(addrTy,C.allocptr,LI'(hp+ws))));
1772                    (* gen code to allocate array header *)                    (* gen code to allocate array header *)
1773                    treeifyAlloc(x,                    treeifyAlloc(x,
1774                       allocHeaderPair(hdrDesc, hdrM, dataPtr, 0, hp+2*ws),                       allocHeaderPair(hdrDesc, hdrM, dataPtr, 0, hp+2*ws),
# Line 1781  Line 1797 
1797                  val mem = memDisambig x                  val mem = memDisambig x
1798                  in                  in
1799                  (* store tag now! *)                  (* store tag now! *)
1800                    emit(M.STORE(ity, ea(C.allocptr, hp), M.LI desc, pi(mem, ~1)));                    emit(M.STORE(ity, ea(C.allocptr, hp), LI desc, pi(mem, ~1)));
1801                  (* assign the address to x *)                  (* assign the address to x *)
1802                    treeifyAlloc(x, hp+ws, e, hp+len*ws+ws)                    treeifyAlloc(x, hp+ws, e, hp+len*ws+ws)
1803                  end                  end
# Line 1852  Line 1868 
1868                let val xreg = newReg I32                let val xreg = newReg I32
1869                    val vreg = regbind v                    val vreg = regbind v
1870                in  updtHeapPtr hp;                in  updtHeapPtr hp;
1871                    emit(M.MV(ity, xreg, M.ADDT(ity, vreg, LW 0wx80000000)));                    emit(M.MV(ity, xreg, M.ADDT(ity, vreg, LI 0x80000000)));
1872                    defI32(x, vreg, e, 0)                    defI32(x, vreg, e, 0)
1873                end                end
1874              | gen (ARITH(P.testu(31,31), [v], x, _, e), hp) =              | gen (ARITH(P.testu(31,31), [v], x, _, e), hp) =
1875                let val xreg = newReg I31                let val xreg = newReg I31
1876                    val vreg = regbind v                    val vreg = regbind v
1877                in  updtHeapPtr hp;                in  updtHeapPtr hp;
1878                    emit(M.MV(ity,xreg,M.ADDT(ity, vreg, LW 0wx80000000)));                    emit(M.MV(ity,xreg,M.ADDT(ity, vreg, LI 0x80000000)));
1879                    defI31(x, vreg, e, 0)                    defI31(x, vreg, e, 0)
1880                end                end
1881              | gen (ARITH(P.testu(32,31), [v], x, _, e), hp) =              | gen (ARITH(P.testu(32,31), [v], x, _, e), hp) =
# Line 1867  Line 1883 
1883                    val tmp = newReg I32                    val tmp = newReg I32
1884                    val tmpR = M.REG(ity,tmp)                    val tmpR = M.REG(ity,tmp)
1885                    val lab = newLabel ()                    val lab = newLabel ()
1886                in  emit(M.MV(ity, tmp, LW 0wx3fffffff));                in  emit(M.MV(ity, tmp, LI 0x3fffffff));
1887                    updtHeapPtr hp;                    updtHeapPtr hp;
1888                    emit                    emit
1889                      (branchWithProb(M.BCC(M.CMP(32, M.LEU, vreg, tmpR),lab),                      (branchWithProb(M.BCC(M.CMP(32, M.LEU, vreg, tmpR),lab),
# Line 2000  Line 2016 
2016                let val ea = M.SUB(ity, regbind v, LI 4)                let val ea = M.SUB(ity, regbind v, LI 4)
2017                    val i' =                    val i' =
2018                      case i                      case i
2019                       of INT k => M.LI(D.makeDesc'(k, D.tag_special))                       of INT k => LI(D.makeDesc'(k, D.tag_special))
2020                        | _ => M.ORB(ity, M.SLL(ity, untagSigned i, LW' D.tagWidth),                        | _ => M.ORB(ity, M.SLL(ity, untagSigned i, LW' D.tagWidth),
2021                                    M.LI D.desc_special)                                    LI D.desc_special)
2022                    val mem = getRegionPi(v, 0)                    val mem = getRegionPi(v, 0)
2023                in  emit(M.STORE(ity, ea, i', mem));                in  emit(M.STORE(ity, ea, i', mem));
2024                    gen(e, hp)                    gen(e, hp)
# Line 2046  Line 2062 
2062                end                end
2063    
2064              (*** BRANCH  ***)              (*** BRANCH  ***)
2065              | gen (BRANCH(P.cmp{oper,kind=P.INT 31},[INT v, INT k],_,e,d), hp) =              | gen (BRANCH(P.cmp{oper, kind},[INT v, INT k], _, e, d), hp) =
2066                if (case oper                  if evalCmp(kind, oper, IntInf.fromInt v, IntInf.fromInt k)
                     of P.> => v>k  
                      | P.>= => v>=k  
                      | P.< => v<k  
                      | P.<= => v<=k  
                      | P.eql => v=k  
                      | P.neq => v<>k  
                 (*esac*))  
2067                then gen(e, hp)                then gen(e, hp)
2068                else gen(d, hp)                else gen(d, hp)
2069              | gen (BRANCH(P.cmp{oper,kind=P.INT 32},[INT32 v',INT32 k'],_,e,d), hp) = let              | gen (BRANCH(P.cmp{oper, kind}, [INT32 v, INT32 k],_,e,d), hp) =
2070                  val v = Word32.toLargeIntX v'                  if evalCmp(kind, oper, Word32.toLargeIntX v, Word32.toLargeIntX k)
                 val k = Word32.toLargeIntX k'  
                 in  
                   if (case oper  
                        of P.> => v>k  
                         | P.>= => v>=k  
                         | P.< => v<k  
                         | P.<= => v<=k  
                         | P.eql => v=k  
                         | P.neq => v<>k  
                       (* end case *))  
2071                      then gen(e, hp)                      then gen(e, hp)
2072                      else gen(d, hp)                      else gen(d, hp)
                 end  
2073              | gen (BRANCH(P.cmp{oper, kind=P.INT _}, vw, p, e, d), hp) =              | gen (BRANCH(P.cmp{oper, kind=P.INT _}, vw, p, e, d), hp) =
2074                  branch(p, signedCmp oper, vw, e, d, hp)                  branch(p, signedCmp oper, vw, e, d, hp)
             | gen (BRANCH(P.cmp{oper,kind=P.UINT 31},[INT v', INT k'],_,e,d),hp)=  
               let open Word  
                   val v = fromInt v'  
                   val k = fromInt k'  
               in  if (case oper  
                         of P.> => v>k  
                          | P.>= => v>=k  
                          | P.< => v<k  
                          | P.<= => v<=k  
                          | P.eql => v=k  
                          | P.neq => v<>k  
                     (*esac*))  
                   then gen(e, hp)  
                   else gen(d, hp)  
               end  
             | gen (BRANCH(P.cmp{oper,kind=P.UINT 32},[INT32 v,INT32 k],_,e,d),  
                   hp) =  
               let open Word32  
               in  if (case oper  
                         of P.> => v>k  
                          | P.>= => v>=k  
                          | P.< => v<k  
                          | P.<= => v<=k  
                          | P.eql => v=k  
                          | P.neq => v<>k  
                     (*esac*))  
                   then gen(e, hp)  
                   else gen(d, hp)  
               end  
2075              | gen (BRANCH(P.cmp{oper, kind=P.UINT _}, vw, p, e, d), hp) =              | gen (BRANCH(P.cmp{oper, kind=P.UINT _}, vw, p, e, d), hp) =
2076                  branch(p, unsignedCmp oper, vw, e, d, hp)                  branch(p, unsignedCmp oper, vw, e, d, hp)
2077  (* REAL32: FIXME *)  (* REAL32: FIXME *)
# Line 2113  Line 2082 
2082                  val rReg = M.REG(ity, r')                  val rReg = M.REG(ity, r')
2083                (* address of the word that contains the sign bit *)                (* address of the word that contains the sign bit *)
2084                  val addr = if MachineSpec.bigEndian                  val addr = if MachineSpec.bigEndian
2085                        then M.ADD(addrTy, C.allocptr, LI hp)                        then M.ADD(addrTy, C.allocptr, LI' hp)
2086                        else M.ADD(pty, rReg, LI((fty - pty) div 8))                        else M.ADD(pty, rReg, LI'((fty - pty) div 8))
2087                  in                  in
2088                    emit(M.MV(ity, r', M.ADD(addrTy, C.allocptr, LI hp)));                    emit(M.MV(ity, r', M.ADD(addrTy, C.allocptr, LI' hp)));
2089                    emit(M.FSTORE(fty,rReg,r,R.memory));                    emit(M.FSTORE(fty,rReg,r,R.memory));
2090                    emit(M.BCC(M.CMP(ity, M.LT, M.LOAD(ity, addr, R.memory), zero), trueLab));                    emit(M.BCC(M.CMP(ity, M.LT, M.LOAD(ity, addr, R.memory), zero), trueLab));
2091                    genCont(e, hp);                    genCont(e, hp);

Legend:
Removed from v.4549  
changed lines
  Added in v.4550

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