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