version 1.7, 2005/12/11 19:31:48
|
version 1.8, 2005/12/11 20:08:09
|
Line 104 Create argptr maxargs 0 [DO] argbuf [I]
|
Line 104 Create argptr maxargs 0 [DO] argbuf [I]
|
\ "forward" when revarg is on |
\ "forward" when revarg is on |
|
|
\ : >c+ ( char buf -- buf' ) tuck c! cell+ cell+ ; |
\ : >c+ ( char buf -- buf' ) tuck c! cell+ cell+ ; |
: >i+ ( n buf -- buf' ) tuck ! cell+ cell+ ; |
: >i+ ( n buf -- buf' ) tuck l! cell+ cell+ ; |
: >p+ ( addr buf -- buf' ) tuck ! cell+ cell+ ; |
: >p+ ( addr buf -- buf' ) tuck ! cell+ cell+ ; |
: >d+ ( d buf -- buf' ) dup >r ffi-2! r> cell+ cell+ ; |
: >d+ ( d buf -- buf' ) dup >r ffi-2! r> cell+ cell+ ; |
: >sf+ ( r buf -- buf' ) dup sf! cell+ cell+ ; |
: >sf+ ( r buf -- buf' ) dup sf! cell+ cell+ ; |
Line 148 Variable args args off
|
Line 148 Variable args args off
|
revarg @ IF drop 0 ELSE 2* cells THEN argbuf + |
revarg @ IF drop 0 ELSE 2* cells THEN argbuf + |
postpone Literal ; |
postpone Literal ; |
|
|
|
Variable ind-call ind-call off |
|
: ind: ind-call on Create here thisproc ! |
|
0 , 0 , 0 , 0 also c-decl DOES> cell+ dup cell+ cell+ >r ! ; |
|
|
: ffi-call, ( -- lit-cif ) |
: ffi-call, ( -- lit-cif ) |
postpone drop postpone argptr postpone retbuf |
postpone drop postpone argptr postpone retbuf |
thisproc @ cell+ postpone literal postpone @ |
thisproc @ cell+ postpone literal postpone @ |
Line 187 Variable args args off
|
Line 191 Variable args args off
|
|
|
: rettype ( endxt n "name" -- ) |
: rettype ( endxt n "name" -- ) |
Create 2, |
Create 2, |
DOES> 2@ args @ decl, symbol, previous revarg off args off ; |
DOES> 2@ args @ decl, ind-call @ 0= IF symbol, THEN |
|
previous revarg off args off ind-call off ; |
|
|
also c-decl definitions |
also c-decl definitions |
|
|
Line 238 Variable callbacks
|
Line 243 Variable callbacks
|
|
|
Variable rtype |
Variable rtype |
|
|
: alloc-callback ( -- addr ) |
: alloc-callback ( ip -- addr ) |
rtype @ create-cif |
rtype @ make-cif here 1 ffi-size allot |
cif@ 1- tuck + c@ ffi-type here dup >r 1 ffi-size allot |
dup >r ffi-prep-closure throw r> ; |
ffi-prep-closure throw r> ; |
|
|
|
: callback ( -- ) |
: callback ( -- ) |
Create 0 ] postpone >r also cb-decl cifreset |
Create 0 ] postpone >r also cb-decl cifreset |
DOES> |
DOES> |
Create here >r 0 , callbacks @ A, r@ callbacks ! |
0 Value -1 cells allot |
|
here >r 0 , callbacks @ A, r@ callbacks ! |
swap postpone Literal postpone call , postpone EXIT |
swap postpone Literal postpone call , postpone EXIT |
r> dup cell+ cell+ alloc-callback swap ! |
r@ cell+ cell+ alloc-callback r> ! ; |
DOES> @ ; |
|
|
|
: callback; ( 0 arg1 .. argn -- ) |
: callback; ( 0 arg1 .. argn -- ) |
BEGIN over WHILE compile, REPEAT |
BEGIN over WHILE compile, REPEAT |