gforth/libffi.fs - diff

Return to libffi.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/libffi.fs between versions 1.6 and 1.9

version 1.6, 2005/12/04 13:46:12	version 1.9, 2005/12/11 20:10:01
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 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 t! ;	: >i- ( n buf -- buf' ) 2 cells - tuck l! ;
: >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 t@ ;	: i>x ( -- n ) retbuf l@ ;
: is>x ( -- n ) retbuf tx@ ;	: is>x ( -- n ) retbuf sl@ ;
: 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 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
	: fptr: 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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.6
changed lines
	Added in v.1.9