vm: 4 bit tags, new representation of alien objects makes unbox-any-c-ptr more efficient (work in progress)
Slava Pestov
parent
7e17c3077c
commit
e4ad642134
|
|
@ -176,14 +176,12 @@ USERENV: callback-stub 45
|
|||
! PIC stubs
|
||||
USERENV: pic-load 47
|
||||
USERENV: pic-tag 48
|
||||
USERENV: pic-hi-tag 49
|
||||
USERENV: pic-tuple 50
|
||||
USERENV: pic-hi-tag-tuple 51
|
||||
USERENV: pic-check-tag 52
|
||||
USERENV: pic-check 53
|
||||
USERENV: pic-hit 54
|
||||
USERENV: pic-miss-word 55
|
||||
USERENV: pic-miss-tail-word 56
|
||||
USERENV: pic-tuple 49
|
||||
USERENV: pic-check-tag 50
|
||||
USERENV: pic-check-tuple 51
|
||||
USERENV: pic-hit 52
|
||||
USERENV: pic-miss-word 53
|
||||
USERENV: pic-miss-tail-word 54
|
||||
|
||||
! Megamorphic dispatch
|
||||
USERENV: mega-lookup 57
|
||||
|
|
@ -227,7 +225,8 @@ USERENV: undefined-quot 60
|
|||
: emit-fixnum ( n -- ) tag-fixnum emit ;
|
||||
|
||||
: emit-object ( class quot -- addr )
|
||||
over tag-number here-as [ swap type-number tag-fixnum emit call align-here ] dip ;
|
||||
[ type-number ] dip over here-as
|
||||
[ swap tag-fixnum emit call align-here ] dip ;
|
||||
inline
|
||||
|
||||
! Write an object to the image.
|
||||
|
|
@ -308,7 +307,7 @@ M: float '
|
|||
|
||||
M: f '
|
||||
#! f is #define F RETAG(0,F_TYPE)
|
||||
drop \ f tag-number ;
|
||||
drop \ f type-number ;
|
||||
|
||||
: 0, ( -- ) 0 >bignum ' 0-offset fixup ;
|
||||
: 1, ( -- ) 1 >bignum ' 1-offset fixup ;
|
||||
|
|
|
|||
|
|
@ -284,7 +284,7 @@ M: ##copy analyze-aliases*
|
|||
M: ##compare analyze-aliases*
|
||||
call-next-method
|
||||
dup useless-compare? [
|
||||
dst>> \ f tag-number \ ##load-immediate new-insn
|
||||
dst>> \ f type-number \ ##load-immediate new-insn
|
||||
analyze-aliases*
|
||||
] when ;
|
||||
|
||||
|
|
|
|||
|
|
@ -119,7 +119,6 @@ IN: compiler.cfg.builder.tests
|
|||
|
||||
{
|
||||
byte-array
|
||||
simple-alien
|
||||
alien
|
||||
POSTPONE: f
|
||||
} [| class |
|
||||
|
|
@ -192,7 +191,7 @@ IN: compiler.cfg.builder.tests
|
|||
] unit-test
|
||||
|
||||
[ f t ] [
|
||||
[ { fixnum simple-alien } declare <displaced-alien> 0 alien-cell ]
|
||||
[ { fixnum alien } declare <displaced-alien> 0 alien-cell ]
|
||||
[ [ ##unbox-any-c-ptr? ] contains-insn? ]
|
||||
[ [ ##unbox-alien? ] contains-insn? ] bi
|
||||
] unit-test
|
||||
|
|
@ -205,7 +204,7 @@ IN: compiler.cfg.builder.tests
|
|||
] unit-test
|
||||
|
||||
[ f t ] [
|
||||
[ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
|
||||
[ { byte-array fixnum } declare alien-cell { alien } declare 4 alien-float ]
|
||||
[ [ ##box-alien? ] contains-insn? ]
|
||||
[ [ ##allot? ] contains-insn? ] bi
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ M: #recursive emit-node
|
|||
and ;
|
||||
|
||||
: emit-trivial-if ( -- )
|
||||
ds-pop \ f tag-number cc/= ^^compare-imm ds-push ;
|
||||
ds-pop \ f type-number cc/= ^^compare-imm ds-push ;
|
||||
|
||||
: trivial-not-if? ( #if -- ? )
|
||||
children>> first2
|
||||
|
|
@ -126,12 +126,12 @@ M: #recursive emit-node
|
|||
and ;
|
||||
|
||||
: emit-trivial-not-if ( -- )
|
||||
ds-pop \ f tag-number cc= ^^compare-imm ds-push ;
|
||||
ds-pop \ f type-number cc= ^^compare-imm ds-push ;
|
||||
|
||||
: emit-actual-if ( #if -- )
|
||||
! Inputs to the final instruction need to be copied because of
|
||||
! loc>vreg sync
|
||||
ds-pop any-rep ^^copy \ f tag-number cc/= ##compare-imm-branch emit-if ;
|
||||
ds-pop any-rep ^^copy \ f type-number cc/= ##compare-imm-branch emit-if ;
|
||||
|
||||
M: #if emit-node
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences assocs fry
|
||||
USING: accessors kernel sequences assocs fry math
|
||||
cpu.architecture layouts
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.registers
|
||||
|
|
@ -21,12 +21,14 @@ GENERIC: allocation-size* ( insn -- n )
|
|||
|
||||
M: ##allot allocation-size* size>> ;
|
||||
|
||||
M: ##box-alien allocation-size* drop 4 cells ;
|
||||
M: ##box-alien allocation-size* drop 5 cells ;
|
||||
|
||||
M: ##box-displaced-alien allocation-size* drop 4 cells ;
|
||||
M: ##box-displaced-alien allocation-size* drop 5 cells ;
|
||||
|
||||
: allocation-size ( bb -- n )
|
||||
instructions>> [ ##allocation? ] filter [ allocation-size* ] map-sum ;
|
||||
instructions>>
|
||||
[ ##allocation? ] filter
|
||||
[ allocation-size* data-alignment align ] map-sum ;
|
||||
|
||||
: insert-gc-check ( bb -- )
|
||||
dup dup '[
|
||||
|
|
|
|||
|
|
@ -43,14 +43,14 @@ insn-classes get [
|
|||
|
||||
: ^^load-literal ( obj -- dst )
|
||||
[ next-vreg dup ] dip {
|
||||
{ [ dup not ] [ drop \ f tag-number ##load-immediate ] }
|
||||
{ [ dup not ] [ drop \ f type-number ##load-immediate ] }
|
||||
{ [ dup fixnum? ] [ tag-fixnum ##load-immediate ] }
|
||||
{ [ dup float? ] [ ##load-constant ] }
|
||||
[ ##load-reference ]
|
||||
} cond ;
|
||||
|
||||
: ^^offset>slot ( slot -- vreg' )
|
||||
cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ;
|
||||
cell 4 = 2 1 ? ^^shr-imm ;
|
||||
|
||||
: ^^tag-fixnum ( src -- dst )
|
||||
tag-bits get ^^shl-imm ;
|
||||
|
|
|
|||
|
|
@ -530,7 +530,7 @@ use: src/int-rep ;
|
|||
: ##unbox-c-ptr ( dst src class temp -- )
|
||||
{
|
||||
{ [ over \ f class<= ] [ 2drop ##unbox-f ] }
|
||||
{ [ over simple-alien class<= ] [ 2drop ##unbox-alien ] }
|
||||
{ [ over alien class<= ] [ 2drop ##unbox-alien ] }
|
||||
{ [ over byte-array class<= ] [ 2drop ##unbox-byte-array ] }
|
||||
[ nip ##unbox-any-c-ptr ]
|
||||
} cond ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ compiler.cfg.utilities compiler.cfg.builder.blocks ;
|
|||
IN: compiler.cfg.intrinsics.allot
|
||||
|
||||
: ##set-slots ( regs obj class -- )
|
||||
'[ _ swap 1 + _ tag-number ##set-slot-imm ] each-index ;
|
||||
'[ _ swap 1 + _ type-number ##set-slot-imm ] each-index ;
|
||||
|
||||
: emit-simple-allot ( node -- )
|
||||
[ in-d>> length ] [ node-output-infos first class>> ] bi
|
||||
|
|
@ -31,10 +31,10 @@ IN: compiler.cfg.intrinsics.allot
|
|||
] [ drop emit-primitive ] if ;
|
||||
|
||||
: store-length ( len reg class -- )
|
||||
[ [ ^^load-literal ] dip 1 ] dip tag-number ##set-slot-imm ;
|
||||
[ [ ^^load-literal ] dip 1 ] dip type-number ##set-slot-imm ;
|
||||
|
||||
:: store-initial-element ( len reg elt class -- )
|
||||
len [ [ elt reg ] dip 2 + class tag-number ##set-slot-imm ] each ;
|
||||
len [ [ elt reg ] dip 2 + class type-number ##set-slot-imm ] each ;
|
||||
|
||||
: expand-<array>? ( obj -- ? )
|
||||
dup integer? [ 0 8 between? ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ IN: compiler.cfg.intrinsics.fixnum
|
|||
ds-push ;
|
||||
|
||||
: tag-literal ( n -- tagged )
|
||||
literal>> [ tag-fixnum ] [ \ f tag-number ] if* ;
|
||||
literal>> [ tag-fixnum ] [ \ f type-number ] if* ;
|
||||
|
||||
: emit-fixnum-op ( insn -- )
|
||||
[ 2inputs ] dip call ds-push ; inline
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ compiler.cfg.instructions compiler.cfg.utilities
|
|||
compiler.cfg.builder.blocks compiler.constants ;
|
||||
IN: compiler.cfg.intrinsics.slots
|
||||
|
||||
: value-tag ( info -- n ) class>> class-tag ; inline
|
||||
: value-tag ( info -- n ) class>> type-number ; inline
|
||||
|
||||
: ^^tag-offset>slot ( slot tag -- vreg' )
|
||||
[ ^^offset>slot ] dip ^^sub-imm ;
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ M:: vector-rep emit-box ( dst src rep -- )
|
|||
int-rep next-vreg-rep :> temp
|
||||
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
|
||||
temp 16 tag-fixnum ##load-immediate
|
||||
temp dst 1 byte-array tag-number ##set-slot-imm
|
||||
temp dst 1 byte-array type-number ##set-slot-imm
|
||||
dst byte-array-offset src rep ##set-alien-vector ;
|
||||
|
||||
M: vector-rep emit-unbox
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ M: insn rewrite drop f ;
|
|||
dup ##compare-imm-branch? [
|
||||
{
|
||||
[ cc>> cc/= eq? ]
|
||||
[ src2>> \ f tag-number eq? ]
|
||||
[ src2>> \ f type-number eq? ]
|
||||
} 1&&
|
||||
] [ drop f ] if ; inline
|
||||
|
||||
|
|
@ -110,7 +110,7 @@ M: ##compare-imm rewrite-tagged-comparison
|
|||
: rewrite-redundant-comparison? ( insn -- ? )
|
||||
{
|
||||
[ src1>> vreg>expr general-compare-expr? ]
|
||||
[ src2>> \ f tag-number = ]
|
||||
[ src2>> \ f type-number = ]
|
||||
[ cc>> { cc= cc/= } member-eq? ]
|
||||
} 1&& ; inline
|
||||
|
||||
|
|
@ -204,7 +204,7 @@ M: ##compare-branch rewrite
|
|||
[ dst>> ] dip
|
||||
{
|
||||
{ t [ t \ ##load-constant new-insn ] }
|
||||
{ f [ \ f tag-number \ ##load-immediate new-insn ] }
|
||||
{ f [ \ f type-number \ ##load-immediate new-insn ] }
|
||||
} case ;
|
||||
|
||||
: rewrite-self-compare ( insn -- insn' )
|
||||
|
|
|
|||
|
|
@ -12,19 +12,18 @@ CONSTANT: deck-bits 18
|
|||
! These constants must match vm/layouts.h
|
||||
: slot-offset ( slot tag -- n ) [ bootstrap-cells ] dip - ; inline
|
||||
|
||||
: header-offset ( -- n ) 0 object tag-number slot-offset ; inline
|
||||
: float-offset ( -- n ) 8 float tag-number - ; inline
|
||||
: string-offset ( -- n ) 4 string tag-number slot-offset ; inline
|
||||
: string-aux-offset ( -- n ) 2 string tag-number slot-offset ; inline
|
||||
: profile-count-offset ( -- n ) 8 \ word tag-number slot-offset ; inline
|
||||
: byte-array-offset ( -- n ) 16 byte-array tag-number - ; inline
|
||||
: alien-offset ( -- n ) 3 alien tag-number slot-offset ; inline
|
||||
: underlying-alien-offset ( -- n ) 1 alien tag-number slot-offset ; inline
|
||||
: tuple-class-offset ( -- n ) 1 tuple tag-number slot-offset ; inline
|
||||
: word-xt-offset ( -- n ) 10 \ word tag-number slot-offset ; inline
|
||||
: quot-xt-offset ( -- n ) 4 quotation tag-number slot-offset ; inline
|
||||
: word-code-offset ( -- n ) 11 \ word tag-number slot-offset ; inline
|
||||
: array-start-offset ( -- n ) 2 array tag-number slot-offset ; inline
|
||||
: 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
|
||||
: word-xt-offset ( -- n ) 10 \ word type-number slot-offset ; inline
|
||||
: quot-xt-offset ( -- n ) 4 quotation type-number slot-offset ; inline
|
||||
: word-code-offset ( -- n ) 11 \ word type-number slot-offset ; inline
|
||||
: array-start-offset ( -- n ) 2 array type-number slot-offset ; inline
|
||||
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
|
||||
|
||||
! Relocation classes
|
||||
|
|
|
|||
|
|
@ -175,20 +175,6 @@ TUPLE: my-tuple ;
|
|||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 1 t ] [
|
||||
B{ 1 2 3 4 } [
|
||||
{ c-ptr } declare
|
||||
[ 0 alien-unsigned-1 ] keep hi-tag
|
||||
] compile-call byte-array type-number =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
B{ 1 2 3 4 } [
|
||||
{ c-ptr } declare
|
||||
0 alien-cell hi-tag
|
||||
] compile-call alien type-number =
|
||||
] unit-test
|
||||
|
||||
[ 2 1 ] [
|
||||
2 1
|
||||
[ 2dup fixnum< [ [ die ] dip ] when ] compile-call
|
||||
|
|
|
|||
|
|
@ -419,7 +419,7 @@ cell 8 = [
|
|||
"b" get [
|
||||
[ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { alien fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
|
||||
[ ] [ "b" get free ] unit-test
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ IN: compiler.tests.low-level-ir
|
|||
! one of the sources
|
||||
[ t ] [
|
||||
V{
|
||||
T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
|
||||
T{ ##load-immediate f 1 $[ 2 cell log2 shift array type-number - ] }
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##slot f 0 0 1 }
|
||||
} compile-test-bb
|
||||
|
|
@ -59,13 +59,13 @@ IN: compiler.tests.low-level-ir
|
|||
[ t ] [
|
||||
V{
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
|
||||
T{ ##slot-imm f 0 0 2 $[ array type-number ] }
|
||||
} compile-test-bb
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
V{
|
||||
T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
|
||||
T{ ##load-immediate f 1 $[ 2 cell log2 shift array type-number - ] }
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##set-slot f 0 0 1 }
|
||||
} compile-test-bb
|
||||
|
|
@ -75,7 +75,7 @@ IN: compiler.tests.low-level-ir
|
|||
[ t ] [
|
||||
V{
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##set-slot-imm f 0 0 2 $[ array tag-number ] }
|
||||
T{ ##set-slot-imm f 0 0 2 $[ array type-number ] }
|
||||
} compile-test-bb
|
||||
dup first eq?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -279,7 +279,7 @@ generic-comparison-ops [
|
|||
] each
|
||||
|
||||
\ alien-cell [
|
||||
2drop simple-alien \ f class-or <class-info>
|
||||
2drop alien \ f class-or <class-info>
|
||||
] "outputs" set-word-prop
|
||||
|
||||
{ <tuple> <tuple-boa> } [
|
||||
|
|
|
|||
|
|
@ -890,10 +890,10 @@ M: tuple-with-read-only-slot clone
|
|||
[ { 1 2 3 } dup tuple-with-read-only-slot boa clone x>> eq? ] final-classes
|
||||
] unit-test
|
||||
|
||||
! alien-cell outputs a simple-alien or f
|
||||
! alien-cell outputs a alien or f
|
||||
[ t ] [
|
||||
[ { byte-array fixnum } declare alien-cell dup [ "OOPS" throw ] unless ] final-classes
|
||||
first simple-alien class=
|
||||
first alien class=
|
||||
] unit-test
|
||||
|
||||
! Don't crash if bad literal inputs are passed to unsafe words
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ CONSTANT: rs-reg 14
|
|||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
0 3 \ f tag-number CMPI
|
||||
0 3 \ f type-number CMPI
|
||||
2 BEQ
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
|
|
@ -174,40 +174,15 @@ CONSTANT: rs-reg 14
|
|||
|
||||
[ load-tag ] pic-tag jit-define
|
||||
|
||||
! Hi-tag
|
||||
[
|
||||
3 4 MR
|
||||
load-tag
|
||||
0 4 object tag-number tag-fixnum CMPI
|
||||
2 BNE
|
||||
4 3 object tag-number neg LWZ
|
||||
] pic-hi-tag jit-define
|
||||
|
||||
! Tuple
|
||||
[
|
||||
3 4 MR
|
||||
load-tag
|
||||
0 4 tuple tag-number tag-fixnum CMPI
|
||||
0 4 tuple type-number tag-fixnum CMPI
|
||||
2 BNE
|
||||
4 3 tuple tag-number neg bootstrap-cell + LWZ
|
||||
4 3 tuple type-number neg bootstrap-cell + LWZ
|
||||
] pic-tuple jit-define
|
||||
|
||||
! Hi-tag and tuple
|
||||
[
|
||||
3 4 MR
|
||||
load-tag
|
||||
! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple)
|
||||
0 4 BIN: 110 tag-fixnum CMPI
|
||||
5 BLT
|
||||
! Untag r3
|
||||
3 3 0 0 31 tag-bits get - RLWINM
|
||||
! Set r4 to 0 for objects, and bootstrap-cell for tuples
|
||||
4 4 1 tag-fixnum ANDI
|
||||
4 4 1 SRAWI
|
||||
! Load header cell or tuple layout cell
|
||||
4 4 3 LWZX
|
||||
] pic-hi-tag-tuple jit-define
|
||||
|
||||
[
|
||||
0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel
|
||||
] pic-check-tag jit-define
|
||||
|
|
@ -215,7 +190,7 @@ CONSTANT: rs-reg 14
|
|||
[
|
||||
0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
|
||||
4 0 5 CMP
|
||||
] pic-check jit-define
|
||||
] pic-check-tuple jit-define
|
||||
|
||||
[ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define
|
||||
|
||||
|
|
@ -283,7 +258,7 @@ CONSTANT: rs-reg 14
|
|||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
3 3 1 SRAWI
|
||||
3 3 2 SRAWI
|
||||
4 4 0 0 31 tag-bits get - RLWINM
|
||||
4 3 3 LWZX
|
||||
3 ds-reg 0 STW
|
||||
|
|
@ -404,7 +379,7 @@ CONSTANT: rs-reg 14
|
|||
5 ds-reg -4 LWZU
|
||||
5 0 4 CMP
|
||||
2 swap execute( offset -- ) ! magic number
|
||||
\ f tag-number 3 LI
|
||||
\ f type-number 3 LI
|
||||
3 ds-reg 0 STW ;
|
||||
|
||||
: define-jit-compare ( insn word -- )
|
||||
|
|
@ -423,7 +398,7 @@ CONSTANT: rs-reg 14
|
|||
4 ds-reg 0 LWZ
|
||||
3 3 4 OR
|
||||
3 3 tag-mask get ANDI
|
||||
\ f tag-number 4 LI
|
||||
\ f type-number 4 LI
|
||||
0 3 0 CMPI
|
||||
2 BNE
|
||||
1 tag-fixnum 4 LI
|
||||
|
|
|
|||
|
|
@ -266,7 +266,7 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
|
|||
! We come back here with displaced aliens
|
||||
"start" resolve-label
|
||||
! Is the object f?
|
||||
0 scratch-reg \ f tag-number CMPI
|
||||
0 scratch-reg \ f type-number CMPI
|
||||
! If so, done
|
||||
"end" get BEQ
|
||||
! Is the object an alien?
|
||||
|
|
@ -288,25 +288,20 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
|
|||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
: alien@ ( n -- n' ) cells object tag-number - ;
|
||||
|
||||
:: %allot-alien ( dst displacement base temp -- )
|
||||
dst 4 cells alien temp %allot
|
||||
temp \ f tag-number %load-immediate
|
||||
! Store underlying-alien slot
|
||||
base dst 1 alien@ STW
|
||||
! Store expired slot
|
||||
temp dst 2 alien@ STW
|
||||
! Store offset
|
||||
displacement dst 3 alien@ STW ;
|
||||
: alien@ ( n -- n' ) cells alien type-number - ;
|
||||
|
||||
M:: ppc %box-alien ( dst src temp -- )
|
||||
[
|
||||
"f" define-label
|
||||
dst \ f tag-number %load-immediate
|
||||
dst %load-immediate
|
||||
0 src 0 CMPI
|
||||
"f" get BEQ
|
||||
dst src temp temp %allot-alien
|
||||
dst 5 cells alien temp %allot
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 1 alien@ STW
|
||||
temp dst 2 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
displacement dst 4 alien@ STW
|
||||
"f" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
|
|
@ -323,7 +318,7 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-cl
|
|||
displacement' :> temp
|
||||
dst 4 cells alien temp %allot
|
||||
! If base is already a displaced alien, unpack it
|
||||
0 base \ f tag-number CMPI
|
||||
0 base \ f type-number CMPI
|
||||
"simple-case" get BEQ
|
||||
temp base header-offset LWZ
|
||||
0 temp alien type-number tag-fixnum CMPI
|
||||
|
|
@ -343,7 +338,7 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-cl
|
|||
! Store offset
|
||||
displacement' dst 3 alien@ STW
|
||||
! Store expired slot (its ok to clobber displacement')
|
||||
temp \ f tag-number %load-immediate
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 2 alien@ STW
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
|
@ -382,7 +377,7 @@ M: ppc %set-alien-double -rot STFD ;
|
|||
scratch-reg dst 0 STW ;
|
||||
|
||||
: store-tagged ( dst tag -- )
|
||||
dupd tag-number ORI ;
|
||||
dupd type-number ORI ;
|
||||
|
||||
M:: ppc %allot ( dst size class nursery-ptr -- )
|
||||
nursery-ptr dst load-allot-ptr
|
||||
|
|
@ -460,7 +455,7 @@ M: ppc %epilogue ( n -- )
|
|||
|
||||
:: (%boolean) ( dst temp branch1 branch2 -- )
|
||||
"end" define-label
|
||||
dst \ f tag-number %load-immediate
|
||||
dst \ f type-number %load-immediate
|
||||
"end" get branch1 execute( label -- )
|
||||
branch2 [ "end" get branch2 execute( label -- ) ] when
|
||||
dst \ t %load-reference
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ IN: bootstrap.x86
|
|||
: stack-reg ( -- reg ) ESP ;
|
||||
: ds-reg ( -- reg ) ESI ;
|
||||
: rs-reg ( -- reg ) EDI ;
|
||||
: fixnum>slot@ ( -- ) temp0 1 SAR ;
|
||||
: fixnum>slot@ ( -- ) temp0 2 SAR ;
|
||||
: rex-length ( -- n ) 0 ;
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ IN: bootstrap.x86
|
|||
: stack-reg ( -- reg ) RSP ;
|
||||
: ds-reg ( -- reg ) R14 ;
|
||||
: rs-reg ( -- reg ) R15 ;
|
||||
: fixnum>slot@ ( -- ) ;
|
||||
: fixnum>slot@ ( -- ) temp0 1 SAR ;
|
||||
: rex-length ( -- n ) 1 ;
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ big-endian off
|
|||
! pop boolean
|
||||
ds-reg bootstrap-cell SUB
|
||||
! compare boolean with f
|
||||
temp0 \ f tag-number CMP
|
||||
temp0 \ f type-number CMP
|
||||
! jump to true branch if not equal
|
||||
0 JNE rc-relative rt-xt jit-rel
|
||||
! jump to false branch if equal
|
||||
|
|
@ -154,7 +154,7 @@ big-endian off
|
|||
|
||||
! ! ! Polymorphic inline caches
|
||||
|
||||
! The PIC and megamorphic code stubs are not permitted to touch temp3.
|
||||
! The PIC stubs are not permitted to touch temp3.
|
||||
|
||||
! Load a value from a stack position
|
||||
[
|
||||
|
|
@ -171,41 +171,15 @@ big-endian off
|
|||
! The 'make' trick lets us compute the jump distance for the
|
||||
! conditional branches there
|
||||
|
||||
! Hi-tag
|
||||
[
|
||||
temp0 temp1 MOV
|
||||
load-tag
|
||||
temp1 object tag-number tag-fixnum CMP
|
||||
[ temp1 temp0 object tag-number neg [+] MOV ] { } make
|
||||
[ length JNE ] [ % ] bi
|
||||
] pic-hi-tag jit-define
|
||||
|
||||
! Tuple
|
||||
[
|
||||
temp0 temp1 MOV
|
||||
load-tag
|
||||
temp1 tuple tag-number tag-fixnum CMP
|
||||
[ temp1 temp0 tuple tag-number neg bootstrap-cell + [+] MOV ] { } make
|
||||
temp1 tuple type-number tag-fixnum CMP
|
||||
[ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ] { } make
|
||||
[ length JNE ] [ % ] bi
|
||||
] pic-tuple jit-define
|
||||
|
||||
! Hi-tag and tuple
|
||||
[
|
||||
temp0 temp1 MOV
|
||||
load-tag
|
||||
! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple)
|
||||
temp1 BIN: 110 tag-fixnum CMP
|
||||
[
|
||||
! Untag temp0
|
||||
temp0 tag-mask get bitnot AND
|
||||
! Set temp1 to 0 for objects, and bootstrap-cell for tuples
|
||||
temp1 1 tag-fixnum AND
|
||||
bootstrap-cell 4 = [ temp1 1 SHR ] when
|
||||
! Load header cell or tuple layout cell
|
||||
temp1 temp0 temp1 [+] MOV
|
||||
] [ ] make [ length JL ] [ % ] bi
|
||||
] pic-hi-tag-tuple jit-define
|
||||
|
||||
[
|
||||
temp1 HEX: ffffffff CMP rc-absolute rt-immediate jit-rel
|
||||
] pic-check-tag jit-define
|
||||
|
|
@ -213,7 +187,7 @@ big-endian off
|
|||
[
|
||||
temp2 HEX: ffffffff MOV rc-absolute-cell rt-immediate jit-rel
|
||||
temp1 temp2 CMP
|
||||
] pic-check jit-define
|
||||
] pic-check-tuple jit-define
|
||||
|
||||
[ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define
|
||||
|
||||
|
|
@ -224,14 +198,7 @@ big-endian off
|
|||
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! key = hashcode(class)
|
||||
temp2 temp1 MOV
|
||||
temp2 3 SHR
|
||||
temp3 temp1 MOV
|
||||
temp3 8 SHR
|
||||
temp2 temp3 ADD
|
||||
temp3 temp1 MOV
|
||||
temp3 13 SHR
|
||||
temp2 temp3 ADD
|
||||
temp2 bootstrap-cell 4 = 3 4 ? SHL
|
||||
bootstrap-cell 4 = [ temp2 1 SHR ] when
|
||||
! key &= cache.length - 1
|
||||
temp2 mega-cache-size get 1 - bootstrap-cell * AND
|
||||
! cache += array-start-offset
|
||||
|
|
@ -417,7 +384,7 @@ big-endian off
|
|||
t jit-literal
|
||||
temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! load f
|
||||
temp1 \ f tag-number MOV
|
||||
temp1 \ f type-number MOV
|
||||
! load first value
|
||||
temp0 ds-reg [] MOV
|
||||
! adjust stack pointer
|
||||
|
|
@ -547,7 +514,7 @@ big-endian off
|
|||
ds-reg bootstrap-cell SUB
|
||||
temp0 ds-reg [] OR
|
||||
temp0 tag-mask get AND
|
||||
temp0 \ f tag-number MOV
|
||||
temp0 \ f type-number MOV
|
||||
temp1 1 tag-fixnum MOV
|
||||
temp0 temp1 CMOVE
|
||||
ds-reg [] temp0 MOV
|
||||
|
|
|
|||
|
|
@ -179,46 +179,37 @@ M: x86 %unbox-alien ( dst src -- )
|
|||
|
||||
M:: x86 %unbox-any-c-ptr ( dst src temp -- )
|
||||
[
|
||||
{ "is-byte-array" "end" "start" } [ define-label ] each
|
||||
dst 0 MOV
|
||||
"end" define-label
|
||||
! Compute tag in temp register
|
||||
temp src MOV
|
||||
! We come back here with displaced aliens
|
||||
"start" resolve-label
|
||||
temp tag-mask get AND
|
||||
dst 0 MOV
|
||||
! Is the object f?
|
||||
temp \ f tag-number CMP
|
||||
src \ f type-number CMP
|
||||
"end" get JE
|
||||
! Is the object an alien?
|
||||
temp header-offset [+] alien type-number tag-fixnum CMP
|
||||
"is-byte-array" get JNE
|
||||
! If so, load the offset and add it to the address
|
||||
dst temp alien-offset [+] ADD
|
||||
! Now recurse on the underlying alien
|
||||
temp temp underlying-alien-offset [+] MOV
|
||||
"start" get JMP
|
||||
"is-byte-array" resolve-label
|
||||
! Add byte array address to address being computed
|
||||
dst temp ADD
|
||||
! Add an offset to start of byte array's data
|
||||
dst byte-array-offset ADD
|
||||
dst src byte-array-offset [+] LEA
|
||||
! Is the object an alien?
|
||||
temp alien type-number CMP
|
||||
"end" get JNE
|
||||
! If so, load the offset and add it to the address
|
||||
dst src alien-offset [+] MOV
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
: alien@ ( reg n -- op ) cells alien tag-number - [+] ;
|
||||
|
||||
:: %allot-alien ( dst displacement base temp -- )
|
||||
dst 4 cells alien temp %allot
|
||||
dst 1 alien@ base MOV ! alien
|
||||
dst 2 alien@ \ f tag-number MOV ! expired
|
||||
dst 3 alien@ displacement MOV ! displacement
|
||||
;
|
||||
: alien@ ( reg n -- op ) cells alien type-number - [+] ;
|
||||
|
||||
M:: x86 %box-alien ( dst src temp -- )
|
||||
[
|
||||
"end" define-label
|
||||
dst \ f tag-number MOV
|
||||
dst \ f type-number MOV
|
||||
src 0 CMP
|
||||
"end" get JE
|
||||
dst src \ f tag-number temp %allot-alien
|
||||
dst 5 cells alien temp %allot
|
||||
dst 1 alien@ \ f type-number MOV ! base
|
||||
dst 2 alien@ \ f type-number MOV ! expired
|
||||
dst 3 alien@ displacement MOV ! displacement
|
||||
dst 4 alien@ displacement MOV ! address
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
|
|
@ -235,9 +226,10 @@ M:: x86 %box-displaced-alien ( dst displacement base displacement' base' base-cl
|
|||
! If base is already a displaced alien, unpack it
|
||||
base' base MOV
|
||||
displacement' displacement MOV
|
||||
base \ f tag-number CMP
|
||||
base \ f type-number CMP
|
||||
"ok" get JE
|
||||
base header-offset [+] alien type-number tag-fixnum CMP
|
||||
! XXX
|
||||
base 0 [+] alien type-number tag-fixnum CMP
|
||||
"ok" get JNE
|
||||
! displacement += base.displacement
|
||||
displacement' base 3 alien@ ADD
|
||||
|
|
@ -245,7 +237,7 @@ M:: x86 %box-displaced-alien ( dst displacement base displacement' base' base-cl
|
|||
base' base 1 alien@ MOV
|
||||
"ok" resolve-label
|
||||
dst 1 alien@ base' MOV ! alien
|
||||
dst 2 alien@ \ f tag-number MOV ! expired
|
||||
dst 2 alien@ \ f type-number MOV ! expired
|
||||
dst 3 alien@ displacement' MOV ! displacement
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
|
@ -402,7 +394,7 @@ M: x86 %vm-field-ptr ( dst field -- )
|
|||
[ [] ] [ type-number tag-fixnum ] bi* MOV ;
|
||||
|
||||
: store-tagged ( dst tag -- )
|
||||
tag-number OR ;
|
||||
type-number OR ;
|
||||
|
||||
M:: x86 %allot ( dst size class nursery-ptr -- )
|
||||
nursery-ptr dst load-allot-ptr
|
||||
|
|
@ -444,7 +436,7 @@ M: x86 %alien-global ( dst symbol library -- )
|
|||
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
|
||||
|
||||
:: %boolean ( dst temp word -- )
|
||||
dst \ f tag-number MOV
|
||||
dst \ f type-number MOV
|
||||
temp 0 MOV \ t rc-absolute-cell rel-immediate
|
||||
dst temp word execute ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: io.buffers
|
|||
|
||||
TUPLE: buffer
|
||||
{ size fixnum }
|
||||
{ ptr simple-alien }
|
||||
{ ptr alien }
|
||||
{ fill fixnum }
|
||||
{ pos fixnum }
|
||||
disposed ;
|
||||
|
|
|
|||
|
|
@ -592,7 +592,7 @@ M: bad-executable summary
|
|||
|
||||
\ set-alien-double { float c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-cell { c-ptr integer } { simple-c-ptr } define-primitive
|
||||
\ alien-cell { c-ptr integer } { pinned-c-ptr } define-primitive
|
||||
\ alien-cell make-flushable
|
||||
|
||||
\ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
|
||||
|
|
|
|||
|
|
@ -13,18 +13,18 @@ IN: tools.time
|
|||
|
||||
: dispatch-stats. ( stats -- )
|
||||
"== Megamorphic caches ==" print nl
|
||||
{ "Hits" "Misses" } swap zip simple-table. ;
|
||||
[ { "Hits" "Misses" } ] dip zip simple-table. ;
|
||||
|
||||
: inline-cache-stats. ( stats -- )
|
||||
"== Polymorphic inline caches ==" print nl
|
||||
3 cut
|
||||
[
|
||||
"- Transitions:" print
|
||||
{ "Cold to monomorphic" "Mono to polymorphic" "Poly to megamorphic" } swap zip
|
||||
[ { "Cold to monomorphic" "Mono to polymorphic" "Poly to megamorphic" } ] dip zip
|
||||
simple-table. nl
|
||||
] [
|
||||
"- Type check stubs:" print
|
||||
{ "Tag only" "Hi-tag" "Tuple" "Hi-tag and tuple" } swap zip
|
||||
[ { "Tag" "Tuple" } ] dip zip
|
||||
simple-table.
|
||||
] bi* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,19 +4,9 @@ USING: accessors assocs kernel math namespaces sequences system
|
|||
kernel.private byte-arrays arrays init ;
|
||||
IN: alien
|
||||
|
||||
! Some predicate classes used by the compiler for optimization
|
||||
! purposes
|
||||
PREDICATE: simple-alien < alien underlying>> not ;
|
||||
PREDICATE: pinned-alien < alien underlying>> not ;
|
||||
|
||||
UNION: simple-c-ptr
|
||||
simple-alien POSTPONE: f byte-array ;
|
||||
|
||||
DEFER: pinned-c-ptr?
|
||||
|
||||
PREDICATE: pinned-alien < alien underlying>> pinned-c-ptr? ;
|
||||
|
||||
UNION: pinned-c-ptr
|
||||
pinned-alien POSTPONE: f ;
|
||||
UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
|
||||
|
||||
GENERIC: >c-ptr ( obj -- c-ptr )
|
||||
|
||||
|
|
@ -33,7 +23,7 @@ M: alien expired? expired>> ;
|
|||
M: f expired? drop t ;
|
||||
|
||||
: <alien> ( address -- alien )
|
||||
f <displaced-alien> { simple-c-ptr } declare ; inline
|
||||
f <displaced-alien> { pinned-c-ptr } declare ; inline
|
||||
|
||||
: <bad-alien> ( -- alien )
|
||||
-1 <alien> t >>expired ; inline
|
||||
|
|
|
|||
|
|
@ -7,32 +7,26 @@ kernel.private ;
|
|||
|
||||
16 data-alignment set
|
||||
|
||||
BIN: 111 tag-mask set
|
||||
8 num-tags set
|
||||
3 tag-bits set
|
||||
BIN: 1111 tag-mask set
|
||||
4 tag-bits set
|
||||
|
||||
15 num-types set
|
||||
14 num-types set
|
||||
|
||||
32 mega-cache-size set
|
||||
|
||||
H{
|
||||
{ fixnum BIN: 000 }
|
||||
{ bignum BIN: 001 }
|
||||
{ array BIN: 010 }
|
||||
{ float BIN: 011 }
|
||||
{ quotation BIN: 100 }
|
||||
{ POSTPONE: f BIN: 101 }
|
||||
{ object BIN: 110 }
|
||||
{ hi-tag BIN: 110 }
|
||||
{ tuple BIN: 111 }
|
||||
} tag-numbers set
|
||||
|
||||
tag-numbers get H{
|
||||
{ fixnum 0 }
|
||||
{ bignum 1 }
|
||||
{ array 2 }
|
||||
{ float 3 }
|
||||
{ quotation 4 }
|
||||
{ POSTPONE: f 5 }
|
||||
{ alien 6 }
|
||||
{ tuple 7 }
|
||||
{ wrapper 8 }
|
||||
{ byte-array 9 }
|
||||
{ callstack 10 }
|
||||
{ string 11 }
|
||||
{ word 12 }
|
||||
{ dll 13 }
|
||||
{ alien 14 }
|
||||
} assoc-union type-numbers set
|
||||
} type-numbers set
|
||||
|
|
|
|||
|
|
@ -177,10 +177,6 @@ bi
|
|||
|
||||
"object?" "kernel" vocab-words delete-at
|
||||
|
||||
! Class of objects with object tag
|
||||
"hi-tag" "kernel.private" create
|
||||
builtins get num-tags get tail define-union-class
|
||||
|
||||
! Empty class with no instances
|
||||
"null" "kernel" create
|
||||
[ f { } f union-class define-class ]
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ ARTICLE: "class-operations" "Class operations"
|
|||
flatten-class
|
||||
flatten-builtin-class
|
||||
class-types
|
||||
class-tags
|
||||
} ;
|
||||
|
||||
ARTICLE: "class-linearization" "Class linearization"
|
||||
|
|
|
|||
|
|
@ -95,8 +95,6 @@ UNION: z1 b1 c1 ;
|
|||
|
||||
[ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test
|
||||
|
||||
[ f ] [ growable \ hi-tag classes-intersect? ] unit-test
|
||||
|
||||
[ t ] [
|
||||
growable tuple sequence class-and class<=
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -237,11 +237,5 @@ M: anonymous-union (flatten-class)
|
|||
flatten-builtin-class keys
|
||||
[ "type" word-prop ] map natural-sort ;
|
||||
|
||||
: class-tags ( class -- seq )
|
||||
class-types [
|
||||
dup num-tags get >=
|
||||
[ drop \ hi-tag tag-number ] when
|
||||
] map prune ;
|
||||
|
||||
: class-tag ( class -- tag/f )
|
||||
class-tags dup length 1 = [ first ] [ drop f ] if ;
|
||||
: class-type ( class -- tag/f )
|
||||
class-types dup length 1 = [ first ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -12,34 +12,20 @@ PREDICATE: builtin-class < class
|
|||
|
||||
: class>type ( class -- n ) "type" word-prop ; foldable
|
||||
|
||||
PREDICATE: lo-tag-class < builtin-class class>type 7 <= ;
|
||||
|
||||
PREDICATE: hi-tag-class < builtin-class class>type 7 > ;
|
||||
|
||||
: type>class ( n -- class ) builtins get-global nth ;
|
||||
|
||||
: bootstrap-type>class ( n -- class ) builtins get nth ;
|
||||
|
||||
M: hi-tag class hi-tag type>class ; inline
|
||||
|
||||
M: object class tag type>class ; inline
|
||||
|
||||
M: builtin-class rank-class drop 0 ;
|
||||
|
||||
GENERIC: define-builtin-predicate ( class -- )
|
||||
|
||||
M: lo-tag-class define-builtin-predicate
|
||||
M: builtin-class define-builtin-predicate
|
||||
dup class>type [ eq? ] curry [ tag ] prepend define-predicate ;
|
||||
|
||||
M: hi-tag-class define-builtin-predicate
|
||||
dup class>type [ eq? ] curry [ hi-tag ] prepend 1quotation
|
||||
[ dup tag 6 eq? ] [ [ drop f ] if ] surround
|
||||
define-predicate ;
|
||||
|
||||
M: lo-tag-class instance? [ tag ] [ class>type ] bi* eq? ;
|
||||
|
||||
M: hi-tag-class instance?
|
||||
over tag 6 eq? [ [ hi-tag ] [ class>type ] bi* eq? ] [ 2drop f ] if ;
|
||||
M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ;
|
||||
|
||||
M: builtin-class (flatten-class) dup set ;
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@ IN: classes.tests
|
|||
[ f ] [ 3 float instance? ] unit-test
|
||||
[ t ] [ 3 number instance? ] unit-test
|
||||
[ f ] [ 3 null instance? ] unit-test
|
||||
[ t ] [ "hi" \ hi-tag instance? ] unit-test
|
||||
|
||||
! Regression
|
||||
GENERIC: method-forget-test ( obj -- obj )
|
||||
|
|
|
|||
|
|
@ -112,15 +112,6 @@ TUPLE: tuple-dispatch-engine echelons ;
|
|||
tuple bootstrap-word
|
||||
\ <tuple-dispatch-engine> convert-methods ;
|
||||
|
||||
! 2.2 Convert hi-tag methods
|
||||
TUPLE: hi-tag-dispatch-engine methods ;
|
||||
|
||||
C: <hi-tag-dispatch-engine> hi-tag-dispatch-engine
|
||||
|
||||
: convert-hi-tag-methods ( assoc -- assoc' )
|
||||
\ hi-tag bootstrap-word
|
||||
\ <hi-tag-dispatch-engine> convert-methods ;
|
||||
|
||||
! 3 Tag methods
|
||||
TUPLE: tag-dispatch-engine methods ;
|
||||
|
||||
|
|
@ -129,7 +120,6 @@ C: <tag-dispatch-engine> tag-dispatch-engine
|
|||
: <engine> ( assoc -- engine )
|
||||
flatten-methods
|
||||
convert-tuple-methods
|
||||
convert-hi-tag-methods
|
||||
<tag-dispatch-engine> ;
|
||||
|
||||
! ! ! Compile engine ! ! !
|
||||
|
|
@ -144,23 +134,12 @@ GENERIC: compile-engine ( engine -- obj )
|
|||
: direct-dispatch-table ( assoc n -- table )
|
||||
default get <array> [ <enum> swap update ] keep ;
|
||||
|
||||
: lo-tag-number ( class -- n )
|
||||
"type" word-prop dup num-tags get iota member?
|
||||
[ drop object tag-number ] unless ;
|
||||
: tag-number ( class -- n ) "type" word-prop ;
|
||||
|
||||
M: tag-dispatch-engine compile-engine
|
||||
methods>> compile-engines*
|
||||
[ [ lo-tag-number ] dip ] assoc-map
|
||||
num-tags get direct-dispatch-table ;
|
||||
|
||||
: num-hi-tags ( -- n ) num-types get num-tags get - ;
|
||||
|
||||
: hi-tag-number ( class -- n ) "type" word-prop ;
|
||||
|
||||
M: hi-tag-dispatch-engine compile-engine
|
||||
methods>> compile-engines*
|
||||
[ [ hi-tag-number num-tags get - ] dip ] assoc-map
|
||||
num-hi-tags direct-dispatch-table ;
|
||||
[ [ tag-number ] dip ] assoc-map
|
||||
num-types get direct-dispatch-table ;
|
||||
|
||||
: build-fast-hash ( methods -- buckets )
|
||||
>alist V{ } clone [ hashcode 1array ] distribute-buckets
|
||||
|
|
|
|||
|
|
@ -651,7 +651,7 @@ HELP: declare
|
|||
|
||||
HELP: tag ( object -- n )
|
||||
{ $values { "object" object } { "n" "a tag number" } }
|
||||
{ $description "Outputs an object's tag number, between zero and one less than " { $link num-tags } ". This is implementation detail and user code should call " { $link class } " instead." } ;
|
||||
{ $description "Outputs an object's tag number, between zero and one less than " { $link num-types } ". This is implementation detail and user code should call " { $link class } " instead." } ;
|
||||
|
||||
HELP: getenv ( n -- obj )
|
||||
{ $values { "n" "a non-negative integer" } { "obj" object } }
|
||||
|
|
|
|||
|
|
@ -230,8 +230,6 @@ ERROR: assert got expect ;
|
|||
|
||||
: declare ( spec -- ) drop ;
|
||||
|
||||
: hi-tag ( obj -- n ) { hi-tag } declare 0 slot ; inline
|
||||
|
||||
: do-primitive ( number -- ) "Improper primitive call" throw ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
|||
|
|
@ -7,18 +7,11 @@ HELP: tag-bits
|
|||
{ $var-description "Number of least significant bits reserved for a type tag in a tagged pointer." }
|
||||
{ $see-also tag } ;
|
||||
|
||||
HELP: num-tags
|
||||
{ $var-description "Number of distinct pointer tags. This is one more than the maximum value from the " { $link tag } " primitive." } ;
|
||||
|
||||
HELP: tag-mask
|
||||
{ $var-description "Taking the bitwise and of a tagged pointer with this mask leaves the tag." } ;
|
||||
|
||||
HELP: num-types
|
||||
{ $var-description "Number of distinct built-in types. This is one more than the maximum value from the " { $link hi-tag } " primitive." } ;
|
||||
|
||||
HELP: tag-number
|
||||
{ $values { "class" class } { "n" "an integer or " { $link f } } }
|
||||
{ $description "Outputs the pointer tag for pointers to instances of " { $link class } ". Will output " { $link f } " if instances of this class are not identified by a distinct pointer tag." } ;
|
||||
{ $var-description "Number of distinct built-in types. This is one more than the maximum value from the " { $link tag } " primitive." } ;
|
||||
|
||||
HELP: type-number
|
||||
{ $values { "class" class } { "n" "an integer or " { $link f } } }
|
||||
|
|
@ -76,7 +69,7 @@ HELP: bootstrap-cell-bits
|
|||
|
||||
ARTICLE: "layouts-types" "Type numbers"
|
||||
"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
|
||||
{ $subsections hi-tag }
|
||||
{ $subsections tag }
|
||||
"Built-in type numbers can be converted to classes, and vice versa:"
|
||||
{ $subsections
|
||||
type>class
|
||||
|
|
@ -88,14 +81,10 @@ ARTICLE: "layouts-types" "Type numbers"
|
|||
ARTICLE: "layouts-tags" "Tagged pointers"
|
||||
"Every pointer stored on the stack or in the heap has a " { $emphasis "tag" } ", which is a small integer identifying the type of the pointer. If the tag is not equal to one of the two special tags, the remaining bits contain the memory address of a heap-allocated object. The two special tags are the " { $link fixnum } " tag and the " { $link f } " tag."
|
||||
$nl
|
||||
"Getting the tag of an object:"
|
||||
{ $link tag }
|
||||
"Words for working with tagged pointers:"
|
||||
{ $subsections
|
||||
tag-bits
|
||||
num-tags
|
||||
tag-mask
|
||||
tag-number
|
||||
}
|
||||
"The Factor VM does not actually expose any words for working with tagged pointers directly. The above words operate on integers; they are used in the bootstrap image generator and the optimizing compiler." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,14 +8,10 @@ SYMBOL: data-alignment
|
|||
|
||||
SYMBOL: tag-mask
|
||||
|
||||
SYMBOL: num-tags
|
||||
|
||||
SYMBOL: tag-bits
|
||||
|
||||
SYMBOL: num-types
|
||||
|
||||
SYMBOL: tag-numbers
|
||||
|
||||
SYMBOL: type-numbers
|
||||
|
||||
SYMBOL: mega-cache-size
|
||||
|
|
@ -23,9 +19,6 @@ SYMBOL: mega-cache-size
|
|||
: type-number ( class -- n )
|
||||
type-numbers get at ;
|
||||
|
||||
: tag-number ( class -- n )
|
||||
type-number dup num-tags get >= [ drop object tag-number ] when ;
|
||||
|
||||
: tag-fixnum ( n -- tagged )
|
||||
tag-bits get shift ;
|
||||
|
||||
|
|
|
|||
13
vm/alien.cpp
13
vm/alien.cpp
|
|
@ -14,7 +14,10 @@ char *factor_vm::pinned_alien_offset(cell obj)
|
|||
alien *ptr = untag<alien>(obj);
|
||||
if(to_boolean(ptr->expired))
|
||||
general_error(ERROR_EXPIRED,obj,false_object,NULL);
|
||||
return pinned_alien_offset(ptr->base) + ptr->displacement;
|
||||
if(to_boolean(ptr->base))
|
||||
type_error(ALIEN_TYPE,obj);
|
||||
else
|
||||
return (char *)ptr->address;
|
||||
}
|
||||
case F_TYPE:
|
||||
return NULL;
|
||||
|
|
@ -41,6 +44,7 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement)
|
|||
|
||||
new_alien->displacement = displacement;
|
||||
new_alien->expired = false_object;
|
||||
new_alien->update_address();
|
||||
|
||||
return new_alien.value();
|
||||
}
|
||||
|
|
@ -168,12 +172,7 @@ char *factor_vm::alien_offset(cell obj)
|
|||
case BYTE_ARRAY_TYPE:
|
||||
return untag<byte_array>(obj)->data<char>();
|
||||
case ALIEN_TYPE:
|
||||
{
|
||||
alien *ptr = untag<alien>(obj);
|
||||
if(to_boolean(ptr->expired))
|
||||
general_error(ERROR_EXPIRED,obj,false_object,NULL);
|
||||
return alien_offset(ptr->base) + ptr->displacement;
|
||||
}
|
||||
return (char *)untag<alien>(obj)->address;
|
||||
case F_TYPE:
|
||||
return NULL;
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -111,9 +111,11 @@ template<typename TargetGeneration, typename Policy> struct collector {
|
|||
workhorse.visit_handle(handle);
|
||||
}
|
||||
|
||||
void trace_slots(object *ptr)
|
||||
void trace_object(object *ptr)
|
||||
{
|
||||
workhorse.visit_slots(ptr);
|
||||
if(ptr->h.hi_tag() == ALIEN_TYPE)
|
||||
((alien *)ptr)->update_address();
|
||||
}
|
||||
|
||||
void trace_roots()
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ struct copying_collector : collector<TargetGeneration,Policy> {
|
|||
{
|
||||
while(scan && scan < this->target->here)
|
||||
{
|
||||
this->trace_slots((object *)scan);
|
||||
this->trace_object((object *)scan);
|
||||
scan = this->target->next_object_after(scan);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ DEF(void,primitive_fixnum_multiply,(void *vm)):
|
|||
lwz r3,0(DS_REG)
|
||||
lwz r4,-4(DS_REG)
|
||||
subi DS_REG,DS_REG,4
|
||||
srawi r3,r3,3
|
||||
srawi r3,r3,4
|
||||
mullwo. r6,r3,r4
|
||||
bso multiply_overflow
|
||||
stw r6,0(DS_REG)
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ DEF(void,primitive_fixnum_multiply,(void *myvm)):
|
|||
mov (DS_REG),ARITH_TEMP_1
|
||||
mov ARITH_TEMP_1,DIV_RESULT
|
||||
mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
|
||||
sar $3,ARITH_TEMP_2
|
||||
sar $4,ARITH_TEMP_2
|
||||
sub $CELL_SIZE,DS_REG
|
||||
imul ARITH_TEMP_2
|
||||
jo multiply_overflow
|
||||
|
|
|
|||
|
|
@ -70,16 +70,6 @@ cell factor_vm::lookup_tuple_method(cell obj, cell methods)
|
|||
return false_object;
|
||||
}
|
||||
|
||||
cell factor_vm::lookup_hi_tag_method(cell obj, cell methods)
|
||||
{
|
||||
array *hi_tag_methods = untag<array>(methods);
|
||||
cell tag = untag<object>(obj)->h.hi_tag() - HEADER_TYPE;
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(tag < TYPE_COUNT - HEADER_TYPE);
|
||||
#endif
|
||||
return array_nth(hi_tag_methods,tag);
|
||||
}
|
||||
|
||||
cell factor_vm::lookup_method(cell obj, cell methods)
|
||||
{
|
||||
cell tag = TAG(obj);
|
||||
|
|
@ -92,13 +82,6 @@ cell factor_vm::lookup_method(cell obj, cell methods)
|
|||
else
|
||||
return method;
|
||||
}
|
||||
else if(tag == OBJECT_TYPE)
|
||||
{
|
||||
if(TAG(method) == ARRAY_TYPE)
|
||||
return lookup_hi_tag_method(obj,method);
|
||||
else
|
||||
return method;
|
||||
}
|
||||
else
|
||||
return method;
|
||||
}
|
||||
|
|
@ -112,21 +95,17 @@ void factor_vm::primitive_lookup_method()
|
|||
|
||||
cell factor_vm::object_class(cell obj)
|
||||
{
|
||||
switch(TAG(obj))
|
||||
{
|
||||
case TUPLE_TYPE:
|
||||
cell tag = TAG(obj);
|
||||
if(tag == TUPLE_TYPE)
|
||||
return untag<tuple>(obj)->layout;
|
||||
case OBJECT_TYPE:
|
||||
return untag<object>(obj)->h.value;
|
||||
default:
|
||||
return tag_fixnum(TAG(obj));
|
||||
}
|
||||
else
|
||||
return tag_fixnum(tag);
|
||||
}
|
||||
|
||||
cell factor_vm::method_cache_hashcode(cell klass, array *array)
|
||||
{
|
||||
cell capacity = (array_capacity(array) >> 1) - 1;
|
||||
return (((klass >> 3) + (klass >> 8) + (klass >> 13)) & capacity) << 1;
|
||||
return ((klass >> TAG_BITS) & capacity) << 1;
|
||||
}
|
||||
|
||||
void factor_vm::update_method_cache(cell cache, cell klass, cell method)
|
||||
|
|
@ -174,7 +153,7 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac
|
|||
gc_root<array> cache(cache_,parent);
|
||||
|
||||
/* Generate machine code to determine the object's class. */
|
||||
emit_class_lookup(index,PIC_HI_TAG_TUPLE);
|
||||
emit_class_lookup(index,PIC_TUPLE);
|
||||
|
||||
/* Do a cache lookup. */
|
||||
emit_with(parent->special_objects[MEGA_LOOKUP],cache.value());
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ void factor_vm::collect_mark_impl(bool trace_contexts_p)
|
|||
{
|
||||
object *obj = mark_stack->back();
|
||||
mark_stack->pop_back();
|
||||
collector.trace_slots(obj);
|
||||
collector.trace_object(obj);
|
||||
code_marker.visit_object_code_block(obj);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -90,9 +90,12 @@ void factor_vm::fixup_quotation(quotation *quot, cell code_relocation_base)
|
|||
quot->xt = (void *)lazy_jit_compile;
|
||||
}
|
||||
|
||||
void factor_vm::fixup_alien(alien *d)
|
||||
void factor_vm::fixup_alien(alien *ptr)
|
||||
{
|
||||
if(!to_boolean(d->base)) d->expired = true_object;
|
||||
if(!to_boolean(ptr->base))
|
||||
ptr->expired = true_object;
|
||||
else
|
||||
ptr->update_address();
|
||||
}
|
||||
|
||||
struct stack_frame_fixupper {
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@ void factor_vm::init_inline_caching(int max_size)
|
|||
cold_call_to_ic_transitions = 0;
|
||||
ic_to_pic_transitions = 0;
|
||||
pic_to_mega_transitions = 0;
|
||||
for(int i = 0; i < 4; i++) pic_counts[i] = 0;
|
||||
pic_counts[0] = 0;
|
||||
pic_counts[1] = 0;
|
||||
}
|
||||
|
||||
void factor_vm::deallocate_inline_cache(cell return_address)
|
||||
|
|
@ -29,39 +30,20 @@ void factor_vm::deallocate_inline_cache(cell return_address)
|
|||
it contains */
|
||||
cell factor_vm::determine_inline_cache_type(array *cache_entries)
|
||||
{
|
||||
bool seen_hi_tag = false, seen_tuple = false;
|
||||
bool seen_tuple = false;
|
||||
|
||||
cell i;
|
||||
for(i = 0; i < array_capacity(cache_entries); i += 2)
|
||||
{
|
||||
cell klass = array_nth(cache_entries,i);
|
||||
|
||||
/* Is it a tuple layout? */
|
||||
switch(TAG(klass))
|
||||
if(TAG(array_nth(cache_entries,i)) == ARRAY_TYPE)
|
||||
{
|
||||
case FIXNUM_TYPE:
|
||||
{
|
||||
fixnum type = untag_fixnum(klass);
|
||||
if(type >= HEADER_TYPE)
|
||||
seen_hi_tag = true;
|
||||
}
|
||||
break;
|
||||
case ARRAY_TYPE:
|
||||
seen_tuple = true;
|
||||
break;
|
||||
default:
|
||||
critical_error("Expected a fixnum or array",klass);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if(seen_hi_tag && seen_tuple) return PIC_HI_TAG_TUPLE;
|
||||
if(seen_hi_tag && !seen_tuple) return PIC_HI_TAG;
|
||||
if(!seen_hi_tag && seen_tuple) return PIC_TUPLE;
|
||||
if(!seen_hi_tag && !seen_tuple) return PIC_TAG;
|
||||
|
||||
critical_error("Oops",0);
|
||||
return 0;
|
||||
return seen_tuple ? PIC_TUPLE : PIC_TAG;
|
||||
}
|
||||
|
||||
void factor_vm::update_pic_count(cell type)
|
||||
|
|
@ -85,10 +67,10 @@ struct inline_cache_jit : public jit {
|
|||
void inline_cache_jit::emit_check(cell klass)
|
||||
{
|
||||
cell code_template;
|
||||
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
|
||||
if(TAG(klass) == FIXNUM_TYPE)
|
||||
code_template = parent->special_objects[PIC_CHECK_TAG];
|
||||
else
|
||||
code_template = parent->special_objects[PIC_CHECK];
|
||||
code_template = parent->special_objects[PIC_CHECK_TUPLE];
|
||||
|
||||
emit_with(code_template,klass);
|
||||
}
|
||||
|
|
@ -250,8 +232,8 @@ VM_C_API void *inline_cache_miss(cell return_address, factor_vm *parent)
|
|||
void factor_vm::primitive_reset_inline_cache_stats()
|
||||
{
|
||||
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
|
||||
cell i;
|
||||
for(i = 0; i < 4; i++) pic_counts[i] = 0;
|
||||
pic_counts[0] = 0;
|
||||
pic_counts[1] = 0;
|
||||
}
|
||||
|
||||
void factor_vm::primitive_inline_cache_stats()
|
||||
|
|
@ -260,9 +242,8 @@ void factor_vm::primitive_inline_cache_stats()
|
|||
stats.add(allot_cell(cold_call_to_ic_transitions));
|
||||
stats.add(allot_cell(ic_to_pic_transitions));
|
||||
stats.add(allot_cell(pic_to_mega_transitions));
|
||||
cell i;
|
||||
for(i = 0; i < 4; i++)
|
||||
stats.add(allot_cell(pic_counts[i]));
|
||||
stats.add(allot_cell(pic_counts[0]));
|
||||
stats.add(allot_cell(pic_counts[1]));
|
||||
stats.trim();
|
||||
dpush(stats.elements.value());
|
||||
}
|
||||
|
|
|
|||
|
|
@ -27,8 +27,8 @@ static const cell data_alignment = 16;
|
|||
|
||||
#define WORD_SIZE (signed)(sizeof(cell)*8)
|
||||
|
||||
#define TAG_MASK 7
|
||||
#define TAG_BITS 3
|
||||
#define TAG_MASK 15
|
||||
#define TAG_BITS 4
|
||||
#define TAG(x) ((cell)(x) & TAG_MASK)
|
||||
#define UNTAG(x) ((cell)(x) & ~TAG_MASK)
|
||||
#define RETAG(x,tag) (UNTAG(x) | (tag))
|
||||
|
|
@ -40,23 +40,18 @@ static const cell data_alignment = 16;
|
|||
#define FLOAT_TYPE 3
|
||||
#define QUOTATION_TYPE 4
|
||||
#define F_TYPE 5
|
||||
#define OBJECT_TYPE 6
|
||||
#define ALIEN_TYPE 6
|
||||
#define TUPLE_TYPE 7
|
||||
|
||||
#define HEADER_TYPE 8 /* anything less than this is a tag */
|
||||
|
||||
#define GC_COLLECTED 5 /* can be anything other than FIXNUM_TYPE */
|
||||
|
||||
/*** Header types ***/
|
||||
#define WRAPPER_TYPE 8
|
||||
#define BYTE_ARRAY_TYPE 9
|
||||
#define CALLSTACK_TYPE 10
|
||||
#define STRING_TYPE 11
|
||||
#define WORD_TYPE 12
|
||||
#define DLL_TYPE 13
|
||||
#define ALIEN_TYPE 14
|
||||
|
||||
#define TYPE_COUNT 15
|
||||
#define TYPE_COUNT 14
|
||||
|
||||
#define GC_COLLECTED 5 /* can be anything other than FIXNUM_TYPE */
|
||||
|
||||
enum code_block_type
|
||||
{
|
||||
|
|
@ -97,11 +92,6 @@ inline static cell tag_fixnum(fixnum untagged)
|
|||
return RETAG(untagged << TAG_BITS,FIXNUM_TYPE);
|
||||
}
|
||||
|
||||
inline static cell tag_for(cell type)
|
||||
{
|
||||
return type < HEADER_TYPE ? type : OBJECT_TYPE;
|
||||
}
|
||||
|
||||
struct object;
|
||||
|
||||
struct header {
|
||||
|
|
@ -334,6 +324,16 @@ struct alien : public object {
|
|||
cell expired;
|
||||
/* untagged */
|
||||
cell displacement;
|
||||
/* untagged */
|
||||
cell address;
|
||||
|
||||
void update_address()
|
||||
{
|
||||
if(base == false_object)
|
||||
address = displacement;
|
||||
else
|
||||
address = UNTAG(base) + sizeof(byte_array) + displacement;
|
||||
}
|
||||
};
|
||||
|
||||
struct dll : public object {
|
||||
|
|
|
|||
|
|
@ -65,11 +65,9 @@ enum special_object {
|
|||
/* Polymorphic inline cache generation in inline_cache.c */
|
||||
PIC_LOAD = 47,
|
||||
PIC_TAG,
|
||||
PIC_HI_TAG,
|
||||
PIC_TUPLE,
|
||||
PIC_HI_TAG_TUPLE,
|
||||
PIC_CHECK_TAG,
|
||||
PIC_CHECK,
|
||||
PIC_CHECK_TUPLE,
|
||||
PIC_HIT,
|
||||
PIC_MISS_WORD,
|
||||
PIC_MISS_TAIL_WORD,
|
||||
|
|
@ -77,7 +75,7 @@ enum special_object {
|
|||
/* Megamorphic cache generation in dispatch.c */
|
||||
MEGA_LOOKUP = 57,
|
||||
MEGA_LOOKUP_WORD,
|
||||
MEGA_MISS_WORD,
|
||||
MEGA_MISS_WORD,
|
||||
|
||||
OBJ_UNDEFINED = 60, /* default quotation for undefined words */
|
||||
|
||||
|
|
|
|||
|
|
@ -3,12 +3,12 @@ namespace factor
|
|||
|
||||
template<typename Type> cell tag(Type *value)
|
||||
{
|
||||
return RETAG(value,tag_for(Type::type_number));
|
||||
return RETAG(value,Type::type_number);
|
||||
}
|
||||
|
||||
inline static cell tag_dynamic(object *value)
|
||||
{
|
||||
return RETAG(value,tag_for(value->h.hi_tag()));
|
||||
return RETAG(value,value->h.hi_tag());
|
||||
}
|
||||
|
||||
template<typename Type>
|
||||
|
|
@ -17,11 +17,7 @@ struct tagged
|
|||
cell value_;
|
||||
|
||||
cell type() const {
|
||||
cell tag = TAG(value_);
|
||||
if(tag == OBJECT_TYPE)
|
||||
return ((object *)UNTAG(value_))->h.hi_tag();
|
||||
else
|
||||
return tag;
|
||||
return TAG(value_);
|
||||
}
|
||||
|
||||
bool type_p(cell type_) const
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ void to_tenured_collector::tenure_reachable_objects()
|
|||
{
|
||||
object *obj = mark_stack->back();
|
||||
mark_stack->pop_back();
|
||||
this->trace_slots(obj);
|
||||
this->trace_object(obj);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -83,8 +83,8 @@ struct factor_vm
|
|||
cell cold_call_to_ic_transitions;
|
||||
cell ic_to_pic_transitions;
|
||||
cell pic_to_mega_transitions;
|
||||
/* Indexed by PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
|
||||
cell pic_counts[4];
|
||||
/* Indexed by PIC_TAG, PIC_TUPLE */
|
||||
cell pic_counts[2];
|
||||
|
||||
/* Number of entries in a polymorphic inline cache */
|
||||
cell max_pic_size;
|
||||
|
|
@ -619,7 +619,6 @@ struct factor_vm
|
|||
cell nth_superclass(tuple_layout *layout, fixnum echelon);
|
||||
cell nth_hashcode(tuple_layout *layout, fixnum echelon);
|
||||
cell lookup_tuple_method(cell obj, cell methods);
|
||||
cell lookup_hi_tag_method(cell obj, cell methods);
|
||||
cell lookup_method(cell obj, cell methods);
|
||||
void primitive_lookup_method();
|
||||
cell object_class(cell obj);
|
||||
|
|
|
|||
Loading…
Reference in New Issue