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