steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

FFI rewrite part 3: eliminate ##push-context-stack and ##pop-context-stack

db4
Slava Pestov 2010-05-10 00:45:07 -04:00
parent acfbea3865
commit 4478c3a51a
7 changed files with 21 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/compiler/cfg/builder/alien/alien.factor
View File

@ -72,13 +72,7 @@ M: reg-class reg-class-full?
: parameter-offsets ( types -- offsets )
0 [ stack-size + ] accumulate nip ;
: each-parameter ( parameters quot -- )
[ [ parameter-offsets ] keep ] dip 2each ; inline
: reverse-each-parameter ( parameters quot -- )
[ [ parameter-offsets ] keep ] dip 2reverse-each ; inline
: prepare-unbox-parameters ( parameters -- offsets types indices )
: prepare-parameters ( parameters -- offsets types indices )
[ length iota <reversed> ] [ parameter-offsets ] [ ] tri ;
GENERIC: unbox-parameter ( src n c-type -- )
@ -95,7 +89,7 @@ M: struct-c-type unbox-parameter
: unbox-parameters ( offset node -- )
parameters>> swap
'[
prepare-unbox-parameters
prepare-parameters
[
[ <ds-loc> ^^peek ] [ _ + ] [ base-type ] tri*
unbox-parameter
@ -234,13 +228,21 @@ M: struct-c-type box-parameter
: box-parameters ( params -- )
alien-parameters
[ base-type box-parameter next-vreg ##push-context-stack ] each-parameter ;
[ length ##inc-d ]
[
prepare-parameters
[
next-vreg next-vreg ##save-context
base-type box-parameter swap <ds-loc> ##replace
] 3each
] bi ;
: registers>objects ( node -- )
! Generate code for boxing input parameters in a callback.
[
dup \ ##save-param-reg move-parameters
##begin-callback
next-vreg next-vreg ##restore-context
box-parameters
] with-param-regs ;
@ -280,7 +282,7 @@ M: #alien-callback emit-node
[ wrap-callback-quot ##alien-callback ]
[
alien-return [ ##end-callback ] [
[ ^^pop-context-stack ] dip
[ D 0 ^^peek ] dip
##end-callback
base-type unbox-return
] if-void

11
basis/compiler/cfg/instructions/instructions.factor
View File

@ -644,10 +644,6 @@ INSN: ##unbox-small-struct
use: src/tagged-rep
literal: c-type ;
INSN: ##pop-context-stack
def: dst/tagged-rep
temp: temp/int-rep ;
INSN: ##prepare-box-struct ;
INSN: ##load-param-reg
@ -665,10 +661,6 @@ use: src/int-rep ;
INSN: ##alien-assembly
literal: quot ;
INSN: ##push-context-stack
use: src/tagged-rep
temp: temp/int-rep ;
INSN: ##save-param-reg
literal: offset reg rep ;
@ -768,6 +760,9 @@ literal: cc ;
INSN: ##save-context
temp: temp1/int-rep temp2/int-rep ;
INSN: ##restore-context
temp: temp1/int-rep temp2/int-rep ;
! GC checks
INSN: ##check-nursery-branch
literal: size cc

3
basis/compiler/codegen/codegen.factor
View File

@ -246,6 +246,7 @@ CODEGEN: ##compare-integer-imm %compare-integer-imm
CODEGEN: ##compare-float-ordered %compare-float-ordered
CODEGEN: ##compare-float-unordered %compare-float-unordered
CODEGEN: ##save-context %save-context
CODEGEN: ##restore-context %restore-context
CODEGEN: ##vm-field %vm-field
CODEGEN: ##set-vm-field %set-vm-field
CODEGEN: ##alien-global %alien-global
@ -283,13 +284,11 @@ CODEGEN: ##unbox %unbox
CODEGEN: ##unbox-long-long %unbox-long-long
CODEGEN: ##unbox-large-struct %unbox-large-struct
CODEGEN: ##unbox-small-struct %unbox-small-struct
CODEGEN: ##pop-context-stack %pop-context-stack
CODEGEN: ##prepare-box-struct %prepare-box-struct
CODEGEN: ##load-param-reg %load-param-reg
CODEGEN: ##alien-invoke %alien-invoke
CODEGEN: ##cleanup %cleanup
CODEGEN: ##alien-indirect %alien-indirect
CODEGEN: ##push-context-stack %push-context-stack
CODEGEN: ##save-param-reg %save-param-reg
CODEGEN: ##begin-callback %begin-callback
CODEGEN: ##alien-callback %alien-callback

18
basis/cpu/architecture/architecture.factor
View File

@ -553,19 +553,8 @@ HOOK: dummy-int-params? cpu ( -- ? )
! If t, all int parameters are shadowed by dummy FP parameters
HOOK: dummy-fp-params? cpu ( -- ? )
! Store a value (to the data stack in the VM's current context)
! The value is passed to a VM to_*() function -- used for
! callback returns
HOOK: %pop-context-stack cpu ( dst temp -- )
! Store a value (to the data stack in the VM's current context)
! The value is returned from a VM from_*() function -- used for
! callback parameters
HOOK: %push-context-stack cpu ( src temp -- )
! Call a function to convert a tagged pointer returned by
! %pop-stack or %pop-context-stack into a value that can be
! passed to a C function, or returned from a callback
! Call a function to convert a tagged pointer into a value that
! can be passed to a C function, or returned from a callback
HOOK: %unbox cpu ( src n rep func -- )
HOOK: %unbox-long-long cpu ( src n func -- )
@ -576,8 +565,7 @@ HOOK: %unbox-large-struct cpu ( src n c-type -- )
! Call a function to convert a value into a tagged pointer,
! possibly allocating a bignum, float, or alien instance,
! which is then pushed on the data stack by %push-stack or
! %push-context-stack
! which is then pushed on the data stack
HOOK: %box cpu ( dst n rep func -- )
HOOK: %box-long-long cpu ( dst n func -- )

10
basis/cpu/x86/32/32.factor
View File

@ -195,12 +195,6 @@ M:: x86.32 %box-small-struct ( dst c-type -- )
"from_small_struct" f %alien-invoke
dst EAX tagged-rep %copy ;
M:: x86.32 %pop-context-stack ( dst temp -- )
temp %context
dst temp "datastack" context-field-offset [+] MOV
dst dst [] MOV
temp "datastack" context-field-offset [+] bootstrap-cell SUB ;
:: call-unbox-func ( src func -- )
EAX src tagged-rep %copy
4 save-vm-ptr
@ -249,10 +243,8 @@ M: x86.32 %begin-callback ( -- )
"begin_callback" f %alien-invoke ;
M: x86.32 %alien-callback ( quot -- )
EAX EDX %restore-context
EAX swap %load-reference
EAX quot-entry-point-offset [+] CALL
EAX EDX %save-context ;
EAX quot-entry-point-offset [+] CALL ;
M: x86.32 %end-callback ( -- )
0 save-vm-ptr

10
basis/cpu/x86/64/64.factor
View File

@ -117,12 +117,6 @@ M: x86.64 %load-param-reg [ swap param@ ] dip %copy ;
call
] with-scope ; inline
M:: x86.64 %pop-context-stack ( dst temp -- )
temp %context
dst temp "datastack" context-field-offset [+] MOV
dst dst [] MOV
temp "datastack" context-field-offset [+] bootstrap-cell SUB ;
M:: x86.64 %unbox ( src n rep func -- )
param-reg-0 src tagged-rep %copy
param-reg-1 %mov-vm-ptr
@ -232,10 +226,8 @@ M: x86.64 %begin-callback ( -- )
"begin_callback" f %alien-invoke ;
M: x86.64 %alien-callback ( quot -- )
param-reg-0 param-reg-1 %restore-context
param-reg-0 swap %load-reference
param-reg-0 quot-entry-point-offset [+] CALL
param-reg-0 param-reg-1 %save-context ;
param-reg-0 quot-entry-point-offset [+] CALL ;
M: x86.64 %end-callback ( -- )
param-reg-0 %mov-vm-ptr

6
basis/cpu/x86/x86.factor
View File

@ -504,12 +504,6 @@ M:: x86 %check-nursery-branch ( label size cc temp1 temp2 -- )
M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
M:: x86 %push-context-stack ( src temp -- )
temp %context
temp "datastack" context-field-offset [+] bootstrap-cell ADD
temp temp "datastack" context-field-offset [+] MOV
temp [] src MOV ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
:: (%boolean) ( dst temp insn -- )