1 (* Copyright (C) 2009,2016-2017 Matthew Fluet.
2 * Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 functor Runtime (S: RUNTIME_STRUCTS): RUNTIME =
31 val atomicStateOffset: Bytes.t ref = ref Bytes.zero
32 val cardMapAbsoluteOffset: Bytes.t ref = ref Bytes.zero
33 val currentThreadOffset: Bytes.t ref = ref Bytes.zero
34 val curSourceSeqsIndexOffset: Bytes.t ref = ref Bytes.zero
35 val exnStackOffset: Bytes.t ref = ref Bytes.zero
36 val frontierOffset: Bytes.t ref = ref Bytes.zero
37 val limitOffset: Bytes.t ref = ref Bytes.zero
38 val limitPlusSlopOffset: Bytes.t ref = ref Bytes.zero
39 val maxFrameSizeOffset: Bytes.t ref = ref Bytes.zero
40 val signalIsPendingOffset: Bytes.t ref = ref Bytes.zero
41 val stackBottomOffset: Bytes.t ref = ref Bytes.zero
42 val stackLimitOffset: Bytes.t ref = ref Bytes.zero
43 val stackTopOffset: Bytes.t ref = ref Bytes.zero
45 fun setOffsets {atomicState, cardMapAbsolute, currentThread, curSourceSeqsIndex,
46 exnStack, frontier, limit, limitPlusSlop, maxFrameSize,
47 signalIsPending, stackBottom, stackLimit, stackTop} =
48 (atomicStateOffset := atomicState
49 ; cardMapAbsoluteOffset := cardMapAbsolute
50 ; currentThreadOffset := currentThread
51 ; curSourceSeqsIndexOffset := curSourceSeqsIndex
52 ; exnStackOffset := exnStack
53 ; frontierOffset := frontier
54 ; limitOffset := limit
55 ; limitPlusSlopOffset := limitPlusSlop
56 ; maxFrameSizeOffset := maxFrameSize
57 ; signalIsPendingOffset := signalIsPending
58 ; stackBottomOffset := stackBottom
59 ; stackLimitOffset := stackLimit
60 ; stackTopOffset := stackTop)
63 fn AtomicState => !atomicStateOffset
64 | CardMapAbsolute => !cardMapAbsoluteOffset
65 | CurrentThread => !currentThreadOffset
66 | CurSourceSeqsIndex => !curSourceSeqsIndexOffset
67 | ExnStack => !exnStackOffset
68 | Frontier => !frontierOffset
69 | Limit => !limitOffset
70 | LimitPlusSlop => !limitPlusSlopOffset
71 | MaxFrameSize => !maxFrameSizeOffset
72 | SignalIsPending => !signalIsPendingOffset
73 | StackBottom => !stackBottomOffset
74 | StackLimit => !stackLimitOffset
75 | StackTop => !stackTopOffset
77 val atomicStateSize: Bytes.t ref = ref Bytes.zero
78 val cardMapAbsoluteSize: Bytes.t ref = ref Bytes.zero
79 val currentThreadSize: Bytes.t ref = ref Bytes.zero
80 val curSourceSeqsIndexSize: Bytes.t ref = ref Bytes.zero
81 val exnStackSize: Bytes.t ref = ref Bytes.zero
82 val frontierSize: Bytes.t ref = ref Bytes.zero
83 val limitSize: Bytes.t ref = ref Bytes.zero
84 val limitPlusSlopSize: Bytes.t ref = ref Bytes.zero
85 val maxFrameSizeSize: Bytes.t ref = ref Bytes.zero
86 val signalIsPendingSize: Bytes.t ref = ref Bytes.zero
87 val stackBottomSize: Bytes.t ref = ref Bytes.zero
88 val stackLimitSize: Bytes.t ref = ref Bytes.zero
89 val stackTopSize: Bytes.t ref = ref Bytes.zero
91 fun setSizes {atomicState, cardMapAbsolute, currentThread, curSourceSeqsIndex,
92 exnStack, frontier, limit, limitPlusSlop, maxFrameSize,
93 signalIsPending, stackBottom, stackLimit, stackTop} =
94 (atomicStateSize := atomicState
95 ; cardMapAbsoluteSize := cardMapAbsolute
96 ; currentThreadSize := currentThread
97 ; curSourceSeqsIndexSize := curSourceSeqsIndex
98 ; exnStackSize := exnStack
99 ; frontierSize := frontier
101 ; limitPlusSlopSize := limitPlusSlop
102 ; maxFrameSizeSize := maxFrameSize
103 ; signalIsPendingSize := signalIsPending
104 ; stackBottomSize := stackBottom
105 ; stackLimitSize := stackLimit
106 ; stackTopSize := stackTop)
109 fn AtomicState => !atomicStateSize
110 | CardMapAbsolute => !cardMapAbsoluteSize
111 | CurrentThread => !currentThreadSize
112 | CurSourceSeqsIndex => !curSourceSeqsIndexSize
113 | ExnStack => !exnStackSize
114 | Frontier => !frontierSize
115 | Limit => !limitSize
116 | LimitPlusSlop => !limitPlusSlopSize
117 | MaxFrameSize => !maxFrameSizeSize
118 | SignalIsPending => !signalIsPendingSize
119 | StackBottom => !stackBottomSize
120 | StackLimit => !stackLimitSize
121 | StackTop => !stackTopSize
124 fn AtomicState => "AtomicState"
125 | CardMapAbsolute => "CardMapAbsolute"
126 | CurrentThread => "CurrentThread"
127 | CurSourceSeqsIndex => "CurSourceSeqsIndex"
128 | ExnStack => "ExnStack"
129 | Frontier => "Frontier"
131 | LimitPlusSlop => "LimitPlusSlop"
132 | MaxFrameSize => "MaxFrameSize"
133 | SignalIsPending => "SignalIsPending"
134 | StackBottom => "StackBottom"
135 | StackLimit => "StackLimit"
136 | StackTop => "StackTop"
138 val layout = Layout.str o toString
141 structure RObjectType =
144 Array of {hasIdentity: bool,
145 bytesNonObjptrs: Bytes.t,
147 | Normal of {hasIdentity: bool,
148 bytesNonObjptrs: Bytes.t,
151 | Weak of {gone: bool}
153 fun layout (t: t): Layout.t =
158 Array {hasIdentity, bytesNonObjptrs, numObjptrs} =>
160 record [("hasIdentity", Bool.layout hasIdentity),
161 ("bytesNonObjptrs", Bytes.layout bytesNonObjptrs),
162 ("numObjptrs", Int.layout numObjptrs)]]
163 | Normal {hasIdentity, bytesNonObjptrs, numObjptrs} =>
165 record [("hasIdentity", Bool.layout hasIdentity),
166 ("bytesNonObjptrs", Bytes.layout bytesNonObjptrs),
167 ("numObjptrs", Int.layout numObjptrs)]]
168 | Stack => str "Stack"
171 record [("gone", Bool.layout gone)]]
173 val _ = layout (* quell unused warning *)
176 (* see gc/object.h *)
178 val maxTypeIndex = Int.pow (2, 19)
180 (* see gc/object.c:buildHeaderFromTypeIndex *)
181 fun typeIndexToHeader typeIndex =
182 (Assert.assert ("Runtime.header", fn () =>
184 andalso typeIndex < maxTypeIndex)
185 ; Word.orb (0w1, Word.<< (Word.fromInt typeIndex, 0w1)))
187 fun headerToTypeIndex w = Word.toInt (Word.>> (w, 0w1))
190 (* see gc/object.h *)
191 val objptrSize : unit -> Bytes.t =
192 Promise.lazy (Bits.toBytes o Control.Target.Size.objptr)
194 (* see gc/object.h *)
195 val headerSize : unit -> Bytes.t =
196 Promise.lazy (Bits.toBytes o Control.Target.Size.header)
197 val headerOffset : unit -> Bytes.t =
198 Promise.lazy (Bytes.~ o headerSize)
201 val arrayLengthSize : unit -> Bytes.t =
202 Promise.lazy (Bits.toBytes o Control.Target.Size.seqIndex)
203 val arrayLengthOffset : unit -> Bytes.t =
204 Promise.lazy (fn () => Bytes.~ (Bytes.+ (headerSize (),
205 arrayLengthSize ())))
207 (* see gc/object.h and gc/array.h *)
208 val arrayMetaDataSize : unit -> Bytes.t =
209 Promise.lazy (Bits.toBytes o Control.Target.Size.arrayMetaData)
210 val normalMetaDataSize : unit -> Bytes.t =
211 Promise.lazy (Bits.toBytes o Control.Target.Size.normalMetaData)
213 val cpointerSize : unit -> Bytes.t =
214 Promise.lazy (Bits.toBytes o Control.Target.Size.cpointer)
215 val labelSize = cpointerSize
218 val limitSlop = Bytes.fromInt 512
220 (* See gc/frame.h. *)
221 val maxFrameSize = Bytes.fromInt (Int.pow (2, 16))