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