1(*
2    Copyright (c) 2017, 2019, 2020 David C.J. Matthews
3    
4    Copyright (c) 2000
5        Cambridge University Technical Services Limited
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
21structure CODE_ARRAY :> CODEARRAYSIG = 
22struct
23    open Address
24    open Misc
25
26    datatype csegStatus =
27        Bytes
28    |   UnlockedCode
29
30    type byteVec = address
31    and codeVec = address
32    and closureRef = address
33
34    val objLength: address -> word = length
35
36    val F_mutable_bytes =  Word.fromLargeWord(Word8.toLargeWord(Word8.orb (F_mutable, F_bytes)))
37
38    fun makeConstantClosure (): closureRef =
39    let
40        open Address
41        (* This is used during the bootstrap on the interpreted version so
42           we need to get the native word size when the code is run.
43           The compiler does not (currently) treated the ! ref as an identity
44           operation. *)
45        val wordsPerNativeWord =
46            length(toAddress(toMachineWord(LargeWord.fromInt(!(ref 0)))))
47    in
48        allocWordData(wordsPerNativeWord, Word8.orb(F_mutable, F_closure), toMachineWord 0w0)
49    end
50
51    fun codeAddressFromClosure closure =
52        if nativeWordSize <> wordSize
53        then raise InternalError "codeAddressFromClosure" (* Not valid in 32-in-64 *)
54        else loadWord(closure, 0w0)
55    
56    fun closureAsAddress closure = toMachineWord closure
57
58    fun byteVecMake size =
59    let
60        val vec : address = RunCall.allocateByteMemory(size, F_mutable_bytes)
61        (* allocateByteMemory does not clear the area.  We have to do that at least
62           to ensure that the constant area is cleared before we copy it into a
63           real code area.  In many cases we could get away with clearing less
64           but for the moment this is the safest way. *)
65        val byteLength = size * wordSize
66        fun clear n =
67            if n < byteLength then (assignByte(vec, n, 0w0); clear (n+0w1)) else ()
68        val () = clear 0w0
69    in
70        vec
71    end
72
73    (* codeVec is a way of referring to the code in a mutable form.
74       We now use the closure itself.  *)
75
76    local
77        val byteVecToClosure = RunCall.rtsCallFull2 "PolyCopyByteVecToClosure"
78    in
79        fun byteVecToCodeVec(bvec, closure) =
80        (
81            byteVecToClosure (bvec, closure);
82            closure
83        )
84    end
85    
86    local
87        val cvecLock = RunCall.rtsCallFull1 "PolyLockMutableClosure"
88    in
89        fun codeVecLock(_, closure) = cvecLock closure
90    end
91
92    (* Return the address of the segment. Used when putting in "self" addresses.
93       Only used in native 32-bit where we don't have relative addresses. *)
94    val codeVecAddr = toAddress o codeAddressFromClosure
95 
96    (* Set a byte. Used when setting the byte data. *)
97    fun byteVecSet (addr, byteIndex, value: Word8.word) =
98    let
99        val lengthWords = objLength addr
100        val lengthBytes = wordSize * lengthWords
101    in
102        if byteIndex < lengthBytes then assignByte (addr, byteIndex, value)
103        else raise Subscript
104    end
105
106    val codeVecGet = RunCall.rtsCallFast2 "PolyGetCodeByte"
107    and codeVecSet = RunCall.rtsCallFast3 "PolySetCodeByte"
108
109    datatype constantType = ConstAbsolute | ConstX86Relative
110
111    local
112        val setCodeConstantCall = RunCall.rtsCallFast4 "PolySetCodeConstant"
113    in
114        (* Store a constant into the code.  This must be used if the constant is
115           not on a word boundary or if it needs special treatment. *)
116        fun codeVecPutConstant (addr, byteIndex, value:machineWord, option: constantType) =
117        let
118            val optValue =
119                case option of ConstAbsolute => 0w2 | ConstX86Relative => 0w1
120        in
121            setCodeConstantCall(addr, byteIndex, value, optValue)
122        end
123        
124        (* Used to set constants in the constant area. *)
125        fun codeVecPutWord(addr, wordIndex, value) =
126            setCodeConstantCall(addr, wordIndex * wordSize, value, 0w0)
127    end
128
129    structure Sharing =
130    struct
131        type byteVec = byteVec
132        and  codeVec = codeVec
133        and  closureRef = closureRef
134        and  constantType = constantType
135    end
136
137end;
138