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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/system/Basis/Implementation/Unsafe/object.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/Unsafe/object.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 633 - (view) (download)

1 : monnier 416 (* object.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4 :     *)
5 :    
6 :     structure Object :> UNSAFE_OBJECT =
7 :     struct
8 :     type object = Core.Assembly.object
9 :    
10 :     (* information about the memory representation of an object.
11 :     * NOTE: some of these are not supported yet, but will be once the new
12 :     * array representation is available.
13 :     *)
14 :     datatype representation
15 :     = Unboxed
16 :     | Word32
17 :     | Real
18 :     | Pair
19 :     | Record
20 :     | Ref
21 :     | PolyVector
22 :     | PolyArray (* includes ref *)
23 :     | ByteVector (* includes Word8Vector.vector and CharVector.vector *)
24 :     | ByteArray (* includes Word8Array.array and CharArray.array *)
25 :     (* | RealVector use PolyVector for now *)
26 :     | RealArray
27 :     | Susp
28 :     | WeakPtr
29 :    
30 :     val toObject : 'a -> object = InlineT.cast
31 :    
32 :     local
33 :     val record1 : object -> object =
34 :     CInterface.c_function "SMLNJ-RunT" "record1"
35 :     val rConcat : (object * object) -> object =
36 :     CInterface.c_function "SMLNJ-RunT" "recordConcat"
37 :     in
38 :     fun mkTuple [] = toObject()
39 :     | mkTuple [a] = record1 a
40 :     | mkTuple [a,b] = toObject(a,b)
41 :     | mkTuple [a,b,c] = toObject(a,b,c)
42 :     | mkTuple [a,b,c,d] = toObject(a,b,c,d)
43 :     | mkTuple (a::b::c::d::r) = rConcat(toObject(a,b,c,d), mkTuple r)
44 :     end (* local *)
45 :    
46 :     val boxed = InlineT.boxed
47 :     val unboxed = InlineT.unboxed
48 :    
49 :     fun rep obj = if (unboxed obj)
50 :     then Unboxed
51 :     else (case (InlineT.gettag obj)
52 :     of 0x02 (* tag_record *) =>
53 :     if (InlineT.objlength obj = 2)
54 :     then Pair
55 :     else Record
56 :     | 0x06 (* tag_vec_hdr *) => (case (InlineT.objlength obj)
57 :     of 0 => PolyVector
58 :     | 1 => ByteVector
59 :     | _ => raise Fail "unknown vec_hdr"
60 :     (* end case *))
61 :     | 0x0a (* tag_tag_arr_hdr *) => (case (InlineT.objlength obj)
62 :     of 0 => PolyArray
63 :     | 1 => ByteArray
64 :     | 6 => RealArray
65 :     | _ => raise Fail "unknown arr_hdr"
66 :     (* end case *))
67 :     | 0x0e (* tag_arr_data/tag_ref *) =>
68 :     if (InlineT.objlength obj = 1)
69 :     then Ref
70 :     else raise Fail "Unknown arr_data"
71 :     | 0x12 (* tag_raw32 *) => Word32
72 :     | 0x16 (* tag_raw64 *) => Real
73 :     | 0x1a (* tag_special *) => (case (InlineT.getspecial obj)
74 :     of (0 | 1) => Susp
75 :     | (2 | 3) => WeakPtr
76 :     | _ => raise Fail "unknown special"
77 :     (* end case *))
78 :     | _ (* tagless pair *) => Pair
79 :     (* end case *))
80 :    
81 :     exception Representation
82 :    
83 :     fun length obj = (case (rep obj)
84 :     of Pair => 2
85 :     | Unboxed => raise Representation
86 :     | _ => InlineT.objlength obj
87 :     (* end case *))
88 :    
89 :     fun nth (obj, n) = (case (rep obj)
90 :     of Pair =>
91 :     if ((0 <= n) andalso (n < 2))
92 :     then InlineT.recordSub(obj, n)
93 :     else raise Representation
94 :     | Record => let val len = InlineT.objlength obj
95 :     in
96 :     if ((0 <= n) andalso (n < len))
97 :     then InlineT.recordSub(obj, n)
98 :     else raise Representation
99 :     end
100 :     | Real => let val len = InlineT.Int31.rshift(InlineT.objlength obj, 1)
101 :     in
102 :     if ((n < 0) orelse (len <= n))
103 :     then raise Representation
104 :     else if (n = 0)
105 :     then obj (* flat singleton tuple *)
106 :     else InlineT.cast(InlineT.raw64Sub(obj, n))
107 :     end
108 :     | _ => raise Representation
109 :     (* end case *))
110 :    
111 :     fun toTuple obj = (case (rep obj)
112 :     of Unboxed => if (((InlineT.cast obj) : int) = 0)
113 :     then []
114 :     else raise Representation
115 :     | Pair => [
116 :     InlineT.recordSub(obj, 0),
117 :     InlineT.recordSub(obj, 1)
118 :     ]
119 :     | Record => let
120 :     fun f i = InlineT.recordSub(obj, i)
121 :     in
122 :     List.tabulate (InlineT.objlength obj, f)
123 :     end
124 :     | Real => let
125 :     val len = InlineT.Int31.rshift(InlineT.objlength obj, 1)
126 :     fun f i = (InlineT.cast(InlineT.raw64Sub(obj, i)) : object)
127 :     in
128 :     if (len = 1)
129 :     then [obj]
130 :     else List.tabulate (len, f)
131 :     end
132 :     | _ => raise Representation
133 :     (* end case *))
134 :     fun toString obj = (case (rep obj)
135 :     of ByteVector => ((InlineT.cast obj) : string)
136 :     | _ => raise Representation
137 :     (* end case *))
138 :     fun toRef obj =
139 :     if (rep obj = Ref)
140 :     then ((InlineT.cast obj) : object ref)
141 :     else raise Representation
142 :     fun toArray obj = (case (rep obj)
143 :     of PolyArray => ((InlineT.cast obj) : object array)
144 :     | _ => raise Representation
145 :     (* end case *))
146 : dbm 633 fun toRealArray obj = (case (rep obj)
147 :     of RealArray => ((InlineT.cast obj) : Real64Array.array)
148 :     | _ => raise Representation
149 :     (* end case *))
150 :     fun toByteArray obj = (case (rep obj)
151 :     of ByteArray => ((InlineT.cast obj) : Word8Array.array)
152 :     | _ => raise Representation
153 :     (* end case *))
154 : monnier 416 fun toVector obj = (case (rep obj)
155 :     of PolyVector => ((InlineT.cast obj) : object vector)
156 :     | _ => raise Representation
157 :     (* end case *))
158 : dbm 633 fun toByteVector obj = (case (rep obj)
159 :     of ByteVector => ((InlineT.cast obj) : Word8Vector.vector)
160 :     | _ => raise Representation
161 :     (* end case *))
162 : monnier 416 fun toExn obj =
163 :     if ((rep obj = Record) andalso (InlineT.objlength obj = 3))
164 :     then ((InlineT.cast obj) : exn)
165 :     else raise Representation
166 :     fun toReal obj = (case (rep obj)
167 :     of Real => ((InlineT.cast obj) : real)
168 :     | _ => raise Representation
169 :     (* end case *))
170 :     fun toInt obj = if (unboxed obj)
171 :     then ((InlineT.cast obj) : int)
172 :     else raise Representation
173 :     fun toInt32 obj =
174 :     if (rep obj = Word32)
175 :     then ((InlineT.cast obj) : Int32.int)
176 :     else raise Representation
177 :     fun toWord obj = if (unboxed obj)
178 :     then ((InlineT.cast obj) : word)
179 :     else raise Representation
180 :     fun toWord8 obj = if (unboxed obj)
181 :     then ((InlineT.cast obj) : Word8.word)
182 :     else raise Representation
183 :     fun toWord32 obj =
184 :     if (rep obj = Word32)
185 :     then ((InlineT.cast obj) : Word32.word)
186 :     else raise Representation
187 :    
188 :     end;
189 :    
190 :    

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