1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: math kernel layouts system strings ;
6 ! These constants must match vm/memory.h
9 : card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline
11 ! These constants must match vm/layouts.h
12 : header-offset ( -- n ) object tag-number neg ; inline
13 : float-offset ( -- n ) 8 float tag-number - ; inline
14 : string-offset ( -- n ) 4 bootstrap-cells object tag-number - ; inline
15 : string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
16 : profile-count-offset ( -- n ) 7 bootstrap-cells object tag-number - ; inline
17 : byte-array-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
18 : alien-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
19 : underlying-alien-offset ( -- n ) bootstrap-cell object tag-number - ; inline
20 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
21 : class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
22 : word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
23 : quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
24 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
25 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
26 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
29 CONSTANT: rc-absolute-cell 0
30 CONSTANT: rc-absolute 1
31 CONSTANT: rc-relative 2
32 CONSTANT: rc-absolute-ppc-2/2 3
33 CONSTANT: rc-relative-ppc-2 4
34 CONSTANT: rc-relative-ppc-3 5
35 CONSTANT: rc-relative-arm-3 6
36 CONSTANT: rc-indirect-arm 7
37 CONSTANT: rc-indirect-arm-pc 8
40 CONSTANT: rt-primitive 0
42 CONSTANT: rt-dispatch 2
46 CONSTANT: rt-immediate 6
47 CONSTANT: rt-stack-chain 7
49 : rc-absolute? ( n -- ? )
50 [ rc-absolute-ppc-2/2 = ]
51 [ rc-absolute-cell = ]