/* zelk.c zilla 3sep91 - assorted elk extensions, also master init.
 *
    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.
 *
 * modified
 * 11nov        cleanup
 * 28may        os-peekchar.  see comment re why this vs. peek-char.
 * 30apr        os-architecture
 * 23apr        Get_Flonum
 * 12apr        fmod
 * 3mar         prelink elk lib/chdir,unix
 * 2mar         (alarm-set), alarm-handler!
 * 1mar         add cshf=csh -f
 */

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


/*%%%%%%%%%%%%%%%% declarations used by pre-linked functions %%%%*/

#if Eunix 

# if Eansiincludes
#   include <unistd.h>
# else
    extern char *getenv();
    extern int4 sleep();
    extern int chmod();
# endif /*!Eansiincludes*/

  extern int getpid();
# if Ebsd
    extern int getppid();
# endif
  extern int unlink(),rename();
  extern pclose( /*FILE *stream*/ ); 

# if Esparc  /* SGI declares these in stdio.h */
   extern fclose(),fseek(); 
   extern int4 fread(),fwrite();
# endif

# if Esgi  /* not declared anywhere in /usr/include on sgi */
   extern int chmod();
#endif

#endif /*Eunix*/


#ifdef ZILLAONLY
# include <libzs.h>
# if Esparc
  extern void malloc_verify();
# endif
#endif


/*%%%%%%%%%%%%%%%% 1. elk internal addtions %%%%%%%%%%%%%%%%*/

Dfloat Get_Flonum(F)
  Object F;
{
  if (TYPE(F) != T_Flonum) Primitive_Error("bad type-expected float");
  return FLONUM(F)->val;
}

/* convert an elk string to a statically allocated c string
 * !! also see lib/util/string.h !!
 */
char *Get_Cstring(str)
  Object str;
{
  int slen;

  slen = STRING(str)->size;
  if ((TYPE(str) != T_String) || (slen >= Ctmpbuflen))
    Panic("Get_Cstring");
  Zbcopy(STRING(str)->data,Ctmpbuf,slen);
  Ctmpbuf[slen] = (char)0;

  return(Ctmpbuf);
} /*Get_Cstring*/


/* scheme in general does not allow control over whether things are
 * int or float.  the closest equivalent is exact->inexact, which
 * elk does not have.  fully maintaining the exact/inexact distinction
 * would require another bit for all numbers, which would degrade
 * some implementations with immediate integers (such as elk).
 * We need control of int/float, for example, to allocate
 * the right type of arrays in vdistribute.
 * Also,
 * (/ 3 4)=>0.75 in both elk and xscheme; what about the scheme standard
 * if rationals are not implemented??
 * I don't want to rely on this feature of elk, so, adding a (float) call.
 */

Object P_float(I)
  Object I;
{
  int i;
  if (TYPE(I) == T_Flonum) return I;
  i = Get_Integer(I);
  return Make_Reduced_Flonum((double)i);
}


/* the elk builtin peek-char actually hangs - it reads one character,
 * and then puts it back in an elk (not stdio) char buffer.
 * It works with string ports, and is suitable for parsing,
 * but is not suitable for real-time user interaction e.g.
 * quit this loop when the user types something.
 * Ioctl test for input only works with terminal, not other streams?
 */

#ifdef NO  /* this would also need to ungetc the character!! */
static Object P_peektty () {
    register int c;
    
    c = Zio_getcif();

    if (c == 4) return False;
    if (c == -1) return False;

    return Make_Char(c);
}
#endif /*NO*/

/*%%%%%%%%%%%%%%%% 2. os routines %%%%%%%%%%%%%%%%*/

/* filename matching */
static Object P_glob(pattern)
  Object pattern;
{
# define maxmatch 2048
  char *match[maxmatch];
  char cpattern[CMAXPATH];
  int i,nmatch;

  Error_Tag = "os-glob";
  Check_Type(pattern,T_String);
  str_cpy(cpattern,Get_Cstring(pattern));
  Ztrace(("glob %s\n",cpattern));

  i = nmatch = Zglob(cpattern, match, maxmatch);
  Ztrace(("glob %s => %d matches\n",cpattern,nmatch));

  {
    Object list,tail,cell;
    GC_Node2;

    GC_Link2(list,tail);
    for (list = tail = Null; --i >= 0; tail = cell) {
        Ztrace(("adding %d:%s\n",i,match[i]));
	cell = Cons( Make_String(match[i],str_len(match[i])), Null );
	if (Nullp (list))
	    list = cell;
	else
	    P_Setcdr (tail, cell);
    }
    GC_Unlink;

    /* Zglob returns pointers to malloced strings */
    for( i=0; i < nmatch; i++ ) free(match[i]);

    return list;
  }
# undef maxmatch 
} /*glob*/


#if Eunix

#if ELKV2 /*%%%% elk version 2 %%%%*/
#include <cstring.h>

/* copied from elk/lib/unix.c; _csh needs this;
   copy it rather than altering the source to make it global.
 */
static Open_Max () {
#ifdef OPEN_MAX              /* POSIX */
    return OPEN_MAX;
#else
#ifdef GETDTABLESIZE
    return getdtablesize();  /* Return value may change during runtime */
#else
#ifdef SYSCONF
    static r;
    if (r == 0) {
	if ((r = sysconf (_SC_OPEN_MAX)) == -1)
	    r = 256;
    }
    return r;
#else
#ifdef NOFILE
    return NOFILE;
#else
    return 256;
#endif
#endif
#endif
#endif
} /*Open_Max*/


/* from lib/unix.c, only run csh rather than sh */
static Object _csh (cmd,startup) 
  Object cmd;
  bool startup;         /* true to read startup (.cshrc) */
{
    register char *s;
    register i, n, pid;
    int status;
    Declare_C_Strings;

    Make_C_String (cmd, s);
#ifdef VFORK
    switch (pid = vfork ()) {
#else
    switch (pid = fork ()) {
#endif
    case -1:
	Saved_Errno = errno;
	Primitive_Error ("cannot fork: ~E");
    case 0:
	n = Open_Max ();
	for (i = 3; i < n; i++)
	    (void)close (i);

        if (startup)
          execl ("/bin/csh", "csh", "-c", s, (char *)0);
        else
          execl ("/bin/csh", "csh", "-f", "-c", s, (char *)0);

        perror("elk (csh) execl failed");
	_exit (127);
    default:
	Disable_Interrupts;
	while ((i = wait (&status)) != pid && i != -1)
		;
	Enable_Interrupts;
    }
    Dispose_C_Strings;
    if (i == -1)
	return False;
    if (n = (status & 0377))
	return Cons (Make_Fixnum (n), Null);
    return Make_Fixnum ((status >> 8) & 0377);
} /*_csh*/


#else /*%%%% version 1* %%%%*/
#include <string.h>

/* from lib/system, only run csh rather than sh */
static Object _csh (cmd,startup) 
  Object cmd;
  bool startup;         /* true to read startup (.cshrc) */
{
    register char *s;
    register i, n, pid;
    int status;
    Declare_C_Strings;

    Make_C_String (cmd, s);
#ifdef VFORK
    switch (pid = vfork ()) {
#else
    switch (pid = fork ()) {
#endif
    case -1:
	Saved_Errno = errno;
	Primitive_Error ("cannot fork: ~E");
    case 0:
#ifdef MAX_OFILES
	n = MAX_OFILES;
#else
#ifdef SYSCONF
	n = sysconf (_SC_OPEN_MAX);
#else
	n = getdtablesize ();
#endif
#endif
	for (i = 3; i < n; i++)
	    (void)close (i);
        if (startup)
          execl ("/bin/csh", "csh", "-c", s, (char *)0);
        else
          execl ("/bin/csh", "csh", "-f", "-c", s, (char *)0);

        perror("elk (csh) execl failed");
	_exit (127);

    default:
	Disable_Interrupts;
	while ((i = wait (&status)) != pid && i != -1)
		;
	Enable_Interrupts;
    }
    Dispose_C_Strings;
    if (i == -1)
	return False;
    if (n = (status & 0377))
	return Cons (Make_Fixnum (n), Null);
    return Make_Fixnum ((status >> 8) & 0377);
} /*_csh*/

#endif /*%%%% version 1* %%%%*/


static Object P_csh (cmd)   Object cmd; 
{
  return _csh(cmd,TRUE);
}

static Object P_cshf (cmd)   Object cmd; 
{
  return _csh(cmd,FALSE);
}

#endif /*unix*/


#if Eunix
static void
osmkdir(path,mode)
  char *path;
  int mode;
{
  int rc;
  extern int errno;
  Error_Tag = "os-mkdir";

  errno = 0;
  rc = mkdir(path,mode);
  if (rc < 0) {
    perror("os-mkdir");
    Primitive_Error("failed");
  }
}
#endif /*unix*/


#ifdef OBSOLETE
/* getenv is now linked as a foreign function */
static Object P_Getenv (e) Object e; {
    register char *s;
    Object ret;
    Declare_C_Strings;

    Make_C_String (e, s);
    ret = (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
    Dispose_C_Strings;
    return ret;
} /*getenv*/
#endif


/* os-exec(string). returns a pid which can be waited for with
 * os-waitpid.
 * Based on elk unix.c P_system() call.
 */
#if Eunix

#define DEF_EXEC   Define_Primitive (P_Exec, "os-exec",  1,1,EVAL);

#if ELKV2       /*%%%% elk version 2 %%%%*/

static Object P_Exec (cmd) Object cmd; {
    register char *s;
    register i, n, pid;
    Declare_C_Strings;
    Error_Tag = "os-exec";

    Make_C_String (cmd, s);
#ifdef VFORK
    switch (pid = vfork ()) {
#else
    switch (pid = fork ()) {
#endif
    case -1:
	Saved_Errno = errno;
	Primitive_Error ("cannot fork: ~E");
    case 0:
	n = Open_Max ();
	for (i = 3; i < n; i++)
	    (void)close (i);

	execl ("/bin/sh", "sh", "-c", s, (char *)0);
        perror("os-exec");
	/* Primitive_Error ("cannot exec"); */
	_exit (127);
    default:
        break;
    }
    Dispose_C_Strings;
    return Make_Fixnum(pid);
} /*P_exec*/


#else   /*%%%% elk version 1* %%%%*/

static Object P_Exec (cmd) Object cmd; {
    register char *s;
    register i, n, pid;
    Declare_C_Strings;
    Error_Tag = "os-exec";

    Make_C_String (cmd, s);
#ifdef VFORK
    switch (pid = vfork ()) {
#else
    switch (pid = fork ()) {
#endif
    case -1:
	Saved_Errno = errno;
	Primitive_Error ("cannot fork: ~E");
    case 0:
#ifdef MAX_OFILES
	n = MAX_OFILES;
#else
#ifdef SYSCONF
	n = sysconf (_SC_OPEN_MAX);
#else
	n = getdtablesize ();
#endif
#endif
	for (i = 3; i < n; i++)
	    (void)close (i);
	execl ("/bin/sh", "sh", "-c", s, (char *)0);
        perror("os-exec");
	/* Primitive_Error ("cannot exec"); */
	_exit (127);
    default:
        break;
    } /*switch*/

    Dispose_C_Strings;
    return Make_Fixnum(pid);
} /*P_exec*/

#endif  /*%%%% elk version 1 %%%%*/

#define DEF_WAITPID     Define_Primitive (P_Waitpid, "os-waitpid",1,1,EVAL);

static Object P_Waitpid(Pid)
  Object Pid;
{
  int i,n,pid;
  int status;
  Error_Tag = "os-waitpid";

  pid = Get_Integer(Pid);

  Disable_Interrupts;
  while ((i = wait (&status)) != pid && i != -1)
    ;
  Enable_Interrupts;
  if (i == -1)
    return False;
  if (n = (status & 0377))
    return Cons (Make_Fixnum (n), Null);        /* signal ? */
  return Make_Fixnum ((status >> 8) & 0377);    /* status */
} /*P_waitpid*/

#endif /*Unix*/


#if Eunix
/*%%%%%%%%%%%%%%%% setenv,unsetenv %%%%%%%%%%%%%%%%
 * unix "environment" is an array of "NAME=VALUE" strings
 * which is passed between processes in the global variable 'char **environ'.
 * to allow additions to the environment, we copy the original environment
 * list (as passed to us e.g. from csh) into a new array known to be
 * malloced by us and to have some free slots, then set 'environ' to this.
 * 
 * to add something, search for the NAME= in the existing array,
 * free and replace if found, if not, add at end.
 *
 * how to unsetenv something?
 * setting entry to (char *)0 ends the list and makes following entries
 * inaccessible.  Instead, copy the whole environment to a second
 * array, omitting the unsetenv item, and then set environ to the
 * new array (after freeing the old array).  Requires two static arrays.
 */

extern char **environ;

#define ENVN 1024
static char *Env1[ENVN] = {""};
static char *Env2[ENVN] = {""};

/* helper: copy original environment to one which we have malloced,
 * so we can free entries as needed by unsetenv 
 */

static void
copyenv()
{
  register int i;
  register char **ep;
  Error_Tag = "setenv";
  Ztrace(("setenv copying original environ\n"));

  for( i = 0, ep = environ; *ep; ep++, i++ ) {
    if (i == ENVN) Primitive_Error("too many entries");
    Env1[i] = Zsalloc(*ep);
  }
  Env1[i] = (char *)0;
  environ = Env1;
} /*copyenv*/


/* setenv(name,value) - APPEARS to be working */
static void
elksetenv(name,value)
  char *name,*value;
{
    char *splice;
    register char **ep;
    Error_Tag = "setenv";
    Ztrace(("setenv %s %s\n",name,value));

    if ((name == (char *)0) || (value == (char *)0))
      Primitive_Error("need both name, value args");

    /* if just starting, copy original environment to one which we have
     * malloced ourselves
     */
    if ((environ != Env1) && (environ != Env2)) copyenv();

    /* create "NAME=VALUE" string 'splice' */
    {
	int len;
	len = strlen(name) + 1 + strlen(value);
	splice = malloc((unsigned int)(len+1));
	strcpy(splice,name); strcat(splice,"="); strcat(splice,value);
    }

    /* search for existing NAME entry, replace if found */
    for (ep = environ; *ep; ep++) {
	register char *cp,*dp;
	for (cp = name, dp = *ep; *cp && *cp == *dp; cp++, dp++)
	    continue;
	if (*cp != 0 || *dp != '=')
	    continue;

	/* found it.  free and replace */
	Ztrace(("setenv existing entry %s\n",*ep));
        free(*ep);

        *ep = splice;

	return;
    }

    /* add new entry at end of array */
    Ztrace(("setenv adding entry at end\n"));
    assert( *ep == (char *)0 );
    if ((ep - environ) >= (ENVN-1)) Primitive_Error("environment is full");
    *ep++ = splice;
    *ep++ = (char *)0;
} /*setenv*/



/* APPEARS to work */
static void
elkunsetenv(name)
  char *name;
{
  register char **ep,**ep2;
  bool found = FALSE;
  Error_Tag = "unsetenv";
  Ztrace(("unsetenv %s\n",name));

  if ((environ != Env1) && (environ != Env2))  copyenv();

  ep = environ;

  /* search for existing NAME entry, replace if found */
  for (; *ep; ep++) {
    register char *cp,*dp;
    for (cp = name, dp = *ep; *cp && *cp == *dp; cp++, dp++) 
      continue;
    if (*cp != 0 || *dp != '=')
      continue;

    /* found it.  free and zero */
    Ztrace(("unsetenv found entry %s\n",*ep));
    free(*ep);
    *ep = (char *)1;    /* !! flag unset !! */
    found = TRUE;

    break;
  }

  if (!found) Primitive_Error("not found"); /* break before copying */

  if (environ == Env1) {
    ep = Env1; ep2 = Env2;
  }
  else if (environ == Env2) {
    ep = Env2; ep2 = Env1;
  }
  else Panic("unsetenv");

  environ = ep2;

  /* copy to another array */
  for (; *ep; ep++) {
    if (*ep != (char *)1) {
      *ep2++ = Zsalloc(*ep);
      free(*ep);
      *ep = (char *)0;
    }
  }
  *ep2 = (char *)0;

} /*unsetenv*/

#endif /*Eunix*/



#if Eunix       /*alarm*/
#include <signal.h>
#include <sys/time.h>

static Object V_Alarm_Handler;

/* this is the C signal handler; it calls the Elk handler if any */
/* adapted from error.c:Intr_Handler */
static void
Alarm_Handler () {
    Object fun;

    (void)signal (SIGALRM, SIG_IGN);

    Error_Tag = "alarm-handler";
    Reset_IO (1);

    /* call alarm-handler if it is defined */
    fun = Val (V_Alarm_Handler);
    if (TYPE(fun) == T_Compound) {
      (void)Funcall (fun, Null, 0);
    }

    /* otherwise print this msg and call top-level */
    Format (Curr_Output_Port, "~%\7Alarm Expired!~%", 19, 0, (Object *)0);
    Reset ();
    /*NOTREACHED*/
} /*Alarm_Handler*/


static Object
P_Alarm_Set(Secs)
  Object Secs;
{
  int which;
  struct itimerval value;
  int secs;
  Error_Tag = "alarm-set";
  secs = Get_Integer(Secs);

  if (secs == 0) {      /* disable alarm */
    signal(SIGALRM,SIG_IGN);
    return Null;
  }

  value.it_value.tv_sec = secs;
  value.it_value.tv_usec = 0;
  value.it_interval.tv_sec = 0;
  value.it_interval.tv_usec = 0;

  which = ITIMER_REAL;

  signal(SIGALRM,Alarm_Handler);
  if (setitimer(which,&value,NULL) < 0) {
    perror("alarm-set ");
    Primitive_Error("setitimer problem");
  }

  return Null;
} /*alarm-set*/
#endif /*Eunix alarm*/

static localinit_alarm() {
#if Eunix
  Define_Variable(&V_Alarm_Handler,"alarm-handler",Null);
  Define_Primitive(P_Alarm_Set,"alarm-set",1,1,EVAL);
#endif
} /*init_alarm*/



/* call filesettimes given a human-readable time string */
#if ZILLAONLY
# include <rnd.h>
static void
os_filesettimestr(path,time)
  char *path,*time;
{
  Ztime_t t;
  t = Zparsetime(time);
  t += (60*60*24)*rndf(); /* dither to prevent make stall */
  Zfilesettimes(path,t,t);
}
#endif

#if Eunix
static char *
elkhostname()
{
  if (gethostname(Ctmpbuf,Ctmpbuflen) < 0)
    perror("elk-gethostname");          /* going to stdout!! */
  Ctmpbuf[Ctmpbuflen-1] = (char)0; /* make sure it is null-terminated */
  return Ctmpbuf;
}
#endif



static char *elkarch()
{

#if Emips
# define gotarch
  str_cpy(Ctmpbuf,"mips");
#endif

#if Esparc
# define gotarch
  str_cpy(Ctmpbuf,"sparc");
#endif

#ifdef mc68020
# define gotarch
  str_cpy(Ctmpbuf,"mc68020");
#endif

#ifndef gotarch
  :error elkarch()
#endif
# undef gotarch
  return Ctmpbuf;
} /*elkarch*/



#if Eunix
extern char *getwd();

static char *elkgetwd()
{
  if (getwd(Ctmpbuf) == (char *)0)
    perror("elk-getwd");          /* going to stdout!!? */
  Ctmpbuf[Ctmpbuflen-1] = (char)0; /* make sure it is null-terminated */
  return Ctmpbuf;
}
#endif /*unix*/


#if Ebsd

/* kill all processes in the current (berkeley) 'process group',
 * most probably, current process and all of its children.
 */
static void
elkkillpg()
{
    kill(getpgrp(getpid()),9);
}

/* kill all processes in the (berkeley) 'process group' of the parent.
 * if parent is login csh, this is equivalent to kill all and logout
 * (equivalent to kill 0 under sh, which is not effective under csh).
 */
static void
elkkillppg()
{
    kill(getpgrp(getppid()),9);
}
#endif /*Ebsd*/


#if Eunix
/* logout *all* my processes on the current machine */
static void
elkkillall()
{
  kill(-1,2);   /* first kill nicely, with interrupt */
  sleep(10);    /* wait for things to cleanup */
  kill(-1,9);   /* kill meanly */
}
#endif



/*%%%%%%%%%%%%%%%% 3. standard pre-linked foreign functions %%%%*/

static struct fordef fortab[] = {

#if Eunix
  {"os-delete-file", (vfunction *)unlink, "SRI"},
  {"os-rename-file", (vfunction *)rename, "SSRI"},
  {"os-chmod", (vfunction *)chmod, "SIRI"},
  {"os-make-directory", (vfunction *)osmkdir, "SI"},
  {"os-getenv", (vfunction *)getenv, "SRS"},
  {"os-setenv", (vfunction *)elksetenv, "SS"},
  {"os-unsetenv", (vfunction *)elkunsetenv, "S"},
  {"os-sleep", (vfunction *)sleep, "I"},
  {"os-hostname", (vfunction *)elkhostname, "RS"},
  {"os-architecture", (vfunction *)elkarch, "RS"},
  {"os-getwd", (vfunction *)elkgetwd, "RS"},    /* should be in libZ */

  {"os-popen",  (vfunction *)popen, "SSRP"}, /* ports can be returned */
                                            /* now? */
  {"os-pclose", (vfunction *)pclose, "P"},

  {"os-getpid", (vfunction *)getpid, "RI"},

# if Ebsd
  {"os-getppid", (vfunction *)getppid, "RI"},
  {"os-killpg", (vfunction *)elkkillpg, (char *)0},
  {"os-killppg", (vfunction *)elkkillppg, (char *)0},
# endif
  {"os-killall", (vfunction *)elkkillall, (char *)0},

  {"os-filesettimes", (vfunction *)Zfilesettimes, "SII"},
# if ZILLAONLY
  {"os-filesettimestr", (vfunction *)os_filesettimestr, "SS"},
  {"os-typeahead", (vfunction *)Zio_typeahead, "RI" },
# if Esparc
  /* on sparc, use /usr/lib/debug/malloc.o.
   * this does some malloc checking by default.
   */
  {"imalloc-verify", (vfunction *)malloc_verify, (char *)0},
# endif /*sparc*/
# endif /*ZILLAONLY*/

#endif /*unix*/

  {"os-fopen", (vfunction *)fopen, "SSRP"},
  {"os-fclose", (vfunction *)fclose, "P"},
  {"os-fread", (vfunction *)fread, "AIIPRI"},
  {"os-fwrite", (vfunction *)fwrite, "AIIPRI"},
  {"os-fseek", (vfunction *)fseek, "PII"},
  {"os-ftell", (vfunction *)ftell, "PRI"},

  {"os-filesize", (vfunction *)Zfilesize, "SRI"},
  {"os-filedirp", (vfunction *)Zfiledirp, "SRB"},

  {"os-timestring", (vfunction *)Ztimestring, "IRS"},
  {"os-curtime", (vfunction *)Zcurtime, "RI"},
# if ZILLAONLY
  {"os-parsetime", (vfunction *)Zparsetime, "SRI"},
# endif
  {"os-filemodtime", (vfunction *)Zfilemodtime, "SRI"},
  {"os-fileacctime", (vfunction *)Zfileacctime, "SRI"},

  {"os-pathgetpath", (vfunction *)Zpathgetpath, "SRS"},
  {"os-pathgetname", (vfunction *)Zpathgetname, "SRS"},
  {"os-pathgetext", (vfunction *)Zpathgetext, "SRS"},
  {"os-pathdelext", (vfunction *)Zpathdelext, "SRS"},

  {"os-uniqnam", (vfunction *)Zuniqnam, "SRS"},

/*  {"regex", (vfunction *)re_match, "SSRB"}, /+ pat,str */ 
  
  {"os-malloc", (vfunction *)malloc, "IRI"},
  {"os-free", free, "I"},

  {"pow", (vfunction *)pow, "FFRF"},
  {"atan2", (vfunction *)atan2, "FFRF"},
  {"fmod", (vfunction *)fmod, "FFRF"},

#if ZILLAONLY
  {"fft", (vfunction *)fft, "AAI"},
#endif

  {(char *)0, (vfunction *)0, (char *)0}
};


#if ZILLAONLY
/* preloaded packages. */
  extern FORPKG0 pkg_RND1;
  extern FORPKG0 pkg_RND2;
  extern FORPKG0 pkg_RND3;
  extern FORPKG0 pkg_VF;
  extern FORPKG0 pkg_VFlib;
/*  extern FORPKG0 pkg_GRAF; */

static void prelinkpkgs()
{
  Zforpkginit("pkg_VF",(PKG_type *)&pkg_VF);
  Zforpkginit("pkg_VFlib",(PKG_type *)&pkg_VFlib);
  Zforpkginit("pkg_RND1",(PKG_type *)&pkg_RND1);
  Zforpkginit("pkg_RND2",(PKG_type *)&pkg_RND2);
  Zforpkginit("pkg_RND3",(PKG_type *)&pkg_RND3);
/*  Zforpkginit("pkg_GRAF",&pkg_GRAF); */
} /*prelinkpkgs*/
#endif /*ZILLAONLY*/



/* Master init for other extensions. 
 * Farray must be inited before foreign because foreign depends T_farray.
 */
void Init_Zelk()
{

/*Not done yet:
  Define_Variable( &V_Flonum_Format, "flonum-format", Make_String("%g",2));
*/

  /* elk lib files which we decided to preload */
  init_lib_chdir();
  init_lib_unix();

  Init_farray();        /* link foreign array routines */
  Init_foreign();       /* link the foreign function interface */
  Init_peekpoke();      /* link foreign structure support */

# if ELKVECTOR
  Init_vector();        /* link vector scheme */
# endif

# if Esgi
   Init_gl();           /* export SGI gl graphics routines */
# endif

#if ZILLAONLY
  Init_press();         /* temporary */
# if Esparc
   Init_posybl();       /* posybl/linda */
   Init_GR();           /* graphics */
# endif

# if Esgi
   Init_GR();           /* graphics */
   init_face();         /*tmp*/
# endif
#endif /*ZILLAONLY*/

  localinit_alarm();

/* various prelinked */
  Define_Fortab(fortab);

#ifdef ZILLAONLY
  prelinkpkgs();
#endif

  Define_Primitive(P_glob,"os-glob",1,1,EVAL);
  Define_Primitive(P_float,"float",1,1,EVAL);
  Define_Primitive (P_csh, "csh",  1,1,EVAL);
  Define_Primitive (P_cshf, "cshf",  1,1,EVAL);
  DEF_EXEC
  DEF_WAITPID

} /*Init_Zelk*/
