2009-04-30 00:35:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008, 2009 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 04:37:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: math kernel layouts system strings words quotations byte-arrays
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								alien arrays literals sequences ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: compiler.constants
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! These constants must match vm/memory.h
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-22 20:13:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: card-bits 8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: deck-bits 18
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! These constants must match vm/layouts.h
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: header-offset ( -- n ) object tag-number neg ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: float-offset ( -- n ) 8 float tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 00:35:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: profile-count-offset ( -- n ) 8 bootstrap-cells \ word tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 00:35:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-12 04:09:15 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: quot-xt-offset ( -- n ) 4 bootstrap-cells quotation tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 04:37:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-05 16:06:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Relocation classes
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-07 15:26:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-cell 0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute 1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative 2
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-22 20:13:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-ppc-2/2 3
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-07 15:26:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-ppc-2 4
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-ppc-2 5
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-ppc-3 6
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-arm-3 7
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-indirect-arm 8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-indirect-arm-pc 9
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Relocation types
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-07 15:26:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-primitive 0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-dlsym 1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-dispatch 2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-xt 3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-xt-pic 4
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-xt-pic-tail 5
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-07 15:26:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-here 6
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-this 7
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-immediate 8
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-stack-chain 9
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-07 15:26:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-untagged 10
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-megamorphic-cache-hits 11
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: rc-absolute? ( n -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-06 20:22:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
							 |