| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: kernel words sequences quotations namespaces io | 
					
						
							| 
									
										
										
										
											2008-10-20 02:56:28 -04:00
										 |  |  | classes.tuple accessors prettyprint prettyprint.config | 
					
						
							| 
									
										
										
										
											2008-12-08 15:58:00 -05:00
										 |  |  | prettyprint.backend prettyprint.custom prettyprint.sections | 
					
						
							|  |  |  | parser compiler.tree.builder compiler.tree.optimizer | 
					
						
							| 
									
										
										
										
											2008-10-07 21:00:38 -04:00
										 |  |  | compiler.cfg.builder compiler.cfg.linearization | 
					
						
							| 
									
										
										
										
											2008-12-08 15:58:00 -05:00
										 |  |  | compiler.cfg.registers compiler.cfg.stack-frame | 
					
						
							|  |  |  | compiler.cfg.linear-scan compiler.cfg.two-operand | 
					
						
							| 
									
										
										
										
											2009-05-31 13:20:46 -04:00
										 |  |  | compiler.cfg.liveness compiler.cfg.optimizer | 
					
						
							|  |  |  | compiler.cfg.mr ;
 | 
					
						
							| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  | IN: compiler.cfg.debugger | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | GENERIC: test-cfg ( quot -- cfgs )
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: callable test-cfg | 
					
						
							| 
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 |  |  |     build-tree optimize-tree gensym build-cfg ;
 | 
					
						
							| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: word test-cfg | 
					
						
							| 
									
										
										
										
											2009-04-22 00:02:00 -04:00
										 |  |  |     [ build-tree optimize-tree ] keep build-cfg ;
 | 
					
						
							| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-10-07 21:00:38 -04:00
										 |  |  | : test-mr ( quot -- mrs )
 | 
					
						
							| 
									
										
										
										
											2008-10-20 02:56:28 -04:00
										 |  |  |     test-cfg [ | 
					
						
							| 
									
										
										
										
											2008-10-22 19:39:41 -04:00
										 |  |  |         optimize-cfg | 
					
						
							| 
									
										
										
										
											2009-05-29 14:11:34 -04:00
										 |  |  |         build-mr | 
					
						
							| 
									
										
										
										
											2008-10-20 02:56:28 -04:00
										 |  |  |     ] map ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : insn. ( insn -- )
 | 
					
						
							| 
									
										
										
										
											2009-05-31 13:20:46 -04:00
										 |  |  |     tuple>array [ pprint bl ] each nl ;
 | 
					
						
							| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : mr. ( mrs -- )
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         "=== word: " write
 | 
					
						
							|  |  |  |         dup word>> pprint | 
					
						
							|  |  |  |         ", label: " write
 | 
					
						
							|  |  |  |         dup label>> pprint nl nl
 | 
					
						
							| 
									
										
										
										
											2008-10-20 02:56:28 -04:00
										 |  |  |         instructions>> [ insn. ] each
 | 
					
						
							| 
									
										
										
										
											2008-09-11 03:05:22 -04:00
										 |  |  |         nl
 | 
					
						
							|  |  |  |     ] each ;
 | 
					
						
							| 
									
										
										
										
											2008-12-08 15:58:00 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | ! Prettyprinting | 
					
						
							|  |  |  | M: vreg pprint* | 
					
						
							|  |  |  |     <block | 
					
						
							|  |  |  |     \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
 | 
					
						
							|  |  |  |     block> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: ds-loc pprint* \ D pprint-loc ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: rs-loc pprint* \ R pprint-loc ;
 |