rts: Add getPhysicalMemorySize
[ghc.git] / rts / RtsStartup.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2002
4 *
5 * Main function for a standalone Haskell program.
6 *
7 * ---------------------------------------------------------------------------*/
8
9 // PAPI uses caddr_t, which is not POSIX
10 #ifndef USE_PAPI
11 #include "PosixSource.h"
12 #endif
13
14 #include "Rts.h"
15 #include "RtsAPI.h"
16 #include "HsFFI.h"
17
18 #include "sm/Storage.h"
19 #include "RtsFlags.h"
20 #include "RtsUtils.h"
21 #include "Prelude.h"
22 #include "Schedule.h" /* initScheduler */
23 #include "Stats.h" /* initStats */
24 #include "STM.h" /* initSTM */
25 #include "RtsSignals.h"
26 #include "Weak.h"
27 #include "Ticky.h"
28 #include "StgRun.h"
29 #include "Prelude.h" /* fixupRTStoPreludeRefs */
30 #include "ThreadLabels.h"
31 #include "sm/BlockAlloc.h"
32 #include "Trace.h"
33 #include "Stable.h"
34 #include "Hash.h"
35 #include "Profiling.h"
36 #include "Timer.h"
37 #include "Globals.h"
38 #include "FileLock.h"
39 void exitLinker( void ); // there is no Linker.h file to include
40
41 #if defined(PROFILING)
42 # include "ProfHeap.h"
43 # include "RetainerProfile.h"
44 #endif
45
46 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
47 #include "win32/AsyncIO.h"
48 #endif
49
50 #if !defined(mingw32_HOST_OS)
51 #include "posix/TTY.h"
52 #endif
53
54 #ifdef HAVE_UNISTD_H
55 #include <unistd.h>
56 #endif
57 #ifdef HAVE_LOCALE_H
58 #include <locale.h>
59 #endif
60
61 #if USE_PAPI
62 #include "Papi.h"
63 #endif
64
65 // Count of how many outstanding hs_init()s there have been.
66 static int hs_init_count = 0;
67
68 static void flushStdHandles(void);
69
70 const RtsConfig defaultRtsConfig = {
71 .rts_opts_enabled = RtsOptsSafeOnly,
72 .rts_opts = NULL,
73 .rts_hs_main = rtsFalse
74 };
75
76 /* -----------------------------------------------------------------------------
77 Initialise floating point unit on x86 (currently disabled; See Note
78 [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs)
79 -------------------------------------------------------------------------- */
80
81 #define X86_INIT_FPU 0
82
83 #if X86_INIT_FPU
84 static void
85 x86_init_fpu ( void )
86 {
87 __volatile unsigned short int fpu_cw;
88
89 // Grab the control word
90 __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
91
92 #if 0
93 printf("fpu_cw: %x\n", fpu_cw);
94 #endif
95
96 // Set bits 8-9 to 10 (64-bit precision).
97 fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
98
99 // Store the new control word back
100 __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
101 }
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 Starting up the RTS
106 -------------------------------------------------------------------------- */
107
108 void
109 hs_init(int *argc, char **argv[])
110 {
111 hs_init_ghc(argc, argv, defaultRtsConfig);
112 }
113
114 void
115 hs_init_with_rtsopts(int *argc, char **argv[])
116 {
117 RtsConfig rts_opts = defaultRtsConfig; /* by value */
118 rts_opts.rts_opts_enabled = RtsOptsAll;
119 hs_init_ghc(argc, argv, rts_opts);
120 }
121
122 void
123 hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
124 {
125 hs_init_count++;
126 if (hs_init_count > 1) {
127 // second and subsequent inits are ignored
128 return;
129 }
130
131 setlocale(LC_CTYPE,"");
132
133 /* Initialise the stats department, phase 0 */
134 initStats0();
135
136 /* Initialize system timer before starting to collect stats */
137 initializeTimer();
138
139 /* Next we do is grab the start time...just in case we're
140 * collecting timing statistics.
141 */
142 stat_startInit();
143
144 /* Set the RTS flags to default values. */
145
146 initRtsFlagsDefaults();
147
148 /* Call the user hook to reset defaults, if present */
149 defaultsHook();
150
151 /* Parse the flags, separating the RTS flags from the programs args */
152 if (argc == NULL || argv == NULL) {
153 // Use a default for argc & argv if either is not supplied
154 int my_argc = 1;
155 char *my_argv[] = { "<unknown>", NULL };
156 setFullProgArgv(my_argc,my_argv);
157 setupRtsFlags(&my_argc, my_argv,
158 rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
159 } else {
160 setFullProgArgv(*argc,*argv);
161 setupRtsFlags(argc, *argv,
162 rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
163 }
164
165 /* Initialise the stats department, phase 1 */
166 initStats1();
167
168 #ifdef USE_PAPI
169 papi_init();
170 #endif
171
172 /* initTracing must be after setupRtsFlags() */
173 #ifdef TRACING
174 initTracing();
175 #endif
176 /* Trace the startup event
177 */
178 traceEventStartup();
179
180 /* initialise scheduler data structures (needs to be done before
181 * initStorage()).
182 */
183 initScheduler();
184
185 /* Trace some basic information about the process */
186 traceWallClockTime();
187 traceOSProcessInfo();
188
189 /* initialize the storage manager */
190 initStorage();
191
192 /* initialise the stable pointer table */
193 initStableTables();
194
195 /* Add some GC roots for things in the base package that the RTS
196 * knows about. We don't know whether these turn out to be CAFs
197 * or refer to CAFs, but we have to assume that they might.
198 */
199 getStablePtr((StgPtr)runIO_closure);
200 getStablePtr((StgPtr)runNonIO_closure);
201 getStablePtr((StgPtr)flushStdHandles_closure);
202
203 getStablePtr((StgPtr)runFinalizerBatch_closure);
204
205 getStablePtr((StgPtr)stackOverflow_closure);
206 getStablePtr((StgPtr)heapOverflow_closure);
207 getStablePtr((StgPtr)unpackCString_closure);
208 getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
209 getStablePtr((StgPtr)nonTermination_closure);
210 getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
211 getStablePtr((StgPtr)nestedAtomically_closure);
212
213 getStablePtr((StgPtr)runSparks_closure);
214 getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
215 getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
216 #ifndef mingw32_HOST_OS
217 getStablePtr((StgPtr)runHandlers_closure);
218 #endif
219
220 /* initialise the shared Typeable store */
221 initGlobalStore();
222
223 /* initialise file locking, if necessary */
224 initFileLocking();
225
226 #if defined(DEBUG)
227 /* initialise thread label table (tso->char*) */
228 initThreadLabelTable();
229 #endif
230
231 initProfiling1();
232
233 /* start the virtual timer 'subsystem'. */
234 initTimer();
235 startTimer();
236
237 #if defined(RTS_USER_SIGNALS)
238 if (RtsFlags.MiscFlags.install_signal_handlers) {
239 /* Initialise the user signal handler set */
240 initUserSignals();
241 /* Set up handler to run on SIGINT, etc. */
242 initDefaultHandlers();
243 }
244 #endif
245
246 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
247 startupAsyncIO();
248 #endif
249
250 #if X86_INIT_FPU
251 x86_init_fpu();
252 #endif
253
254 startupHpc();
255
256 // This must be done after module initialisation.
257 // ToDo: make this work in the presence of multiple hs_add_root()s.
258 initProfiling2();
259
260 // ditto.
261 #if defined(THREADED_RTS)
262 ioManagerStart();
263 #endif
264
265 /* Record initialization times */
266 stat_endInit();
267 }
268
269 // Compatibility interface
270 void
271 startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
272 {
273 hs_init(&argc, &argv);
274 }
275
276
277 /* -----------------------------------------------------------------------------
278 hs_add_root: backwards compatibility. (see #3252)
279 -------------------------------------------------------------------------- */
280
281 void
282 hs_add_root(void (*init_root)(void) STG_UNUSED)
283 {
284 /* nothing */
285 }
286
287 /* ----------------------------------------------------------------------------
288 * Shutting down the RTS
289 *
290 * The wait_foreign parameter means:
291 * True ==> wait for any threads doing foreign calls now.
292 * False ==> threads doing foreign calls may return in the
293 * future, but will immediately block on a mutex.
294 * (capability->lock).
295 *
296 * If this RTS is a DLL that we're about to unload, then you want
297 * safe=True, otherwise the thread might return to code that has been
298 * unloaded. If this is a standalone program that is about to exit,
299 * then you can get away with safe=False, which is better because we
300 * won't hang on exit if there is a blocked foreign call outstanding.
301 *
302 ------------------------------------------------------------------------- */
303
304 static void
305 hs_exit_(rtsBool wait_foreign)
306 {
307 nat g;
308
309 if (hs_init_count <= 0) {
310 errorBelch("warning: too many hs_exit()s");
311 return;
312 }
313 hs_init_count--;
314 if (hs_init_count > 0) {
315 // ignore until it's the last one
316 return;
317 }
318
319 /* start timing the shutdown */
320 stat_startExit();
321
322 OnExitHook();
323
324 flushStdHandles();
325
326 // sanity check
327 #if defined(DEBUG)
328 checkFPUStack();
329 #endif
330
331 #if defined(THREADED_RTS)
332 ioManagerDie();
333 #endif
334
335 /* stop all running tasks */
336 exitScheduler(wait_foreign);
337
338 /* run C finalizers for all active weak pointers */
339 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
340 runAllCFinalizers(generations[g].weak_ptr_list);
341 }
342
343 #if defined(RTS_USER_SIGNALS)
344 if (RtsFlags.MiscFlags.install_signal_handlers) {
345 freeSignalHandlers();
346 }
347 #endif
348
349 /* stop the ticker */
350 stopTimer();
351 exitTimer(wait_foreign);
352
353 // set the terminal settings back to what they were
354 #if !defined(mingw32_HOST_OS)
355 resetTerminalSettings();
356 #endif
357
358 // uninstall signal handlers
359 resetDefaultHandlers();
360
361 /* stop timing the shutdown, we're about to print stats */
362 stat_endExit();
363
364 /* shutdown the hpc support (if needed) */
365 exitHpc();
366
367 // clean up things from the storage manager's point of view.
368 // also outputs the stats (+RTS -s) info.
369 exitStorage();
370
371 /* free the tasks */
372 freeScheduler();
373
374 /* free shared Typeable store */
375 exitGlobalStore();
376
377 /* free linker data */
378 exitLinker();
379
380 /* free file locking tables, if necessary */
381 freeFileLocking();
382
383 /* free the stable pointer table */
384 exitStableTables();
385
386 #if defined(DEBUG)
387 /* free the thread label table */
388 freeThreadLabelTable();
389 #endif
390
391 #if defined(PROFILING)
392 reportCCSProfiling();
393 #endif
394
395 endProfiling();
396 freeProfiling();
397
398 #ifdef PROFILING
399 // Originally, this was in report_ccs_profiling(). Now, retainer
400 // profiling might tack some extra stuff on to the end of this file
401 // during endProfiling().
402 if (prof_file != NULL) fclose(prof_file);
403 #endif
404
405 #ifdef TRACING
406 endTracing();
407 freeTracing();
408 #endif
409
410 #if defined(TICKY_TICKY)
411 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
412 #endif
413
414 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
415 shutdownAsyncIO(wait_foreign);
416 #endif
417
418 /* free hash table storage */
419 exitHashTable();
420
421 // Finally, free all our storage. However, we only free the heap
422 // memory if we have waited for foreign calls to complete;
423 // otherwise a foreign call in progress may still be referencing
424 // heap memory (e.g. by being passed a ByteArray#).
425 freeStorage(wait_foreign);
426
427 // Free the various argvs
428 freeRtsArgs();
429 }
430
431 // Flush stdout and stderr. We do this during shutdown so that it
432 // happens even when the RTS is being used as a library, without a
433 // main (#5594)
434 static void flushStdHandles(void)
435 {
436 Capability *cap;
437 cap = rts_lock();
438 rts_evalIO(&cap, flushStdHandles_closure, NULL);
439 rts_unlock(cap);
440 }
441
442 // The real hs_exit():
443 void
444 hs_exit(void)
445 {
446 hs_exit_(rtsTrue);
447 // be safe; this might be a DLL
448 }
449
450 // Compatibility interfaces
451 void
452 shutdownHaskell(void)
453 {
454 hs_exit();
455 }
456
457 void
458 shutdownHaskellAndExit(int n)
459 {
460 // even if hs_init_count > 1, we still want to shut down the RTS
461 // and exit immediately (see #5402)
462 hs_init_count = 1;
463
464 // we're about to exit(), no need to wait for foreign calls to return.
465 hs_exit_(rtsFalse);
466
467 stg_exit(n);
468 }
469
470 #ifndef mingw32_HOST_OS
471 void
472 shutdownHaskellAndSignal(int sig)
473 {
474 hs_exit_(rtsFalse);
475 kill(getpid(),sig);
476 }
477 #endif
478
479 /*
480 * called from STG-land to exit the program
481 */
482
483 void (*exitFn)(int) = 0;
484
485 void
486 stg_exit(int n)
487 {
488 if (exitFn)
489 (*exitFn)(n);
490 exit(n);
491 }