Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

# SCM Repository

[smlnj] View of /MLRISC/trunk/mltree/machine-int.sml
 [smlnj] / MLRISC / trunk / mltree / machine-int.sml

# View of /MLRISC/trunk/mltree/machine-int.sml

Sat Feb 16 00:14:43 2008 UTC (12 years, 3 months ago) by mrainey
File size: 8273 byte(s)
```  Added 64-bit integer constants.
```
```(*
* How to evaluate constants for various widths.
*
* Internally, we represent machine_int as a signed integer.
* So when we do bit or unsigned operations we have to convert to
* the unsigned representation first.
*
* Note: this implementation requires andb, orb, xorb etc in IntInf.
* fails to compile.
*)
local

val maxSz = 65

in

structure MachineInt : MACHINE_INT =
struct

structure I = IntInf
structure S = String
type machine_int = I.int
type sz = int

datatype div_rounding_mode = DIV_TO_ZERO | DIV_TO_NEGINF

val itow = Word.fromInt

(* Parse hex or binary, but not octal, that's for wussies *)
val hexToInt = StringCvt.scanString (I.scan StringCvt.HEX)
val binToInt = StringCvt.scanString (I.scan StringCvt.BIN)

(* Precompute some tables for faster arithmetic *)
local
val pow2table = Array.tabulate(maxSz,fn n => I.<<(1,itow n))  (* 2^n *)
fn n => I.-(I.<<(1,itow n),1))      (* 2^n-1 *)
val maxtable  = Array.tabulate(maxSz+1,
fn 0 => 0
| n => I.-(I.<<(1,itow(n-1)),1))  (* 2^{n-1}-1 *)
val mintable  = Array.tabulate(maxSz+1,
fn 0 => 0
| n => I.~(I.<<(1,itow(n-1))))   (* -2^{n-1} *)
in

fun pow2 i       = if i < maxSz then Array.sub(pow2table, i)
else I.<<(1,itow i)
else I.-(I.<<(1,itow sz),1)
fun maxOfSize sz = if sz < maxSz then Array.sub(maxtable, sz)
else I.-(I.<<(1,itow(sz-1)),1)
fun minOfSize sz = if sz < maxSz then Array.sub(mintable, sz)
else I.~(I.<<(1,itow(sz-1)))
end

(* queries *)
fun isNeg(i)    = I.sign i < 0
fun isPos(i)    = I.sign i > 0
fun isZero(i)   = I.sign i = 0
fun isNonNeg(i) = I.sign i >= 0
fun isNonPos(i) = I.sign i <= 0
fun isEven(i)   = isZero(I.rem(i,2))
fun isOdd(i)    = not(isEven(i))

(* to unsigned representation *)
fun unsigned(sz, i) = if isNeg i then I.+(i, pow2 sz) else i

(* to signed representation *)
fun signed(sz, i) = if I.>(i, maxOfSize sz) then I.-(i, pow2 sz) else i

(* Narrow to the representation of a given type *)
fun narrow(sz, i) = signed(sz, I.andb(i, maskOf sz))

(* Recognize 0x and 0b prefix and do the right thing *)
fun fromString(sz, s) =
let val n = S.size s
fun conv(i,negate) =
if n >= 2+i andalso S.sub(s, i) = #"0" then
(case S.sub(s, i+1) of
#"x" => (hexToInt (S.substring(s,2+i,n-2-i)), negate)
| #"b" => (binToInt (S.substring(s,2+i,n-2-i)), negate)
| _    => (I.fromString s, false)
)
else (I.fromString s, false)
val (result, negate) =
if s = "" then (NONE, false)
else if S.sub(s, 0) = #"~" then conv(1, true)
else conv(0, false)
in  case (result, negate) of
(SOME n, true) => SOME(narrow(sz, I.~ n))
| (SOME n, false) => SOME(narrow(sz, n))
| (NONE, _) => NONE
end

(* Convert types into IntInf without losing precision. *)
structure Cvt =
struct
structure W   = Word
structure W32 = Word32
val wtoi   = W.toIntX
val w32toi = W32.toIntX
val fromInt    = I.fromInt
val fromInt32  = Int32.toLarge
fun fromWord w = I.fromLarge(Word.toLargeInt w)
fun fromWord32 w = I.+(I.<<(I.fromInt(w32toi(W32.>>(w,0w16))),0w16),
I.fromInt(w32toi(W32.andb(w,0wxffff))))
end
(* machine_int <-> other types *)
fun fromInt(sz,i)      = narrow(sz,Cvt.fromInt i)
fun fromInt32(sz,i)    = narrow(sz,Cvt.fromInt32 i)
fun fromWord(sz,w)     = narrow(sz,Cvt.fromWord w)
fun fromWord32(sz,w)   = narrow(sz,Cvt.fromWord32 w)
fun toString(sz,i)     = I.toString i
val toHex = I.fmt StringCvt.HEX
val toBin = I.fmt StringCvt.BIN
fun toHexString(sz, i) = "0x"^toHex(unsigned(sz, i))
fun toBinString(sz, i) = "0b"^toBin(unsigned(sz, i))
fun toInt(sz, i)       = I.toInt(narrow(sz, i))
fun toWord(sz, i)      = Word.fromLargeInt(I.toLarge(unsigned(sz, i)))
fun toWord32(sz, i)    =
let val i  = unsigned(sz, i)
val lo = I.andb(i,0xffff)
val hi = I.~>>(i,0w16)
fun tow32 i = Word32.fromLargeInt(I.toLarge i)
in  tow32 lo + Word32.<<(tow32 hi, 0w16) end
fun toInt32(sz, i) = Int32.fromLarge(narrow(sz, i))

fun toInt64(sz, i) = Int64.fromLarge(narrow(sz, i))

fun hash i = Word.fromInt(I.toInt(I.andb(i,0x1fffffff)))

fun isInRange(sz, i) = I.<=(minOfSize sz,i) andalso I.<=(i,maxOfSize sz)

fun signedBinOp f (sz,i,j) = narrow(sz, f(i, j))

fun signedUnaryOp f (sz,i) = narrow(sz, f i)

fun unsignedBinOp f (sz,i,j) = narrow(sz, f(unsigned(sz,i), unsigned(sz,j)))

fun trappingUnaryOp f (sz,i) =
let val x = f i
in  if isInRange(sz, x) then x else raise Overflow
end

fun trappingBinOp f (sz,i,j) =
let val x = f(i,j)
in  if isInRange(sz, x) then x else raise Overflow
end

(* two's complement operators *)
val NEG   = signedUnaryOp I.~
val ABS   = signedUnaryOp I.abs
val SUB   = signedBinOp I.-
val MULS  = signedBinOp I.*
fun DIVS (DIV_TO_ZERO, ty, x, y) = signedBinOp I.quot (ty, x, y)
| DIVS (DIV_TO_NEGINF, ty, x, y) = signedBinOp I.div (ty, x, y)
fun REMS (DIV_TO_ZERO, ty, x, y) = signedBinOp I.rem (ty, x, y)
| REMS (DIV_TO_NEGINF, ty, x, y) = signedBinOp I.mod (ty, x, y)
val MULU  = unsignedBinOp I.*
val DIVU  = unsignedBinOp I.div
(*
val QUOTU = unsignedBinOp I.quot
*)
val REMU  = unsignedBinOp I.rem

val NEGT  = trappingUnaryOp I.~
val ABST  = trappingUnaryOp I.abs
val SUBT  = trappingBinOp I.-
val MULT  = trappingBinOp I.*
fun DIVT (DIV_TO_ZERO, ty, x, y) = trappingBinOp I.quot (ty, x, y)
| DIVT (DIV_TO_NEGINF, ty, x, y) = trappingBinOp I.div (ty, x, y)

fun NOTB(sz,x)   = narrow(sz,I.notb x)
fun ANDB(sz,x,y) = narrow(sz,I.andb(x,y))
fun ORB(sz,x,y)  = narrow(sz,I.orb(x,y))
fun XORB(sz,x,y) = narrow(sz,I.xorb(x,y))
fun EQVB(sz,x,y) = narrow(sz,I.xorb(I.notb x,y))
fun Sll(sz,x,y)  = narrow(sz,I.<<(x, y))
fun Srl(sz,x,y)  = narrow(sz,I.~>>(unsigned(sz, x), y))
fun Sra(sz,x,y)  = narrow(sz,I.~>>(x, y))
fun SLL(sz,x,y)  = Sll(sz,x,toWord(sz, y))
fun SRL(sz,x,y)  = Srl(sz,x,toWord(sz, y))
fun SRA(sz,x,y)  = Sra(sz,x,toWord(sz, y))

fun BITSLICE(sz,sl,x) =
let fun slice([],n) = n
| slice((from,to)::sl,n) =
slice(sl, ORB(sz, narrow(to-from+1,
Srl(sz, x, Word.fromInt from)), n))
in  slice(sl, 0)
end

fun bitOf(sz, i, b) =
toWord(1, narrow(1, Srl(sz, i, Word.fromInt b)))
fun byteOf(sz, i, b) =
toWord(8, narrow(8, Srl(sz, i, Word.fromInt(b*8))))
fun halfOf(sz, i, h) =
toWord(16, narrow(16, Srl(sz, i, Word.fromInt(h*16))))
fun wordOf(sz, i, w) =
toWord32(32, narrow(32, Srl(sz, i, Word.fromInt(w*32))))

(* type promotion *)
fun SX(toSz,fromSz,i) = narrow(toSz, narrow(fromSz, i))
fun ZX(toSz,fromSz,i) = narrow(toSz, unsigned(fromSz, narrow(fromSz, i)))

(* comparisions *)
fun EQ(sz,i:I.int,j)  = i = j
fun NE(sz,i:I.int,j)  = i <> j
fun GT(sz,i:I.int,j)  = i > j
fun GE(sz,i:I.int,j)  = i >= j
fun LT(sz,i:I.int,j)  = i < j
fun LE(sz,i:I.int,j)  = i <= j
fun LTU(sz,i,j) = unsigned(sz, i) < unsigned(sz, j)
fun GTU(sz,i,j) = unsigned(sz, i) > unsigned(sz, j)
fun LEU(sz,i,j) = unsigned(sz, i) <= unsigned(sz, j)
fun GEU(sz,i,j) = unsigned(sz, i) >= unsigned(sz, j)
(*
* Split an integer "i" of size "sz" into words of size "wordSize"
*)
fun split{sz, wordSize, i} =
let fun loop(sz, i, ws) =
if sz <= 0 then rev ws
else
let val w = narrow(wordSize, i)
val i = IntInf.~>>(i, Word.fromInt wordSize)
in  loop(sz - wordSize, i, w::ws)
end
in  loop(sz, unsigned(sz, i), [])
end

end

end
```