File:  [gforth] / gforth / lib.fs
Revision 1.4: download - view: text, annotated - select for diffs
Tue Dec 8 22:02:46 1998 UTC (20 years, 11 months ago) by anton
Branches: MAIN
CVS tags: v0-4-0, HEAD
updated dates in copyright messages
inserted copyright messages in most files that did not have them
removed outdated files engine/32bit.h engine/strsig.c

    1: \ lib.fs	shared library support package 		11may97py
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: Create icall-table
   22:     ] icall0 ;s icall1 ;s icall2 ;s icall3 ;s icall4 ;s icall5 ;s icall6 ;s
   23:       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap
   24:       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  icall20 ;s [
   25: Create fcall-table
   26:     ] fcall0 ;s fcall1 ;s fcall2 ;s fcall3 ;s fcall4 ;s fcall5 ;s fcall6 ;s
   27:       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap
   28:       NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  NIL swap  fcall20 ;s [
   29: 
   30: Variable libs 0 libs !
   31: \G links between libraries
   32: 
   33: : @lib ( lib -- )
   34:     \G obtains library handle
   35:     cell+ dup 2 cells + count open-lib
   36:     dup 0= abort" Library not found" swap ! ;
   37: 
   38: : @proc ( lib addr -- )
   39:     \G obtains symbol address
   40:     cell+ tuck 2 cells + count rot cell+ @
   41:     lib-sym  dup 0= abort" Proc not found!" swap cell+ ! ;
   42: 
   43: : proc, ( pars type lib addr -- )
   44:     \G allocates and initializes proc stub
   45:     \G stub format:
   46:     \G    linked list in library
   47:     \G    address of proc
   48:     \G    offset in lcall1-table to call proc
   49:     \G    OS name of symbol as counted string
   50:     here 2dup swap 2 cells + dup @ A, !
   51:     2swap  1 and  IF  fcall-table  ELSE  icall-table  THEN  swap
   52:     cells 2* + , 0 , bl sword string, @proc ;
   53: 
   54: -1 Constant (addr)
   55:  0 Constant (int)
   56:  1 Constant (float)
   57:  2 Constant (void)
   58:  4 Constant (int...)
   59:  5 Constant (float...)
   60:  6 Constant (void...)
   61: 
   62: : proc:  ( pars type lib "name" "string" -- )
   63:     \G Creates a named proc stub
   64:     Create proc,
   65: DOES> ( x1 .. xn -- r )
   66:     cell+ 2@ >r ;
   67: 
   68: : vaproc:  ( pars type lib "name" "string" -- )
   69:     \G Creates a named proc stub with variable arguments
   70:     Create proc,
   71: DOES> ( x1 .. xn n -- r )
   72:     cell+ 2@ rot 2* cells + >r ;
   73: 
   74: : (>void)  >r ;
   75: 
   76: : vproc:  ( pars type lib "name" "string" -- )
   77:     \G Creates a named proc stub for void functions
   78:     Create proc,
   79: DOES> ( x1 .. xn -- )
   80:     cell+ 2@ (>void) drop ;
   81: 
   82: : vvaproc:  ( pars type lib "name" "string" -- )
   83:     \G Creates a named proc stub with variable arguments, void return
   84:     Create proc,
   85: DOES> ( x1 .. xn n -- )
   86:     cell+ 2@ rot 2* cells + (>void) drop ;
   87: 
   88: : label: ( type lib "name" "string" -- )
   89:     \G Creates a named label stub
   90:     -1 -rot Create proc,
   91: DOES> ( -- addr )
   92:     [ 2 cells ] Literal + @ ;
   93: 
   94: : library ( "name" "file" -- )
   95:     \G loads library "file" and creates a proc defining word "name"
   96:     \G library format:
   97:     \G    linked list of libraries
   98:     \G    library handle
   99:     \G    linked list of library's procs
  100:     \G    OS name of library as counted string
  101:     Create  here libs @ A, dup libs !
  102:     0 , 0 A, bl sword string, @lib
  103: DOES> ( pars/ type -- )
  104:     over -1 = IF  label:
  105:     ELSE
  106: 	over 4 and IF
  107: 	    over 2 and IF  vvaproc:  ELSE  vaproc:  THEN
  108: 	ELSE
  109: 	    over 2 and IF  vproc:  ELSE  proc:  THEN
  110: 	THEN
  111:     THEN ;
  112: 
  113: : init-shared-libs ( -- )
  114:     defers 'cold  libs
  115:     0  libs  BEGIN  @ dup  WHILE  dup  REPEAT  drop
  116:     BEGIN  dup  WHILE  >r
  117: 	r@ @lib
  118: 	r@ 2 cells +  BEGIN  @ dup  WHILE  r@ over @proc  REPEAT
  119: 	drop rdrop
  120:     REPEAT  drop ;
  121: 
  122: ' init-shared-libs IS 'cold

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