More compact relocation layout
Slava Pestov
parent
9366ffe83a
commit
7f4c967ace
|
|
@ -53,7 +53,7 @@ SYMBOL: labels
|
|||
V{ } clone literal-table set
|
||||
V{ } clone calls set
|
||||
compiling-word set
|
||||
compiled-stack-traces? compiling-word get f ? add-literal drop ;
|
||||
compiled-stack-traces? compiling-word get f ? add-literal ;
|
||||
|
||||
: generate ( mr -- asm )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays byte-arrays byte-vectors generic assocs hashtables
|
||||
io.binary kernel kernel.private math namespaces make sequences
|
||||
|
|
@ -28,51 +28,47 @@ M: label-fixup fixup*
|
|||
[ label>> ] [ class>> ] bi compiled-offset 4 - rot
|
||||
3array label-table get push ;
|
||||
|
||||
TUPLE: rel-fixup arg class type ;
|
||||
TUPLE: rel-fixup class type ;
|
||||
|
||||
: rel-fixup ( arg class type -- ) \ rel-fixup boa , ;
|
||||
: rel-fixup ( class type -- ) \ rel-fixup boa , ;
|
||||
|
||||
: push-4 ( value vector -- )
|
||||
[ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying>> ] tri
|
||||
swap set-alien-unsigned-4 ;
|
||||
|
||||
M: rel-fixup fixup*
|
||||
[ [ arg>> ] [ class>> ] [ type>> ] tri { 0 8 16 } bitfield ]
|
||||
[ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] bi
|
||||
[ relocation-table get push-4 ] bi@ ;
|
||||
[ type>> ]
|
||||
[ class>> ]
|
||||
[ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] tri
|
||||
{ 0 24 28 } bitfield
|
||||
relocation-table get push-4 ;
|
||||
|
||||
M: integer fixup* , ;
|
||||
|
||||
: indq ( elt seq -- n ) [ eq? ] with find drop ;
|
||||
|
||||
: adjoin* ( obj table -- n )
|
||||
2dup indq [ 2nip ] [ dup length [ push ] dip ] if* ;
|
||||
|
||||
SYMBOL: literal-table
|
||||
|
||||
: add-literal ( obj -- n ) literal-table get adjoin* ;
|
||||
: add-literal ( obj -- ) literal-table get push ;
|
||||
|
||||
: add-dlsym-literals ( symbol dll -- )
|
||||
[ string>symbol ] dip 2array literal-table get push-all ;
|
||||
[ string>symbol add-literal ] [ add-literal ] bi* ;
|
||||
|
||||
: rel-dlsym ( name dll class -- )
|
||||
[ literal-table get length [ add-dlsym-literals ] dip ] dip
|
||||
rt-dlsym rel-fixup ;
|
||||
[ add-dlsym-literals ] dip rt-dlsym rel-fixup ;
|
||||
|
||||
: rel-word ( word class -- )
|
||||
[ add-literal ] dip rt-xt rel-fixup ;
|
||||
|
||||
: rel-primitive ( word class -- )
|
||||
[ def>> first ] dip rt-primitive rel-fixup ;
|
||||
[ def>> first add-literal ] dip rt-primitive rel-fixup ;
|
||||
|
||||
: rel-immediate ( literal class -- )
|
||||
[ add-literal ] dip rt-immediate rel-fixup ;
|
||||
|
||||
: rel-this ( class -- )
|
||||
0 swap rt-label rel-fixup ;
|
||||
rt-this rel-fixup ;
|
||||
|
||||
: rel-here ( offset class -- )
|
||||
rt-here rel-fixup ;
|
||||
[ add-literal ] dip rt-here rel-fixup ;
|
||||
|
||||
: init-fixup ( -- )
|
||||
BV{ } clone relocation-table set
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ CONSTANT: deck-bits 18
|
|||
: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
|
||||
: word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
|
||||
: array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
|
||||
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
|
||||
: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline
|
||||
|
||||
! Relocation classes
|
||||
CONSTANT: rc-absolute-cell 0
|
||||
|
|
@ -42,7 +42,7 @@ CONSTANT: rt-dlsym 1
|
|||
CONSTANT: rt-dispatch 2
|
||||
CONSTANT: rt-xt 3
|
||||
CONSTANT: rt-here 4
|
||||
CONSTANT: rt-label 5
|
||||
CONSTANT: rt-this 5
|
||||
CONSTANT: rt-immediate 6
|
||||
CONSTANT: rt-stack-chain 7
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ big-endian on
|
|||
stack-frame 6 LI
|
||||
6 1 next-save STW
|
||||
0 1 lr-save stack-frame + STW
|
||||
] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
|
||||
] rc-absolute-ppc-2/2 rt-this 1 jit-prolog jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ big-endian off
|
|||
temp0 PUSH
|
||||
! alignment
|
||||
stack-reg stack-frame-size 3 bootstrap-cells - SUB
|
||||
] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
|
||||
] rc-absolute-cell rt-this 1 rex-length + jit-prolog jit-define
|
||||
|
||||
[
|
||||
! load literal
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ words ;
|
|||
|
||||
: indirect-test ( callback -- ) "void" { } "cdecl" alien-indirect ;
|
||||
|
||||
: foobar ;
|
||||
: foobar ( -- ) ;
|
||||
|
||||
[
|
||||
[ ] [ callback-test indirect-test ] unit-test
|
||||
|
|
@ -34,9 +34,9 @@ words ;
|
|||
|
||||
[ 1 ] [ \ foobar counter>> ] unit-test
|
||||
|
||||
: fooblah { } [ ] each ;
|
||||
: fooblah ( -- ) { } [ ] like call ;
|
||||
|
||||
: foobaz fooblah fooblah ;
|
||||
: foobaz ( -- ) fooblah fooblah ;
|
||||
|
||||
[ foobaz ] profile
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue