1(* 2 Copyright (c) 2000 3 Cambridge University Technical Services Limited 4 5 Further development copyright David C.J. Matthews 2000-2017 6 7 This library is free software; you can redistribute it and/or 8 modify it under the terms of the GNU Lesser General Public 9 License version 2.1 as published by the Free Software Foundation. 10 11 This library is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 Lesser General Public License for more details. 15 16 You should have received a copy of the GNU Lesser General Public 17 License along with this library; if not, write to the Free Software 18 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19*) 20 21signature AddressSig = 22sig 23 type machineWord 24 type address 25 type short = Word.word 26 27 val stringOfWord: machineWord -> string 28 29 val wordEq : machineWord * machineWord -> bool 30 31 val isShort : machineWord -> bool 32 33 exception Cast of string 34 val toMachineWord: 'a -> machineWord 35 val toShort: machineWord -> Word.word 36 val toAddress: machineWord -> address 37 38 val loadByte: (address * Word.word) -> Word8.word 39 val loadWord: (address * Word.word) -> machineWord 40 41 val assignByte: (address * Word.word * Word8.word) -> unit 42 val assignWord: (address * Word.word * machineWord) -> unit 43 44 val allocWordData: (short * Word8.word * machineWord) -> address 45 46 val maxAllocation: word 47 48 val lock: address -> unit 49 val length: address -> short 50 val flags: address -> Word8.word 51 52 val wordSize: word and nativeWordSize: word 53 54 val F_words : Word8.word 55 val F_bytes : Word8.word 56 val F_closure : Word8.word 57 val F_code : Word8.word 58 val F_negative : Word8.word 59 val F_mutable : Word8.word 60 val F_gc : Word8.word 61 val F_noOverwrite : Word8.word 62 val F_weak : Word8.word 63 val F_profile : Word8.word 64 65 val isWords : address -> bool 66 val isBytes : address -> bool 67 val isCode : address -> bool 68 val isClosure: address -> bool 69 val isMutable:address -> bool 70end 71 72structure Address :> AddressSig = 73 74struct 75 (* These want to be abstract. *) 76 local 77 structure M:> sig type machineWord and address end = 78 struct 79 type machineWord = word (* a legal ML object (tag = 0 or 1) *) 80 and address = word (* a normal pointer (tag = 0) *) 81 end 82 in 83 open M 84 end 85 86 (* This is the same as word *) 87 type short = word (* a 31/63-bit int (tag = 1) *) 88 89 (* pointer equality *) 90 val wordEq: machineWord * machineWord -> bool = PolyML.pointerEq 91 92 val unsafeCast : 'a -> 'b = RunCall.unsafeCast 93 94 val isShort : machineWord->bool = RunCall.isShort 95 96 (* The following cast is always safe *) 97 val toMachineWord : 'a -> machineWord = unsafeCast 98 99 (* The following casts need checking *) 100 exception Cast of string 101 102 fun toAddress (w: machineWord) : address = 103 if isShort w then raise Cast "toAddress" else unsafeCast w 104 105 fun toShort (w: machineWord) : Word.word = 106 if isShort w then unsafeCast w else raise Cast "toShort" 107 108 109 (* Note: 110 assignByte should *not* be used with word-objects 111 (we might copy half a pointer into the object, 112 then call the garbage collector) 113 114 loadWord should *not* be used with byte-objects 115 (we might load something that's not a valid ML value, 116 then call the garbage collector) 117 118 Violating these assertions may corrupt the heap and cause unpredictable 119 behaviour. 120 121 It's safe to use assignWord with a byte-object or loadByte 122 with a word-object but it may not do what you expect. 123 124 Note that the offset for the 125 "Word" functions is in words, whereas the offset for the 126 "Byte" functions is in bytes. 127 *) 128 129 val loadByte: address * Word.word -> Word8.word = RunCall.loadByte 130 and loadWord: address * Word.word -> machineWord = RunCall.loadWord 131 and assignByte: address * Word.word * Word8.word -> unit = RunCall.storeByte 132 and assignWord: address * Word.word * machineWord -> unit = RunCall.storeWord 133 and lock: address -> unit = RunCall.clearMutableBit 134 (* wordSize is the number of bytes in a Poly word. *) 135 and wordSize: word = RunCall.bytesPerWord 136 and length: address -> Word.word = RunCall.memoryCellLength 137 and flags: address -> Word8.word = Word8.fromLargeWord o Word.toLargeWord o RunCall.memoryCellFlags 138 139 (* The native word size is the number of bytes in an address. This is the same as 140 wordSize except in 32-in-64. *) 141 val nativeWordSize = length(toAddress(toMachineWord(0w0:LargeWord.word))) * wordSize 142 143 local 144 val callGetAllocationSize = RunCall.rtsCallFast0 "PolyGetMaxAllocationSize" 145 in 146 val maxAllocation: word = callGetAllocationSize() 147 end 148 149 fun allocWordData(len: word, flags: Word8.word, initial: machineWord): address = 150 (* Check that the size is within the acceptable range. *) 151 if len >= maxAllocation 152 then raise Size 153 else RunCall.allocateWordMemory(len, Word.fromLargeWord(Word8.toLargeWord flags), initial) 154 155 val F_words : Word8.word = 0wx00 (* word object - contains pointers and/or tagged values. *) 156 val F_bytes : Word8.word = 0wx01 (* byte object (contains no pointers) *) 157 val F_code : Word8.word = 0wx02 (* code object (mixed bytes and words) *) 158 val F_closure : Word8.word = 0wx03 (* closure object. This is only used in 32-in-64. *) 159 val F_noOverwrite : Word8.word = 0wx08 (* don't overwrite when loading - mutables only. *) 160 val F_negative : Word8.word = 0wx10 (* sign bit for arbitrary precision ints (byte objects) *) 161 val F_profile : Word8.word = 0wx10 (* object has a profile pointer (word objects) *) 162 val F_weak : Word8.word = 0wx20 (* object contains weak references to option values. *) 163 val F_mutable : Word8.word = 0wx40 (* object is mutable *) 164 val F_gc : Word8.word = 0wx80 (* object is (pointer or depth) tombstone *) 165 166 local 167 val typeMask : Word8.word = 0wx03 168 169 fun isType (t: Word8.word) (a: address):bool = Word8.andb(flags a, typeMask) = t 170 in 171 val isWords = isType F_words 172 val isBytes = isType F_bytes 173 val isCode = isType F_code 174 val isClosure = isType F_closure 175 176 (* The mutable flag may be used with any of the others. *) 177 fun isMutable a = Word8.andb(flags a, F_mutable) = F_mutable 178 end 179 180 val functionName: machineWord -> string = RunCall.rtsCallFull1 "PolyGetFunctionName" 181 182 fun stringOfWord w = 183 if isShort w 184 then "LIT" ^ Word.toString (unsafeCast w) 185 186 else 187 let 188 val v = toAddress w 189 in 190 if isCode v 191 then "CODE \"" ^ functionName w ^ "\"" 192 193 else if isBytes v 194 then 195 let 196 val length = Int.min(Word.toInt(length v * wordSize), 16) 197 val data = Word8Vector.tabulate(length, fn n => loadByte(v, Word.fromInt n)) 198 in 199 "BYTE data" ^ String.toString(Byte.bytesToString data) 200 end 201 202 else if not(isMutable v) andalso isClosure v andalso Word.toInt(length v) >= 1 203 then (* In 32-in-64 the first word of a closure is an absolute code address. *) 204 ( 205 "FUN \"" ^ functionName w ^ "\"" (* Get the function name. *) 206 handle Fail _ => "LIT <long word data>" (* May fail if it hasn't been set. *) 207 ) 208 209 else if isWords v andalso Word.toInt(length(toAddress w)) >= 1 210 then (* If it's the closure of a function try to print that. *) 211 let 212 val firstWord = loadWord(toAddress w, 0w0) 213 in 214 if not (isShort firstWord) andalso isCode(toAddress firstWord) 215 then "FUN \"" ^ functionName firstWord ^ "\"" (* Get the function name. *) 216 else "LIT <long word data>" 217 end 218 219 else "LIT <long word data>" 220 end 221 222end; 223 224(* Add a print function for machineWord. This is really only for 225 the debugger but prevents addresses being printed as Word.word values. *) 226local 227 open PolyML Address 228 fun printMachineWord _ _ w = PrettyString(stringOfWord w) 229in 230 val () = addPrettyPrinter printMachineWord 231end; 232 233