/* forpkg.c zilla - 'foreign library' linking
 * Called from stab.c: Call_Initializers:
 * when a .o file is loaded, look for a routine named PKGrtn_xx.
 * If found, call it.  It will return a package structure;
 * pass that structure to Zforpkginit() here in order to export the
 * foreign functions mentioned in that structure.
 *>> In this approach, the library does not reference any Elk internals, 
 * so the .o file can also be used as a normal c library.
 *
 * The package structure is called FORPKG0 and is defined in rtlpkg.h:
 * typedef struct {
 *     int structtype;
 *     int (*initfunc)();		// initialization function 
 *     char *ssubs;                     // scheme subrs - not implemented yet
 *     struct fordef *fsubs;		// c-linked
 *     struct fordef_usage *fusubs;	// c-linked+usage
 * } FORPKG0;
 *
 * The value of FORPKG0->fsubs is initialized to the address of
 * a 'struct fordef' table (see zelk.h),
 * The fields fusubs and ssubs are for similar tables of foreign
 * functions with usage strings (not implemented yet) and scheme
 * convention functions (also not implemented yet).
 * Optionally Initfunc can be set to an initialization function,
 * which will also be called by the object loader.
 *
    Portions of this file are Copyright (C) 1991 John Lewis,
    adapted from Elk2.0 by Oliver Laumann.

    This file is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 *
 ****NOTE THE ELK COPYING GC: ALL Object REFERENCES MUST BE GC_LINKED
 ****ACROSS CALLS WHICH MAY ALLOCATE STORAGE.  ALL C VARIABLES WHICH 
 ****ARE ASSIGNED FROM THE ADDRESS OF AN OBJECT MUST BE REASSIGNED
 ****AFTER A GC.
 *
 * 14nov        various
 * 12oct        load-foreign is obsolete, just use load for this.
 *              this requires that .pkg files be renamed to .o
 * 11may        GC checked-ok
 * 30apr        sgi loading
 * 3mar         delete two obsolete/unused args from forpkglink
 * 30oct        correctly export package name
 * 8oct         put link definitions in rtlpkg.h
 * 31aug.       link ALL pkgs found in object, not just <name>
 */

#include <theusual.h>
#include <scheme.h>
#include <zelk.h>
#include <constants.h>

#if defined(CAN_LOAD_OBJ) /* skip this file if not */

extern Object V_Load_Noisilyp;

#include <rtlpkg.h>

/*forward*/ static void pkginit P_((FORPKG0 *));
#if ZILLAONLY
void oldpkginit P_((PKG_init1 *));
#endif


void ZLprimdeftab(tab)
  struct primdef *tab;
{
  struct primdef *f;
  for( f = tab; f->name != (char *)0; f++ ) {
    if (Truep (Val (V_Load_Noisilyp)))
      Printf(Standard_Output_Port,"primdeftab %s %d\n",f->name,f->minargs);

    Define_Primitive(f->fun,f->name,f->minargs,f->maxargs,f->disc);
  }
} /*primdeftab*/



void Zforpkginit(name,pkgini)
  char *name;
  PKG_type *pkgini;
{
    Ztrace(("Zforpkginit %s pkg->structtype=%d\n",name,pkgini->structtype));

    if (Truep (Val (V_Load_Noisilyp)))
      Printf(Standard_Output_Port,"pkg_init %s\n",name);

/*  pkg_name(name);  */

    P_Provide(Intern(name));

    switch (pkgini->structtype) {
	case 0:		pkginit((FORPKG0 *)pkgini);
                        break;
#       if ZILLAONLY
	case 1:		oldpkginit((PKG_init1 *)pkgini);
			break;
#       endif
	default:	Panic("pkginit");
    }
} /*forpkginit*/


/* link and init a package */
static void pkginit(p)
  FORPKG0 *p;
{
    Ztrace(("pkginit--\n"));
    if (p->ssubs != (char *)0)	                ZLdeftab(p->ssubs);
    if (p->fsubs != (struct fordef *)0) 	Define_Fortab(p->fsubs);
    if (p->fusubs != (struct fordef_usage *)0)  ZLforudeftab(p->fusubs);
    if (p->initfunc != (int (*)())0)	        (*p->initfunc)();
} /*_init1*/


#endif  /*defined(CAN_LOAD_OBJECTS)%%%%%%%%%%%%%%%%*/
/* end of forpkg.c */
