File:  [gforth] / gforth / oldlib.fs
Revision 1.5: download - view: text, annotated - select for diffs
Wed Oct 3 17:03:10 2007 UTC (16 years, 5 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Changed oldlib words

    1: \ lib.fs	shared library support package 		11may97py
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2005 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., 59 Temple Place, Suite 330, Boston, MA 02111, 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: Variable legacy  legacy off
   34: 
   35: : @lib ( lib -- )
   36:     \G obtains library handle
   37:     cell+ dup 2 cells + count open-lib
   38:     dup 0= abort" Library not found" swap ! ;
   39: 
   40: : @proc ( lib addr -- )
   41:     \G obtains symbol address
   42:     cell+ tuck 2 cells + count rot cell+ @
   43:     lib-sym  dup 0= abort" Proc not found!" swap cell+ ! ;
   44: 
   45: -1 Constant <addr>
   46:  0 Constant <int>
   47:  1 Constant <float>
   48:  2 Constant <void>
   49:  4 Constant <int...>
   50:  5 Constant <float...>
   51:  6 Constant <void...>
   52: 
   53: : proc, ( pars type lib addr -- )
   54:     \G allocates and initializes proc stub
   55:     \G stub format:
   56:     \G    linked list in library
   57:     \G    address of proc
   58:     \G    offset in lcall1-table to call proc
   59:     \G    OS name of symbol as counted string
   60:     legacy @ IF  (int) -rot  THEN
   61:     here 2dup swap 2 cells + dup @ A, !
   62:     2swap  1 and  IF  fcall-table  ELSE  icall-table  THEN  swap
   63:     cells 2* + , 0 , bl sword string, @proc ;
   64: 
   65: : proc:  ( pars type lib "name" "string" -- )
   66:     \G Creates a named proc stub
   67:     Create proc,
   68: DOES> ( x1 .. xn -- r )
   69:     cell+ 2@ >r ;
   70: 
   71: : vaproc:  ( pars type lib "name" "string" -- )
   72:     \G Creates a named proc stub with variable arguments
   73:     Create proc,
   74: DOES> ( x1 .. xn n -- r )
   75:     cell+ 2@ rot 2* cells + >r ;
   76: 
   77: : (>void)  >r ;
   78: 
   79: : vproc:  ( pars type lib "name" "string" -- )
   80:     \G Creates a named proc stub for void functions
   81:     Create proc,
   82: DOES> ( x1 .. xn -- )
   83:     cell+ 2@ (>void) drop ;
   84: 
   85: : vvaproc:  ( pars type lib "name" "string" -- )
   86:     \G Creates a named proc stub with variable arguments, void return
   87:     Create proc,
   88: DOES> ( x1 .. xn n -- )
   89:     cell+ 2@ rot 2* cells + (>void) drop ;
   90: 
   91: : label: ( type lib "name" "string" -- )
   92:     \G Creates a named label stub
   93:     -1 -rot Create proc,
   94: DOES> ( -- addr )
   95:     [ 2 cells ] Literal + @ ;
   96: 
   97: : library ( "name" "file" -- )
   98:     \G loads library "file" and creates a proc defining word "name"
   99:     \G library format:
  100:     \G    linked list of libraries
  101:     \G    library handle
  102:     \G    linked list of library's procs
  103:     \G    OS name of library as counted string
  104:     Create  here libs @ A, dup libs !
  105:     0 , 0 A, bl sword string, @lib
  106: DOES> ( pars/ type -- )
  107:     over -1 = IF  label:
  108:     ELSE
  109: 	over 4 and IF
  110: 	    over 2 and IF  vvaproc:  ELSE  vaproc:  THEN
  111: 	ELSE
  112: 	    over 2 and IF  vproc:  ELSE  proc:  THEN
  113: 	THEN
  114:     THEN ;
  115: 
  116: : init-shared-libs ( -- )
  117:     defers 'cold  libs
  118:     0  libs  BEGIN  @ dup  WHILE  dup  REPEAT  drop
  119:     BEGIN  dup  WHILE  >r
  120: 	r@ @lib
  121: 	r@ 2 cells +  BEGIN  @ dup  WHILE  r@ over @proc  REPEAT
  122: 	drop rdrop
  123:     REPEAT  drop ;
  124: 
  125: ' init-shared-libs IS 'cold

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