2011-10-03 00:58:58 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008, 2011 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-30 05:12:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 02:33:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors debugger continuations threads io io.styles
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								prettyprint kernel make math.parser namespaces ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-30 05:12:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: debugger.threads
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: error-in-thread. ( thread -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "Error in thread " write
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        dup id>> #
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        " (" % dup name>> %
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ", " % dup quot>> unparse-short % ")" %
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-03 21:20:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] "" make swap write-object ":" print ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-30 05:12:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 02:33:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! ( error thread -- )
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 00:58:58 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 02:33:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup initial-thread get-global eq? [ die ] [
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-13 20:21:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 02:33:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            error-in-thread. nl
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            print-error nl
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            :c
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            flush
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-13 20:21:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        ] with-global
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 02:33:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        stop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-03 00:58:58 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								] thread-error-hook set-global
							 |