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

SCM Repository

[smlnj] View of /sml/trunk/src/cm/stable/verify.sml
ViewVC logotype

View of /sml/trunk/src/cm/stable/verify.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 569 - (download) (annotate)
Tue Mar 7 04:01:07 2000 UTC (19 years, 6 months ago) by blume
File size: 2722 byte(s)
- size info in BOOTLIST
     * no fixed upper limits for number of bootfiles or length of
       bootfile names in runtime
     * falling back to old behavior if no BOOTLIST size info found
- allocation size heuristics in .run-sml
     * tries to read cache size from /proc/cpuinfo (this is important for
        small-cache Celeron systems!)
- install.sh robustified
- CM manual updates
- paranoid mode
     * no more CMB.deliver() (i.e., all done by CMB.make())
     * can re-use existing sml.boot.* files
     * init.cmi now treated as library
     * library stamps for consistency checks
- sml.boot.<arch>-<os>/PIDMAP file
     * This file is read by the CM startup code.  This is used to minimize
       the amount of dynamic state that needs to be stowed away for the
       purpose of sharing between interactive system and user code.
- CM.Anchor.anchor instead of CM.Anchor.{set,cancel}
     * Upon request by Elsa.  Anchors now controlled by get-set-pair
       like most other CM state variables.
- Compiler.CMSA eliminated
     * No longer supported by CM anyway.
- fixed bugs in pickler that kept biting Stefan
     * past refs to past refs (was caused by the possibility that
       ad-hoc sharing is more discriminating than hash-cons sharing)
     * integer overflow on LargeInt.minInt
- ml-{lex,yacc} build scripts now use new mechanism
  for building standalone programs
- fixed several gcc -Wall warnings that were caused by missing header
  files, missing initializations, etc., in runtime (not all warnings
  eliminated, though)
(*
 * Verifying the validity of an existing stable file for a (non-stable)
 * library.
 *   - This is used for "paranoia" mode during bootstrap compilation.
 *     Normally, CM takes stable files and doesn't ask questions, but
 *     during bootstrap compilation it takes the stable file only if
 *     it is verified to be valid.
 *
 * (C) 2000 Lucent Technologies, Bell Laboratories
 *
 * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
 *)
local
    structure DG = DependencyGraph
    structure GG = GroupGraph
    structure GP = GeneralParams
    structure TS = TStamp
in
signature VERIFY_STABLE = sig
    type exportmap = SmlInfo.info StableMap.map
    val verify' : GP.info -> exportmap
	-> SrcPath.t *			(* grouppath *)
	   DG.sbnode list *		(* export_nodes *)
	   (SrcPath.t * GG.group) list * (* sublibs *)
	   SrcPathSet.set		(* groups *)
	-> bool
    val verify : GP.info -> exportmap -> GG.group -> bool
end

functor VerStabFn (structure Stabilize: STABILIZE) :> VERIFY_STABLE = struct

    type exportmap = SmlInfo.info StableMap.map

    fun verify' (gp: GP.info) em (grouppath, export_nodes, sublibs, groups) =
    let val groups = SrcPathSet.add (groups, grouppath)
	val policy = #fnpolicy (#param gp)
	fun sname p = FilenamePolicy.mkStableName policy p
	val stablename = sname grouppath

	fun invalidMember stab_t i = let
	    val p = SmlInfo.sourcepath i
		    
	    val bn = SmlInfo.binname i
	in
	    case (SrcPath.tstamp p, TS.fmodTime bn) of
		(TS.TSTAMP src_t, TS.TSTAMP bin_t) =>
		    Time.compare (src_t, bin_t) <> EQUAL orelse
		    Time.compare (src_t, stab_t) = GREATER
	      | _ => true
	end

	fun nonstabSublib (_, GG.GROUP { kind = GG.STABLELIB _, ... }) = false
	  | nonstabSublib _ = true

	fun invalidGroup stab_t p =
	    case SrcPath.tstamp p of
		TS.TSTAMP g_t => Time.compare (g_t, stab_t) = GREATER
	      | _ => true

	val validStamp = Stabilize.libStampIsValid gp

	val isValid =
	    case TS.fmodTime stablename of
		TS.TSTAMP st => let
		    val (m, i) = Reachable.reachable' export_nodes
		in
		    (* The group itself is included in "groups"... *)
		    not (SrcPathSet.exists (invalidGroup st) groups) andalso
		    not (List.exists nonstabSublib sublibs) andalso
		    validStamp (grouppath, export_nodes, sublibs) andalso
		    not (SmlInfoSet.exists (invalidMember st) m)
		end
	      | _ => false
    in
	if not isValid then
	    OS.FileSys.remove stablename handle _ => ()
	else ();
	isValid
    end

    fun verify gp em (group as GG.GROUP g) = let
	val { exports, grouppath, sublibs, ... } = g
	val groups = Reachable.groupsOf group
    in
	verify' gp em (grouppath,
		       map (#2 o #1) (SymbolMap.listItems exports),
		       sublibs, groups)
    end
end
end

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