x86 fixes, and fix alien-indirect for c-type-prep stuff

slava 2006-11-04 00:47:24 +00:00
parent a38da64d75
commit df3c693da1
5 changed files with 14 additions and 13 deletions

View File

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

View File

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

View File

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

View File

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

View File

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