further PowerPC fixes
parent
df2f809fd3
commit
01e7a2a820
|
@ -134,14 +134,6 @@ sequences words ;
|
||||||
1 %dec-d ,
|
1 %dec-d ,
|
||||||
] "intrinsic" set-word-prop
|
] "intrinsic" set-word-prop
|
||||||
|
|
||||||
GENERIC: load-value ( vreg n value -- )
|
|
||||||
|
|
||||||
M: computed load-value ( vreg n value -- )
|
|
||||||
drop %peek-d , ;
|
|
||||||
|
|
||||||
M: literal load-value ( vreg n value -- )
|
|
||||||
nip literal-value %immediate , ;
|
|
||||||
|
|
||||||
: value/vreg-list ( in -- list )
|
: value/vreg-list ( in -- list )
|
||||||
[ 0 swap length 1 - ] keep
|
[ 0 swap length 1 - ] keep
|
||||||
[ >r 2dup r> 3list >r 1 - >r 1 + r> r> ] map 2nip ;
|
[ >r 2dup r> 3list >r 1 - >r 1 + r> r> ] map 2nip ;
|
||||||
|
|
|
@ -42,10 +42,17 @@ M: #call-label linearize-node* ( node -- )
|
||||||
#! by GC, and is indexed through a table.
|
#! by GC, and is indexed through a table.
|
||||||
dup fixnum? swap f eq? or ;
|
dup fixnum? swap f eq? or ;
|
||||||
|
|
||||||
: push-1 ( obj -- )
|
GENERIC: load-value ( vreg n value -- )
|
||||||
0 swap literal-value dup
|
|
||||||
|
M: computed load-value ( vreg n value -- )
|
||||||
|
drop %peek-d , ;
|
||||||
|
|
||||||
|
M: literal load-value ( vreg n value -- )
|
||||||
|
nip literal-value dup
|
||||||
immediate? [ %immediate ] [ %indirect ] ifte , ;
|
immediate? [ %immediate ] [ %indirect ] ifte , ;
|
||||||
|
|
||||||
|
: push-1 ( value -- ) >r 0 0 r> load-value ;
|
||||||
|
|
||||||
M: #push linearize-node* ( node -- )
|
M: #push linearize-node* ( node -- )
|
||||||
node-out-d dup length dup %inc-d ,
|
node-out-d dup length dup %inc-d ,
|
||||||
1 - swap [ push-1 0 over %replace-d , ] each drop ;
|
1 - swap [ push-1 0 over %replace-d , ] each drop ;
|
||||||
|
|
|
@ -115,7 +115,8 @@ C: absolute-16/16 ( word -- )
|
||||||
|
|
||||||
M: absolute-16/16 fixup ( absolute -- ) >absolute fixup-16/16 ;
|
M: absolute-16/16 fixup ( absolute -- ) >absolute fixup-16/16 ;
|
||||||
|
|
||||||
: absolute-16/16 ( word -- ) <absolute-16/16> deferred-xt ;
|
: absolute-16/16 ( word -- )
|
||||||
|
<absolute-16/16> deferred-xt 0 1 rel-address ;
|
||||||
|
|
||||||
: compiling? ( word -- ? )
|
: compiling? ( word -- ? )
|
||||||
#! A word that is compiling or already compiled will not be
|
#! A word that is compiling or already compiled will not be
|
||||||
|
|
|
@ -199,7 +199,7 @@ M: tuple clone ( tuple -- tuple )
|
||||||
M: tuple hashcode ( vec -- n )
|
M: tuple hashcode ( vec -- n )
|
||||||
#! If the capacity is two, then all we have is the class
|
#! If the capacity is two, then all we have is the class
|
||||||
#! slot and delegate.
|
#! slot and delegate.
|
||||||
dup length 2 number= [
|
dup array-capacity 2 number= [
|
||||||
drop 0
|
drop 0
|
||||||
] [
|
] [
|
||||||
2 swap array-nth hashcode
|
2 swap array-nth hashcode
|
||||||
|
|
|
@ -34,7 +34,7 @@ NODE: #call
|
||||||
: #call ( word -- node ) param-node <#call> ;
|
: #call ( word -- node ) param-node <#call> ;
|
||||||
|
|
||||||
NODE: #call-label
|
NODE: #call-label
|
||||||
: #call-label ( label -- node ) param-node <#call> ;
|
: #call-label ( label -- node ) param-node <#call-label> ;
|
||||||
|
|
||||||
NODE: #push
|
NODE: #push
|
||||||
: #push ( outputs -- node ) d-tail out-d-node <#push> ;
|
: #push ( outputs -- node ) d-tail out-d-node <#push> ;
|
||||||
|
|
|
@ -9,9 +9,7 @@ void init_ffi(void)
|
||||||
|
|
||||||
void ffi_dlopen(DLL *dll)
|
void ffi_dlopen(DLL *dll)
|
||||||
{
|
{
|
||||||
void *dllptr;
|
void *dllptr = dlopen(to_c_string(untag_string(dll->path)), RTLD_LAZY);
|
||||||
|
|
||||||
dllptr = dlopen(to_c_string(untag_string(dll->path)), RTLD_LAZY);
|
|
||||||
|
|
||||||
if(dllptr == NULL)
|
if(dllptr == NULL)
|
||||||
{
|
{
|
||||||
|
@ -37,7 +35,7 @@ void *ffi_dlsym(DLL *dll, F_STRING *symbol)
|
||||||
|
|
||||||
void ffi_dlclose(DLL *dll)
|
void ffi_dlclose(DLL *dll)
|
||||||
{
|
{
|
||||||
if(dlclose(dll->dll) == -1)
|
if(dlclose(dll->dll) != NULL)
|
||||||
{
|
{
|
||||||
general_error(ERROR_FFI,tag_object(
|
general_error(ERROR_FFI,tag_object(
|
||||||
from_c_string(dlerror())));
|
from_c_string(dlerror())));
|
||||||
|
|
|
@ -58,7 +58,7 @@ void primitive_cwd(void)
|
||||||
{
|
{
|
||||||
char wd[MAXPATHLEN];
|
char wd[MAXPATHLEN];
|
||||||
maybe_garbage_collection();
|
maybe_garbage_collection();
|
||||||
if(getcwd(wd,MAXPATHLEN) < 0)
|
if(getcwd(wd,MAXPATHLEN) == NULL)
|
||||||
io_error();
|
io_error();
|
||||||
box_c_string(wd);
|
box_c_string(wd);
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue