--- gforth/libffi.fs 2005/12/11 20:10:01 1.9 +++ gforth/libffi.fs 2007/12/31 18:40:24 1.14 @@ -1,12 +1,12 @@ \ libffi.fs shared library support package 14aug05py -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005,2006 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ common stuff, same as fflib.fs @@ -107,6 +106,7 @@ Create argptr maxargs 0 [DO] argbuf [I] : >i+ ( n buf -- buf' ) tuck l! cell+ cell+ ; : >p+ ( addr buf -- buf' ) tuck ! cell+ cell+ ; : >d+ ( d buf -- buf' ) dup >r ffi-2! r> cell+ cell+ ; +: >dl+ ( d buf -- buf' ) nip dup >r ! r> cell+ cell+ ; : >sf+ ( r buf -- buf' ) dup sf! cell+ cell+ ; : >df+ ( r buf -- buf' ) dup df! cell+ cell+ ; @@ -115,6 +115,7 @@ Create argptr maxargs 0 [DO] argbuf [I] : >i- ( n buf -- buf' ) 2 cells - tuck l! ; : >p- ( addr buf -- buf' ) 2 cells - tuck ! ; : >d- ( d buf -- buf' ) 2 cells - dup >r ffi-2! r> ; +: >dl- ( d buf -- buf' ) 2 cells - nip dup >r ! r> ; : >sf- ( r buf -- buf' ) 2 cells - dup sf! ; : >df- ( r buf -- buf' ) 2 cells - dup df! ; @@ -123,6 +124,7 @@ Create argptr maxargs 0 [DO] argbuf [I] : i>x ( -- n ) retbuf l@ ; : is>x ( -- n ) retbuf sl@ ; : p>x ( -- addr ) retbuf @ ; +: dl>x ( -- d ) retbuf @ s>d ; : d>x ( -- d ) retbuf ffi-2@ ; : sf>x ( -- r ) retbuf sf@ ; : df>x ( -- r ) retbuf df@ ; @@ -149,7 +151,7 @@ Variable args args off postpone Literal ; Variable ind-call ind-call off -: fptr: ind-call on Create here thisproc ! +: fptr ind-call on Create here thisproc ! 0 , 0 , 0 , 0 also c-decl DOES> cell+ dup cell+ cell+ >r ! ; : ffi-call, ( -- lit-cif ) @@ -194,21 +196,27 @@ Variable ind-call ind-call off DOES> 2@ args @ decl, ind-call @ 0= IF symbol, THEN previous revarg off args off ind-call off ; +6 1 cells 4 > 2* - Constant _long + also c-decl definitions : revarg on ; ' >i+ ' >i- 6 argtype int +' >p+ ' >p- _long argtype long ' >p+ ' >p- &12 argtype ptr ' >d+ ' >d- 8 argtype llong +' >dl+ ' >dl- 6 argtype dlong ' >sf+ ' >sf- 9 argtype sf ' >df+ ' >df- &10 argtype df ' noop 0 rettype (void) ' is>x 6 rettype (int) -' i>x 6 rettype (uint) +' i>x 5 rettype (uint) +' p>x _long rettype (long) ' p>x &12 rettype (ptr) ' d>x 8 rettype (llong) +' dl>x 6 rettype (dlong) ' sf>x 9 rettype (sf) ' df>x &10 rettype (fp) @@ -281,7 +289,9 @@ also cb-decl definitions ' ffi-arg-int 6 argtype' int ' ffi-arg-float 9 argtype' sf ' ffi-arg-double &10 argtype' df +' ffi-arg-long _long argtype' long ' ffi-arg-longlong 8 argtype' llong +' ffi-arg-dlong 6 argtype' dlong ' ffi-arg-ptr &12 argtype' ptr ' ffi-ret-void 0 rettype' (void) @@ -289,6 +299,8 @@ also cb-decl definitions ' ffi-ret-float 9 rettype' (sf) ' ffi-ret-double &10 rettype' (fp) ' ffi-ret-longlong 8 rettype' (llong) +' ffi-ret-long _long rettype' (long) +' ffi-ret-dlong _long rettype' (dlong) ' ffi-ret-ptr &12 rettype' (ptr) previous definitions