\ lib.fs shared library support package 11may97py \ Copyright (C) 1995-1997 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 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, \ but WITHOUT ANY WARRANTY; without even the implied warranty of \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the \ 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., 675 Mass Ave, Cambridge, MA 02139, USA. Create icall-table ] icall0 ;s icall1 ;s icall2 ;s icall3 ;s icall4 ;s icall5 ;s icall6 ;s 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 icall20 ;s [ Create fcall-table ] fcall0 ;s fcall1 ;s fcall2 ;s fcall3 ;s fcall4 ;s fcall5 ;s fcall6 ;s 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