2010-04-27 10:51:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008, 2010 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors compiler.cfg.stack-frame kernel layouts math
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								namespaces vectors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: compiler.cfg
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: basic-block < identity-tuple
							 | 
						
					
						
							
								
									
										
										
										
											2015-04-13 17:22:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    number
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { instructions vector }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { successors vector }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { predecessors vector }
							 | 
						
					
						
							
								
									
										
										
										
											2016-05-02 19:16:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    { kill-block? boolean }
							 | 
						
					
						
							
								
									
										
										
										
											2016-09-07 19:58:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    height
							 | 
						
					
						
							
								
									
										
										
										
											2016-08-29 06:07:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    replaces
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    peeks
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    kills ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-27 19:58:01 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <basic-block> ( -- bb )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    basic-block new
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        V{ } clone >>instructions
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-22 19:38:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        V{ } clone >>successors
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-10 22:06:36 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        V{ } clone >>predecessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-04-12 23:27:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: cfg
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { entry basic-block }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    word
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    label
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    stack-frame
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    frame-pointer?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    post-order linear-order
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    predecessors-valid? dominance-valid? loops-valid? ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-03 00:09:31 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-03-24 12:38:42 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <cfg> ( word label entry -- cfg )
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-07 18:44:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    cfg new
							 | 
						
					
						
							
								
									
										
										
										
											2015-03-24 12:38:42 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        swap >>entry
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-07 18:44:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        swap >>label
							 | 
						
					
						
							
								
									
										
										
										
											2015-04-12 23:27:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        swap >>word
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        stack-frame new cell >>spill-area-align >>stack-frame ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-03 00:09:31 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: cfg-changed ( cfg -- )
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    f >>post-order
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f >>linear-order
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f >>dominance-valid?
							 | 
						
					
						
							
								
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    f >>loops-valid? drop ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: predecessors-changed ( cfg -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f >>predecessors-valid? drop ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-09 02:38:10 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ dup cfg ] dip with-variable ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: local-allot-offset ( n -- offset )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    cfg get stack-frame>> allot-area-base>> + ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: spill-offset ( n -- offset )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    cfg get stack-frame>> spill-area-base>> + ;
							 |