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

Parent Directory | 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