1 /* Copyright (C) 2009,2012,2015,2017 Matthew Fluet.
2 * Copyright (C) 1999-2008 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 /* ---------------------------------------------------------------- */
12 /* ---------------------------------------------------------------- */
14 static bool stringToBool (char *s
) {
15 if (0 == strcmp (s
, "false"))
17 if (0 == strcmp (s
, "true"))
19 die ("Invalid @MLton bool: %s.", s
);
22 // From gdtoa/gdtoa.h.
23 // Can't include the whole thing because it brings in too much junk.
24 float gdtoa__strtof (const char *, char **);
26 static float stringToFloat (char *s
) {
30 f
= gdtoa__strtof (s
, &endptr
);
32 die ("Invalid @MLton float: %s.", s
);
36 static size_t stringToBytes (char *s
) {
41 d
= strtod (s
, &endptr
);
47 factor
= 1024 * 1024 * 1024;
61 unless (*endptr
== '\0'
63 and d
<= (double)SIZE_MAX
)
67 die ("Invalid @MLton memory amount: %s.", s
);
70 /* ---------------------------------------------------------------- */
72 /* ---------------------------------------------------------------- */
74 int processAtMLton (GC_state s
, int start
, int argc
, char **argv
,
79 while (s
->controls
.mayProcessAtMLton
81 and (0 == strcmp (argv
[i
], "@MLton"))) {
88 die ("Missing -- at end of @MLton args.");
93 if (0 == strcmp (arg
, "copy-generational-ratio")) {
95 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
96 die ("@MLton copy-generational-ratio missing argument.");
97 s
->controls
.ratios
.copyGenerational
= stringToFloat (argv
[i
++]);
98 unless (1.0 < s
->controls
.ratios
.copyGenerational
)
99 die ("@MLton copy-generational-ratio argument must be greater than 1.0.");
100 } else if (0 == strcmp (arg
, "copy-ratio")) {
102 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
103 die ("@MLton copy-ratio missing argument.");
104 s
->controls
.ratios
.copy
= stringToFloat (argv
[i
++]);
105 unless (1.0 < s
->controls
.ratios
.copy
)
106 die ("@MLton copy-ratio argument must be greater than 1.0.");
107 } else if (0 == strcmp (arg
, "fixed-heap")) {
109 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
110 die ("@MLton fixed-heap missing argument.");
111 s
->controls
.fixedHeap
= align (stringToBytes (argv
[i
++]),
112 2 * s
->sysvals
.pageSize
);
113 } else if (0 == strcmp (arg
, "gc-messages")) {
115 s
->controls
.messages
= TRUE
;
116 } else if (0 == strcmp (arg
, "gc-summary")) {
118 s
->controls
.summary
= TRUE
;
119 } else if (0 == strcmp (arg
, "gc-summary-file")) {
121 if (i
== argc
|| (0 == strcmp (argv
[i
], "--")))
122 die ("@MLton gc-summary-file missing argument.");
123 s
->controls
.summary
= TRUE
;
124 s
->controls
.summaryFile
= fopen(argv
[i
++], "w");
125 if (s
->controls
.summaryFile
== NULL
) {
126 die ("Invalid @MLton gc-summary-file %s (%s).", argv
[i
-1], strerror(errno
));
128 } else if (0 == strcmp (arg
, "grow-ratio")) {
130 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
131 die ("@MLton grow-ratio missing argument.");
132 s
->controls
.ratios
.grow
= stringToFloat (argv
[i
++]);
133 unless (1.0 < s
->controls
.ratios
.grow
)
134 die ("@MLton grow-ratio argument must be greater than 1.0.");
135 } else if (0 == strcmp (arg
, "hash-cons")) {
137 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
138 die ("@MLton hash-cons missing argument.");
139 s
->controls
.ratios
.hashCons
= stringToFloat (argv
[i
++]);
140 unless (0.0 <= s
->controls
.ratios
.hashCons
141 and s
->controls
.ratios
.hashCons
<= 1.0)
142 die ("@MLton hash-cons argument must be between 0.0 and 1.0.");
143 } else if (0 == strcmp (arg
, "live-ratio")) {
145 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
146 die ("@MLton live-ratio missing argument.");
147 s
->controls
.ratios
.live
= stringToFloat (argv
[i
++]);
148 unless (1.0 < s
->controls
.ratios
.live
)
149 die ("@MLton live-ratio argument must be greater than 1.0.");
150 } else if (0 == strcmp (arg
, "load-world")) {
151 unless (s
->controls
.mayLoadWorld
)
152 die ("May not load world.");
154 s
->amOriginal
= FALSE
;
155 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
156 die ("@MLton load-world missing argument.");
157 *worldFile
= argv
[i
++];
158 } else if (0 == strcmp (arg
, "mark-compact-generational-ratio")) {
160 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
161 die ("@MLton mark-compact-generational-ratio missing argument.");
162 s
->controls
.ratios
.markCompactGenerational
= stringToFloat (argv
[i
++]);
163 unless (1.0 < s
->controls
.ratios
.markCompactGenerational
)
164 die ("@MLton mark-compact-generational-ratio argument must be greater than 1.0.");
165 } else if (0 == strcmp (arg
, "mark-compact-ratio")) {
167 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
168 die ("@MLton mark-compact-ratio missing argument.");
169 s
->controls
.ratios
.markCompact
= stringToFloat (argv
[i
++]);
170 unless (1.0 < s
->controls
.ratios
.markCompact
)
171 die ("@MLton mark-compact-ratio argument must be greater than 1.0.");
172 } else if (0 == strcmp (arg
, "max-heap")) {
174 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
175 die ("@MLton max-heap missing argument.");
176 s
->controls
.maxHeap
= align (stringToBytes (argv
[i
++]),
177 2 * s
->sysvals
.pageSize
);
178 } else if (0 == strcmp (arg
, "may-page-heap")) {
180 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
181 die ("@MLton may-page-heap missing argument.");
182 s
->controls
.mayPageHeap
= stringToBool (argv
[i
++]);
183 } else if (0 == strcmp (arg
, "no-load-world")) {
185 s
->controls
.mayLoadWorld
= FALSE
;
186 } else if (0 == strcmp (arg
, "nursery-ratio")) {
188 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
189 die ("@MLton nursery-ratio missing argument.");
190 s
->controls
.ratios
.nursery
= stringToFloat (argv
[i
++]);
191 unless (1.0 < s
->controls
.ratios
.nursery
)
192 die ("@MLton nursery-ratio argument must be greater than 1.0.");
193 } else if (0 == strcmp (arg
, "ram-slop")) {
195 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
196 die ("@MLton ram-slop missing argument.");
197 s
->controls
.ratios
.ramSlop
= stringToFloat (argv
[i
++]);
198 } else if (0 == strcmp (arg
, "show-sources")) {
201 } else if (0 == strcmp (arg
, "stop")) {
203 s
->controls
.mayProcessAtMLton
= FALSE
;
204 } else if (0 == strcmp (arg
, "stack-current-grow-ratio")) {
206 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
207 die ("@MLton stack-current-grow-ratio missing argument.");
208 s
->controls
.ratios
.stackCurrentGrow
= stringToFloat (argv
[i
++]);
209 unless (1.0 < s
->controls
.ratios
.stackCurrentGrow
)
210 die ("@MLton stack-current-grow-ratio argument must greater than 1.0.");
211 } else if (0 == strcmp (arg
, "stack-current-max-reserved-ratio")) {
213 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
214 die ("@MLton stack-current-max-reserved-ratio missing argument.");
215 s
->controls
.ratios
.stackCurrentMaxReserved
= stringToFloat (argv
[i
++]);
216 unless (1.0 < s
->controls
.ratios
.stackCurrentMaxReserved
)
217 die ("@MLton stack-current-max-reserved-ratio argument must greater than 1.0.");
218 } else if (0 == strcmp (arg
, "stack-current-permit-reserved-ratio")) {
220 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
221 die ("@MLton stack-current-permit-reserved-ratio missing argument.");
222 s
->controls
.ratios
.stackCurrentPermitReserved
= stringToFloat (argv
[i
++]);
223 unless (1.0 < s
->controls
.ratios
.stackCurrentPermitReserved
)
224 die ("@MLton stack-current-permit-reserved-ratio argument must greater than 1.0.");
225 } else if (0 == strcmp (arg
, "stack-current-shrink-ratio")) {
227 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
228 die ("@MLton stack-current-shrink-ratio missing argument.");
229 s
->controls
.ratios
.stackCurrentShrink
= stringToFloat (argv
[i
++]);
230 unless (0.0 <= s
->controls
.ratios
.stackCurrentShrink
231 and s
->controls
.ratios
.stackCurrentShrink
<= 1.0)
232 die ("@MLton stack-current-shrink-ratio argument must be between 0.0 and 1.0.");
233 } else if (0 == strcmp (arg
, "stack-max-reserved-ratio")) {
235 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
236 die ("@MLton stack-max-reserved-ratio missing argument.");
237 s
->controls
.ratios
.stackMaxReserved
= stringToFloat (argv
[i
++]);
238 unless (1.0 < s
->controls
.ratios
.stackMaxReserved
)
239 die ("@MLton stack-max-reserved-ratio argument must greater than 1.0.");
240 } else if (0 == strcmp (arg
, "stack-shrink-ratio")) {
242 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
243 die ("@MLton stack-shrink-ratio missing argument.");
244 s
->controls
.ratios
.stackShrink
= stringToFloat (argv
[i
++]);
245 unless (0.0 <= s
->controls
.ratios
.stackShrink
246 and s
->controls
.ratios
.stackShrink
<= 1.0)
247 die ("@MLton stack-shrink-ratio argument must be between 0.0 and 1.0.");
248 } else if (0 == strcmp (arg
, "use-mmap")) {
250 if (i
== argc
|| 0 == strcmp (argv
[i
], "--"))
251 die ("@MLton use-mmap missing argument.");
252 GC_setCygwinUseMmap (stringToBool (argv
[i
++]));
253 } else if (0 == strcmp (arg
, "--")) {
257 die ("Strange @MLton arg: %s", argv
[i
]);
265 int GC_init (GC_state s
, int argc
, char **argv
) {
269 assert (s
->alignment
>= GC_MODEL_MINALIGN
);
270 assert (isAligned (sizeof (struct GC_stack
), s
->alignment
));
271 // While the following asserts are manifestly true,
272 // they check the asserts in sizeofThread and sizeofWeak.
273 assert (sizeofThread (s
) == sizeofThread (s
));
274 assert (sizeofWeak (s
) == sizeofWeak (s
));
277 s
->amOriginal
= TRUE
;
279 s
->callFromCHandlerThread
= BOGUS_OBJPTR
;
280 s
->controls
.fixedHeap
= 0;
281 s
->controls
.maxHeap
= 0;
282 s
->controls
.mayLoadWorld
= TRUE
;
283 s
->controls
.mayPageHeap
= FALSE
;
284 s
->controls
.mayProcessAtMLton
= TRUE
;
285 s
->controls
.messages
= FALSE
;
286 s
->controls
.oldGenArraySize
= 0x100000;
287 s
->controls
.ratios
.copy
= 4.0f
;
288 s
->controls
.ratios
.copyGenerational
= 4.0f
;
289 s
->controls
.ratios
.grow
= 8.0f
;
290 s
->controls
.ratios
.hashCons
= 0.0f
;
291 s
->controls
.ratios
.live
= 8.0f
;
292 s
->controls
.ratios
.markCompact
= 1.04f
;
293 s
->controls
.ratios
.markCompactGenerational
= 8.0f
;
294 s
->controls
.ratios
.nursery
= 10.0f
;
295 s
->controls
.ratios
.ramSlop
= 0.5f
;
296 s
->controls
.ratios
.stackCurrentGrow
= 2.0f
;
297 s
->controls
.ratios
.stackCurrentMaxReserved
= 32.0f
;
298 s
->controls
.ratios
.stackCurrentPermitReserved
= 4.0f
;
299 s
->controls
.ratios
.stackCurrentShrink
= 0.5f
;
300 s
->controls
.ratios
.stackMaxReserved
= 8.0f
;
301 s
->controls
.ratios
.stackShrink
= 0.5f
;
302 s
->controls
.summary
= FALSE
;
303 s
->controls
.summaryFile
= stderr
;
304 s
->cumulativeStatistics
.bytesAllocated
= 0;
305 s
->cumulativeStatistics
.bytesCopied
= 0;
306 s
->cumulativeStatistics
.bytesCopiedMinor
= 0;
307 s
->cumulativeStatistics
.bytesHashConsed
= 0;
308 s
->cumulativeStatistics
.bytesMarkCompacted
= 0;
309 s
->cumulativeStatistics
.bytesScannedMinor
= 0;
310 s
->cumulativeStatistics
.maxBytesLive
= 0;
311 s
->cumulativeStatistics
.maxHeapSize
= 0;
312 s
->cumulativeStatistics
.maxPauseTime
= 0;
313 s
->cumulativeStatistics
.maxStackSize
= 0;
314 s
->cumulativeStatistics
.numCardsMarked
= 0;
315 s
->cumulativeStatistics
.numCopyingGCs
= 0;
316 s
->cumulativeStatistics
.numHashConsGCs
= 0;
317 s
->cumulativeStatistics
.numMarkCompactGCs
= 0;
318 s
->cumulativeStatistics
.numMinorGCs
= 0;
319 rusageZero (&s
->cumulativeStatistics
.ru_gc
);
320 rusageZero (&s
->cumulativeStatistics
.ru_gcCopying
);
321 rusageZero (&s
->cumulativeStatistics
.ru_gcMarkCompact
);
322 rusageZero (&s
->cumulativeStatistics
.ru_gcMinor
);
323 s
->currentThread
= BOGUS_OBJPTR
;
324 s
->hashConsDuringGC
= FALSE
;
325 initHeap (s
, &s
->heap
);
326 s
->lastMajorStatistics
.bytesHashConsed
= 0;
327 s
->lastMajorStatistics
.bytesLive
= 0;
328 s
->lastMajorStatistics
.kind
= GC_COPYING
;
329 s
->lastMajorStatistics
.numMinorGCs
= 0;
330 s
->savedThread
= BOGUS_OBJPTR
;
331 initHeap (s
, &s
->secondaryHeap
);
332 s
->signalHandlerThread
= BOGUS_OBJPTR
;
333 s
->signalsInfo
.amInSignalHandler
= FALSE
;
334 s
->signalsInfo
.gcSignalHandled
= FALSE
;
335 s
->signalsInfo
.gcSignalPending
= FALSE
;
336 s
->signalsInfo
.signalIsPending
= FALSE
;
337 sigemptyset (&s
->signalsInfo
.signalsHandled
);
338 sigemptyset (&s
->signalsInfo
.signalsPending
);
339 s
->sysvals
.pageSize
= GC_pageSize ();
340 s
->sysvals
.physMem
= GC_physMem ();
342 s
->saveWorldStatus
= true;
348 unless (isAligned (s
->sysvals
.pageSize
, CARD_SIZE
))
349 die ("Page size must be a multiple of card size.");
350 processAtMLton (s
, 0, s
->atMLtonsLength
, s
->atMLtons
, &worldFile
);
351 res
= processAtMLton (s
, 1, argc
, argv
, &worldFile
);
352 if (s
->controls
.fixedHeap
> 0 and s
->controls
.maxHeap
> 0)
353 die ("Cannot use both fixed-heap and max-heap.");
354 unless (s
->controls
.ratios
.markCompact
<= s
->controls
.ratios
.copy
355 and s
->controls
.ratios
.copy
<= s
->controls
.ratios
.live
)
356 die ("Ratios must satisfy mark-compact-ratio <= copy-ratio <= live-ratio.");
357 unless (s
->controls
.ratios
.stackCurrentPermitReserved
358 <= s
->controls
.ratios
.stackCurrentMaxReserved
)
359 die ("Ratios must satisfy stack-current-permit-reserved <= stack-current-max-reserved.");
360 /* We align s->sysvals.ram by s->sysvals.pageSize so that we can
361 * test whether or not we we are using mark-compact by comparing
362 * heap size to ram size. If we didn't round, the size might be
366 ram
= alignMax ((uintmax_t)(s
->controls
.ratios
.ramSlop
* (double)(s
->sysvals
.physMem
)),
367 (uintmax_t)(s
->sysvals
.pageSize
));
368 ram
= min (ram
, alignMaxDown((uintmax_t)SIZE_MAX
, (uintmax_t)(s
->sysvals
.pageSize
)));
369 s
->sysvals
.ram
= (size_t)ram
;
370 if (DEBUG
or DEBUG_RESIZING
or s
->controls
.messages
)
371 fprintf (stderr
, "[GC: Found %s bytes of RAM; using %s bytes (%.1f%% of RAM).]\n",
372 uintmaxToCommaString(s
->sysvals
.physMem
),
373 uintmaxToCommaString(s
->sysvals
.ram
),
374 100.0 * ((double)ram
/ (double)(s
->sysvals
.physMem
)));
375 if (DEBUG_SOURCES
or DEBUG_PROFILE
) {
377 for (i
= 0; i
< s
->sourceMaps
.frameSourcesLength
; i
++) {
380 fprintf (stderr
, "%"PRIu32
"\n", i
);
381 sourceSeq
= s
->sourceMaps
.sourceSeqs
[s
->sourceMaps
.frameSources
[i
]];
382 for (j
= 1; j
<= sourceSeq
[0]; j
++)
383 fprintf (stderr
, "\t%s\n",
384 s
->sourceMaps
.sourceNames
[
385 s
->sourceMaps
.sources
[sourceSeq
[j
]].sourceNameIndex
389 /* Initialize profiling. This must occur after processing
390 * command-line arguments, because those may just be doing a
391 * show-sources, in which case we don't want to initialize the
397 /* The mutator stack invariant doesn't hold,
398 * because the mutator has yet to run.
400 assert (invariantForMutator (s
, TRUE
, FALSE
));
402 loadWorldFromFileName (s
, worldFile
);
403 if (s
->profiling
.isOn
and s
->profiling
.stack
)
404 foreachStackFrame (s
, enterFrameForProfiling
);
405 assert (invariantForMutator (s
, TRUE
, TRUE
));