--- gforth/fflib.fs 2005/11/27 23:05:34 1.9 +++ gforth/fflib.fs 2006/12/31 13:39:13 1.15 @@ -1,6 +1,6 @@ \ lib.fs shared library support package 16aug03py -\ Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005,2006 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -63,6 +63,11 @@ Defer legacy-proc ' noop IS legacy-proc DOES> ( x1 .. xn -- r ) dup cell+ @ swap 3 cells + >r ; +Variable ind-call ind-call off +: fptr ( "name" -- ) + Create here thisproc ! 0 , 0 , 0 , 0 also c-decl ind-call on + DOES> 3 cells + >r ; + : library ( "name" "file" -- ) \G loads library "file" and creates a proc defining word "name" \G library format: @@ -112,7 +117,8 @@ DOES> ( -- ) dup thislib ! proc: ; : rettype ( endxt startxt "name" -- ) Create 2, - DOES> decl, symbol, previous revarg off ; + DOES> decl, ind-call @ 0= IF symbol, THEN + previous revarg off ind-call off ; also c-decl definitions @@ -121,17 +127,17 @@ also c-decl definitions ' av-int ' av-int-r ' >r argtype int ' av-float ' av-float-r ' f>l argtype sf ' av-double ' av-double-r ' f>l argtype df -' av-longlong ' av-longlong-r ' 2>r argtype llong +' av-longlong ' av-longlong-r ' 2>r argtype dlong ' av-ptr ' av-ptr-r ' >r argtype ptr ' av-call-void ' av-start-void rettype (void) ' av-call-int ' av-start-int rettype (int) ' av-call-float ' av-start-float rettype (sf) ' av-call-double ' av-start-double rettype (fp) -' av-call-longlong ' av-start-longlong rettype (llong) +' av-call-longlong ' av-start-longlong rettype (dlong) ' av-call-ptr ' av-start-ptr rettype (ptr) -: (addr) postpone EXIT symbol, previous revarg off ; +: (addr) postpone EXIT drop symbol, previous revarg off ; previous definitions @@ -190,14 +196,14 @@ also cb-decl definitions ' va-arg-int Alias int ' va-arg-float Alias sf ' va-arg-double Alias df -' va-arg-longlong Alias llong +' va-arg-longlong Alias dlong ' va-arg-ptr Alias ptr ' va-return-void ' va-start-void va-ret (void) ' va-return-int ' va-start-int va-ret (int) ' va-return-float ' va-start-float va-ret (sf) ' va-return-double ' va-start-double va-ret (fp) -' va-return-longlong ' va-start-longlong va-ret (llong) +' va-return-longlong ' va-start-longlong va-ret (dlong) ' va-return-ptr ' va-start-ptr va-ret (ptr) previous definitions