/*
 *  MODULE  :   sysutil.c
 *              file-handling and system-utilities
 *
{*  last modification:	14.08.92  13:19   }

 *  uli 04.02.91 : objmain added
 *  uli 26.02.91 : os_verbose read
 *  uli 06.03.91 : new style headers.
 *  uli 06.03.91 : declaration of envfile moved from p88cfg.h
 *  uli 06.03.91 : prognam added . pointpos and del_extension, filename and
		   name moved from sysutil.h
 *  uli 08.03.91 : errfnam, exefnam added. Used by manager.
 *  uli 17.04.91 : p88_fgets moved from import.c
 *  uli 19.04.91 : srcext and objelen added.
 *  uli 19.04.22 : srcext and objelen added.
 *  uli 22.04.91 : sysdir, linkinfo are global now
 *  uli 22.04.91 : dclfpath: do not add path of source directory
 *  uli 13.05.91 : setdefault returns NULL, if env. file not found.
 *  uli 21.05.91 : dclinam  added , dclfnam modified.
 *  uli 13.06.91 : usrdir: do not search in usrdir, if empty string
 *  uli 30.07.91 : on_sysrts added. rtsfnam checks on_sysrts
 *  uli 30.07.91 : sysenv added.
 *  uli 26.08.91 : on_handling added.
 *  uli 03.09.91 : exefnam adds current directory path "./".
 *  uli 05.09.91 : exeext and pathch added. exefnam moved to depend.c
 *  uli 05.09.91 : exefnam moved to depend.c.
 *  uli 17.12.91 : namelength added.
 *  uli 02.01.92 : on_sysrts default true.
 *  uli 09.01.92 : setdefault : ov_abort added.
 *  uli 17.02.92 : setdefault : on_fastfor added.
 *  PJ  14.08.92 : fnaminit : non-CASE_SENSITIVE file names will be shifted
                              to upper case filenames
*/

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#include           "impor.t"
#include "option.h"
#include           "expor.t"
#include "sysutil.h"

#include           "implemen.t"
#include "p88cfg.h"             /* variables which are used by p88cfg.c and */
				/* by sysutil, contents of enviroment-file  */

int    namelength   = NAMElength ;
local char  name[FILENAME_MAX];             /* filename including path name */
local char *filename;             /* filename without pathname = modulename */

local char  envname [FILENAME_MAX] ;
		   /* holds the path and filename of the environment file */
		   /* used only to report it after reading +v option */
char    path[FILENAME_MAX+1] = "";       /* path name without filename */
char*   pathpos;                         /* points to last pathchar in path */
char    dummy[FILENAME_MAX+1] ;          /* string returned by functions */
local   FILE  * envfile     = (FILE*)0;
local   char *pointpos;                  /* position of point in filename */
#define del_extension  *pointpos='\0'

local boolean on_sysrts = true ;         /* non-command-line option */
				    /* "Use system directory for p88rts.i" */

#ifdef LINT_ARGS
local char * b_fgets  (void);
local void   envopen  (void);
local int    getnext  (void);
local void   memerr   (void) ;
#else
local char * b_fgets  ( );
local void   envopen  ( );
local int    getnext  ( );
local void   memerr   ( ) ;
#endif


							/*-------------------*/
#ifdef LINT_ARGS
global void fnaminit  (char * progname)
#else
global void fnaminit (progname)                         /*  f n a m i n i t  */
char * progname ;
#endif
BEGIN (fnaminit)

char *str_ptr;

  if (progname==NULL or *progname=='\0') {
    fprintf (stderr, "Reading source from stdin, output is \"dummy\".\n") ;
    filename = "dummy" ;
    on_merge = false ;
  }
  else  filename = progname ;

  strcpy (name, filename) ;                /* name is filename within path */
#ifdef NEW
  i := pathchar ;
  while (*i != '\0' && (pointpos=strrchr(name,*i)) == NULL)
    i++;           /* pointpos points to last occurence of pathchar */
#else
  pointpos = strrchr(name, pathchar);  /* pointpos points to last pathchar */
#endif
  if (pointpos) {                                        /* pathchar exist */
    strcpy (path, filename);        /* path is to be path without filename */
    pathpos = path+(pointpos-name);    /* points to last pathchar in path  */
    *(pathpos+1) = '\0';                  /* last char of path is pathchar */
    filename = pointpos+1;        /* now filename is filename without path */
  }
  else {                                  /* filename was without pathname */
    pointpos = name;
    filename = name;
    *path = '\0';
    pathpos = path;
  }

  pointpos = strrchr (filename, point) ;      /* last point in filename */
  if  (pointpos==NULL  or  strcmp (pointpos, srcfext)!=0)
   begin
     pointpos = filename + strlen (filename);  /* no source file extension */
     /* points behind filename */
     strcat (pointpos,srcfext);                /* add source extension */
   end ;

/* PJ 14.08.92 : */

#if !CASE_SENSITIVE
  for ( str_ptr = filename; *str_ptr != '\0'; str_ptr++ )
    if ( isalpha( *str_ptr ) )
      *str_ptr = toupper( *str_ptr );
#endif

END  /* fnaminit */                                     /* f n a m i n i t */
							/*-----------------*/




							/*-----------------*/
#ifdef LINT_ARGS
global char* prognam  (void)
#else
global char* prognam ()                                 /*  p r o g n a m  */
#endif
BEGIN (prognam)
  del_extension;
  return  filename ;
END  /* prognam */                                      /*  p r o g n a m  */
							/*-----------------*/




							/*-----------------*/
#ifdef LINT_ARGS
global char* codfnam  (void)
#else
global char* codfnam ()                                 /*  c o d f n a m  */
#endif
BEGIN (codfnam)

  del_extension;
  if (on_srcdir)
    return (strcat(name,codfext));    /* code-file to source-directory*/
  else
    return (strcat(filename,codfext));   /* code-file to current dir. */

END  /* codfnam */                                      /*  c o d f n a m  */
							/*-----------------*/


							/*-----------------*/
#ifdef LINT_ARGS
global char* lnkfnam  (void)
#else
global char* lnkfnam ()                                 /*  l n k f n a m  */
#endif
BEGIN (lnkfnam)
#ifdef OLD
  del_extension;
  if (on_srcdir)
    return (strcat(name, ".lnk"));    /* link-info-file to source-directory*/
  else
    return (strcat(filename, ".lnk"));   /* link-info-file to current dir. */
#else
  return (linkinfo) ;
#endif
END  /* lnkfnam */                                      /*  l n k f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* errfnam  (void)
#else
global char* errfnam ()                                 /*  e r r f n a m  */
#endif
BEGIN (errfnam)
  return (ERRmess) ;
END  /* errfnam */                                      /*  e r r f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* intfnam  (void)
#else
global char* intfnam ()                                 /*  i n t f n a m  */
#endif
BEGIN (intfnam)
/* intfnam is called by routines, which are creating interface-files */
/* modfnam is called by routines, which are reading interface-files. */
/* on_srcdir is only tested by intfnam, not by modfnam.              */


  del_extension;
  if (on_srcdir)
    return (strcat(name,intfext));    /* interface-file in source-directory*/
  else
    return (strcat(filename,intfext));   /* interface-file in current dir. */

END  /* intfnam */                                      /*  i n t f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* modfnam  (  char *modname)
#else
global char* modfnam (modname)                          /*  m o d f n a m  */
  /* searches the interface file of the module modname */
  /* and returns the filename with path name and extension name */
  char *modname; /* module name without path and extension */
#endif
BEGIN (modfnam)
  char  fn[FILENAME_MAX+1]; /* filename with extension */
  char * p ;
  FILE* f;
/*
modfnam soll die angegebenen interfacefiles der module suchen und dem
aufrufenden Programm den vollstaendigen Namen des Interfacefiles, dh. mit
Pfad und Extension.
Gesucht wird :  im aktuellen Verzeichnis
		in dem Verzeichnis des zu uebersetzenden Programms
		in dem (den) im env-file angegebenen Verzeichnis(sen)
		im Benutzer-Verzeichnis
		im System-Verzeichnis
*/


  strcat (strcpy (fn, modname), intfext);  /* fn = module name + extension */
  strcpy (dummy,fn);                       /* dummy = fn */
  f = fopen (dummy, "r");
  if (f)  {                     /* search in current directory */
    fclose (f);
    return (dummy) ;
  }

  strcpy (dummy,path);
  strcat (dummy, fn);                 /* dummy = srcdir + fn */
  f = fopen (dummy, "r");
  if (f)  {                           /* search in source directory */
    fclose (f);
    return (dummy) ;
  }

  strcpy (dummy, findmod);      /* findmod = path for interface files, */
  strcat (dummy, fn);           /*  read from envfile */
  f = fopen (dummy, "r");
  if (f)   {
    fclose (f);
    return (dummy) ;
  }

  p = getenv (P88USR) ;                 /* user environment variable */
  if  (p)  then   {
    strcat (strcpy (dummy, p), fn) ;
    f = fopen(dummy,"r");               /* search in user directory */
    if (f)   {
      fclose (f);
      return (dummy) ;
    }
  }

  p = getenv (HOME) ;                   /* users home directory */
  if  (p or *usrdir)   {
    if  (p)  then
       strcat (strcpy (dummy, p), usrdir) ; /* dummy = $HOME + usrdir + fn */
    else
       strcpy (dummy, usrdir);              /* dummy = usrdir + fn */
    strcat (dummy, fn);
    f = fopen (dummy, "r");
    if (f)  {                           /* search in user directory */
      fclose (f);
      return (dummy) ;
    }
  }

  if  (sysenv)  then   {
    strcat (strcpy (dummy, sysenv), fn) ;
    f = fopen(dummy,"r");               /* search in system directory */
    if (f)   {
      fclose (f);
      return (dummy) ;
    }
  }

  strcat (strcpy (dummy, sysdir), fn);
  f = fopen(dummy,"r");              /* search in system directory */
  if (f)   {
    fclose (f);
    return (dummy) ;
  }
  else  {
    strcpy (dummy, fn) ;
    return (dummy) ;
  }

END  /* modfnam */                                      /*  m o d f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* dclfnam (void)
#else
global char* dclfnam ()                                 /*  d c l f n a m  */
#endif
      /* This name in used in opening this file */
BEGIN (dclfnam)

  del_extension;
  if (on_srcdir)
    return (strcat(name,dclfext));    /* dcl- or header-file to source-dir. */
  else
    return (strcat(filename,dclfext));   /* header-file to current dir. */

END  /* dclfnam */                                      /*  d c l f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* dclinam (void)
#else
global char* dclinam ()                                 /*  d c l i n a m  */
#endif
			/* This name is used in the include directive */
BEGIN (dclinam)         /* In C-compilation current directory is srcdir! */
  del_extension;        /* therefore no pathname in include directive */
  return (strcat(filename,dclfext));   /* header-file to current dir. */

END  /* dclinam */                                      /*  d c l i n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* dclfpath  (  char * intpath)
#else
global char* dclfpath (intpath)                         /* d c l f p a t h */
  /* converts interface-filename to header-filename */
  char * intpath;       /* interface-file with path */
#endif
BEGIN (dclfpath)
  char *p, *q ;

  if (on_srcdir and filename != name)   /* directory isn't current dir */
   begin
     p = name ; q = intpath ;
     while (*p == *q  and *p != '\0')  p++ , q++ ;
     if  (p == filename)   intpath = q ; /* interface dir == source dir */
   end ;

  strcpy (dummy, intpath);
  dummy [strlen(dummy) - strlen(modfext)] = '\0';
  return (strcat(dummy, dclfext));      /* return name of dcl- or headerfile */

END  /* dclfpath */                                     /* d c l f p a t h */
							/*-----------------*/


							/*---------------*/
#ifdef LINT_ARGS
global char  pathch  (void)                             /*  p a t h c h  */
#else
global char  pathch  ()
#endif
BEGIN (pathch)      /* used by manager only */
  return (pathchar) ;
END /* pathch */


							/*---------------*/
#ifdef LINT_ARGS
global char* srcext   (void)                            /*  s r c e x t  */
#else
global char* srcext  ()
#endif
BEGIN (srcext)      /* used by manager only */
  return (srcfext) ;
END /* srcext */


							/*---------------*/
#ifdef LINT_ARGS
global char* exeext   (void)                            /*  e x e e x t  */
#else
global char* exeext  ()
#endif
BEGIN (exeext)      /* used by manager only */
  return (exefext) ;
END /* exeext */


							/*---------------*/
#ifdef LINT_ARGS
global char* objext   (void)
#else
global char* objext  ()                                 /*  o b j e x t  */
#endif
BEGIN (objext)      /* used by manager only */
  return (objfext) ;
END /* objext */


							/*---------------*/
#ifdef LINT_ARGS
global char* libext   (void)
#else
global char* libext  ()                                 /*  l i b e x t  */
#endif
BEGIN (libext)      /* used by manager only */
  return (libfext) ;
END /* libext */


							/*-----------------*/
#ifdef LINT_ARGS
global char* srcfnam  (void)
#else
global char* srcfnam ()                                 /*  s r c f n a m  */
#endif
BEGIN (srcfnam)

  if  (filename)  {
    del_extension;
    return (strcat(name,srcfext));         /* return name of sourcefile */
  } else  return (char*) 0 ;

END  /* srcfnam */                                      /*  s r c f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* lstfnam  (void)
#else
global char* lstfnam ()                                 /*  l s t f n a m  */
#endif
BEGIN (lstfnam)

  del_extension;
  if (on_srcdir)
    return (strcat(name,lstfext));    /* listing-file to source-directory*/
  else
    return (strcat(filename,lstfext));   /* listing-file to current dir. */

END  /* lstfnam */                                      /*  l s t f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global int   objelen  (void)
#else
global int   objelen ()                                 /*  o b j e l e n  */
  /* returns the object filename extension length */
#endif
BEGIN (objelen)        /* used by manager only */
  return  strlen (objfext) ;
END  /* objelen */


							/*-----------------*/
#ifdef LINT_ARGS
global char* objmain  (void)
#else
global char* objmain ()                                 /*  o b j m a i n  */
  /* returns the object filename of the current program */
#endif
BEGIN (objmain)

  del_extension;
  if (on_srcdir)
    return (strcat(name,objfext));    /* listing-file to source-directory*/
  else
    return (strcat(filename,objfext));   /* listing-file to current dir. */

END  /* objmain */                                      /*  o b j m a i n  */
							/*-----------------*/


							/*-----------------*/
#ifdef LINT_ARGS
global char* dmpfnam  (void)
#else
global char* dmpfnam ()                                 /*  d m p f n a m  */
#endif
BEGIN (dmpfnam)

  del_extension;
  if (on_srcdir)
    return (strcat(name,dmpfext));    /* dump-file to source-directory*/
  else
    return (strcat(filename,dmpfext));   /* dump-file to current dir. */

END  /* dmpfnam */                                      /*  d m p f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* objfnam  (  char * path)
#else
global char* objfnam (path)                             /*  o b j f n a m  */
  /* converts interface-filename to object-filename */
  char * path;
#endif
BEGIN (objfnam)

  strcpy (dummy, path);
  strcpy (dummy+strlen(dummy)-strlen(modfext), objfext);

  return (dummy);                       /* return name of object-file */

END  /* objfnam */                                      /*  o b j f n a m  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global char* rtsfnam  (void)
#else
global char* rtsfnam ()                                 /*  r t s f n a m  */
#endif
   /* name of runtime include file */
BEGIN (rtsfnam)

  if  (on_sysrts)
    strcpy (dummy, sysenv ? sysenv : sysdir) ;
  else
    strcpy (dummy, runtime) ;
  return (strcat (dummy, rtifnam)) ;

END  /* rtsfnam */                                      /*  r t s f n a m  */
							/*-----------------*/



/*
 * p88_fgets() : replaces the standard char *fgets() declared in stdio.h
 * ------------  this was necessary because the implementation of the
 * standard-function varies for different compilers, so the results of
 * the standard-function were unsafe.
 *
 * fgets() reads at most the next n-1 characters into the array s,
 * stopping if a newline is encountered; the newline is included in the
 * array, which is teminated by '\0'. fgets() returns s, or NULL if
 * end of file or error occurs.
*/
#ifdef LINT_ARGS                                        /*-------------------*/
global char *p88_fgets (char *s, int n, FILE *f)        /* p 8 8 _ f g e t s */
#else
global char *p88_fgets (s, n, f)
  /* fgets may be erroneous */
  char  *s;
  int    n;
  FILE  *f;
#endif
BEGIN (p88_fgets)
  int  i;
  int  c;

  if (n <= 1) {         /* if n<=1, n is less than or equal to Null, so */
    s[0] = '\0';        /* no character will be read, the returned string */
    return (s);         /* is empty, no error occured. */
  }
  else {
    for (i=0; i<n-1; i++) {                     /* read the next n-1 chars */
      if ((c=fgetc(f)) != '\n'  and  c != EOF)  /* while they are not EOF */
	s[i] = c;                               /* and not the newline-char */
      else
	break;
    }
    if (c ==  EOF) {            /* if end of file occured, the string s is  */
      s[0] = '\0';              /* cleared, '\0' indicates an empty string. */
      return (NULL);            /* fgets() returns NULL indicating the EOF. */
    }
    else if (c == '\n') {       /* if the last read char was newline, it is */
      s[i]   = c;               /* added to the string; '\0' teminates the */
      s[i+1] = '\0';            /* string; fgets() returns s. */
      return (s);
    }
    else {                      /* the string s contains now n-1 characters. */
      s[i] = '\0';              /* the terminating '\0' is added and the */
      return (s);               /* string is returned. */
    }
  }
							/* p 8 8 _ f g e t s */
END  /* p88_fgets */                                    /*-------------------*/



							/*-----------------*/
#ifdef LINT_ARGS
local char * b_fgets  (void)
#else
local char * b_fgets ()                                 /*  b _ f g e t s  */
#endif
BEGIN (b_fgets)
  int    len;
  char * str;

  if ((len=fgetc(envfile)) != EOF) {
    str = (char*) malloc (len);
    if (str)
     if  (len>1)
      p88_fgets (str, len, envfile);
     else
      *str = '\0' ;  /* some C runtime systems are wrong */
    else   memerr () ;
  }
  else {
    str = (char*) malloc (1);
    if (str)
      *str = '\0';
    else  memerr () ;
  }
  return (str);

END  /* b_fgets */                                      /*  b _ f g e t s  */
							/*-----------------*/


						  /*-----------------------*/
#ifdef LINT_ARGS
global char *  setdefault  (void)
#else
global char *  setdefault ()                      /*  s e t d e f a u l t  */
#endif
BEGIN (setdefault)
  int c;
/*-------------------------------------------------------------------------*/
#define b_set(b_flag);       if ((c = fgetc(envfile)) != delimiter)   \
			       b_flag = c;                            \
			     else                                     \
			       ungetc (c, envfile);
/*-------------------------------------------------------------------------*/

  envopen ();
			     /* same as envread in p88cfg.c */
  if (envfile) {

    while ((c=getnext())!=options && c!=EOF) ;          /* default options */
    if (c!=EOF) {
      b_set (on_verbose  );
      b_set (on_list     );
      b_set (on_warning  );
      b_set (on_merge    );
      b_set (os_code     );
      b_set (on_code     );
      b_set (on_index    );
      b_set (on_number   );
      b_set (on_dump     );
      b_set (on_terminal );
      b_set (on_rename   );
      b_set (on_include  );
      b_set (on_srcdir   );
      b_set (on_remove   );
      b_set (on_prototyp );
      b_set (on_reverse  );
      b_set (os_verbose  );
      b_set (on_sysrts   );
      b_set (on_handling );
      b_set (on_fastfor  );
    }

    while ((c=getnext())!=includes && c!=EOF) ;           /* include <files> */
    ov_real  = b_fgets ();
    ov_include = b_fgets ();

    while ((c=getnext())!=extensions && c!=EOF) ;         /* file extensions */
    codfext = b_fgets ();
    dclfext = b_fgets ();
    intfext = b_fgets ();   modfext = intfext ;
    srcfext = b_fgets ();
    lstfext = b_fgets ();   dmpfext = lstfext ;
    objfext = b_fgets ();
    libfext = b_fgets ();
    exefext = b_fgets ();

    while ((c=getnext())!=paths && c!=EOF) ;
    findmod = b_fgets ();                       /* path for interface-files */
    runtime = b_fgets ();                       /* path for runtime-include */

    while ((c=getnext())!='n' && c!=EOF) ;
    if (c=='n')  namelength = fgetc (envfile) ;  /* max. length of C names */

/* getnext reports invalid envir file ! 
    while ((c=getnext())!='a' && c!=EOF) ;
    if (c=='a')  ov_abort = fgetc (envfile) ; */ /* abort after n errors */

#ifdef OLD
    while ((c=getnext())!='c' && c!=EOF) ;
    c_comp = b_fgets ();                         /* System-Call of C-Compiler */
    cc_opt = b_fgets ();                         /* Options for C-Compiler    */
    c_link = b_fgets ();                         /* System-Call of Linker     */
    cl_opt = b_fgets ();                         /* Options for Linker        */
#endif

    fclose (envfile);
  } /* if (envfile) */
  else
   begin
     printf(" environment file %s   n o t   found.\n", envname);
     return (NULL) ;
   end

  return (envname) ;
END  /* setdefault */                              /*  s e t d e f a u l t  */
						   /*-----------------------*/

							 /*-----------------*/
#ifdef LINT_ARGS
local void  envopen  (void)
#else
local void  envopen ()                                   /*  e n v o p e n  */
#endif
BEGIN (envopen)
  char * p ;

  sysenv = getenv (P88SYS) ;            /* system environment variable */

  strcpy (envname, envfnam) ;           /* search in current directory */
  envfile = fopen (envname, "rb");
  if (envfile)   return ;

  p = getenv (P88USR) ;                 /* user environment variable */
  if  (p)  then   {
    strcat (strcpy (envname, p), envfnam) ;
    envfile = fopen(envname,"rb");      /* search in user directory */
    if  (envfile)  return ;
  }

  p = getenv (HOME) ;                   /* users home directory */
  if  (p or *usrdir)  {
    if  (p)  then
       strcat (strcpy (envname, p), usrdir) ;
    else
       strcpy (envname, usrdir);
    strcat (envname, envfnam);
    envfile = fopen(envname,"rb");      /* search in user directory */
    if (envfile)  return ;
  }

  if  (sysenv)  then   {
    strcat (strcpy (envname, sysenv), envfnam) ;
    envfile = fopen(envname,"rb");      /* search in system directory */
    if  (envfile)  return ;
  }

  strcpy (envname, sysdir);
  strcat (envname, envfnam);
  envfile = fopen(envname,"rb");        /* search in system directory */
END  /* envopen */                                      /*  e n v o p e n  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
local int  getnext  (void)
#else
local int  getnext ()                                   /*  g e t n e x t  */
#endif
BEGIN (getnext)
  int  c;

  while  ((c=fgetc(envfile)) != delimiter  &&  c!=EOF) ;
  if (c==delimiter)
    c = fgetc(envfile);
  else
    printf ("invalid environment file\n");

  return (c);

END  /* getnext */                                      /*  g e t n e x t  */
							/*-----------------*/



							/*-----------------*/
#ifdef LINT_ARGS
global void  time_in  ( char c)
#else
global void  time_in (c)                                /*  t i m e _ i n  */
  char c;
#endif
BEGIN (time_in)

#ifdef TIMER
  if (c==0)
    sp0 = clock();
  else
    sp1 = clock();
#endif

END /* time_in */                                       /*  t i m e _ i n  */
							/*-----------------*/

							/*-----------------*/
#ifdef LINT_ARGS
global void time_out  ( char c,char * routname)
#else
global void time_out (c, routname)                      /* t i m e _ o u t */
  char   c;
  char * routname;
#endif
BEGIN (time_out)

#ifdef TIMER
  clock_t bb;
  double  b_diff;

  if ((bb=clock()) != -1) {
    if (c == 0) {
      b_diff = (bb-sp0)/(1.0*CLK_TCK);
      printf ("     %f sec  used for %s\n", b_diff, routname);
      sp0 = clock();
    }
    else /* c==1 */ {
      b_diff = (bb-sp1)/(CLK_TCK);
      printf ("* %f sec  used for %s\n", b_diff, routname);
      sp1 = clock();
    }
  }
  else
    fprintf (stderr, "processor time not available\n");
#endif

END  /* time_out */                                     /* t i m e _ o u t */
							/*-----------------*/

#ifdef LINT_ARGS
global void  total_in  (void)
#else
global void  total_in ()
#endif
BEGIN (total_in)
#ifdef TIMER
  tc0 = time ((time_t *) 0);
#endif
END /* total_in */

#ifdef LINT_ARGS
global void total_out  (void)
#else
global void total_out ()
#endif
BEGIN (total_out)

#ifdef TIMER
  if (clock()!=-1)
    printf ("\n%-8f sec processor time used by p88\n", clock()/(1.0*CLK_TCK));
  else
    fprintf (stderr, "processor time not available\n");

  tc1    = time ((time_t *) 0);
  printf ("%-8.0lf sec total time used by p88\n", difftime (tc1, tc0));
#endif

END /* total_out */



							/*---------------*/
#ifdef LINT_ARGS
global void finish  ( int status )
#else
global void finish (status)                             /*  f i n i s h  */
  int status ;
#endif
BEGIN(finish)
#ifdef GEM
    fprintf (stderr, "Press RETURN to continue") ;
    (void) getchar () ;
#endif
  exit (status) ;
END /* finish */                                        /*  f i n i s h  */
							/*---------------*/


							/*---------------*/
#ifdef LINT_ARGS
local void memerr  (void)
#else
local void memerr ()                                    /*  m e m e r r  */
#endif
BEGIN(memerr)
    fprintf (stderr, "Insufficient memory. Compilation abort.\n");
    fprintf (stdout, "Insufficient memory. Compilation abort.\n");
    finish(-999);
END /* memerr */                                        /*  m e m e r r  */
							/*---------------*/
