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/branches/primop-branch-2/src/compiler/FLINT/trans/translate.sml
 [smlnj] / sml / branches / primop-branch-2 / src / compiler / FLINT / trans / translate.sml

Diff of /sml/branches/primop-branch-2/src/compiler/FLINT/trans/translate.sml

revision 1182, Thu Mar 28 16:41:29 2002 UTC revision 1183, Fri Mar 29 19:09:48 2002 UTC
# Line 444  Line 444
444     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))
445    end    end
446
fun intOp p = PRIM(p, lt_intop, [])
447  fun cmpOp p = PRIM(p, lt_icmp, [])  fun cmpOp p = PRIM(p, lt_icmp, [])
448  fun inegOp p = PRIM(p, lt_ineg, [])  fun inegOp p = PRIM(p, lt_ineg, [])
449
fun DIV(b,c) = APP(intOp(PO.IDIV), RECORD[b, c])
450  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}
451
(* pure arith on int31 (guaranteed to not overflow) *)
val pIADD = PO.ARITH { oper=PO.+, overflow = false, kind = PO.INT 31 }
val pISUB = PO.ARITH { oper=PO.-, overflow = false, kind = PO.INT 31 }
val pIMUL = PO.ARITH { oper=PO.*, overflow = false, kind = PO.INT 31 }
fun pADD(b,c) = APP(intOp pIADD, RECORD [b, c])
fun pSUB(b,c) = APP(intOp pISUB, RECORD [b, c])
fun pMUL(b,c) = APP(intOp pIMUL, RECORD [b, c])

fun CMP (cop, e1, e2) = APP (cmpOp cop, RECORD [e1, e2])
fun EQ (e1, e2) = CMP (PO.IEQL, e1, e2)
fun NONNEG e = CMP (PO.IGE, e, INT 0)
fun ISZERO e = EQ (e, INT 0)

452  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])
453  val lt_upd =  val lt_upd =
454    let val x = LT.ltc_ref (LT.ltc_tv 0)    let val x = LT.ltc_ref (LT.ltc_tv 0)
# Line 511  Line 496
496                            RECORD [vw, vcnt])))))                            RECORD [vw, vcnt])))))
497    end    end
498
499    fun inlops nk = let
500        val (lt_arg, zero, overflow) =
501            case nk of
502                PO.INT 31 => (LT.ltc_int, INT 0, true)
503              | PO.UINT 31 => (LT.ltc_int, WORD 0w0, false)
504              | PO.INT 32 => (LT.ltc_int32, INT32 0, true)
505              | PO.UINT 32 => (LT.ltc_int32, WORD32 0w0, false)
506              | PO.FLOAT 64 => (LT.ltc_real, REAL "0.0", false)
507              | _ => bug "inlops: bad numkind"
508        val lt_argpair = lt_tup [lt_arg, lt_arg]
509        val lt_cmp = lt_arw (lt_argpair, lt_bool)
510        val lt_neg = lt_arw (lt_arg, lt_arg)
511        val less = PRIM (PO.CMP { oper = PO.<, kind = nk }, lt_cmp, [])
512        val greater = PRIM (PO.CMP { oper = PO.>, kind = nk }, lt_cmp, [])
513        val negate =
514            PRIM (PO.ARITH { oper = PO.~, overflow = overflow, kind = nk },
515                  lt_neg, [])
516    in
517        { lt_arg = lt_arg, lt_argpair = lt_argpair, lt_cmp = lt_cmp,
518          less = less, greater = greater,
519          zero = zero, negate = negate }
520    end
521
522    fun inlminmax (nk, ismax) = let
523        val { lt_argpair, less, greater, lt_cmp, ... } = inlops nk
524        val x = mkv () and y = mkv () and z = mkv ()
525        val cmpop = if ismax then greater else less
526        val elsebranch =
527            case nk of
528                PO.FLOAT _ => let
529                    (* testing for NaN *)
530                    val fequal =
531                        PRIM (PO.CMP { oper = PO.EQL, kind = nk }, lt_cmp, [])
532                in
533                    COND (APP (fequal, RECORD [VAR y, VAR y]), VAR x, VAR y)
534                end
535              | _ => VAR y
536    in
537        FN (z, lt_argpair,
538            LET (x, SELECT (0, VAR z),
539                 LET (y, SELECT (1, VAR z),
540                      COND (APP (cmpop, RECORD [VAR x, VAR y]),
541                            VAR x, elsebranch))))
542    end
543
544    fun inlabs nk = let
545        val { lt_arg, greater, zero, negate, ... } = inlops nk
546        val x = mkv ()
547    in
548        FN (x, lt_arg,
549            COND (APP (greater, RECORD [VAR x, zero]),
550                  VAR x, APP (negate, VAR x)))
551    end
552
553  fun transPrim (prim, lt, ts) =  fun transPrim (prim, lt, ts) =
554    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))
# Line 521  Line 559
559                 in inlineShift(rshiftOp, k, clear)                 in inlineShift(rshiftOp, k, clear)
560                end                end
561
562          | g (PO.INLDIV) =          | g (PO.INLMIN nk) = inlminmax (nk, false)
563            (* This should give a slightly faster path through this          | g (PO.INLMAX nk) = inlminmax (nk, true)
564             * operation for the frequent case that the result is non-negative.          | g (PO.INLABS nk) = inlabs nk
565             * Some hardware calculates the remainder as part of the DIV
* operation -- in which case we could save the MUL step.
* This will have to be done in the backend because it is
* architecture-specific. *)
let val a = mkv () and b = mkv ()
and q = mkv () and z = mkv ()
in
FN (z, lt_ipair,
LET (a, SELECT (0, VAR z),
LET (b, SELECT (1, VAR z),
LET (q, DIV (VAR a, VAR b),
COND (NONNEG (VAR q), VAR q,
COND (EQ (VAR a, pMUL (VAR q, VAR b)),
VAR q,
pSUB (VAR q, INT 1)))))))
end
(*
let val a = mkv() and b = mkv() and z = mkv()
in FN(z, lt_ipair,
LET(a, SELECT(0, VAR z),
LET(b, SELECT(1, VAR z),
COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),
COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),
DIV(VAR a, VAR b),
SUB(DIV(ADD(VAR a, INT 1), VAR b), INT 1)),
COND(APP(cmpOp(PO.IGT), RECORD[VAR a, INT 0]),
SUB(DIV(SUB(VAR a, INT 1), VAR b), INT 1),
DIV(VAR a, VAR b))))))
end
*)
| g (PO.INLMOD) =
(* Same here: Fast path for q >= 0.  However, since the remainder
* is the intended result, we can't avoid the MUL.  On architectures
* where r is directly available, this should rather be done
* in the backend. *)
let val a = mkv () and b = mkv ()
and q = mkv () and r = mkv ()
and z = mkv ()
in
FN (z, lt_ipair,
LET (a, SELECT (0, VAR z),
LET (b, SELECT (1, VAR z),
LET (q, DIV (VAR a, VAR b),
LET (r, pSUB (VAR a, pMUL (VAR q, VAR b)),
COND (NONNEG (VAR q), VAR r,
COND (ISZERO (VAR r), VAR r,
pADD (VAR r, VAR b))))))))
end
(*
let val a = mkv() and b = mkv() and z = mkv()
in FN(z, lt_ipair,
LET(a,SELECT(0, VAR z),
LET(b,SELECT(1,VAR z),
COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),
COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),
SUB(VAR a, MUL(DIV(VAR a, VAR b), VAR b)),
VAR b)), VAR b)),
COND(APP(cmpOp(PO.IGT), RECORD[VAR a,INT 0]),
ADD(SUB(VAR a,MUL(DIV(SUB(VAR a,INT 1), VAR b),
VAR b)), VAR b),
COND(APP(cmpOp(PO.IEQL),RECORD[VAR a,
INT ~1073741824]),
COND(APP(cmpOp(PO.IEQL),
RECORD[VAR b,INT 0]),
INT 0,
SUB(VAR a, MUL(DIV(VAR a, VAR b),
VAR b))),
SUB(VAR a, MUL(DIV(VAR a, VAR b),
VAR b))))))))
end
*)
| g (PO.INLREM) =
let val a = mkv() and b = mkv() and z = mkv()
in FN(z, lt_ipair,
LET(a, SELECT(0,VAR z),
LET(b, SELECT(1,VAR z),
pSUB(VAR a, pMUL(DIV(VAR a,VAR b),VAR b)))))
end

| g (PO.INLMIN) =
let val x = mkv() and y = mkv() and z = mkv()
in FN(z, lt_ipair,
LET(x, SELECT(0,VAR z),
LET(y, SELECT(1,VAR z),
COND(APP(cmpOp(PO.ILT), RECORD[VAR x,VAR y]),
VAR x, VAR y))))
end
| g (PO.INLMAX) =
let val x = mkv() and y = mkv() and z = mkv()
in FN(z, lt_ipair,
LET(x, SELECT(0,VAR z),
LET(y, SELECT(1,VAR z),
COND(APP(cmpOp(PO.IGT), RECORD[VAR x,VAR y]),
VAR x, VAR y))))
end
| g (PO.INLABS) =
let val x = mkv()
in FN(x, lt_int,
COND(APP(cmpOp(PO.IGT), RECORD[VAR x,INT 0]),
VAR x, APP(inegOp(PO.INEG), VAR x)))
end
566          | g (PO.INLNOT) =          | g (PO.INLNOT) =
567                let val x = mkv()                let val x = mkv()
568                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))
# Line 653  Line 590
590                    val x = mkv()                    val x = mkv()
591                 in FN(x, argt, SELECT(0,VAR x))                 in FN(x, argt, SELECT(0,VAR x))
592                end                end
593            | g (PO.INLIGNORE) =
594              let val argt =
595                      case ts of [a] => lt_tyc a
596                               | _ => bug "unexpected type for INLIGNORE"
597              in FN (mkv (), argt, unitLexp)
598              end
599
600          | g (PO.INLSUBSCRIPTV) =          | g (PO.INLSUBSCRIPTV) =
601                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)

Legend:
 Removed from v.1182 changed lines Added in v.1183

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