Removed %parameters VOP
parent
592c684f6b
commit
78f63c0890
|
@ -36,10 +36,8 @@ M: alien-callback-error summary ( error -- )
|
|||
[ box-parameter ] map-parameters % ;
|
||||
|
||||
: registers>objects ( parameters -- )
|
||||
dup stack-space %parameters ,
|
||||
dup \ %freg>stack move-parameters %
|
||||
"nest_stacks" f %alien-invoke ,
|
||||
box-parameters ;
|
||||
"nest_stacks" f %alien-invoke , box-parameters ;
|
||||
|
||||
: unbox-return ( node -- )
|
||||
alien-callback-return [
|
||||
|
@ -54,6 +52,7 @@ M: alien-callback-error summary ( error -- )
|
|||
|
||||
: linearize-callback ( node -- )
|
||||
dup alien-callback-xt [
|
||||
dup stack-reserve* %prologue ,
|
||||
dup alien-callback-parameters registers>objects
|
||||
dup alien-callback-quot \ init-error-handler swons
|
||||
%alien-callback ,
|
||||
|
@ -63,3 +62,6 @@ M: alien-callback-error summary ( error -- )
|
|||
|
||||
M: alien-callback linearize* ( node -- )
|
||||
compile-gc linearize-callback iterate-next ;
|
||||
|
||||
M: alien-callback stack-reserve*
|
||||
alien-callback-parameters stack-space ;
|
||||
|
|
|
@ -54,9 +54,7 @@ M: alien-invoke-error summary ( error -- )
|
|||
#! code for moving these parameters to register on
|
||||
#! architectures where parameters are passed in registers
|
||||
#! (PowerPC, AMD64).
|
||||
dup stack-space %parameters ,
|
||||
dup unbox-parameters
|
||||
"save_stacks" f %alien-invoke ,
|
||||
dup unbox-parameters "save_stacks" f %alien-invoke ,
|
||||
\ %stack>freg move-parameters % ;
|
||||
|
||||
: box-return ( node -- )
|
||||
|
@ -76,6 +74,9 @@ M: alien-invoke linearize* ( node -- )
|
|||
dup linearize-cleanup box-return
|
||||
iterate-next ;
|
||||
|
||||
M: alien-invoke stack-reserve*
|
||||
alien-invoke-parameters stack-space ;
|
||||
|
||||
: parse-arglist ( return seq -- types stack-effect )
|
||||
unpair [
|
||||
" " % [ "," ?tail drop ] map " " join % " -- " % swap %
|
||||
|
|
|
@ -4,4 +4,6 @@ IN: compiler-backend
|
|||
USING: assembler kernel math namespaces ;
|
||||
|
||||
M: %prologue generate-node ( vop -- )
|
||||
drop RSP stack-increment SUB ;
|
||||
drop
|
||||
0 input \ stack-reserve set
|
||||
RSP stack-increment SUB ;
|
||||
|
|
|
@ -8,12 +8,6 @@ vectors words ;
|
|||
! Compile a VOP.
|
||||
GENERIC: generate-node ( vop -- )
|
||||
|
||||
: set-stack-reserve ( linear -- )
|
||||
#! The %prologue node contains the maximum stack reserve of
|
||||
#! all VOPs. The precise meaning of stack reserve is
|
||||
#! platform-specific.
|
||||
0 [ stack-reserve max ] reduce \ stack-reserve set ;
|
||||
|
||||
: generate-code ( word linear -- length )
|
||||
compiled-offset >r
|
||||
compile-aligned
|
||||
|
@ -30,7 +24,6 @@ GENERIC: generate-node ( vop -- )
|
|||
: (generate) ( word linear -- )
|
||||
#! Compile a word definition from linear IR.
|
||||
V{ } clone relocation-table set
|
||||
dup set-stack-reserve
|
||||
begin-assembly swap >r >r
|
||||
generate-code
|
||||
generate-reloc
|
||||
|
@ -57,8 +50,6 @@ M: %label generate-node ( vop -- )
|
|||
M: %target-label generate-node ( vop -- )
|
||||
drop label 0 assemble-cell absolute-cell ;
|
||||
|
||||
M: %parameters generate-node ( vop -- ) drop ;
|
||||
|
||||
M: %cleanup generate-node ( vop -- ) drop ;
|
||||
|
||||
M: %freg>stack generate-node ( vop -- ) drop ;
|
||||
|
|
|
@ -1,9 +1,20 @@
|
|||
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays compiler-backend hashtables inference kernel
|
||||
namespaces sequences words ;
|
||||
USING: arrays compiler-backend generic hashtables inference
|
||||
kernel math namespaces sequences words ;
|
||||
IN: compiler-frontend
|
||||
|
||||
! On PowerPC and AMD64, we use a stack discipline whereby
|
||||
! stack frames are used to hold parameters. We need to compute
|
||||
! the stack frame size to compile the prologue on entry to a
|
||||
! word.
|
||||
GENERIC: stack-reserve*
|
||||
|
||||
M: object stack-reserve* drop 0 ;
|
||||
|
||||
: stack-reserve ( node -- )
|
||||
0 swap [ stack-reserve* max ] each-node ;
|
||||
|
||||
DEFER: #terminal?
|
||||
|
||||
PREDICATE: #merge #terminal-merge node-successor #terminal? ;
|
||||
|
@ -27,12 +38,13 @@ SYMBOL: renamed-labels
|
|||
|
||||
: make-linear ( word quot -- )
|
||||
[
|
||||
swap >r [ %prologue , call ] { } make r>
|
||||
linearized get set-hash
|
||||
swap >r { } make r> linearized get set-hash
|
||||
] with-node-iterator ; inline
|
||||
|
||||
: linearize-1 ( word node -- )
|
||||
swap [ linearize-child ] make-linear ;
|
||||
swap [
|
||||
dup stack-reserve %prologue , linearize-child
|
||||
] make-linear ;
|
||||
|
||||
: init-linearizer ( -- )
|
||||
H{ } clone linearized set
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
! Copyright (C) 2005, 200 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler-backend
|
||||
USING: alien assembler compiler inference kernel
|
||||
kernel-internals lists math memory namespaces words ;
|
||||
USING: alien assembler compiler compiler-frontend inference
|
||||
kernel kernel-internals lists math memory namespaces words ;
|
||||
|
||||
: compile-dlsym ( symbol dll register -- )
|
||||
>r 2dup dlsym r> LOAD32 rel-2/2 rel-dlsym ;
|
||||
|
@ -14,6 +14,7 @@ kernel-internals lists math memory namespaces words ;
|
|||
|
||||
M: %prologue generate-node ( vop -- )
|
||||
drop
|
||||
0 input \ stack-reserve set
|
||||
1 1 stack-increment neg STWU
|
||||
0 MFLR
|
||||
0 1 stack-increment lr@ STW ;
|
||||
|
|
|
@ -80,9 +80,7 @@ TUPLE: vop inputs outputs label ;
|
|||
\ scratch get nth ;
|
||||
|
||||
: with-vop ( vop quot -- )
|
||||
[
|
||||
swap vop set (scratch) \ scratch set call
|
||||
] with-scope ; inline
|
||||
swap vop set (scratch) \ scratch set call ; inline
|
||||
|
||||
: input ( n -- obj ) vop get vop-inputs nth ;
|
||||
: input-operand ( n -- n ) input v>operand ;
|
||||
|
@ -96,12 +94,6 @@ M: vop basic-block? drop f ;
|
|||
! simplifies some code
|
||||
M: f basic-block? drop f ;
|
||||
|
||||
! Only on PowerPC. The %parameters node needs to reserve space
|
||||
! in the stack frame.
|
||||
GENERIC: stack-reserve
|
||||
|
||||
M: vop stack-reserve drop 0 ;
|
||||
|
||||
: make-vop ( inputs outputs label vop -- vop )
|
||||
[ >r <vop> r> set-delegate ] keep ;
|
||||
|
||||
|
@ -120,7 +112,7 @@ M: vop stack-reserve drop 0 ;
|
|||
! miscellanea
|
||||
TUPLE: %prologue ;
|
||||
C: %prologue make-vop ;
|
||||
: %prologue empty-vop <%prologue> ;
|
||||
: %prologue src-vop <%prologue> ;
|
||||
|
||||
TUPLE: %label ;
|
||||
C: %label make-vop ;
|
||||
|
@ -358,12 +350,6 @@ TUPLE: %setenv ;
|
|||
C: %setenv make-vop ;
|
||||
: %setenv 2-in-vop <%setenv> ;
|
||||
|
||||
! alien operations
|
||||
TUPLE: %parameters ;
|
||||
C: %parameters make-vop ;
|
||||
M: %parameters stack-reserve vop-inputs first ;
|
||||
: %parameters ( n -- vop ) src-vop <%parameters> ;
|
||||
|
||||
TUPLE: %stack>freg ;
|
||||
C: %stack>freg make-vop ;
|
||||
: %stack>freg ( n reg reg-class -- vop ) 3-in-vop <%stack>freg> ;
|
||||
|
|
Loading…
Reference in New Issue