+ val funclist = Symbol.elemsi funcs
+
+ val alignments = ref Symbol.empty (* Ref for memoization. *)
+ fun alignment A.Int = 4
+ | alignment (A.Typedef(id)) =
+ (case Symbol.look (!alignments) id
+ of NONE =>
+ let
+ val r = alignment_s (Symbol.look' defs id)
+ val _ = (alignments := (Symbol.bind (!alignments) (id, r)))
+ in
+ r
+ end
+ | SOME r => r)
+ | alignment (A.Pointer(_)) = 8
+ | alignment (A.Array(_)) = 8
+ | alignment (A.TNull) = raise ErrorMsg.InternalError "alignmentof TNull?"
+ and alignment_s (A.Struct(members)) =
+ foldl
+ (fn ((_,t),al) => Int.max (al, alignment t))
+ 1
+ members
+ | alignment_s (A.MarkedTypedef(a)) = alignment_s (Mark.data a)
+
+ fun align t curpos =
+ let
+ val al = alignment t
+ in
+ if (curpos mod al) = 0
+ then curpos
+ else curpos + al - (curpos mod al)
+ end
+
+ val sizes = ref Symbol.empty
+ fun sizeof_v A.Int = 4
+ | sizeof_v (A.Typedef(id)) =
+ (case Symbol.look (!sizes) id
+ of NONE =>
+ let
+ val r = sizeof_s (Symbol.look' defs id)
+ val _ = (sizes := (Symbol.bind (!sizes) (id, r)))
+ in
+ r
+ end
+ | SOME r => r)
+ | sizeof_v (A.Pointer(_)) = 8
+ | sizeof_v (A.Array(_)) = 8
+ | sizeof_v (A.TNull) = raise ErrorMsg.InternalError "sizeof TNull?"
+ and sizeof_s (A.Struct(l)) =
+ foldl
+ (fn ((_,t),curpos) => align t curpos + sizeof_v t)
+ 0
+ l
+ | sizeof_s (A.MarkedTypedef(a)) = sizeof_s (Mark.data a)
+
+ fun offset_s id (A.Typedef(id')) =
+ let
+ val shit = Symbol.look' defs id'
+ fun eat (A.Struct(l)) = l
+ | eat (A.MarkedTypedef(a)) = eat (Mark.data a)
+ fun offset_s' ((id1,t)::l') curofs =
+ let
+ val a = align t curofs
+ in
+ if Symbol.compare(id,id1) = EQUAL
+ then a
+ else offset_s' l' (a + sizeof_v t)
+ end
+ | offset_s' nil _ = raise ErrorMsg.InternalError "looking for offset of something that isn't in the structure"
+ in
+ offset_s' (eat shit) 0
+ end
+ | offset_s _ _ = raise ErrorMsg.InternalError "cannot find offset into non-typedef"
+
+ fun type_s id (A.Typedef id') =
+ let
+ val td =
+ case AU.Typedef.data (Symbol.look' defs id')
+ of A.Struct d => d
+ | _ => raise ErrorMsg.InternalError "data didn't return struct"
+ fun type_s' ((id',t)::l) =
+ if (Symbol.compare (id, id') = EQUAL)
+ then t
+ else type_s' l
+ | type_s' nil = raise ErrorMsg.InternalError "struct member not found in type_s"
+ in
+ type_s' td
+ end
+ | type_s id _ = raise ErrorMsg.InternalError "cannot find internal type non-typedef"
+
+ fun deref (A.Pointer i) = i
+ | deref (A.Array i) = i
+ | deref _ = raise ErrorMsg.InternalError "cannot deref non-pointer"