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
|
(*
Title: PolyML structure before compiling the rest of the basis.
Author: Dave Matthews, Cambridge University Computer Laboratory
Copyright (c) 2000-7
Cambridge University Technical Services Limited
Modified David C.J. Matthews 2008
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
*)
(* We need to use onEntry in the IO library so this has to be compiled
first. However we also want "make" in the PolyML structure so we have
to complete the compilation later. *)
local
open RuntimeCalls;
in
structure PolyML =
(* We must not have a signature on the result otherwise print and makestring
will be given polymorphic types and will only produce "?" *)
struct
(* The type-specific functions e.g. PolyML.print must be extracted by using open.
They appear to be polymorphic but we have to be careful that they are
recognised by the compiler as type-specific and not as normal polymorphic
functions. *)
open PolyML;
local
(* This is slightly awkward but is needed because otherwise the compiler
would complain about a free type variable. *)
val etrace: word->word = RunCall.run_call1 POLY_SYS_exception_trace;
in
fun exception_trace (f: unit->'a):'a =
RunCall.unsafeCast etrace f
end
local
(* Initialise the list with the existing start-up function *)
val onEntryList: (unit->unit) list ref = ref[]
(* Run the list in reverse order. *)
fun runOnEntry [] = ()
| runOnEntry (f :: b) = (runOnEntry b; f() handle _ => ());
(* If the installed function returns without calling OS.Process.exit
we have to run the installed "atExit" functions as though it had.
Unfortunately we have to duplicate code from OS.Process here. *)
local
val doExit =
RunCall.run_call1 RuntimeCalls.POLY_SYS_exit
val doCall: int*unit -> (unit->unit) =
RunCall.run_call2 RuntimeCalls.POLY_SYS_process_env
in
fun exit () =
let
val exitFun =
(* If we get an empty list here we've finished. *)
doCall(19, ()) handle _ => doExit 0
in
(* Run the function and then repeat. *)
exitFun() handle _ => ();
exit()
end
end
in
(* The equivalent of atExit except that functions are added to
the list persistently and of course the functions are executed
at start-up rather than close-down. *)
(* TODO: There ought to be a mutex here. *)
fun onEntry (f: unit->unit) = onEntryList := f :: !onEntryList
fun runFunction f () =
(
runOnEntry(! onEntryList); (* Perform start-up operations. *)
f(); (* Run the main function. *)
exit() (* Perform close-down actions. *)
)
(* Export functions - write out the function and everything reachable from it. *)
fun export(filename: string, f: unit->unit): unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (1, (filename, runFunction f))
fun exportPortable(filename: string, f: unit->unit): unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (3, (filename, runFunction f))
end
fun shareCommonData(root: 'a): unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (13, root)
(* The first two used to be in the System structure but that is no longer included. *)
fun objSize(x:'a): int = RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (14, x)
and showSize(x:'a): int = RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (15, x)
and objProfile(x:'a): int = RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (16, x)
val fullGC: unit -> unit =
RunCall.run_call0 POLY_SYS_full_gc;
val stackTrace: unit -> unit =
RunCall.run_call0 POLY_SYS_stack_trace;
local
val eqWord : word*word->bool = RunCall.run_call2 POLY_SYS_word_eq
in
fun pointerEq(x: 'a ,y: 'a): bool = RunCall.unsafeCast eqWord (x,y)
end
fun rtsVersion () : int = RunCall.run_call2 POLY_SYS_process_env(104, ())
fun architecture(): string = RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (12, ())
fun rtsArgumentHelp(): string = RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (19, ());
local
val onLoadList = ref []
fun loadSavedState (f: string): unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (21, f)
in
(* Add a function to be called when a saved state is loaded. This is really
here to ensure that we can preserve the contents of the buffer for stdIn. *)
fun onLoad (f: (unit->unit)->unit): unit = onLoadList := f :: ! onLoadList
(* Saving and loading state. *)
structure SaveState =
struct
fun saveChild(f: string, depth: int): unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (20, (f, depth))
fun saveState f = saveChild (f, 0);
fun showHierarchy(): string list =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (22, ())
fun renameParent{ child: string, newParent: string }: unit =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (23, (child, newParent))
fun showParent(child: string): string option =
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (24, child)
fun loadState (f: string): unit =
let
val loadList = ! onLoadList
(* Work along the list calling each function with an argument to
call the next item. That allows the functions to make local copies
of any references and then reset them when the recursion unwinds. *)
fun apply [] = (* Actually do the loading. *)
RunCall.run_call2 RuntimeCalls.POLY_SYS_poly_specific (21, f)
| apply (h::t) = h (fn () => apply t)
in
apply loadList;
(* Reset the load list since that will have been overwritten by the load. *)
onLoadList := loadList
end
end
end
local
(* Poly/ML exceptions. *)
structure XWindowsEx =
RunCall.Run_exception1
(
type ex_type = string;
val ex_iden = RuntimeCalls.EXC_XWindows
)
and ForeignEx =
RunCall.Run_exception1
(
type ex_type = string;
val ex_iden = RuntimeCalls.EXC_foreign
)
in
exception XWindows = XWindowsEx.ex
and Foreign = ForeignEx.ex
end;
end
end;
|
