| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  | ! Copyright (C) 2008, 2009 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | USING: kernel accessors sequences namespaces combinators | 
					
						
							|  |  |  | combinators.short-circuit classes vectors compiler.cfg | 
					
						
							|  |  |  | compiler.cfg.instructions compiler.cfg.rpo ;
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  | IN: compiler.cfg.empty-blocks | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  | : update-predecessor ( bb -- )
 | 
					
						
							|  |  |  |     ! We have to replace occurrences of bb with bb's successor | 
					
						
							|  |  |  |     ! in bb's predecessor's list of successors. | 
					
						
							|  |  |  |     dup predecessors>> first [ | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             2dup eq? [ drop successors>> first ] [ nip ] if
 | 
					
						
							|  |  |  |         ] with map
 | 
					
						
							|  |  |  |     ] change-successors drop ;
 | 
					
						
							|  |  |  |   | 
					
						
							|  |  |  | : update-successor ( bb -- )
 | 
					
						
							|  |  |  |     ! We have to replace occurrences of bb with bb's predecessor | 
					
						
							|  |  |  |     ! in bb's sucessor's list of predecessors. | 
					
						
							|  |  |  |     dup successors>> first [ | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             2dup eq? [ drop predecessors>> first ] [ nip ] if
 | 
					
						
							|  |  |  |         ] with map
 | 
					
						
							|  |  |  |     ] change-predecessors drop ;
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: changed? | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  | : delete-basic-block ( bb -- )
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  |     [ update-predecessor ] [ update-successor ] bi
 | 
					
						
							|  |  |  |     changed? on ;
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  |   | 
					
						
							|  |  |  | : delete-basic-block? ( bb -- ? )
 | 
					
						
							|  |  |  |     { | 
					
						
							|  |  |  |         [ instructions>> length 1 = ] | 
					
						
							|  |  |  |         [ predecessors>> length 1 = ] | 
					
						
							|  |  |  |         [ successors>> length 1 = ] | 
					
						
							|  |  |  |         [ instructions>> first ##branch? ] | 
					
						
							|  |  |  |     } 1&& ;
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  | : delete-empty-blocks ( cfg -- cfg' )
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  |     changed? off
 | 
					
						
							| 
									
										
										
										
											2009-07-23 19:02:46 -04:00
										 |  |  |     dup [ dup delete-basic-block? [ delete-basic-block ] [ drop ] if ] each-basic-block | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  |     changed? get [ cfg-changed ] when ;
 |