x86 fixes, and fix alien-indirect for c-type-prep stuff
parent
a38da64d75
commit
df3c693da1
|
|
@ -22,9 +22,10 @@ M: alien-indirect-error summary
|
||||||
empty-node <alien-indirect>
|
empty-node <alien-indirect>
|
||||||
pop-literal nip over set-alien-indirect-abi
|
pop-literal nip over set-alien-indirect-abi
|
||||||
pop-literal nip over set-alien-indirect-parameters
|
pop-literal nip over set-alien-indirect-parameters
|
||||||
pop-literal nip swap set-alien-indirect-return
|
pop-literal nip over set-alien-indirect-return
|
||||||
dup alien-indirect-parameters prep-alien-parameters
|
dup alien-indirect-parameters
|
||||||
dup node,
|
make-prep-quot 1 make-dip infer-quot
|
||||||
|
node,
|
||||||
] "infer" set-word-prop
|
] "infer" set-word-prop
|
||||||
|
|
||||||
: generate-indirect-cleanup ( node -- )
|
: generate-indirect-cleanup ( node -- )
|
||||||
|
|
|
||||||
|
|
@ -37,7 +37,7 @@ M: alien-invoke-error summary
|
||||||
pop-literal nip over set-alien-invoke-function
|
pop-literal nip over set-alien-invoke-function
|
||||||
pop-literal nip over set-alien-invoke-library
|
pop-literal nip over set-alien-invoke-library
|
||||||
pop-literal nip over set-alien-invoke-return
|
pop-literal nip over set-alien-invoke-return
|
||||||
dup alien-invoke-parameters prep-alien-parameters
|
dup alien-invoke-parameters make-prep-quot infer-quot
|
||||||
dup ensure-dlsym
|
dup ensure-dlsym
|
||||||
dup node,
|
dup node,
|
||||||
alien-invoke-stack
|
alien-invoke-stack
|
||||||
|
|
|
||||||
|
|
@ -59,13 +59,13 @@ inference ;
|
||||||
: if-void ( type true false -- )
|
: if-void ( type true false -- )
|
||||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||||
|
|
||||||
: make-prep-quot ( parameters -- )
|
: (make-prep-quot) ( parameters -- )
|
||||||
dup empty? [
|
dup empty? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
unclip c-type c-type-prep %
|
unclip c-type c-type-prep %
|
||||||
\ >r , make-prep-quot \ r> ,
|
\ >r , (make-prep-quot) \ r> ,
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: prep-alien-parameters ( parameters -- quot )
|
: make-prep-quot ( parameters -- quot )
|
||||||
[ <reversed> make-prep-quot ] [ ] make infer-quot ;
|
[ <reversed> (make-prep-quot) ] [ ] make ;
|
||||||
|
|
|
||||||
|
|
@ -9,10 +9,10 @@ M: float-regs (%peek)
|
||||||
fp-scratch swap %move-int>int
|
fp-scratch swap %move-int>int
|
||||||
fp-scratch %move-int>float ;
|
fp-scratch %move-int>float ;
|
||||||
|
|
||||||
: load-zone-ptr ( vreg -- )
|
: load-zone-ptr ( reg -- )
|
||||||
#! Load pointer to start of zone array
|
#! Load pointer to start of zone array
|
||||||
dup "generations" f [ dlsym MOV ] 2keep
|
0 MOV
|
||||||
rel-absolute-cell rel-dlsym
|
dup "generations" f rel-absolute-cell rel-dlsym
|
||||||
dup [] MOV ;
|
dup [] MOV ;
|
||||||
|
|
||||||
: load-allot-ptr ( vreg -- )
|
: load-allot-ptr ( vreg -- )
|
||||||
|
|
|
||||||
|
|
@ -265,8 +265,8 @@ IN: compiler
|
||||||
|
|
||||||
! User environment
|
! User environment
|
||||||
: %userenv ( -- )
|
: %userenv ( -- )
|
||||||
"x" operand "userenv" f [ dlsym MOV ] 2keep
|
"x" operand 0 MOV
|
||||||
rel-absolute-cell rel-dlsym
|
"userenv" f rel-absolute-cell rel-dlsym
|
||||||
"n" operand fixnum>slot@
|
"n" operand fixnum>slot@
|
||||||
"n" operand "x" operand ADD ;
|
"n" operand "x" operand ADD ;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue