Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/rt-transition/system/smlnj/internal/int-sys.sml
ViewVC logotype

Annotation of /sml/branches/rt-transition/system/smlnj/internal/int-sys.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2848 - (view) (download)

1 : blume 573 (* Copyright 1997 by AT&T Bell Laboratories *)
2 :     (* Copyright 1998 by Lucent Technologies *)
3 :     (* Copyright 1999 by Lucent Technologies *)
4 : blume 1208 (* Copyright 2002 by Lucent Technologies *)
5 : blume 573 (* int-sys.sml *)
6 :    
7 :     (*
8 :     * This is the interactive system;
9 :     * At link-time (i.e., at bootstrap time) this code builds the boot
10 :     * environments, sets default signal handlers, and then dumps a heap.
11 :     * When the heap image restarts, the system goes interactive.
12 :     *
13 :     * (We do not want to go interactive before dumping the heap because it
14 :     * would mean that environments get loaded unnecessarily.)
15 :     *
16 :     * This code refers directly to structure Compiler, because by the time it
17 :     * gets compiled, CM's conditional compilation facility has already
18 :     * made sure that structure Compiler refers to the visible compiler
19 :     * for the current architecture.
20 :     *)
21 :     structure InteractiveSystem : sig end = struct
22 :    
23 :     (* first, we have to step back out of the boot directory... *)
24 :     val bootdir = OS.FileSys.getDir ()
25 :     val _ = OS.FileSys.chDir OS.Path.parentArc
26 : jhr 2848
27 : blume 573 (* environment initializations *)
28 : mblume 1342 val { heapfile, procCmdLine } =
29 :     BootEnv.init bootdir
30 :     handle e as IO.Io { function, name, cause } =>
31 :     (TextIO.output (TextIO.stdErr,
32 :     concat ["IO exception: file = ", name,
33 :     ", function = ", function,
34 :     ", cause: ",
35 :     General.exnMessage cause,
36 :     "\n"]);
37 :     raise e)
38 :     | e => (TextIO.output (TextIO.stdErr,
39 :     concat ["exception raised during init phase: ",
40 :     General.exnMessage e, "\n"]);
41 :     raise e)
42 : blume 573
43 :     (* establish default signal handlers *)
44 :     fun handleINT _ = !Unsafe.topLevelCont
45 :     fun handleTERM _ = OS.Process.exit OS.Process.failure
46 :     fun ifSignal (sigName, handler) =
47 :     (case Signals.fromString sigName of
48 :     SOME s =>
49 :     (Signals.overrideHandler (s, Signals.HANDLER handler); ())
50 :     | _ => ())
51 :    
52 :     val _ =
53 :     (Signals.overrideHandler (Signals.sigINT, Signals.HANDLER handleINT);
54 :     Signals.overrideHandler (Signals.sigTERM, Signals.HANDLER handleTERM);
55 :     ifSignal ("QUIT", handleTERM))
56 :    
57 : blume 1208 (* install "use" functionality *)
58 : blume 879 val _ = UseHook.useHook := Backend.Interact.useFile
59 : blume 573
60 : blume 1208 (* put MLRISC controls into the main hierarchy of controls *)
61 :     val _ = BasicControl.nest (Control.MLRISC.prefix,
62 :     Control.MLRISC.registry,
63 :     Control.MLRISC.priority)
64 : blume 771
65 :     (* add cleanup code that resets the internal timers and stats
66 :     * when resuming from exportML... *)
67 :     local
68 :     structure I = SMLofNJ.Internals
69 :     structure C = I.CleanUp
70 : blume 879 fun reset _ = (I.resetTimers (); Stats.reset ())
71 : blume 771 in
72 :     val _ = C.addCleaner ("initialize-timers-and-stats", [C.AtInit], reset)
73 :     end
74 :    
75 : blume 1201 (* initialize control *)
76 :     val _ = ControlRegistry.init BasicControl.topregistry
77 :    
78 : blume 573 (* launch interactive loop *)
79 : mblume 1792 val _ =
80 :     let val f = SMLofNJ.Cont.callcc (fn k =>
81 :     (Backend.Interact.redump_heap_cont := k;
82 :     heapfile))
83 :     in Control.Print.say "Generating heap image...\n";
84 :     if SMLofNJ.exportML f then
85 :     (print SMLNJVersion.banner;
86 :     print "\n";
87 :     getOpt (procCmdLine, fn () => ()) ();
88 :     Backend.Interact.interact ())
89 :     else
90 :     (print "This is...\n";
91 :     print SMLNJVersion.banner;
92 :     print "\n";
93 :     OS.Process.exit OS.Process.success)
94 :     end
95 : blume 573 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0