| 1 | (* Copyright (C) 2009,2016-2017 Matthew Fluet. |
| 2 | * Copyright (C) 2002-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 Runtime (S: RUNTIME_STRUCTS): RUNTIME = |
| 10 | struct |
| 11 | |
| 12 | open S |
| 13 | |
| 14 | structure GCField = |
| 15 | struct |
| 16 | datatype t = |
| 17 | AtomicState |
| 18 | | CardMapAbsolute |
| 19 | | CurrentThread |
| 20 | | CurSourceSeqsIndex |
| 21 | | ExnStack |
| 22 | | Frontier |
| 23 | | Limit |
| 24 | | LimitPlusSlop |
| 25 | | MaxFrameSize |
| 26 | | SignalIsPending |
| 27 | | StackBottom |
| 28 | | StackLimit |
| 29 | | StackTop |
| 30 | |
| 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 |
| 44 | |
| 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) |
| 61 | |
| 62 | val offset = |
| 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 |
| 76 | |
| 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 |
| 90 | |
| 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 |
| 100 | ; limitSize := limit |
| 101 | ; limitPlusSlopSize := limitPlusSlop |
| 102 | ; maxFrameSizeSize := maxFrameSize |
| 103 | ; signalIsPendingSize := signalIsPending |
| 104 | ; stackBottomSize := stackBottom |
| 105 | ; stackLimitSize := stackLimit |
| 106 | ; stackTopSize := stackTop) |
| 107 | |
| 108 | val size = |
| 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 |
| 122 | |
| 123 | val toString = |
| 124 | fn AtomicState => "AtomicState" |
| 125 | | CardMapAbsolute => "CardMapAbsolute" |
| 126 | | CurrentThread => "CurrentThread" |
| 127 | | CurSourceSeqsIndex => "CurSourceSeqsIndex" |
| 128 | | ExnStack => "ExnStack" |
| 129 | | Frontier => "Frontier" |
| 130 | | Limit => "Limit" |
| 131 | | LimitPlusSlop => "LimitPlusSlop" |
| 132 | | MaxFrameSize => "MaxFrameSize" |
| 133 | | SignalIsPending => "SignalIsPending" |
| 134 | | StackBottom => "StackBottom" |
| 135 | | StackLimit => "StackLimit" |
| 136 | | StackTop => "StackTop" |
| 137 | |
| 138 | val layout = Layout.str o toString |
| 139 | end |
| 140 | |
| 141 | structure RObjectType = |
| 142 | struct |
| 143 | datatype t = |
| 144 | Array of {hasIdentity: bool, |
| 145 | bytesNonObjptrs: Bytes.t, |
| 146 | numObjptrs: int} |
| 147 | | Normal of {hasIdentity: bool, |
| 148 | bytesNonObjptrs: Bytes.t, |
| 149 | numObjptrs: int} |
| 150 | | Stack |
| 151 | | Weak of {gone: bool} |
| 152 | |
| 153 | fun layout (t: t): Layout.t = |
| 154 | let |
| 155 | open Layout |
| 156 | in |
| 157 | case t of |
| 158 | Array {hasIdentity, bytesNonObjptrs, numObjptrs} => |
| 159 | seq [str "Array ", |
| 160 | record [("hasIdentity", Bool.layout hasIdentity), |
| 161 | ("bytesNonObjptrs", Bytes.layout bytesNonObjptrs), |
| 162 | ("numObjptrs", Int.layout numObjptrs)]] |
| 163 | | Normal {hasIdentity, bytesNonObjptrs, numObjptrs} => |
| 164 | seq [str "Normal ", |
| 165 | record [("hasIdentity", Bool.layout hasIdentity), |
| 166 | ("bytesNonObjptrs", Bytes.layout bytesNonObjptrs), |
| 167 | ("numObjptrs", Int.layout numObjptrs)]] |
| 168 | | Stack => str "Stack" |
| 169 | | Weak {gone} => |
| 170 | seq [str "Weak", |
| 171 | record [("gone", Bool.layout gone)]] |
| 172 | end |
| 173 | val _ = layout (* quell unused warning *) |
| 174 | end |
| 175 | |
| 176 | (* see gc/object.h *) |
| 177 | local |
| 178 | val maxTypeIndex = Int.pow (2, 19) |
| 179 | in |
| 180 | (* see gc/object.c:buildHeaderFromTypeIndex *) |
| 181 | fun typeIndexToHeader typeIndex = |
| 182 | (Assert.assert ("Runtime.header", fn () => |
| 183 | 0 <= typeIndex |
| 184 | andalso typeIndex < maxTypeIndex) |
| 185 | ; Word.orb (0w1, Word.<< (Word.fromInt typeIndex, 0w1))) |
| 186 | |
| 187 | fun headerToTypeIndex w = Word.toInt (Word.>> (w, 0w1)) |
| 188 | end |
| 189 | |
| 190 | (* see gc/object.h *) |
| 191 | val objptrSize : unit -> Bytes.t = |
| 192 | Promise.lazy (Bits.toBytes o Control.Target.Size.objptr) |
| 193 | |
| 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) |
| 199 | |
| 200 | (* see gc/array.h *) |
| 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 ()))) |
| 206 | |
| 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) |
| 212 | |
| 213 | val cpointerSize : unit -> Bytes.t = |
| 214 | Promise.lazy (Bits.toBytes o Control.Target.Size.cpointer) |
| 215 | val labelSize = cpointerSize |
| 216 | |
| 217 | (* See gc/heap.h. *) |
| 218 | val limitSlop = Bytes.fromInt 512 |
| 219 | |
| 220 | (* See gc/frame.h. *) |
| 221 | val maxFrameSize = Bytes.fromInt (Int.pow (2, 16)) |
| 222 | |
| 223 | end |