2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 08:30:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: threads kernel prettyprint prettyprint.config
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 20:13:11 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io io.styles sequences assocs namespaces sorting boxes
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-29 18:07:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								heaps.private system math math.parser math.order accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-26 00:17:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: tools.threads
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: thread. ( thread -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-30 13:35:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup id>> pprint-cell
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup name>> over [ write-object ] with-cell
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup state>> [
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-25 07:31:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ dup self eq? "running" "yield" ? ] unless*
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        write
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-cell
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 20:13:11 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-30 13:35:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        sleep-entry>> [
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-19 02:50:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            key>> micros [-] number>string write
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            " us" write
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 20:13:11 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] when*
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-cell ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: threads. ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    standard-table-style [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            { "ID:" "Name:" "Waiting on:" "Remaining sleep:" }
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ [ write ] with-cell ] each
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] with-row
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        threads >alist sort-keys values [
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ thread. ] with-row
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] each
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-11 04:17:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] tabular-output nl ;
							 |