1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
(*
Copyright (c) 2000
Cambridge University Technical Services Limited
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
(*
Title: Code vector operations.
Author: Dave Matthews, Cambridge University Computer Laboratory
Copyright Cambridge University 1985
*)
(*
This module constructs and operates on segments for machine code.
"csegMake" constructs and returns a segment of the specified size with
give flag codes.
The segment can be read and written a byte at a time using the "csegGet"
procedure, and the code can be entered using "csegCall" (this is only used
if the code is an "early" procedure which must be called by the compiler
or is a declaration or expression at the outer level. More usually
"csegAddr" is used to return the address of the segment which is then
compiled into another procedure as a constant.
When a procedure has been compiled "csegLock" is called to remove the
"mutable" bit. The segment then becomes a constant and cannot be
changed.
It is used in two ways. Initially the code is assembled into a segment which
expands as necessary so that there is always room for the code. When the
code has been completely assembled and we know how much there is, it is
copied into a segment of the correct size.
*)
structure CODE_ARRAY :
sig
type machineWord
type address
type cseg
val csegMake: word -> cseg
val csegConvertToCode: cseg -> unit
val csegLock: cseg -> unit
val csegGet: cseg * word -> Word8.word
val csegSet: cseg * word * Word8.word -> unit
val csegGetWord: cseg * word -> machineWord
val csegPutWord: cseg * word * machineWord -> unit
val csegCopySeg: cseg * cseg * word * word -> unit
val csegAddr: cseg -> address
val csegPutConstant: cseg * word * machineWord * 'a -> unit
end =
struct
open Address
open Misc
datatype csegStatus =
Bytes
| UnlockedCode
| LockedCode
type cseg = (csegStatus * address) ref
val objLength: address -> word = length
val expansionFactor = 0w3 (* Factor by which to increase size of segment *)
val F_mutable_bytes = Word8.orb (F_mutable, F_bytes)
val F_mutable_code = Word8.orb (F_mutable, F_code)
val wordSize = Word.fromInt Address.wordSize
fun csegMake (size : word) : cseg =
let
val vec : address = alloc (size, F_mutable_bytes, toMachineWord 0)
in
ref (Bytes, vec)
end
fun csegConvertToCode (r as ref (Bytes, addr)) : unit =
let
val () = setFlags (addr, F_mutable_code)
in
r := (UnlockedCode, addr)
end
| csegConvertToCode _ =
raise InternalError "csegConvertToCode: not a byte segment"
fun csegLock (r as ref (UnlockedCode, addr)) : unit =
let
val () = setFlags (addr, F_code)
in
r := (LockedCode, addr)
end
| csegLock _ = raise InternalError "csegConvertToCode: not an unlocked code segment"
fun csegAddr (ref (status, addr)) : address =
if status = Bytes
then raise InternalError "csegAddr: not a code segment"
else addr
(* Copy a segment. This can only be called while the code is being constructed when it
consists only of bytes. Constants are not added to the vector at this stage. *)
fun csegCopySeg (ref (Bytes, fromAddr), ref (Bytes, toAddr), lengthBytes : word, offsetWords : word) =
let
val fromLengthWords : word = objLength fromAddr
val toLengthWords : word = objLength toAddr
val fromLengthBytes : word = wordSize * fromLengthWords
val toLengthBytes : word = wordSize * toLengthWords
val offsetBytes : word = wordSize * offsetWords
val System_move_bytes:
address*word*address*word*word->unit = RunCall.run_call5 RuntimeCalls.POLY_SYS_move_bytes
val maxOffsetBytes = toLengthBytes - lengthBytes
in
(* Check the lengths are in the range. *)
if fromLengthBytes < lengthBytes orelse maxOffsetBytes < offsetBytes
then raise Subscript
else System_move_bytes(fromAddr, 0w0, toAddr, offsetBytes, lengthBytes)
end
| csegCopySeg _ = raise InternalError "csegCopySeg: can only copy between byte segments"
(* Returns a value from the vector. *)
fun csegGet (ref (_, addr), byteIndex : word) : Word8.word =
let
val lengthWords = objLength addr
val lengthBytes = wordSize * lengthWords
in
if byteIndex < lengthBytes
then loadByte (addr, byteIndex)
else raise Subscript
end
fun csegSet (ref (LockedCode, _), _, _) : unit =
raise InternalError "csegSet: can't change locked code segment"
| csegSet (r as (ref (status, addr)), byteIndex, value:Word8.word) : unit =
let
val lengthWords = objLength addr
val lengthBytes = wordSize * lengthWords
in
if byteIndex < lengthBytes then assignByte (addr, byteIndex, value)
else if status <> Bytes then raise InternalError "csegSet: can't extend code segment"
else
let (* length <= byteIndex; construct a new segment*)
val oldSize = lengthWords (* size in words *)
val expSize = expansionFactor * oldSize
val wordIndex = byteIndex div wordSize
val minSize = wordIndex + 0w1
val newSize = Word.max(expSize, minSize)
(* create temporary codeseg (with larger byte-vector) *)
val newVec = alloc (newSize, F_mutable_bytes, toMachineWord 0w0)
val newSeg = (Bytes, newVec)
in
(* copy the old code into the new codeseg *)
csegCopySeg (r, ref newSeg, lengthBytes, 0w0);
(* assign the byte to the new codeseg's byte-vector *)
assignByte (newVec, byteIndex, value);
(* update the old segment to point at the new byte-vector *)
r := newSeg
end
end
(* Puts in a word at a given word offset. Does not expand the segment. *)
fun csegPutWord (ref (UnlockedCode, addr), wordIndex, value:machineWord) : unit =
let
val lengthWords = objLength addr
in
if lengthWords <= wordIndex
then raise Subscript
else assignWord (addr, wordIndex, value)
end
| csegPutWord _ = raise InternalError "csegPutWord: not an unlocked code segment"
(* Gets a word at a given word offset. Does not expand the segment. *)
fun csegGetWord (ref (status, addr), wordIndex) : machineWord =
let
val lengthWords = objLength addr
in
if status = Bytes
then raise InternalError "csegGetWord: can't load a a word from a byte segment"
else if lengthWords <= wordIndex
then raise Subscript
else loadWord (addr, wordIndex)
end
(* csegPutConstant: store a constant into the code. Exactly how this is
done is architecture dependent: on the i386 it's simply a store, on
other architectures the constant may have to be split between instructions.
This means that it has to be done by the RTS so as to be certain that
we don't have a garbage collection with an invalid address. DCJM 2/1/01. *)
fun csegPutConstant (ref (UnlockedCode, addr), byteIndex,
value:machineWord, data: 'a) : unit =
let
val lengthWords = objLength addr
val lengthBytes = wordSize * lengthWords
in
if lengthBytes <= byteIndex
then raise Subscript
else RunCall.run_call4 RuntimeCalls.POLY_SYS_set_code_constant
(addr, byteIndex, value, data)
end
| csegPutConstant _ = raise InternalError "csegPutConstant: not an unlocked code segment"
end; (* CODE_SEG *)
|
