version 1.3, 2005/11/27 22:47:18
|
version 1.6, 2005/12/04 13:46:12
|
Line 112 Create argptr maxargs 0 [DO] argbuf [I]
|
Line 112 Create argptr maxargs 0 [DO] argbuf [I]
|
|
|
\ "backward" when revarg is off |
\ "backward" when revarg is off |
|
|
: >i- ( n buf -- buf' ) 2 cells - tuck ffi-i! ; |
: >i- ( n buf -- buf' ) 2 cells - tuck t! ; |
: >p- ( addr buf -- buf' ) 2 cells - tuck ! ; |
: >p- ( addr buf -- buf' ) 2 cells - tuck ! ; |
: >d- ( d buf -- buf' ) 2 cells - dup >r ffi-2! r> ; |
: >d- ( d buf -- buf' ) 2 cells - dup >r ffi-2! r> ; |
: >sf- ( r buf -- buf' ) 2 cells - dup sf! ; |
: >sf- ( r buf -- buf' ) 2 cells - dup sf! ; |
Line 120 Create argptr maxargs 0 [DO] argbuf [I]
|
Line 120 Create argptr maxargs 0 [DO] argbuf [I]
|
|
|
\ return value |
\ return value |
|
|
: i>x ( -- n ) retbuf ffi-i@ ; |
: 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@ ; |
Line 159 Variable args args off
|
Line 160 Variable args args off
|
: 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 |
Line 197 also c-decl definitions
|
Line 200 also c-decl definitions
|
' >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) |
' df>x &10 rettype (fp) |
' df>x &10 rettype (fp) |
|
|
: (addr) thisproc @ cell+ postpone Literal postpone @ postpone EXIT |
: (addr) thisproc @ cell+ postpone Literal postpone @ postpone EXIT |
symbol, previous revarg off args off ; |
drop symbol, previous revarg off args off ; |
|
|
previous definitions |
previous definitions |
|
|
Line 235 Variable callbacks
|
Line 239 Variable callbacks
|
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 ( -- ) |