| \ return value |
\ return value |
| |
|
| : i>x ( -- n ) retbuf t@ ; |
: i>x ( -- n ) retbuf t@ ; |
| |
: is>x ( -- n ) retbuf tx@ ; |
| : p>x ( -- addr ) retbuf @ ; |
: p>x ( -- addr ) retbuf @ ; |
| : d>x ( -- d ) retbuf ffi-2@ ; |
: d>x ( -- d ) retbuf ffi-2@ ; |
| : sf>x ( -- r ) retbuf sf@ ; |
: sf>x ( -- r ) retbuf sf@ ; |
| : cif@ ( -- addr u ) |
: cif@ ( -- addr u ) |
| cifbuf cell+ cifbuf @ over - ; |
cifbuf cell+ cifbuf @ over - ; |
| |
|
| : make-cif ( rtype -- addr ) cif, |
: create-cif ( rtype -- addr ) cif, |
| cif@ cifs search-wordlist |
cif@ cifs search-wordlist |
| IF execute EXIT THEN |
IF execute EXIT THEN |
| get-current >r cifs set-current |
get-current >r cifs set-current |
| cif@ nextname Create here >r |
cif@ nextname Create here >r |
| cif@ 1- bounds ?DO I c@ ffi-type , LOOP |
cif@ 1- bounds ?DO I c@ ffi-type , LOOP r> |
| r> cif@ 1- tuck + c@ ffi-type here dup >r 0 ffi-size allot |
r> set-current ; |
| ffi-prep-cif throw |
|
| r> r> set-current ; |
: make-cif ( rtype -- addr ) create-cif |
| |
cif@ 1- tuck + c@ ffi-type here 0 ffi-size allot |
| |
dup >r ffi-prep-cif throw r> ; |
| |
|
| : decl, ( 0 arg1 .. argn call rtype start -- ) |
: decl, ( 0 arg1 .. argn call rtype start -- ) |
| start, { retxt rtype } cifreset |
start, { retxt rtype } cifreset |
| ' >df+ ' >df- &10 argtype df |
' >df+ ' >df- &10 argtype df |
| |
|
| ' noop 0 rettype (void) |
' noop 0 rettype (void) |
| ' i>x 6 rettype (int) |
' is>x 6 rettype (int) |
| |
' i>x 6 rettype (uint) |
| ' p>x &12 rettype (ptr) |
' p>x &12 rettype (ptr) |
| ' d>x 8 rettype (llong) |
' d>x 8 rettype (llong) |
| ' sf>x 9 rettype (sf) |
' sf>x 9 rettype (sf) |
| Variable rtype |
Variable rtype |
| |
|
| : alloc-callback ( -- addr ) |
: alloc-callback ( -- addr ) |
| rtype @ cif, |
rtype @ create-cif |
| here >r |
cif@ 1- tuck + c@ ffi-type here dup >r 1 ffi-size allot |
| cif@ 1- bounds ?DO I c@ ffi-type , LOOP |
|
| r> cif@ 1- tuck + c@ ffi-type here dup >r 1 ffi-size allot |
|
| ffi-prep-closure throw r> ; |
ffi-prep-closure throw r> ; |
| |
|
| : callback ( -- ) |
: callback ( -- ) |