More compact relocation layout

db4
Slava Pestov 2009-03-19 20:02:43 -05:00
parent 9366ffe83a
commit 7f4c967ace
6 changed files with 22 additions and 26 deletions

View File

@ -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 )
[

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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