CVS: sml-dist/src/tools/TraceDebugProf back-trace.sml,1.1,1.2

Update of /cvsroot/smlnj/sml-dist/src/tools/TraceDebugProf
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14854/src/tools/TraceDebugProf

Modified Files:
	back-trace.sml 
Log Message:
fixed problem with bogus exn message when using btrace

Index: back-trace.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/tools/TraceDebugProf/back-trace.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** back-trace.sml	15 Feb 2005 23:52:33 -0000	1.1
--- back-trace.sml	16 Nov 2005 16:21:43 -0000	1.2
***************
*** 185,189 ****
      exception BTraceTriggered of unit -> string list
  
!     fun monitor work =
  	let val restore = save ()
  	    fun last (x, []) = x
--- 185,189 ----
      exception BTraceTriggered of unit -> string list
  
!     fun monitor0 (report_final_exn, work) =
  	let val restore = save ()
  	    fun last (x, []) = x
***************
*** 191,205 ****
  	    fun emsg e =
  		case SMLofNJ.exnHistory e of
! 		    [] => General.exnMessage e
! 		  | (h :: t) =>
! 		      concat [last (h, t), ": ", General.exnMessage e]
  	    fun hdl (e, []) =
! 		  (Control.Print.say (emsg e ^ "\n\n");
  		   raise e)
  	      | hdl (e, hist) =
  		  (Control.Print.say
  		       (concat ("\n*** BACK-TRACE ***\n" :: hist));
! 		   Control.Print.say
! 		       (concat ["\n", emsg e, "\n\n"]);
  		   raise e)
  	in
--- 191,208 ----
  	    fun emsg e =
  		case SMLofNJ.exnHistory e of
! 		      [] => General.exnMessage e
! 		    | (h :: t) =>
! 		        concat [last (h, t), ": ", General.exnMessage e]
  	    fun hdl (e, []) =
! 		  (if report_final_exn then
! 		       Control.Print.say (emsg e ^ "\n\n")
! 		   else ();
  		   raise e)
  	      | hdl (e, hist) =
  		  (Control.Print.say
  		       (concat ("\n*** BACK-TRACE ***\n" :: hist));
! 		   if report_final_exn then
! 		       Control.Print.say (concat ["\n", emsg e, "\n\n"])
! 		   else ();
  		   raise e)
  	in
***************
*** 216,219 ****
--- 219,224 ----
  	end
  
+     fun monitor work = monitor0 (true, work)
+ 
      val name = "btrace"
  
***************
*** 222,226 ****
  			   push = push, nopush = nopush,
  			   enter = enter, register = register }
! 	    val monitor = { name = name, monitor = monitor }
  	    fun addto r x = r := x :: !r
  	in
--- 227,231 ----
  			   push = push, nopush = nopush,
  			   enter = enter, register = register }
! 	    val monitor = { name = name, monitor = monitor0 }
  	    fun addto r x = r := x :: !r
  	in



-------------------------------------------------------
This SF.Net email is sponsored by the JBoss Inc.  Get Certified Today
Register for a JBoss Training Course.  Free Certification Exam
for All Training Attendees Through End of 2005. For more info visit:
http://ads.osdn.com/?ad_id=7628&alloc_id=16845&op=click