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