home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-zelk / forpkg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-15  |  4.2 KB  |  130 lines
  1. /* forpkg.c zilla - 'foreign library' linking
  2.  * Called from stab.c: Call_Initializers:
  3.  * when a .o file is loaded, look for a routine named PKGrtn_xx.
  4.  * If found, call it.  It will return a package structure;
  5.  * pass that structure to Zforpkginit() here in order to export the
  6.  * foreign functions mentioned in that structure.
  7.  *>> In this approach, the library does not reference any Elk internals, 
  8.  * so the .o file can also be used as a normal c library.
  9.  *
  10.  * The package structure is called FORPKG0 and is defined in rtlpkg.h:
  11.  * typedef struct {
  12.  *     int structtype;
  13.  *     int (*initfunc)();        // initialization function 
  14.  *     char *ssubs;                     // scheme subrs - not implemented yet
  15.  *     struct fordef *fsubs;        // c-linked
  16.  *     struct fordef_usage *fusubs;    // c-linked+usage
  17.  * } FORPKG0;
  18.  *
  19.  * The value of FORPKG0->fsubs is initialized to the address of
  20.  * a 'struct fordef' table (see zelk.h),
  21.  * The fields fusubs and ssubs are for similar tables of foreign
  22.  * functions with usage strings (not implemented yet) and scheme
  23.  * convention functions (also not implemented yet).
  24.  * Optionally Initfunc can be set to an initialization function,
  25.  * which will also be called by the object loader.
  26.  *
  27.     Portions of this file are Copyright (C) 1991 John Lewis,
  28.     adapted from Elk2.0 by Oliver Laumann.
  29.  
  30.     This file is free software; you can redistribute it and/or modify
  31.     it under the terms of the GNU General Public License as published by
  32.     the Free Software Foundation.
  33.  
  34.     This program is distributed in the hope that it will be useful,
  35.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  36.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  37.     GNU General Public License for more details.
  38.  
  39.     You should have received a copy of the GNU General Public License
  40.     along with this program; if not, write to the Free Software
  41.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  42.  
  43.  *
  44.  ****NOTE THE ELK COPYING GC: ALL Object REFERENCES MUST BE GC_LINKED
  45.  ****ACROSS CALLS WHICH MAY ALLOCATE STORAGE.  ALL C VARIABLES WHICH 
  46.  ****ARE ASSIGNED FROM THE ADDRESS OF AN OBJECT MUST BE REASSIGNED
  47.  ****AFTER A GC.
  48.  *
  49.  * 14nov        various
  50.  * 12oct        load-foreign is obsolete, just use load for this.
  51.  *              this requires that .pkg files be renamed to .o
  52.  * 11may        GC checked-ok
  53.  * 30apr        sgi loading
  54.  * 3mar         delete two obsolete/unused args from forpkglink
  55.  * 30oct        correctly export package name
  56.  * 8oct         put link definitions in rtlpkg.h
  57.  * 31aug.       link ALL pkgs found in object, not just <name>
  58.  */
  59.  
  60. #include <theusual.h>
  61. #include <scheme.h>
  62. #include <zelk.h>
  63. #include <constants.h>
  64.  
  65. #if defined(CAN_LOAD_OBJ) /* skip this file if not */
  66.  
  67. extern Object V_Load_Noisilyp;
  68.  
  69. #include <rtlpkg.h>
  70.  
  71. /*forward*/ static void pkginit P_((FORPKG0 *));
  72. #if ZILLAONLY
  73. void oldpkginit P_((PKG_init1 *));
  74. #endif
  75.  
  76.  
  77. void ZLprimdeftab(tab)
  78.   struct primdef *tab;
  79. {
  80.   struct primdef *f;
  81.   for( f = tab; f->name != (char *)0; f++ ) {
  82.     if (Truep (Val (V_Load_Noisilyp)))
  83.       Printf(Standard_Output_Port,"primdeftab %s %d\n",f->name,f->minargs);
  84.  
  85.     Define_Primitive(f->fun,f->name,f->minargs,f->maxargs,f->disc);
  86.   }
  87. } /*primdeftab*/
  88.  
  89.  
  90.  
  91. void Zforpkginit(name,pkgini)
  92.   char *name;
  93.   PKG_type *pkgini;
  94. {
  95.     Ztrace(("Zforpkginit %s pkg->structtype=%d\n",name,pkgini->structtype));
  96.  
  97.     if (Truep (Val (V_Load_Noisilyp)))
  98.       Printf(Standard_Output_Port,"pkg_init %s\n",name);
  99.  
  100. /*  pkg_name(name);  */
  101.  
  102.     P_Provide(Intern(name));
  103.  
  104.     switch (pkgini->structtype) {
  105.     case 0:        pkginit((FORPKG0 *)pkgini);
  106.                         break;
  107. #       if ZILLAONLY
  108.     case 1:        oldpkginit((PKG_init1 *)pkgini);
  109.             break;
  110. #       endif
  111.     default:    Panic("pkginit");
  112.     }
  113. } /*forpkginit*/
  114.  
  115.  
  116. /* link and init a package */
  117. static void pkginit(p)
  118.   FORPKG0 *p;
  119. {
  120.     Ztrace(("pkginit--\n"));
  121.     if (p->ssubs != (char *)0)                    ZLdeftab(p->ssubs);
  122.     if (p->fsubs != (struct fordef *)0)     Define_Fortab(p->fsubs);
  123.     if (p->fusubs != (struct fordef_usage *)0)  ZLforudeftab(p->fusubs);
  124.     if (p->initfunc != (int (*)())0)            (*p->initfunc)();
  125. } /*_init1*/
  126.  
  127.  
  128. #endif  /*defined(CAN_LOAD_OBJECTS)%%%%%%%%%%%%%%%%*/
  129. /* end of forpkg.c */
  130.