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/system/Basis/Implementation/NJ/internals.sml
ViewVC logotype

View of /sml/trunk/src/system/Basis/Implementation/NJ/internals.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 675 - (download) (annotate)
Fri Jun 23 09:18:18 2000 UTC (20 years, 4 months ago) by blume
File size: 1228 byte(s)
new back-trace facility added; see HISTORY
(* internals.sml
 *
 * COPYRIGHT (c) 1996 AT&T Research.
 *
 * This structure (SMLofNJ.Internals) is a gathering place for internal
 * features that need to be exposed outside the boot directory.
 *)

structure Internals : INTERNALS =
  struct

    structure CleanUp = CleanUp
    structure ProfControl = ProfControl
    structure GC = GC

    val prHook = PrintHook.prHook

    val initSigTbl = InternalSignals.initSigTbl
    val clearSigTbl = InternalSignals.clearSigTbl
    val resetSigTbl = InternalSignals.resetSigTbl

    val resetTimers = InternalTimer.resetTimers

    structure BTrace = struct
        exception BTrace of unit -> string list
        val mode = let
	    val state = ref false
	    fun access NONE = !state
	      | access (SOME change) = !state before state := change
	in
	    access
	end
	local
	    val hook = ref { mkid = fn (s: string) => 0,
			     reset = fn () => () }
	in
	    fun install { corefns, reset, mkid } =
		(hook := { mkid = mkid, reset = reset };
		 Core.bt_install corefns)
	    fun mkid s = #mkid (!hook) s
	    fun reset () = #reset (!hook) ()
	end
	fun report () = Core.bt_report () ()
	fun trigger () = raise BTrace (report ())
	fun save () = Core.bt_save () ()
    end

  end;

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