2010-01-02 07:03:30 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008, 2010 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2014-12-13 19:10:21 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: alien arrays byte-arrays kernel layouts literals math
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								quotations sequences strings words ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: compiler.constants
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-22 20:13:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: card-bits 8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: deck-bits 18
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-23 21:49:33 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: card-mark ( -- n ) 0x40 0x80 bitor ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-02 19:36:36 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-15 03:40:23 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: slot-offset ( slot tag -- n ) [ bootstrap-cells ] dip - ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-02 04:25:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: float-offset ( -- n ) 8 float type-number - ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: string-offset ( -- n ) 4 string type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: string-aux-offset ( -- n ) 2 string type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: profile-count-offset ( -- n ) 8 \ word type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: byte-array-offset ( -- n ) 16 byte-array type-number - ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: alien-offset ( -- n ) 4 alien type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: underlying-alien-offset ( -- n ) 1 alien type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: tuple-class-offset ( -- n ) 1 tuple type-number slot-offset ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-10 19:00:47 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: word-entry-point-offset ( -- n ) 9 \ word type-number slot-offset ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-18 02:51:27 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: quot-entry-point-offset ( -- n ) 4 quotation type-number slot-offset ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-02 04:25:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: array-start-offset ( -- n ) 2 array type-number slot-offset ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-05 21:47:36 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: callstack-length-offset ( -- n ) 1 \ callstack type-number slot-offset ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: callstack-top-offset ( -- n ) 2 \ callstack type-number slot-offset ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-05 23:55:20 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: vm-context-offset ( -- n ) 0 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: vm-spare-context-offset ( -- n ) 1 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-25 02:46:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: vm-signal-handler-addr-offset ( -- n ) 8 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-12 15:57:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: vm-fault-flag-offset ( -- n ) 9 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-05 23:55:20 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: context-callstack-top-offset ( -- n ) 0 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: context-callstack-bottom-offset ( -- n ) 1 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: context-datastack-offset ( -- n ) 2 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: context-retainstack-offset ( -- n ) 3 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: context-callstack-save-offset ( -- n ) 4 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-03 20:24:33 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: context-callstack-seg-offset ( -- n ) 7 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: segment-start-offset ( -- n ) 0 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: segment-size-offset ( -- n ) 1 bootstrap-cells ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: segment-end-offset ( -- n ) 2 bootstrap-cells ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Relocation classes
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-18 16:34:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-cell 0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute 1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative 2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-ppc-2/2 3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-ppc-2 4
							 | 
						
					
						
							
								
									
										
										
										
											2011-05-20 18:11:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-ppc-2-pc 5
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-ppc-3-pc 6
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-18 16:34:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-relative-arm-3 7
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-indirect-arm 8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-indirect-arm-pc 9
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-2 10
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-1 11
							 | 
						
					
						
							
								
									
										
										
										
											2011-05-20 18:11:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rc-absolute-ppc-2/2/2/2 12
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Relocation types
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-18 16:34:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-dlsym 0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-entry-point 1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-entry-point-pic 2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-entry-point-pic-tail 3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-here 4
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-this 5
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-literal 6
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-untagged 7
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-megamorphic-cache-hits 8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-vm 9
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-cards-offset 10
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-decks-offset 11
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-exception-handler 12
							 | 
						
					
						
							
								
									
										
										
										
											2011-05-20 18:11:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-dlsym-toc 13
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-14 04:08:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-inline-cache-miss 14
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-17 18:23:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: rt-safepoint 15
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-17 01:46:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: rc-absolute? ( n -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-12 17:22:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ${
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-18 16:34:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        $ rc-absolute-ppc-2/2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $ rc-absolute-cell
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $ rc-absolute
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $ rc-absolute-2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $ rc-absolute-1
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-12 17:22:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    } member? ;
							 |