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/trunk/src/cm/compile/compile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/compile.sml

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

revision 801, Mon Mar 19 22:53:00 2001 UTC revision 879, Thu Jul 19 18:59:38 2001 UTC
# Line 9  Line 9 
9      structure GP = GeneralParams      structure GP = GeneralParams
10      structure DG = DependencyGraph      structure DG = DependencyGraph
11      structure GG = GroupGraph      structure GG = GroupGraph
12      structure E = GenericVC.Environment      structure E = Environment
13      structure SE = GenericVC.StaticEnv      structure SE = StaticEnv
14      structure Pid = GenericVC.PersStamps      structure Pid = PersStamps
15      structure DE = GenericVC.DynamicEnv      structure DE = DynamicEnv
16      structure PP = PrettyPrint      structure PP = PrettyPrint
17      structure EM = GenericVC.ErrorMsg      structure EM = ErrorMsg
18      structure SF = GenericVC.SmlFile      structure SF = SmlFile
19    
20      type pid = Pid.persstamp      type pid = Pid.persstamp
21      type statenv = E.staticEnv      type statenv = E.staticEnv
# Line 36  Line 36 
36    
37          (* type of a function to store away the binfile contents *)          (* type of a function to store away the binfile contents *)
38          type bfcReceiver =          type bfcReceiver =
39               SmlInfo.info * { content: bfc, stats: stats } -> unit               SmlInfo.info * { contents: bfc, stats: stats } -> unit
40    
41          val getII : SmlInfo.info -> IInfo.info          val getII : SmlInfo.info -> IInfo.info
42    
# Line 51  Line 51 
51                exports: (GP.info -> result option) SymbolMap.map }                exports: (GP.info -> result option) SymbolMap.map }
52      end      end
53    
54      functor CompileFn (structure MachDepVC : MACHDEP_VC      functor CompileFn (structure Backend : BACKEND
55                         structure StabModmap : STAB_MODMAP                         structure StabModmap : STAB_MODMAP
56                         val useStream : TextIO.instream -> unit                         val useStream : TextIO.instream -> unit
57                         val compile_there : SrcPath.file -> bool) :>                         val compile_there : SrcPath.file -> bool) :>
58          COMPILE where type bfc = MachDepVC.Binfile.bfContent          COMPILE where type bfc = Binfile.bfContents
59                  where type stats = MachDepVC.Binfile.stats =                  where type stats = Binfile.stats =
60      struct      struct
61    
62            val arch = Backend.architecture
63    
64          type notifier = GP.info -> SmlInfo.info -> unit          type notifier = GP.info -> SmlInfo.info -> unit
65    
66          structure BF = MachDepVC.Binfile          structure BF = Binfile
67            structure C = Backend.Compile
68    
69          type bfc = BF.bfContent          type bfc = BF.bfContents
70          type stats = BF.stats          type stats = BF.stats
71    
72          type bfcReceiver =          type bfcReceiver =
73               SmlInfo.info * { content: bfc, stats: stats } -> unit               SmlInfo.info * { contents: bfc, stats: stats } -> unit
74    
75          structure FilterMap = MapFn          structure FilterMap = MapFn
76              (struct              (struct
# Line 109  Line 112 
112    
113          fun memo2ed memo = memo2ii memo          fun memo2ed memo = memo2ii memo
114    
115          fun bfc2memo (bfc, ts) = let          fun bfc2memo (bfc, ts, context_senv) = let
116              val ii = { statenv = fn () => BF.senvOf bfc,              fun statenv () =
117                         symenv = fn () => BF.symenvOf bfc,                  let val mm0 = StabModmap.get ()
118                        val m = GenModIdMap.mkMap' (context_senv, mm0)
119                        fun context _ = m
120                        val { pid, pickle } = BF.senvPickleOf bfc
121                    in UnpickMod.unpickleEnv context (pid, pickle)
122                    end
123                fun symenv () =
124                    let val { pickle, ... } = BF.lambdaPickleOf bfc
125                        val l = if Word8Vector.length pickle = 0 then NONE
126                                else UnpickMod.unpickleFLINT pickle
127                    in SymbolicEnv.mk (BF.exportPidOf bfc, l)
128                    end
129                val ii = { statenv = Memoize.memoize statenv,
130                           symenv = Memoize.memoize symenv,
131                         statpid = BF.staticPidOf bfc,                         statpid = BF.staticPidOf bfc,
132                         sympid = BF.lambdaPidOf bfc }                         sympid = BF.lambdaPidOf bfc }
133              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
# Line 151  Line 167 
167                          case FilterMap.find (!filtermap, key) of                          case FilterMap.find (!filtermap, key) of
168                              SOME statpid' => statpid'                              SOME statpid' => statpid'
169                            | NONE => let                            | NONE => let
170                                  val statpid' = GenericVC.Rehash.rehash                                  val statpid' = Rehash.rehash
171                                          { env = ste', orig_hash = statpid }                                          { env = ste', orig_hash = statpid }
172                              in                              in
173                                  filtermap :=                                  filtermap :=
# Line 257  Line 273 
273                                 cleanup = fn _ => () })                                 cleanup = fn _ => () })
274                      fun save bfc = let                      fun save bfc = let
275                          fun writer s = let                          fun writer s = let
276                              val s = BF.write { stream = s, content = bfc,                              val s = BF.write { arch = arch, nopickle = false,
277                                                 nopickle = false }                                                 stream = s, contents = bfc }
278                          in pstats s; s                          in pstats s; s
279                          end                          end
280                          fun cleanup _ =                          fun cleanup _ =
# Line 291  Line 307 
307                                    | SOME sy => CoreHack.rewrite (ast, sy)                                    | SOME sy => CoreHack.rewrite (ast, sy)
308                              val cmData = PidSet.listItems pids                              val cmData = PidSet.listItems pids
309                              val (pre, post) = SmlInfo.setup i                              val (pre, post) = SmlInfo.setup i
310                              val toplenv = #get GenericVC.EnvRef.topLevel ()                              val toplenv = #get EnvRef.topLevel ()
311                                            before perform_setup "pre" pre                                            before perform_setup "pre" pre
312                              (* clear error flag (could still be set from                              (* clear error flag (could still be set from
313                               * earlier run) *)                               * earlier run) *)
314                              val _ = #anyErrors source := false                              val _ = #anyErrors source := false
315                                (* we actually run the compiler here;
316                                 * Binfile is not doing it anymore *)
317                                val err = EM.errors source
318                                fun check phase =
319                                    if EM.anyErrors err then
320                                        raise CompileExn.Compile
321                                                  (phase ^ " failed")
322                                    else ()
323                                val cinfo = C.mkCompInfo { source = source,
324                                                           transform = fn x => x }
325                                val splitting = Control.LambdaSplitting.get' split
326                                val { csegments, newstatenv, exportPid,
327                                      staticPid, imports, pickle = senvP,
328                                      inlineExp, ... } =
329                                    C.compile { source = source, ast = ast,
330                                                statenv = stat, symenv = sym,
331                                                compInfo = cinfo, checkErr = check,
332                                                splitting = splitting }
333                                val { hash = lambdaPid, pickle = lambdaP } =
334                                    PickMod.pickleFLINT inlineExp
335                                val lambdaP = case inlineExp of
336                                                  NONE => Byte.stringToBytes ""
337                                                | SOME _ => lambdaP
338                              val bfc = BF.create                              val bfc = BF.create
339                                  { splitting = split,                                        { imports = imports,
340                                            exportPid = exportPid,
341                                    cmData = cmData,                                    cmData = cmData,
342                                    ast = ast,                                          senv = { pickle = senvP,
343                                    source = source,                                                   pid = staticPid },
344                                    senv = stat,                                          lambda = { pickle = lambdaP,
345                                    symenv = sym }                                                     pid = lambdaPid },
346                              val memo = bfc2memo (bfc, SmlInfo.lastseen i)                                          csegments = csegments }
347                                val memo =
348                                    bfc2memo (bfc, SmlInfo.lastseen i, stat)
349                          in                          in
350                              perform_setup "post" post;                              perform_setup "post" post;
351                              #set GenericVC.EnvRef.topLevel toplenv;                              #set EnvRef.topLevel toplenv;
352                              storeBFC (i, { content = bfc, stats = save bfc });                              storeBFC (i, { contents = bfc, stats = save bfc });
353                              SOME memo                              SOME memo
354                          end handle (EM.Error | SF.Compile _)                          end handle (EM.Error | CompileExn.Compile _)
355                                     (* At this point we handle only                                     (* At this point we handle only
356                                      * explicit compiler bugs and ordinary                                      * explicit compiler bugs and ordinary
357                                      * compilation errors because for those                                      * compilation errors because for those
# Line 358  Line 400 
400                                      fun reader s = let                                      fun reader s = let
401                                          val mm0 = StabModmap.get ()                                          val mm0 = StabModmap.get ()
402                                          val m = GenModIdMap.mkMap' (stat, mm0)                                          val m = GenModIdMap.mkMap' (stat, mm0)
403                                          val { content, stats } =                                          val { contents, stats } =
404                                              BF.read { stream = s,                                              BF.read { arch = arch,
405                                                        name = binname,                                                        stream = s,
406                                                        modmap = m }                                                        name = binname }
407                                      in                                      in
408                                          (content, ts, stats)                                          (contents, ts, stats)
409                                      end                                      end
   
410                                  in                                  in
411                                      SOME (SafeIO.perform                                      SOME (SafeIO.perform
412                                            { openIt = openIt,                                            { openIt = openIt,
# Line 378  Line 419 
419                                      case (sync (); load ()) of                                      case (sync (); load ()) of
420                                          NONE => otherwise ()                                          NONE => otherwise ()
421                                        | SOME (bfc, ts, stats) => let                                        | SOME (bfc, ts, stats) => let
422                                              val memo = bfc2memo (bfc, ts)                                              val memo = bfc2memo (bfc, ts, stat)
423                                              val contst = { content = bfc,                                              val contst = { contents = bfc,
424                                                             stats = stats }                                                             stats = stats }
425                                          in                                          in
426                                              if isValidMemo (memo, pids, i) then                                              if isValidMemo (memo, pids, i) then

Legend:
Removed from v.801  
changed lines
  Added in v.879

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