1 (* Copyright (C
) 2010-2011,2013-2014,2017 Matthew Fluet
.
2 * Copyright (C
) 1999-2009 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
4 * Copyright (C
) 1997-2000 NEC Research Institute
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 (* Primitive names are special
-- see atoms
/prim
.fun. *)
12 structure Primitive
= struct
16 structure MLton
= struct
18 val eq
= _prim
"MLton_eq": 'a
* 'a
-> bool;
19 val equal
= _prim
"MLton_equal": 'a
* 'a
-> bool;
20 (* val deserialize
= _prim
"MLton_deserialize": Word8Vector
.vector
-> 'a ref
; *)
21 val halt
= _prim
"MLton_halt": C_Status
.t
-> unit
;
22 val hash
= _prim
"MLton_hash": 'a
-> Word32
.word;
23 (* val serialize
= _prim
"MLton_serialize": 'a ref
-> Word8Vector
.vector
; *)
24 val share
= _prim
"MLton_share": 'a
-> unit
;
25 val size
= _prim
"MLton_size": 'a
-> C_Size
.t
;
27 val installSignalHandler
=
28 _prim
"MLton_installSignalHandler": unit
-> unit
;
34 val gcState
= #
1 _symbol
"gcStateAddress" private
: t GetSet
.t
; ()
39 datatype t
= Align4 | Align8
42 case _build_const
"MLton_Align_align": Int32
.int; of
45 | _
=> raise Primitive
.Exn
.Fail8
"MLton_Align_align"
50 (* The most recent caller is at index
0 in the array
. *)
51 datatype t
= T
of Word32
.word array
54 _import
"GC_callStack" runtime private
: GCState
.t
* Word32
.word array
-> unit
;
55 val frameIndexSourceSeq
=
56 _import
"GC_frameIndexSourceSeq" runtime private
: GCState
.t
* Word32
.word -> Pointer
.t
;
57 val keep
= _command_line_const
"CallStack.keep": bool = false;
59 _import
"GC_numStackFrames" runtime private
: GCState
.t
-> Word32
.word;
60 val sourceName
= _import
"GC_sourceName" runtime private
: GCState
.t
* Word32
.word -> C_String
.t
;
65 datatype t
= AMD64 | C | LLVM | X86
68 case _build_const
"MLton_Codegen_codegen": Int32
.int; of
73 | _
=> raise Primitive
.Exn
.Fail8
"MLton_Codegen_codegen"
76 val isAMD64
= codegen
= AMD64
77 val isLLVM
= codegen
= LLVM
78 val isX86
= codegen
= X86
83 (* The polymorphism
with extra
and setInitExtra is because primitives
84 * are only supposed to deal
with basic types
. The polymorphism
85 * allows the various passes like monomorphisation to translate
86 * the types appropriately
.
88 type extra
= CallStack
.t option
90 val extra
= _prim
"Exn_extra": exn
-> 'a
;
91 val extra
: exn
-> extra
= extra
92 val keepHistory
= _command_line_const
"Exn.keepHistory": bool = false;
93 val setExtendExtra
= _prim
"Exn_setExtendExtra": ('a
-> 'a
) -> unit
;
94 val setExtendExtra
: (extra
-> extra
) -> unit
= setExtendExtra
96 (* Ensure that setExtendExtra is initialized
.
97 * Important for
-const
'Exn
.keepHistory
true', so that
98 * exceptions can be
raised (and handled
) during Basis Library
101 val setExtendExtra
: (extra
-> extra
) -> unit
=
103 then (setExtendExtra (fn _
=> NONE
)
110 val getOpArgsResPtr
= #
1 _symbol
"MLton_FFI_opArgsResPtr" private
: Pointer
.t GetSet
.t
;
111 val numExports
= _build_const
"MLton_FFI_numExports": Int32
.int;
114 structure Finalizable
=
116 val touch
= _prim
"MLton_touch": 'a
-> unit
;
121 val collect
= _prim
"GC_collect": unit
-> unit
;
122 val pack
= _import
"GC_pack" runtime private
: GCState
.t
-> unit
;
123 val getBytesAllocated
=
124 _import
"GC_getCumulativeStatisticsBytesAllocated" runtime private
: GCState
.t
-> C_UIntmax
.t
;
125 val getNumCopyingGCs
=
126 _import
"GC_getCumulativeStatisticsNumCopyingGCs" runtime private
: GCState
.t
-> C_UIntmax
.t
;
127 val getNumMarkCompactGCs
=
128 _import
"GC_getCumulativeStatisticsNumMarkCompactGCs" runtime private
: GCState
.t
-> C_UIntmax
.t
;
130 _import
"GC_getCumulativeStatisticsNumMinorGCs" runtime private
: GCState
.t
-> C_UIntmax
.t
;
131 val getLastBytesLive
=
132 _import
"GC_getLastMajorStatisticsBytesLive" runtime private
: GCState
.t
-> C_Size
.t
;
133 val getMaxBytesLive
=
134 _import
"GC_getCumulativeStatisticsMaxBytesLive" runtime private
: GCState
.t
-> C_Size
.t
;
135 val setHashConsDuringGC
=
136 _import
"GC_setHashConsDuringGC" runtime private
: GCState
.t
* bool -> unit
;
137 val setMessages
= _import
"GC_setControlsMessages" runtime private
: GCState
.t
* bool -> unit
;
138 val setRusageMeasureGC
=
139 _import
"GC_setControlsRusageMeasureGC" runtime private
: GCState
.t
* bool -> unit
;
140 val setSummary
= _import
"GC_setControlsSummary" runtime private
: GCState
.t
* bool -> unit
;
141 val unpack
= _import
"GC_unpack" runtime private
: GCState
.t
-> unit
;
164 case _const
"MLton_Platform_Arch_host": String8
.string; of
173 |
"powerpc" => PowerPC
174 |
"powerpc64" => PowerPC64
178 | _
=> raise Primitive
.Exn
.Fail8
"strange MLton_Platform_Arch_host"
180 val hostIsBigEndian
= _const
"MLton_Platform_Arch_bigendian": bool;
192 case _build_const
"MLton_Platform_Format": String8
.string; of
194 |
"executable" => Executable
195 |
"libarchive" => LibArchive
196 |
"library" => Library
197 | _
=> raise Primitive
.Exn
.Fail8
"strange MLton_Platform_Format"
216 case _const
"MLton_Platform_OS_host": String8
.string; of
220 |
"freebsd" => FreeBSD
226 |
"openbsd" => OpenBSD
227 |
"solaris" => Solaris
228 | _
=> raise Primitive
.Exn
.Fail8
"strange MLton_Platform_OS_host"
233 #
1 _symbol
"MLton_Platform_CygwinUseMmap" private
: bool GetSet
.t
; ()
237 val useWindowsProcess
= not forkIsEnabled
247 _prim
"CPointer_add": t
* C_Ptrdiff
.t
-> t
;
249 _prim
"CPointer_sub": t
* C_Ptrdiff
.t
-> t
;
251 _prim
"CPointer_diff": t
* t
-> C_Ptrdiff
.t
;
252 val < = _prim
"CPointer_lt": t
* t
-> bool;
254 structure S
= IntegralComparisons(type t
= t
261 _prim
"CPointer_fromWord": C_Size
.t
-> t
;
263 _prim
"CPointer_toWord": t
-> C_Size
.t
;
265 val null
: t
= fromWord
0w0
267 fun isNull p
= p
= null
269 val getCPointer
= _prim
"CPointer_getCPointer": t
* C_Ptrdiff
.t
-> t
;
270 val getInt8
= _prim
"CPointer_getWord8": t
* C_Ptrdiff
.t
-> Int8
.int;
271 val getInt16
= _prim
"CPointer_getWord16": t
* C_Ptrdiff
.t
-> Int16
.int;
272 val getInt32
= _prim
"CPointer_getWord32": t
* C_Ptrdiff
.t
-> Int32
.int;
273 val getInt64
= _prim
"CPointer_getWord64": t
* C_Ptrdiff
.t
-> Int64
.int;
274 val getObjptr
= _prim
"CPointer_getObjptr": t
* C_Ptrdiff
.t
-> 'a
;
275 val getReal32
= _prim
"CPointer_getReal32": t
* C_Ptrdiff
.t
-> Real32
.real;
276 val getReal64
= _prim
"CPointer_getReal64": t
* C_Ptrdiff
.t
-> Real64
.real;
277 val getWord8
= _prim
"CPointer_getWord8": t
* C_Ptrdiff
.t
-> Word8.word;
278 val getWord16
= _prim
"CPointer_getWord16": t
* C_Ptrdiff
.t
-> Word16
.word;
279 val getWord32
= _prim
"CPointer_getWord32": t
* C_Ptrdiff
.t
-> Word32
.word;
280 val getWord64
= _prim
"CPointer_getWord64": t
* C_Ptrdiff
.t
-> Word64
.word;
281 val setCPointer
= _prim
"CPointer_setCPointer": t
* C_Ptrdiff
.t
* t
-> unit
;
282 val setInt8
= _prim
"CPointer_setWord8": t
* C_Ptrdiff
.t
* Int8
.int -> unit
;
283 val setInt16
= _prim
"CPointer_setWord16": t
* C_Ptrdiff
.t
* Int16
.int -> unit
;
284 val setInt32
= _prim
"CPointer_setWord32": t
* C_Ptrdiff
.t
* Int32
.int -> unit
;
285 val setInt64
= _prim
"CPointer_setWord64": t
* C_Ptrdiff
.t
* Int64
.int -> unit
;
286 val setObjptr
= _prim
"CPointer_setObjptr": t
* C_Ptrdiff
.t
* 'a
-> unit
;
287 val setReal32
= _prim
"CPointer_setReal32": t
* C_Ptrdiff
.t
* Real32
.real -> unit
;
288 val setReal64
= _prim
"CPointer_setReal64": t
* C_Ptrdiff
.t
* Real64
.real -> unit
;
289 val setWord8
= _prim
"CPointer_setWord8": t
* C_Ptrdiff
.t
* Word8.word -> unit
;
290 val setWord16
= _prim
"CPointer_setWord16": t
* C_Ptrdiff
.t
* Word16
.word -> unit
;
291 val setWord32
= _prim
"CPointer_setWord32": t
* C_Ptrdiff
.t
* Word32
.word -> unit
;
292 val setWord64
= _prim
"CPointer_setWord64": t
* C_Ptrdiff
.t
* Word64
.word -> unit
;
297 val isOn
= _build_const
"MLton_Profile_isOn": bool;
302 val dummy
= Pointer
.null
303 val free
= _import
"GC_profileFree" runtime private
: GCState
.t
* t
-> unit
;
304 val malloc
= _import
"GC_profileMalloc" runtime private
: GCState
.t
-> t
;
306 _import
"GC_profileWrite" runtime private
: GCState
.t
* t
* NullString8
.t
-> unit
;
308 val done
= _import
"GC_profileDone" runtime private
: GCState
.t
-> unit
;
309 val getCurrent
= _import
"GC_getProfileCurrent" runtime private
: GCState
.t
-> Data
.t
;
310 val setCurrent
= _import
"GC_setProfileCurrent" runtime private
: GCState
.t
* Data
.t
-> unit
;
315 type preThread
= PreThread
.t
316 type thread
= Thread
.t
318 val atomicState
= _prim
"Thread_atomicState": unit
-> Word32
.word;
319 val atomicBegin
= _prim
"Thread_atomicBegin": unit
-> unit
;
321 if atomicState () = 0w0
322 then raise Primitive
.Exn
.Fail8
"Thread.atomicEnd"
323 else _prim
"Thread_atomicEnd": unit
-> unit
; ()
324 val copy
= _prim
"Thread_copy": preThread
-> thread
;
325 (* copyCurrent
's result is accesible via
savedPre ().
326 * It is not possible to have the
type of copyCurrent
as
327 * unit
-> preThread
, because there are two different ways to
328 * return from the call to copyCurrent
. One way is the direct
329 * obvious way
, in the thread that called copyCurrent
. That one
,
330 * of course
, wants to call
savedPre (). However
, another way to
331 * return is by making a copy
of the preThread
and then switching
332 * to it
. In that
case, there is no preThread to return
. Making
333 * copyCurrent return a preThread creates nasty bugs
where the
334 * return code from the CCall expects to see a preThread result
335 * according to the C return convention
, but there isn
't one when
336 * switching to a copy
.
338 val copyCurrent
= _prim
"Thread_copyCurrent": unit
-> unit
;
339 val current
= _import
"GC_getCurrentThread" runtime private
: GCState
.t
-> thread
;
340 val finishSignalHandler
= _import
"GC_finishSignalHandler" runtime private
: GCState
.t
-> unit
;
341 val returnToC
= _prim
"Thread_returnToC": unit
-> unit
;
342 val saved
= _import
"GC_getSavedThread" runtime private
: GCState
.t
-> thread
;
343 val savedPre
= _import
"GC_getSavedThread" runtime private
: GCState
.t
-> preThread
;
344 val setCallFromCHandler
=
345 _import
"GC_setCallFromCHandlerThread" runtime private
: GCState
.t
* thread
-> unit
;
346 val setSignalHandler
=
347 _import
"GC_setSignalHandlerThread" runtime private
: GCState
.t
* thread
-> unit
;
348 val setSaved
= _import
"GC_setSavedThread" runtime private
: GCState
.t
* thread
-> unit
;
349 val startSignalHandler
= _import
"GC_startSignalHandler" runtime private
: GCState
.t
-> unit
;
350 val switchTo
= _prim
"Thread_switchTo": thread
-> unit
;
357 val canGet
= _prim
"Weak_canGet": 'a t
-> bool;
358 val get
= _prim
"Weak_get": 'a t
-> 'a
;
359 val new
= _prim
"Weak_new": 'a
-> 'a t
;
364 val getAmOriginal
= _import
"GC_getAmOriginal" runtime private
: GCState
.t
-> bool;
365 val setAmOriginal
= _import
"GC_setAmOriginal" runtime private
: GCState
.t
* bool -> unit
;
366 val getSaveStatus
= _import
"GC_getSaveWorldStatus" runtime private
: GCState
.t
-> bool C_Errno
.t
;
367 (* save
's result status is accesible via
getSaveStatus ().
368 * It is not possible to have the
type of save
as
369 * NullString8
.t
-> bool C_Errno
.t
, because there are two
370 * different ways to return from the call to save
. One way is
371 * the direct obvious way
, in the program instance that called
372 * save
. However
, another way to return is
in the program
373 * instance that loads the world
. Making save return a
bool
374 * creates nasty bugs
where the return code from the CCall
375 * expects to see a
bool result according to the C return
376 * convention
, but there isn
't one when returning
in the load
379 val save
= _prim
"World_save": NullString8
.t
-> unit
;