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