1(* 2 Title: Foreign Function Interface: main part 3 Author: David Matthews 4 Copyright David Matthews 2015-16, 2018, 2020 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20(* A subset of the main Foreign structure for booting. We need 21 memoise in the interpreter. *) 22 23structure Foreign = 24struct 25 exception Foreign = RunCall.Foreign 26 27 structure Memory :> 28 sig 29 eqtype volatileRef 30 val volatileRef: SysWord.word -> volatileRef 31 val setVolatileRef: volatileRef * SysWord.word -> unit 32 val getVolatileRef: volatileRef -> SysWord.word 33 34 eqtype voidStar 35 (* Remember an address except across loads. *) 36 val memoise: ('a -> voidStar) ->'a -> unit -> voidStar 37 end 38 = 39 struct 40 open ForeignConstants 41 42 (* Both volatileRef and SysWord.word are the ADDRESSes of the actual value. *) 43 type volatileRef = word ref 44 45 val memMove: SysWord.word * SysWord.word * word * word* word -> unit = RunCall.moveBytes 46 47 fun volatileRef init = 48 let 49 (* Allocate a single word marked as mutable, weak, no-overwrite, byte. *) 50 (* A weak byte cell is cleared to zero when it is read in either from the 51 executable or from a saved state. Using the no-overwrite bit ensures 52 that if it is contained in the executable it won't be changed by loading 53 a saved state but there's a problem if it is contained in a parent state. 54 Then loading a child state will clear it because we reload all the parents 55 when we load a child. *) 56 val v = RunCall.allocateWordMemory(sysWordSize div wordSize, 0wx69, 0w0) 57 (* Copy the SysWord into it. *) 58 val () = memMove(init, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) 59 in 60 v 61 end 62 63 fun setVolatileRef(v, i) = memMove(i, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) 64 65 fun getVolatileRef var = 66 let 67 (* Allocate a single word marked as mutable, byte. *) 68 val v = RunCall.allocateByteMemory(sysWordSize div wordSize, 0wx41) 69 val () = memMove(RunCall.unsafeCast var, v, 0w0, 0w0, sysWordSize) 70 val () = RunCall.clearMutableBit v 71 in 72 v 73 end 74 75 type voidStar = SysWord.word 76 77 fun 'a memoise(f: 'a -> voidStar) (a: 'a) : unit -> voidStar = 78 let 79 (* Initialise to zero. That means the function won't be 80 executed until we actually want the result. *) 81 val v = volatileRef 0w0 82 in 83 (* If we've reloaded the volatile ref it will have been reset to zero. 84 We need to execute the function and set it. *) 85 fn () => (case getVolatileRef v of 0w0 => let val r = f a in setVolatileRef(v, r); r end | r => r) 86 end 87 end 88end; 89