home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / debug / kernel.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  6.7 KB  |  189 lines
  1. (* DebugKernel
  2.  
  3.    Fundamentals of executing user code under debugger control.
  4.    Handles transfer of control between debugger and user program,
  5.    execution mode for user program, and "current state" of user
  6.    program when it is stopped.
  7.  
  8.    This interface is used directly only by DebugExec and the various
  9.    history-maintaining subsystems (Store,Io,Signals).
  10.    Instrumented code also needs access to times and break; this 
  11.    is provided via a special system ref, set in DebugInterface. *)
  12.  
  13.  
  14. signature DEBUG_KERNEL =  
  15. sig
  16.   (* Basic types *)
  17.   type time (* = int *)
  18.   type evn (* = int *)
  19.   type action (* = unit -> unit *)
  20.   type userCont (* = action cont *)
  21.  
  22.   val nullAction: action
  23.  
  24.   datatype onNoise = QUIET | NOISY | BREAK of (unit->bool)
  25.       (* Control what happens when a visible side-effect occurs:
  26.          we may want to muffle them (QUIET),
  27.          perform them under all circumstances (NOISY),
  28.      or re-enter debugger control with a pseudo-event (BREAK).
  29.      We ignore the condition argument to BREAK at this level.*)
  30.   type doers (* = {redo:onNoise->unit,undo:onNoise->unit} *)
  31.        (* Subsystem history mechanism encapsulates a remembered state in
  32.       this type:
  33.        redo(onNoise) will redo to remembered state from (earlier) 
  34.          current state;
  35.        undo(onNoise) will undo to remembered state from (later) 
  36.          current state. *)
  37.  
  38.   (* Describes the mode in which user code is executed.  This is chiefly
  39.      useful for history-maintaining subsystems. 
  40.      Mode IGNORE should be set when the user program is not supposed
  41.      to have control.  It is necessary because higher levels of the system
  42.      do not provide any way to prevent instrumented user code from being
  43.      run outside of the debugger's control; if this happens, we want to
  44.      pretend that the instrumentation is not there, as far as we can.
  45.      Note that IGNORE should be set to prevent unwanted signals while 
  46.      the debugger has control but is not executing the user program.  *)
  47.   datatype execMode = RECORD of onNoise
  48.                     | REPLAY of onNoise
  49.             | IGNORE (* not running under debugger control *)
  50.   val execMode: execMode ref  (* current mode *)
  51.  
  52.   (* Data returned by user program when it transfers control back to debugger. *)
  53.   type evData  (* = {evn:evn,lbt:time,args:System.Unsafe.object list} 
  54.                      event number, last bind time, arguments *)
  55.  
  56.   (* Accessing elements of current state. *)
  57.   val times: time array  (* only exported for DebugInstrum; 
  58.                 others: don't user directly!! *)
  59.   val currentTime: unit -> time 
  60.   val setCurrentTime: time -> unit 
  61.   val targetTime: unit -> time   
  62.   val setTargetTime: time -> unit 
  63.   val knownTime: unit -> time
  64.   val advanceKnownTime: unit -> unit (* to current time, if later. *)
  65.   val resetKnownTime: unit -> unit  (* to current time, if earlier. *)
  66.   val userCont: unit -> userCont
  67.   val setUserCont: userCont -> unit
  68.   val currentEvData: unit  -> evData
  69.   val setCurrentEvData: evData -> unit
  70.  
  71.   (* Transfering control between debugger and user program *) 
  72.   val continue: time * execMode * action -> unit 
  73.        (* Transfer control to user program, executing action
  74.       before returning to instrumented code execution.
  75.       Returns when control transfered back to debugger. *)
  76.   val ignore: unit -> unit
  77.        (* Set mode and target time so that instrumented code can be
  78.       executed harmlessly outside of debugger control. *)
  79.   val break: System.Unsafe.object array -> unit  
  80.        (* Return control to debugger from instrumented code. *)
  81.   val pseudoEvent: {evn:evn,forced:bool,args:System.Unsafe.object list} -> unit
  82.        (* Return control to debugger from special built-in code. *)
  83.   val execTime : time ref  (* total execution steps *)
  84. end
  85.  
  86. structure DebugKernel: DEBUG_KERNEL =
  87. struct
  88.   open Array List DebugUtil 
  89.   infix 9 sub
  90.   type time = int
  91.   type evn = int
  92.   type action = unit -> unit
  93.   val nullAction = fn () => ()
  94.   type userCont = action cont
  95.   datatype onNoise = QUIET | NOISY | BREAK of (unit->bool)
  96.   type doers  = {redo:onNoise->unit,undo:onNoise->unit}
  97.   datatype execMode = RECORD of onNoise
  98.                      | REPLAY of onNoise
  99.              | IGNORE (* not running under debugger control *)
  100.   type evData = {evn:evn,lbt:time,args:System.Unsafe.object list} 
  101.   val execMode = ref IGNORE
  102.   val times = array (2,0)    (* sub 0 = currentTime *)
  103.                 (* sub 1 = targetTime *)
  104.   fun currentTime () = times sub 0
  105.   fun setCurrentTime t = update(times,0,t)
  106.   fun targetTime () = times sub 1
  107.   fun setTargetTime t = update(times,1,t)
  108.   local 
  109.     val knownTimeR = ref 0
  110.   in
  111.     fun knownTime() = !knownTimeR
  112.     fun resetKnownTime() = 
  113.     if !knownTimeR >= currentTime() then
  114.       knownTimeR := currentTime()
  115.         else debugPanic (implode["kernel.resetKnownTime ",
  116.                  makestring (currentTime()), " ",
  117.                  makestring (!knownTimeR)])
  118.     fun advanceKnownTime() =
  119.     if !knownTimeR < currentTime() then
  120.       knownTimeR := currentTime()
  121.     else ()
  122.   end
  123.   val nullEvData = {evn=0,lbt=0,args=nil:System.Unsafe.object list}
  124.   local
  125.     val currentEvDataR = ref nullEvData
  126.   in
  127.     fun currentEvData () = !currentEvDataR
  128.     fun setCurrentEvData evData = currentEvDataR := evData
  129.   end
  130.  
  131.   val startTime = ref 0
  132.   val execTime = ref 0
  133.  
  134.   val debugContR:unit cont ref = ref (makeCont "debugCont")
  135.   val userContR: userCont ref  = 
  136.       ref (callcc (fn c => ((callcc (fn c' => throw c c')) ();
  137.                 debugPanic ("empty userCont"))))
  138.   fun userCont () = !userContR
  139.   fun setUserCont c = userContR := c
  140.  
  141.   fun continue (target:time, mode:execMode, action:action) =
  142.       (setTargetTime target;
  143.        execMode := mode;
  144.        startTime := currentTime();
  145.        callcc (fn cont => 
  146.            (debugContR := cont;
  147.         throw (!userContR) action)))
  148.  
  149.   fun ignore () =
  150.       (execMode := IGNORE;
  151.        setTargetTime infinity)
  152.  
  153.   (* called from instrumented code *)
  154.   fun break (stuff:System.Unsafe.object array) =
  155.       callcc(fn cont =>  (ignore();
  156.               userContR := cont;
  157.               setCurrentEvData 
  158.                    {evn=System.Unsafe.cast (stuff sub 0),
  159.                 lbt=System.Unsafe.cast (stuff sub 1),
  160.                 args=
  161.                   let fun makelist n =
  162.                      (Array.sub(stuff,n)::(makelist (n+1)))
  163.                           handle Subscript => nil
  164.                   in makelist 2
  165.                   end};
  166.               execTime := 
  167.                   ((!execTime + (currentTime() - (!startTime)))
  168.                      handle Overflow => 0);
  169.               advanceKnownTime();
  170.               throw (!debugContR) ())) ()
  171.  
  172.   (* called from predefined code *)
  173.   fun pseudoEvent {evn:evn,forced:bool,args:System.Unsafe.object list} : unit =
  174.     (setCurrentTime (currentTime() + 1);
  175.      if forced orelse currentTime() = targetTime() then
  176.        callcc (fn cont => 
  177.               (ignore();
  178.            userContR := cont;
  179.            setCurrentEvData
  180.            {evn=evn,
  181.             lbt=currentTime()-1,
  182.             args=args};
  183.            execTime := 
  184.            !execTime + (currentTime() - (!startTime));
  185.            advanceKnownTime();
  186.            throw (!debugContR) ())) () 
  187.      else ())
  188. end
  189.