Diff for /gforth/lib.fs between versions 1.6 and 1.7

version 1.6, 2003/03/09 15:16:50 version 1.7, 2003/08/15 21:45:46
Line 18 Line 18
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
 Create icall-table  [IFDEF] av-call-int
     ] icall0 ;s icall1 ;s icall2 ;s icall3 ;s icall4 ;s icall5 ;s icall6 ;s      include fflib.fs
       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap      legacy on
       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  icall20 ;s [  [ELSE]
 Create fcall-table      include oldlib.fs
     ] fcall0 ;s fcall1 ;s fcall2 ;s fcall3 ;s fcall4 ;s fcall5 ;s fcall6 ;s  [THEN]
       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  
       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  fcall20 ;s [  
   
 Variable libs 0 libs !  
 \G links between libraries  
   
 : @lib ( lib -- )  
     \G obtains library handle  
     cell+ dup 2 cells + count open-lib  
     dup 0= abort" Library not found" swap ! ;  
   
 : @proc ( lib addr -- )  
     \G obtains symbol address  
     cell+ tuck 2 cells + count rot cell+ @  
     lib-sym  dup 0= abort" Proc not found!" swap cell+ ! ;  
   
 : proc, ( pars type lib addr -- )  
     \G allocates and initializes proc stub  
     \G stub format:  
     \G    linked list in library  
     \G    address of proc  
     \G    offset in lcall1-table to call proc  
     \G    OS name of symbol as counted string  
     here 2dup swap 2 cells + dup @ A, !  
     2swap  1 and  IF  fcall-table  ELSE  icall-table  THEN  swap  
     cells 2* + , 0 , bl sword string, @proc ;  
   
 -1 Constant (addr)  
  0 Constant (int)  
  1 Constant (float)  
  2 Constant (void)  
  4 Constant (int...)  
  5 Constant (float...)  
  6 Constant (void...)  
   
 : proc:  ( pars type lib "name" "string" -- )  
     \G Creates a named proc stub  
     Create proc,  
 DOES> ( x1 .. xn -- r )  
     cell+ 2@ >r ;  
   
 : vaproc:  ( pars type lib "name" "string" -- )  
     \G Creates a named proc stub with variable arguments  
     Create proc,  
 DOES> ( x1 .. xn n -- r )  
     cell+ 2@ rot 2* cells + >r ;  
   
 : (>void)  >r ;  
   
 : vproc:  ( pars type lib "name" "string" -- )  
     \G Creates a named proc stub for void functions  
     Create proc,  
 DOES> ( x1 .. xn -- )  
     cell+ 2@ (>void) drop ;  
   
 : vvaproc:  ( pars type lib "name" "string" -- )  
     \G Creates a named proc stub with variable arguments, void return  
     Create proc,  
 DOES> ( x1 .. xn n -- )  
     cell+ 2@ rot 2* cells + (>void) drop ;  
   
 : label: ( type lib "name" "string" -- )  
     \G Creates a named label stub  
     -1 -rot Create proc,  
 DOES> ( -- addr )  
     [ 2 cells ] Literal + @ ;  
   
 : library ( "name" "file" -- )  
     \G loads library "file" and creates a proc defining word "name"  
     \G library format:  
     \G    linked list of libraries  
     \G    library handle  
     \G    linked list of library's procs  
     \G    OS name of library as counted string  
     Create  here libs @ A, dup libs !  
     0 , 0 A, bl sword string, @lib  
 DOES> ( pars/ type -- )  
     over -1 = IF  label:  
     ELSE  
         over 4 and IF  
             over 2 and IF  vvaproc:  ELSE  vaproc:  THEN  
         ELSE  
             over 2 and IF  vproc:  ELSE  proc:  THEN  
         THEN  
     THEN ;  
   
 : init-shared-libs ( -- )  
     defers 'cold  libs  
     0  libs  BEGIN  @ dup  WHILE  dup  REPEAT  drop  
     BEGIN  dup  WHILE  >r  
         r@ @lib  
         r@ 2 cells +  BEGIN  @ dup  WHILE  r@ over @proc  REPEAT  
         drop rdrop  
     REPEAT  drop ;  
   
 ' init-shared-libs IS 'cold  

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


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