Return to fflib.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/fflib.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: Variable libs 0 libs !
        !            22: Variable thisproc
        !            23: Variable thislib
        !            24: \G links between libraries
        !            25: 
        !            26: : @lib ( lib -- )
        !            27:     \G obtains library handle
        !            28:     cell+ dup 2 cells + count open-lib
        !            29:     dup 0= abort" Library not found" swap ! ;
        !            30: 
        !            31: : @proc ( lib addr -- )
        !            32:     \G obtains symbol address
        !            33:     cell+ tuck cell+ @ count rot cell+ @
        !            34:     lib-sym  dup 0= abort" Proc not found!" swap ! ;
        !            35: 
        !            36: : proc, ( lib -- )
        !            37: \G allocates and initializes proc stub
        !            38: \G stub format:
        !            39: \G    linked list in library
        !            40: \G    address of proc
        !            41: \G    ptr to OS name of symbol as counted string
        !            42: \G    threaded code for invocation
        !            43:     here dup thisproc !
        !            44:     swap 2 cells + dup @ A, !
        !            45:     0 , 0 A, ;
        !            46: 
        !            47: : proc:  ( lib "name" -- )
        !            48:     \G Creates a named proc stub
        !            49:     Create proc, 0
        !            50: DOES> ( x1 .. xn -- r )
        !            51:     dup cell+ @ swap 3 cells + >r ;
        !            52: 
        !            53: : library ( "name" "file" -- )
        !            54:     \G loads library "file" and creates a proc defining word "name"
        !            55:     \G library format:
        !            56:     \G    linked list of libraries
        !            57:     \G    library handle
        !            58:     \G    linked list of library's procs
        !            59:     \G    OS name of library as counted string
        !            60:     Create  here libs @ A, dup libs !
        !            61:     0 , 0 A, bl sword string, @lib
        !            62: DOES> ( -- )  dup thislib ! proc: ;
        !            63: 
        !            64: : init-shared-libs ( -- )
        !            65:     defers 'cold  libs
        !            66:     0  libs  BEGIN  @ dup  WHILE  dup  REPEAT  drop
        !            67:     BEGIN  dup  WHILE  >r
        !            68:        r@ @lib
        !            69:        r@ 2 cells +  BEGIN  @ dup  WHILE  r@ over @proc  REPEAT
        !            70:        drop rdrop
        !            71:     REPEAT  drop ;
        !            72: 
        !            73: ' init-shared-libs IS 'cold
        !            74: 
        !            75: ' av-int AConstant int
        !            76: ' av-float AConstant sf
        !            77: ' av-double AConstant df
        !            78: ' av-longlong AConstant llong
        !            79: ' av-ptr AConstant ptr
        !            80: 
        !            81: Variable revdec  revdec off
        !            82: \ turn revdec on to compile bigFORTH libraries
        !            83: 
        !            84: : rettype ( endxt startxt "name" -- )
        !            85:     create immediate 2,
        !            86:   DOES>
        !            87:     2@ compile, >r
        !            88:     revdec @ IF
        !            89:        0 >r  BEGIN  dup  WHILE  >r  REPEAT  drop
        !            90:        BEGIN  r> dup  WHILE  compile,  REPEAT  drop
        !            91:     ELSE
        !            92:        BEGIN dup  WHILE  compile,  REPEAT  drop
        !            93:     THEN
        !            94:     r> compile,  postpone EXIT
        !            95:     here thisproc @ 2 cells + ! bl sword s,
        !            96:     thislib @ thisproc @ @proc ;
        !            97: 
        !            98: ' av-call-void ' av-start-void rettype (void)
        !            99: ' av-call-int ' av-start-int rettype (int)
        !           100: ' av-call-float ' av-start-float rettype (sf)
        !           101: ' av-call-double ' av-start-double rettype (fp)
        !           102: ' av-call-longlong ' av-start-longlong rettype (llong)
        !           103: ' av-call-ptr ' av-start-ptr rettype (ptr)
        !           104: 
        !           105: \ compatibility layer for old library -- use is deprecated
        !           106: 
        !           107: Variable legacy
        !           108: 
        !           109: \ turn legacy on for old library
        !           110: 
        !           111: warnings @ warnings off
        !           112: 
        !           113: : (int) ( n -- )
        !           114:     legacy @ IF
        !           115:        >r ' execute r> 0 ?DO  int  LOOP
        !           116:     THEN  (int) ;
        !           117: : (void) ( n -- )
        !           118:     legacy @ IF
        !           119:        >r ' execute r> 0 ?DO  int  LOOP
        !           120:     THEN  (void) ;
        !           121: : (float) ( n -- )
        !           122:     legacy @ IF
        !           123:        >r ' execute r> 0 ?DO  df  LOOP
        !           124:     THEN  (df) ;
        !           125: 
        !           126: warnings on
        !           127: 
        !           128: [ifdef] testing
        !           129: 
        !           130: library libc /lib/libc.so.6
        !           131:                 
        !           132: libc sleep int (int) sleep
        !           133: libc open  int int ptr (int) open
        !           134: libc lseek int llong int (llong) lseek
        !           135: libc read  int ptr int (int) read
        !           136: libc close int (int) close
        !           137: 
        !           138: library libm /lib/libm.so.6
        !           139: 
        !           140: libm fmodf sf sf (sf) fmodf
        !           141: libm fmod  df df (fp) fmod
        !           142: 
        !           143: [then]