Annotation of gforth/lib.fs, revision 1.6
1.1 pazsan 1: \ lib.fs shared library support package 11may97py
2:
1.6 ! anton 3: \ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
1.1 pazsan 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
1.5 anton 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1 pazsan 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
1.3 anton 52: cells 2* + , 0 , bl sword string, @proc ;
1.1 pazsan 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:
1.2 pazsan 94: : library ( "name" "file" -- )
1.1 pazsan 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 !
1.3 anton 102: 0 , 0 A, bl sword string, @lib
1.1 pazsan 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
1.2 pazsan 115: 0 libs BEGIN @ dup WHILE dup REPEAT drop
116: BEGIN dup WHILE >r
1.1 pazsan 117: r@ @lib
118: r@ 2 cells + BEGIN @ dup WHILE r@ over @proc REPEAT
1.2 pazsan 119: drop rdrop
120: REPEAT drop ;
1.1 pazsan 121:
122: ' init-shared-libs IS 'cold
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>