Annotation of gforth/oldlib.fs, revision 1.1

1.1     ! pazsan      1: \ lib.fs       shared library support package          11may97py
        !             2: 
        !             3: \ Copyright (C) 1995,1996,1997,1998,2000 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: : @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>