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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1200, Fri May 17 19:53:41 2002 UTC revision 1201, Fri May 17 20:48:38 2002 UTC
# Line 46  Line 46 
46          (* register the MLRISC controls with the central controls          (* register the MLRISC controls with the central controls
47           * facility... *)           * facility... *)
48          structure C = Controls          structure C = Controls
49            structure CR = ControlRegistry
50    
51          val m0 = C.noconfig          val priority = [10, 3]
52          val m = C.registry { name = "MLRISC",          val obscurity = 3
53                               priority = [10, 3],          val prefix = "mlrisc"
54                               obscurity = 3,  
55                               prefix = "mlrisc-",          val registry = CR.new { help = "MLRISC" }
56                               default_suffix = SOME "-default",  
57                               mk_ename = NONE }          val _ = BasicControl.nest (prefix, registry)
58    
59          val counter_r = C.group m0 C.int          fun uc #"-" = #"_"
60          val int_r =     C.group m C.int            | uc c = Char.toUpper c
61          val flag_r = C.group m C.bool          fun en n = SOME ("MLRISC_" ^ String.map uc n)
62          val real_r = C.group m C.real  
63          val string_r = C.group m C.string          fun reg0 en c { cell, descr, stem } = let
64          val stringList_r = C.group m C.stringList              val ctl = C.control { name = stem,
65          val timing_r = C.group m0                                    pri = priority,
66                { tname = "timing",                                    obscurity = obscurity,
67                                      help = descr,
68                                      ctl = cell }
69            in
70                CR.register registry { ctl = C.stringControl c ctl,
71                                       envName = en stem }
72            end
73    
74            fun reg x = reg0 en x
75            fun reg' x = reg0 (fn _ => NONE) x
76    
77            val int_cvt = { tyName = "int",
78                            fromString = Int.fromString,
79                            toString = Int.toString }
80            val flag_cvt = { tyName = "bool",
81                             fromString = Bool.fromString,
82                             toString = Bool.toString }
83            val real_cvt = { tyName = "real",
84                             fromString = Real.fromString,
85                             toString = Real.toString }
86            val string_cvt = { tyName = "string",
87                               fromString = SOME,
88                               toString = fn x => x }
89            val stringList_cvt = { tyName = "string list",
90                                   fromString = SOME o String.tokens Char.isSpace,
91                                   toString = concat o
92                                            foldr (fn (s, r) => " " :: s :: r) [] }
93            val timing_cvt =
94                { tyName = "timing",
95                  fromString = fn _ => (NONE : Control.MLRISC.cpu_time option),                  fromString = fn _ => (NONE : Control.MLRISC.cpu_time option),
96                  toString = fn _ => "<timing>" }                  toString = fn _ => "<timing>" }
97      in      in
98          val _ = app (C.reg counter_r) (!Control.MLRISC.counters)          val _ = app (reg' int_cvt) (!Control.MLRISC.counters)
99          val _ = app (C.reg int_r) (!Control.MLRISC.ints)          val _ = app (reg int_cvt) (!Control.MLRISC.ints)
100          val _ = app (C.reg flag_r) (!Control.MLRISC.flags)          val _ = app (reg flag_cvt) (!Control.MLRISC.flags)
101          val _ = app (C.reg real_r) (!Control.MLRISC.reals)          val _ = app (reg real_cvt) (!Control.MLRISC.reals)
102          val _ = app (C.reg string_r) (!Control.MLRISC.strings)          val _ = app (reg string_cvt) (!Control.MLRISC.strings)
103          val _ = app (C.reg stringList_r) (!Control.MLRISC.stringLists)          val _ = app (reg stringList_cvt) (!Control.MLRISC.stringLists)
104          val _ = app (C.reg timing_r) (!Control.MLRISC.timings)          val _ = app (reg' timing_cvt) (!Control.MLRISC.timings)
105      end      end
106    
107      (* add cleanup code that resets the internal timers and stats      (* add cleanup code that resets the internal timers and stats
# Line 85  Line 114 
114          val _ = C.addCleaner ("initialize-timers-and-stats", [C.AtInit], reset)          val _ = C.addCleaner ("initialize-timers-and-stats", [C.AtInit], reset)
115      end      end
116    
117        (* initialize control *)
118        val _ = ControlRegistry.init BasicControl.topregistry
119    
120      (* launch interactive loop *)      (* launch interactive loop *)
121      val _ = (Control.Print.say "Generating heap image...\n";      val _ = (Control.Print.say "Generating heap image...\n";
122               if SMLofNJ.exportML heapfile then               if SMLofNJ.exportML heapfile then

Legend:
Removed from v.1200  
changed lines
  Added in v.1201

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