| 1 | (* Copyright (C) 2014 Matthew Fluet. |
| 2 | * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh |
| 3 | * Jagannathan, and Stephen Weeks. |
| 4 | * |
| 5 | * MLton is released under a BSD-style license. |
| 6 | * See the file MLton-LICENSE for details. |
| 7 | *) |
| 8 | |
| 9 | functor CType (S: C_TYPE_STRUCTS): C_TYPE = |
| 10 | struct |
| 11 | |
| 12 | open S |
| 13 | |
| 14 | datatype t = |
| 15 | CPointer |
| 16 | | Int8 |
| 17 | | Int16 |
| 18 | | Int32 |
| 19 | | Int64 |
| 20 | | Objptr |
| 21 | | Real32 |
| 22 | | Real64 |
| 23 | | Word8 |
| 24 | | Word16 |
| 25 | | Word32 |
| 26 | | Word64 |
| 27 | |
| 28 | val all = [CPointer, |
| 29 | Int8, Int16, Int32, Int64, |
| 30 | Objptr, |
| 31 | Real32, Real64, |
| 32 | Word8, Word16, Word32, Word64] |
| 33 | |
| 34 | val cpointer = CPointer |
| 35 | val objptr = Objptr |
| 36 | val thread = objptr |
| 37 | |
| 38 | val equals: t * t -> bool = op = |
| 39 | |
| 40 | fun memo (f: t -> 'a): t -> 'a = |
| 41 | let |
| 42 | val cpointer = f CPointer |
| 43 | val int8 = f Int8 |
| 44 | val int16 = f Int16 |
| 45 | val int32 = f Int32 |
| 46 | val int64 = f Int64 |
| 47 | val objptr = f Objptr |
| 48 | val real32 = f Real32 |
| 49 | val real64 = f Real64 |
| 50 | val word8 = f Word8 |
| 51 | val word16 = f Word16 |
| 52 | val word32 = f Word32 |
| 53 | val word64 = f Word64 |
| 54 | in |
| 55 | fn CPointer => cpointer |
| 56 | | Int8 => int8 |
| 57 | | Int16 => int16 |
| 58 | | Int32 => int32 |
| 59 | | Int64 => int64 |
| 60 | | Objptr => objptr |
| 61 | | Real32 => real32 |
| 62 | | Real64 => real64 |
| 63 | | Word8 => word8 |
| 64 | | Word16 => word16 |
| 65 | | Word32 => word32 |
| 66 | | Word64 => word64 |
| 67 | end |
| 68 | |
| 69 | val toString = |
| 70 | fn CPointer => "CPointer" |
| 71 | | Int8 => "Int8" |
| 72 | | Int16 => "Int16" |
| 73 | | Int32 => "Int32" |
| 74 | | Int64 => "Int64" |
| 75 | | Objptr => "Objptr" (* CHECK *) |
| 76 | | Real32 => "Real32" |
| 77 | | Real64 => "Real64" |
| 78 | | Word8 => "Word8" |
| 79 | | Word16 => "Word16" |
| 80 | | Word32 => "Word32" |
| 81 | | Word64 => "Word64" |
| 82 | |
| 83 | val layout = Layout.str o toString |
| 84 | |
| 85 | fun size (t: t): Bytes.t = |
| 86 | case t of |
| 87 | CPointer => Bits.toBytes (Control.Target.Size.cpointer ()) |
| 88 | | Int8 => Bytes.fromInt 1 |
| 89 | | Int16 => Bytes.fromInt 2 |
| 90 | | Int32 => Bytes.fromInt 4 |
| 91 | | Int64 => Bytes.fromInt 8 |
| 92 | | Objptr => Bits.toBytes (Control.Target.Size.objptr ()) |
| 93 | | Real32 => Bytes.fromInt 4 |
| 94 | | Real64 => Bytes.fromInt 8 |
| 95 | | Word8 => Bytes.fromInt 1 |
| 96 | | Word16 => Bytes.fromInt 2 |
| 97 | | Word32 => Bytes.fromInt 4 |
| 98 | | Word64 => Bytes.fromInt 8 |
| 99 | |
| 100 | fun name t = |
| 101 | case t of |
| 102 | CPointer => "Q" (* CHECK *) |
| 103 | | Int8 => "I8" |
| 104 | | Int16 => "I16" |
| 105 | | Int32 => "I32" |
| 106 | | Int64 => "I64" |
| 107 | | Objptr => "P" (* CHECK *) |
| 108 | | Real32 => "R32" |
| 109 | | Real64 => "R64" |
| 110 | | Word8 => "W8" |
| 111 | | Word16 => "W16" |
| 112 | | Word32 => "W32" |
| 113 | | Word64 => "W64" |
| 114 | |
| 115 | fun align (t: t, b: Bytes.t): Bytes.t = |
| 116 | Bytes.align (b, {alignment = size t}) |
| 117 | |
| 118 | fun real (s: RealSize.t): t = |
| 119 | case Bits.toInt (RealSize.bits s) of |
| 120 | 32 => Real32 |
| 121 | | 64 => Real64 |
| 122 | | _ => Error.bug "CType.real" |
| 123 | |
| 124 | fun word' (b: Bits.t, {signed: bool}): t = |
| 125 | case (signed, Bits.toInt b) of |
| 126 | (false, 8) => Word8 |
| 127 | | (true, 8) => Int8 |
| 128 | | (false, 16) => Word16 |
| 129 | | (true, 16) => Int16 |
| 130 | | (false, 32) => Word32 |
| 131 | | (true, 32) => Int32 |
| 132 | | (false, 64) => Word64 |
| 133 | | (true, 64) => Int64 |
| 134 | | _ => Error.bug "CType.word'" |
| 135 | |
| 136 | fun word (s: WordSize.t, {signed: bool}): t = |
| 137 | word' (WordSize.bits s, {signed = signed}) |
| 138 | |
| 139 | val cint = |
| 140 | Promise.lazy |
| 141 | (fn () => word' (Control.Target.Size.cint (), |
| 142 | {signed = true})) |
| 143 | val csize = |
| 144 | Promise.lazy |
| 145 | (fn () => word' (Control.Target.Size.csize (), |
| 146 | {signed = false})) |
| 147 | |
| 148 | val seqIndex = |
| 149 | Promise.lazy |
| 150 | (fn () => word' (Control.Target.Size.seqIndex (), |
| 151 | {signed = true})) |
| 152 | |
| 153 | val objptrHeader = |
| 154 | Promise.lazy |
| 155 | (fn () => word' (Control.Target.Size.header (), |
| 156 | {signed = false})) |
| 157 | |
| 158 | val bool = word (WordSize.bool, {signed = true}) |
| 159 | val compareRes = word (WordSize.compareRes, {signed = true}) |
| 160 | val shiftArg = word (WordSize.shiftArg, {signed = false}) |
| 161 | |
| 162 | end |