| 
									
										
										
										
											2008-07-30 05:12:17 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: accessors debugger continuations threads threads.private | 
					
						
							| 
									
										
										
										
											2008-09-10 21:07:00 -04:00
										 |  |  | io io.styles prettyprint kernel math.parser namespaces make ;
 | 
					
						
							| 
									
										
										
										
											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
										 |  |  | 
 | 
					
						
							|  |  |  | M: thread error-in-thread ( error thread -- )
 | 
					
						
							|  |  |  |     initial-thread get-global eq? [ | 
					
						
							|  |  |  |         die drop
 | 
					
						
							|  |  |  |     ] [ | 
					
						
							|  |  |  |         global [ | 
					
						
							| 
									
										
										
										
											2008-09-03 21:20:03 -04:00
										 |  |  |             error-thread get-global error-in-thread. nl
 | 
					
						
							|  |  |  |             print-error nl
 | 
					
						
							|  |  |  |             :c | 
					
						
							|  |  |  |             flush
 | 
					
						
							| 
									
										
										
										
											2008-07-30 05:12:17 -04:00
										 |  |  |         ] bind | 
					
						
							|  |  |  |     ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-08-18 16:47:49 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | [ self error-in-thread stop ] | 
					
						
							|  |  |  | thread-error-hook set-global
 |