Annotation of gforth/lib.fs, revision 1.1
1.1 ! pazsan 1: \ lib.fs shared library support package 11may97py
! 2:
! 3: \ Copyright (C) 1995-1997 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 parse-word 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: : lib: ( "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 parse-word 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: BEGIN @ dup WHILE >r
! 116: r@ @lib
! 117: r@ 2 cells + BEGIN @ dup WHILE r@ over @proc REPEAT
! 118: drop r>
! 119: REPEAT drop ;
! 120:
! 121: ' init-shared-libs IS 'cold
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>