/*


 Copyright (C) 1990 Texas Instruments Incorporated.

 Permission is granted to any individual or institution to use, copy, modify,
 and distribute this software, provided that this complete copyright and
 permission notice is maintained, intact, in all copies and supporting
 documentation.

 Texas Instruments Incorporated provides this software "as is" without
 express or implied warranty.


 *
 *				C P P 7 . C
 *
 *			   Process Internal/External defmacros
 *
 * Edit history
 * 15-Mar-89	LGO	Initial design and implementation.
 * 20-Oct-89    AFM     OS2, XENIX and AIX port.
 * 19-Jan-90    DKM     MVS support
 * 01-Sep-90    MJF     External macros support for OS/2 by using temp file
 * 25-Jun-91	GPD	Remove #elif to make more portable.
 *			Added support for Interactive Unix.
 */

#include	<stdio.h>
#include	<ctype.h>
#include	"cppdef.h"

#if defined(vms)
#include        <types.h>
#else
#if !defined(SYS_OSVS)
#include        <sys/types.h>
#endif
#endif

#if defined(_AIX)
#include        <sys/select.h>
#endif

#include	"cpp.h"
 
#if defined(M_XENIX)
#include        <string.h>
#include        <sys/fcntl.h>
#include        <sys/file.h>
#else
#if defined(DOS) || defined(MSDOS)
#include        <string.h>
#include        <fcntl.h>
#else
#if defined(SYS_OSVS)
#include        <string.h>
#include        <fcntl.h>
#else
#if defined(vms)
#include        <file.h>
#else
#if defined(M_INTERACTIVE)
#include	<unistd.h>
#include	<sys/bsdtypes.h>
#include	<sys/fcntl.h>
#endif
#include        <sys/file.h>
#endif
#endif
#endif
#endif

#if HOST == SYS_VMS
#define F_OK            0      /* does file exist */
#define X_OK            1      /* is file executable */
#define W_OK            2      /* is file writable */
#define R_OK            4      /* is file readable */
#endif

int current_line;			/* line at start of defmacro global */
char current_file[256];			/* file at start of defmacro global */

FILEINFO *MacInFile, *MacOutFile;
char* MacOutEnd;

struct macroargs {
  char* name;
  char  expanding;		/* Non-zero when args are macro expanded */
  char  recursive;		/* Non-zero when recursive */
  char  delimiter;		/* Delimiter */
  char  conditional;		/* Expand only if this char found after name */
  internal_expander expander;	/* Macro expander or NULL if file */
  char *program;		/* macro program pathname */
  char *args[1];		/* arg list (vector of strings) */
};

extern FILEINFO* getfile();

/* Getfile without side effects */
FILEINFO*
get_temp_file (bufsize, name)
     int bufsize;
     char* name;
{
  FILEINFO* file = getfile(bufsize, name);
  infile = file->parent;
  file->parent = NULL;
  line = infile->line;
  return(file);
}

static FILEINFO*
next_buffer(Buffer)
   FILEINFO* Buffer;
{
  FILEINFO* new = get_temp_file(NBUFF, Buffer->filename);
  new->parent = Buffer->parent;	/* When new ends read from infile */
  Buffer->parent = new;	        /* When Buffer dries up, read from new */
  *Buffer->bptr = EOS;
  Buffer->bptr = Buffer->buffer;
  return new;
}

/* Helper function for the getchar macro used by internal defmacros */
char
NextMacInChar() {
  char c;
  do {
    if (MacInFile->parent == NULL) {
      return(EOF);			  /* End of file */
    } else {
      FILEINFO* new = MacInFile->parent;
      free(MacInFile->filename);	  /* Free name and	*/
      if (MacInFile->progname != NULL)	  /* if a #line was seen, */
	free(MacInFile->progname);	  /* free it, too.	*/
      free(MacInFile->buffer);		  /* Free buffer */
      free((char *) MacInFile);		  /* Free file space	*/

      *new->bptr = EOS;
      new->bptr = new->buffer;
      c = *new->bptr++;
      MacInFile = new;
    }
  }
  while (c == EOS);
  return (c);
}

void
NextMacOutBuffer()
{
  MacOutFile = next_buffer(MacOutFile);
  MacOutEnd = MacOutFile->buffer + (NBUFF - 1);
}

void
NextMacOutString(s)
char* s;
{ 
  int slen = strlen(s);
  int blen;
  while ((blen = (MacOutEnd - MacOutFile->bptr) - 1) < slen) {
    if(blen>0) {
      strncpy(MacOutFile->bptr, s, blen);
      MacOutFile->bptr += blen;
      s += blen;
      slen -= blen;
    }
    NextMacOutBuffer();
  }
  strcpy(MacOutFile->bptr, s);
  MacOutFile->bptr += slen;
}

static char* new_buffer (obuf, obufend, file)
     char*      obuf;			/* Output Buffer */
     char**     obufend;		/* End of Output Buffer */
     FILEINFO	**file;			/* Funny #include	*/
{
  FILEINFO* old = *file;
  FILEINFO* new = get_temp_file(NBUFF, old->filename);
  *obuf = EOS;
  /* NOTE: this code leaves file->bptr pointing at the END of the */
  /*       buffer.  This is to keep double_copy from having to use */
  /*       strlen to get the number of bytes in the buffer */
  old->bptr = obuf;
  old->parent = new;		  /* When file dries up, read from new */
  *obufend = new->buffer + (NBUFF - 1);
  *file = new;
  return new->bptr;
}
/*
 * Copy from the input stream to a buffer, stopping at the first
 * delim, but including everything with matching {} [] ()
 * <> "" '' and comments found along the way.
 */
static FILEINFO*
copy_body(file, delim, is_string, is_top_level, expand)
     FILEINFO	*file;			/* Funny #include	*/
     char delim;			/* Char to stop on */
     int is_string;			/* True when inside a string */
     int is_top_level;			/* True when the outer most call */
     int expand;			/* if non-zero, macroexpand */
{
  register char* obuf;			/* Current output pointer */
  register char c;			/* Current character */
  char p;				/* Previous character */
  char* obufend;			/* End of output buffer */
  char newdelim;			/* New delimiter to look for */
  int new_is_string = FALSE;		/* New is_string flag */

  obuf = file->bptr;			/* -> output buffer	*/
  obufend = file->buffer + (NBUFF - 1);	/* Note its end		*/

  *obuf = EOS;
  for (p = EOS; (c = get()) != EOF_CHAR; p = c) {
    if (obuf >= obufend)		/* End of buffer, get a new one */
      obuf = new_buffer(obuf, &obufend, &file);
    if(expand && !is_string && type[c] == LET) {    /* expand macros */
      c = macroid(c);			/* Grab the token	*/
      if (obuf >= obufend-strlen(tokenbuf)) /* End of buffer, get a new one */
	obuf = new_buffer(obuf, &obufend, &file);
      if(type[c] == LET) {
	strcpy(obuf, tokenbuf);
	obuf += strlen(tokenbuf);
	continue;
      }
    }
    *obuf++ = c;
    if (c == delim)			/* Quit when delimeter found */
      if (delim != '/' || p == '*') {	/* Special test for end of comment */
	*obuf = EOS;
	file->bptr = obuf;
	return(file);
      }
    if (!is_string) {
      switch (c) {	       /* Look for new delimeters when not is_string */
      case DEF_MAGIC:
      case TOK_SEP:
      case COM_SEP:
	obuf--; continue;		  /* Ignore magic characters */
      case '{':  newdelim = '}'; break;
      case '[':  newdelim = ']'; break;
      case '(':  newdelim = ')'; break;
      case '<':
	if (delim != '>') continue;
	newdelim = '>'; break;
      case '\'':  newdelim = '\''; new_is_string = TRUE; break;
      case '\"':  newdelim = '\"'; new_is_string = TRUE; break;
      case '*':				  /* Start of C comment? */
	if (p == '/') {
	  if (keepcomments) {
	    newdelim = '/';
	    new_is_string = TRUE;
	    break;
	  }				  /* Eat comment */
	  for (; (c = get()) != EOF_CHAR; p = c) {
	    if (c == '\n') {
	      if (obuf >= obufend)	  /* End of buffer, get a new one */
		obuf = new_buffer(obuf, &obufend, &file);
	      *obuf++ = c;		  /* Preserve newlines */
	    } else if (c == '/' && p == '*') break;
	  }
	  if (obuf+2 >= obufend)	  /* End of buffer, get a new one */
	    obuf = new_buffer(obuf, &obufend, &file);
	  *obuf++ = '*';		  /* Terminate the comment */
	  *obuf++ = '/';
	}
	continue;

      case '/':				/* Start of C++ comment? */
	if (p == '/') {
	  if (keepcomments) {
	    newdelim = '\n';
	    new_is_string = TRUE;
	    break;
	  }				  /* Eat comment */
	  while ((c = get()) != EOF_CHAR && c != '\n');
	  if (obuf >= obufend)	  /* End of buffer, get a new one */
	    obuf = new_buffer(obuf, &obufend, &file);
	  *obuf++ = c;		  /* Preserve newlines */
	}
	continue;

      default:
	  continue;	/* Loop to next character, unless break above */
      }	/* end switch */
      if (is_top_level && newdelim == delim) {
	is_top_level = FALSE;
	continue;		/* at top_level, with left side of delimiter */
      }
      file->bptr = obuf;
      file = copy_body(file, newdelim, new_is_string, FALSE, expand);
      if (file == NULL)
	return(NULL);
      obuf = file->bptr;		/* -> output buffer	*/
      obufend = file->buffer + (NBUFF - 1); /* Note its end		*/
      new_is_string = FALSE;
      c = EOS; /* don't know what last character is anymore */
    }  /* if !is_string */
  } /* end while */
  fprintf(stderr, "Searching for '%c'\n", delim); /* DEBUG */
  infile = getfile(1, current_file);	  /* Hack up infile */
  infile->fp = stdin;			  /* to print correct file */
  line = current_line;			  /* and line number */
  cfatal("End of file during %s macro expansion.", file->filename);
  return(NULL);
} /* copy_body */

#if !(HOST == SYS_OS2 || HOST == SYS_VMS || HOST == SYS_MVS)
/*
 *  support for fork and pipe on unix machines only
 */

/*
 * Copy two files in parallel: from in1 to out2 and in2 to out2 
 * Returns when both copies are complete, closing all files.
 * in1 and out2 will not block (i.e. they're files)
 * out1 and in2 may be pipes and can block for long periods
 */
static void
doublecopy (in1, out1, in2, out2)

  FILEINFO	*in1, *out2;  
  int           out1, in2;
{
  fd_set readfds;
  fd_set writefds;
  fd_set errorfds;
  int n, width;
  int is_first = TRUE;
  char* outptr = in1->buffer;

  width = 1 + ((in2 > out1) ? in2 : out1); /* width = max(in2, out1); */

  do {
    FD_ZERO(&readfds);
    FD_ZERO(&writefds);
    FD_ZERO(&errorfds);
    if (in2  >= 0) FD_SET(in2, &readfds);
    if (out1 >= 0) FD_SET(out1, &writefds);

    if (select(width, &readfds, &writefds, &errorfds, NULL) <= 0)
      perror("Select Error");

    if (out1>=0 && FD_ISSET(out1, &errorfds))
      perror("Select output Error");

    if (in2>=0 && FD_ISSET(in2, &errorfds))
      perror("Select input Error");

    if (!(out1>=0 && FD_ISSET(out1, &writefds)) &&
	!(in2>=0 && FD_ISSET(in2, &readfds))) {
      perror("Select when nothing happened");
    }

    if (out1>=0 && FD_ISSET(out1, &writefds)) {
      if (in1 == NULL) {
	close(out1);
	out1 = -1;
      } else {
	int nbytes = in1->bptr - outptr;
	int wbytes = write(out1, outptr, nbytes);
	if (wbytes < 0)
	  perror("Error writing to pipe");
	outptr += wbytes;
	if (nbytes == wbytes) {
	  in1 = in1->parent;
	  if (in1 != NULL)
	    outptr = in1->buffer;
	}
      }
    }

    if (in2>=0 && FD_ISSET(in2, &readfds)) {
      if (is_first)
	is_first = FALSE;
      else {				/* Chain in a new buffer */
	FILEINFO* new = get_temp_file(NBUFF, out2->filename);
	new->parent = out2->parent;	/* When new ends read from infile */
	out2->parent = new;	        /* When out2 dries up, read from new */
	out2 = new;
      }
      n = read(in2, out2->buffer, NBUFF);
      if (n <= 0) {
	if(n<0)
	  perror("Error reading from pipe");
	close(in2);
	in2 = -1;
      } else {
	char* p = out2->buffer + n;
	*p = EOS;	
      }
    }
  } while (in2>=0 || out1>=0);
} /* end doublecopy */

/*
 * Fork an external macro expander
 */
static void
fork_macro (args, ifile, ofile)
     struct macroargs* args;
     FILEINFO *ifile, *ofile;
{     
  int inchannel, outchannel;
  int forkin, forkout;
  int pid, status;
  {					/* Create the pipes */
    int sv[2];
    pipe (sv);
    forkin = sv[0];
    outchannel = sv[1];
    pipe (sv);
    inchannel = sv[0];
    forkout = sv[1];
  }
					/* Fork the macro process */
  if ((pid = fork ()) == 0) {
    /* child process.  Move pipes to stdin and stdout then exec */
    close(0); dup2(forkin, 0);
    close(1); dup2(forkout, 1);
    close(forkin);
    close(forkout);
    close(inchannel);  /* Close files used only by the parent */
    close(outchannel);
    execv(args->program, args->args);
    /* execv never returns */
  }
  close(forkin);  /* Close files used only by the child */
  close(forkout);
  if (pid < 0) 
    cfatal("Can't fork %s macro.", args->program);
  /* Make output to the pipe non-blocking to avoid deadlocks */
  fcntl(outchannel, F_SETFL, FNDELAY | fcntl(outchannel, F_GETFL, 0));
  doublecopy (ifile, outchannel, inchannel, ofile);
  wait(&status);
  if(status != 0)
    cerror("Error during %s macro expansion", args->program);
} /* end fork_macro */

#else
/* 
 * execute macro using temp files to redirect stdin and stdout
 * temp file implementation used for DOS, VMS and MVS ports
 * instead of fork/pipe implementation
 */
void run_macro (macname, args, in, out)
    char* macname;
    char* args[];
    char *in, *out;
{
    int status;
    int ifd, ofd;
#if HOST != SYS_OS2 && HOST != SYS_MVS
    /* 
     * no fork function on OS2 or MVS
     */
    int pid;
    if ((pid=fork()) == 0) {
      /* child process */
      ifd = open(in, O_RDONLY);
      if (ifd < 0) {
	perror("cpp exec macro error");
	cerror("Cannot open external macro temp file \"%s\"", in);
	return;
      }
      ofd = open(out, O_WRONLY | O_CREAT | O_TRUNC, 0644);
      if (ofd < 0) {
	perror("cpp exec macro error");
	cerror("Cannot open external macro temp file \"%s\"", out);
	return;
      }
      if (dup2(ifd, 0) < 0) {
	perror("cpp exec macro error");
	cerror("Cannot dup external macro temp file \"%s\"", in);
	return;
      }
      if (dup2(ofd, 1) < 0) {
	perror("cpp exec macro error");
	cerror("Cannot dup external macro temp file \"%s\"", out);
	return;
      }
      execvp(macname, args);
      perror("cpp exec macro error");
      cerror(stderr, "cpp: Cannot execute %s\n", macname);
      close(ifd);
      close(ofd);
    }
    if (pid < 0)
      cfatal("Cannot execute %s\n", macname);
    wait(&status);
#else
    /* for OS/2 and MVS
     * use system function to execute macro with command interpreter
     */
    char arglist[256];
    char subarg[256];
    char command[512];
    char* c;
    /* build arglist of macro command */
    char** argp = &args[1];		  /* skip macro name */
    if (*argp != NULL) {
      sprintf(arglist,"%s", *argp);
      for (++argp; *argp !=NULL; argp++) {
	strcpy(subarg,arglist);
	sprintf(arglist,"%s %s",subarg, *argp);
      }
    } else strcpy(arglist,"");
    for (c = macname; *c != '\n'; c++)
      if (*c == '/') *c = '\\';
    /* build complete command redirecting stdin and stdout to temp files */
    sprintf(command,"%s %s < %s > %s",macname,arglist,in,out);
    /* execute command */
    status = system(command);
#endif
    if(status != 0)
      cerror("Error during %s macro expansion", macname);
} /* end of run_macro */

#if HOST == SYS_OS2 || HOST == SYS_MVS
static char* TMPDIR = "E:\\";
#else
static char* TMPDIR = "/tmp/";
#endif

/* exec macro using temp files to redirect stdin and stdout */
void exec_macro (args, ifile, ofile)
     struct macroargs* args;
     FILEINFO *ifile, *ofile;
{     
  char tmpin[256];
  char tmpout[256];
  FILEINFO *f;
  int n, ifds,ofds;
  char* p;

  /* make temp file names using process id */
  sprintf(tmpin, "%s%s%d", TMPDIR, "in", getpid() % 9999);
  sprintf(tmpout, "%s%s%d", TMPDIR, "out", getpid() % 9999);

  /* copy ifile to input temp file and close it */
  ifds = open(tmpin, O_WRONLY | O_CREAT | O_TRUNC, 0644);
  if (ifds < 0) {
    perror("cpp exec macro error");
    cerror("Cannot open external macro temp file \"%s\"", tmpin);
    return;
  }
  f = ifile;
  for (;;) {
    n = write(ifds, f->buffer, f->bptr - f->buffer);
    if (n < 0) {
      perror("cpp macro error");
      cerror("Cannot write to external macro temp file \"%s\"", tmpin);
      close(ifds);
      return;
    }
    if ((f = f->parent) == NULL) break;
  }
  close(ifds);

  /*  fork and exec external macro */
  run_macro(args->program, args->args, tmpin, tmpout);

  /* copy output temp file to ofile and close it */
  ofds = open(tmpout, O_RDONLY);
  if (ofds < 0) return;
  n = read(ofds, ofile->buffer, NBUFF);
  for (;;) {
    FILEINFO* new;
    if (n <= 0) break;
    p = ofile->buffer + n;
    *p = EOS;
    new = get_temp_file(NBUFF, ofile->filename);
    new->parent = ofile->parent;
    ofile->parent = new;
    ofile = new;
    n = read(ofds, ofile->bptr, NBUFF);
  }
  close(ofds);

  /* remove temp files */
  unlink(tmpin);
  unlink(tmpout);
}

#endif  /* for DOS or VMS or MVS */

/*
 * Call an internal macro expander
 */
static void
call_expander (args, ifile, ofile)
     struct macroargs* args;
     FILEINFO *ifile, *ofile;
{     
  int nargs = 0;
  char** arg = args->args;
  while(*arg++ != NULL) nargs++;	/* Count args */
  *ifile->bptr = EOS;
  ifile->bptr = ifile->buffer;
  MacInFile = ifile;			/* Set global I/O buffers */
  MacOutFile = ofile;
  MacOutEnd = ofile->buffer + (NBUFF - 1);
  if (((*args->expander)(nargs, args->args)) != 0)
    cerror("Error during internal %s macro expansion", args->program);
  *MacOutFile->bptr = EOS;
  MacOutFile->bptr = MacOutFile->buffer;
}
/*
 * Expand an external macro.
 *   1. Grab the macro name and everything until the next semicolon
 *      (includling all matching {} [] () <> "" '' and comments found along
 *      the way), and put it in a macro buffer.  Commands found along
 *      the way are processed.
 *   2. Pipe this into the macro, and put the result in another macro buffer.
 *   3. Process the macro expansion.
 */
void
expand_external(dp)
  char* dp;
{
  FILEINFO	*ifile, *ofile;	/* The first output file buffer */
  struct macroargs* args = (struct macroargs*) dp; /* macro arguments */
  char* name = args->name;		/* Macro name */
  extern int macroid();			/* Get a macro-expanded character */

  if(!args->recursive) {
    FILEINFO *f;	        /* If recursion where it isn't allowed */
    for (f = infile; (f->parent != NULL); f = f->parent) {
      if(strcmp(f->filename, name) == 0) {
	fputs(name, stdout);	/* Skip expansion */
	return;}}}
  /*
   * Ensure the start is correct
   */
  strcpy(work, name);
  workp = work + strlen(name);
  { char c;			/* current character */
    char d = args->conditional;
    if(d != EOS) {		/* check for conditional character */
      instring = TRUE;
      while(isspace(c = get())) *workp++ = c;
      *workp = EOS;
      instring = FALSE;
      unget();
      if (c != d) {		/* When no conditional character, exit */
#ifdef paranoia
	cwarn("defmacro \"%s\" needs arguments", name);
#endif
				/* Place macro name back in input stream */
				/* being careful to avoid recursion */
	/* fputs(work, stdout); this isn't good enough */
	ofile = get_temp_file(strlen(work)+1, name);
	ofile->parent = infile;
	ofile->buffer[0] = DEF_MAGIC;
	strcpy(ofile->buffer+1, work);
	infile = ofile;
	return;
      }
    }
  }
  current_line = line;
  strcpy(current_file,
	 (infile->progname != NULL) ? infile->progname : infile->filename);
  /*
   * Copy everything to the next ;
   */
  ifile = get_temp_file(NBUFF, name);
  ofile = get_temp_file(NBUFF, name);
  strcpy(ifile->buffer, work);	/* Send name to macro expander */
  ifile->bptr = ifile->buffer + strlen(work);
  instring = TRUE;		/* Ensure comments get copied too */
  if (copy_body(ifile, args->delimiter, FALSE, TRUE, args->expanding) == NULL) {
    instring = FALSE;
    return;
  }
  instring = FALSE;
  infile->line = line;
  /*
   * Expand the macro
   */
  ofile->parent = infile;
  if (args->expander == NULL) {
#if !(HOST == SYS_OS2 || HOST == SYS_VMS || HOST == SYS_MVS)
    fork_macro(args, ifile, ofile);
#else
    exec_macro(args, ifile, ofile);
#endif
  }
  else
    call_expander(args, ifile, ofile);
  infile = ofile;
}

/*
 * scanthing(delim)
 *   Copy from input to work, stopping at delim
 *   but including everything with matching {} [] ()
 *   <> "" '' and comments found along the way.
 */
static int
scanthing(delim, is_string, is_top_level)
  char delim; 			        /* Current delimiter */
  int is_string, is_top_level;	        /* flags */
{
  char c; 			        /* Current character */
  char newdelim;			/* New delimiter to look for */
  int new_is_string = FALSE;		/* New is_string flag */

  if (is_top_level) {			/* Skip leading whitespace */
    workp = work;
    c = skipws();
    unget();
  }
  while ((c = get()) != EOF_CHAR) {
    save(c);
    if (delim == c &&			/* Quit when delimeter found */
	delim != ' ') {
      *workp = EOS;
      return FALSE;
    }
    if (!is_string) {
      switch (c) {		/* Look for new delimeters when not is_string */
      case ' ':
      case ',':
      case '\t':
      case '\n':
	if (delim == ' ') {
	  unget();
	  workp -= 1;
	  *workp = EOS;
	  return FALSE;
	} else continue;
      case '{':  newdelim = '}'; break;
      case '[':  newdelim = ']'; break;
      case '(':  newdelim = ')'; break;
      case '\'':  newdelim = '\''; new_is_string = TRUE; break;
      case '\"':  newdelim = '\"'; new_is_string = TRUE; break;
      default: 
	continue;		/* Loop to next character, unless break above */
      }	/* end switch */
      if (is_top_level && newdelim == delim) {
	is_top_level = FALSE;
	continue;		/* at top_level, with left side of delimiter */
      }
      scanthing(newdelim, new_is_string, FALSE);
      new_is_string = FALSE;
    }  /* if !is_string */
  } /* end while */
  return (c == EOF_CHAR);
} 
/*
 * create a new defmacro (internal function)
 */
void
new_defmacro(name, expanding, recursive, delimiter, conditional, 
	     expander, program, args)
  char* name;
  char  expanding;		/* Non-zero when args are macro expanded */
  char  recursive;		/* Non-zero when recursive */
  char  delimiter;		/* Delimiter */
  char  conditional;		/* Expand only if this char found after name */
  internal_expander expander;	/* Macro expander or NULL if file */
  char *program;		/* macro program pathname */
  char** args;			/* arg list (vector of strings) */
{
  struct macroargs* new;
  int nargs = 1;
  char** argp;

  if (args == NULL) {			  /* Setup default args */
    args = (char**) getmem(sizeof(char*)*2);
    args[0] = program;
    args[1] = NULL;
  }
  for(argp = args; *argp++!=NULL; nargs++);	/* Count arguments */

  new = (struct macroargs*) getmem(sizeof(struct macroargs) +
				   (nargs*sizeof(char*)));
  new->name = name;
  new->expanding = expanding;
  new->recursive = recursive;
  new->delimiter = delimiter;
  new->conditional = conditional;
  new->expander = expander;
  new->program = program;
  while(nargs-- > 0)
    new->args[nargs] = args[nargs];
  define_builtin(name, expand_external, (char*) new);
}

/*
 * Define an external macro handler
 *
 *     Called when #pragma defmacro
 *     is found in the input.
 * The complete form is:
 * #pragma defmacro name <file> options
 * #pragma defmacro name "file" options
 * #pragma defmacro name program options
 *
 * where "options" is zero or more of the following:
 *  recursive    - when present, the macro is recursively expanded
 *  delimiter=?  - the default delimiter of ; is replaced with ?
 *  condition=?  - Expand only if this char found after name
 *  other        - other options are passed as arguments to the
 *                 macro expander
 */
void
define_external()
{
  char c;
  char delim;
  char* name;
  char* program;
  int nargs = 1;
  int maxargs = 32;
  char* args[32];
  int recursive = 0;
  int expanding = 0;
  int delimiter = ';';
  int conditional = EOS;
  internal_expander expander = NULL;

  c = skipws();
  scanid(c);
  name = savestring(tokenbuf);
  program = name;
		/* Parse_include returns EOS for internal macros (no " or <) */
  delim = parse_include();		  /* Get program to work */
  strcpy(tokenbuf, work); /* Keep copy because findinclude mangles it */
#if HOST == SYS_OS2
  strcat(work,".exe");
#endif
  if (delim == EOS || findinclude(work, (delim == '"'), X_OK) == FALSE) {
    struct expander_pair* p = internal_macros; /* Macro file not found */
    strcpy(work, tokenbuf);                    /* restore progam name */
    for (; p->name != NULL; p++)	       /* Search for internal macro */
      if (strcmp(p->name, work) == 0) {
	expander = p->function;
	goto found_internal;
      }	
    cerror("Cannot open macro file \"%s\"", work);
    goto macerr;
  }
/*
#if HOST == SYS_VMS || HOST == SYS_MVS
  else {
    cerror("External macros not supported for \"%s\"", work);
    goto macerr;
  }
#endif
*/
found_internal:
  program = args[0] = savestring(work);

  c = skipws();
  while (c != '\n' && c != EOF_CHAR) {
    while (c == ',') {
      args[nargs++] = ",";
      c = skipws();
    }
    unget();
    if (scanthing(' ', FALSE, TRUE))
      cfatal("End of file during #pragma defmacro %s processing.", name);
    if(strcmp(work, "recursive") == 0) {
      recursive = 1;
      c = skipws();
      continue;
    }
    if(strcmp(work, "expanding") == 0) {
      expanding = 1;
      continue;
    } 
    {
      int* option = NULL;
      if(strncmp(work, "delimiter", 9) == 0) option = &delimiter;
      if(strncmp(work, "condition", 9) == 0) option = &conditional;
      if(option != NULL) {
	if (work[9] != '=' && (c = skipws()) != '=') {
	  cerror("In #pragma defmacro, Missing = after %s", work);
	  goto macerr;
	}
	if(strlen(work) == 11)
	  *option = work[10];
	else 
	  *option = skipws();
	if(*option != '\n') c = skipws();
	continue;
      }
    }                /* must be a program option */
    if (nargs >= maxargs) {
      cerror("In #pragma defmacro %s, too many arguments.", name);
      goto macerr;
    }
    args[nargs] = savestring(work);
    nargs++;
    c = skipws();
  } /* end while not newline */
  unget();			/* Force nl after includee	*/
  args[nargs] = NULL;
  new_defmacro(name, expanding, recursive, delimiter, conditional, 
	       expander, program, args);
  return;

 macerr:
  skipnl();			/* Skip to end of line */
  unget();			/* Force nl */
  return;
}

/*-----------------------------------------------------------------------------
 * Process DEFPACKAGE command.
 * format is: defpackage NAME <path> options
 * where options are optional and seperated by comma's.
 *
 * This really should be an internal defmacro, but
 * it was so much easier to handle it here...
 */
static char* defpackage_options[] = {
  "length", "case",
  "start", "increment", "template", "max", "use_first", "nospace", NULL};

void
define_package(dp)
  char* dp;
{
  extern void package_define();
  char c;
  char delim;
  char* pkgname;
  char* pkgfile;
  char* options[8];
  long loptions[6];
  int np;
  char errmsg[100];

  options[0]=""; options[1]=""; options[2]=""; options[3]="";
  options[4]=""; options[5]=""; options[6]=""; options[7]="";
  c = skipws();
  scanid(c);
  pkgname = savestring(tokenbuf);
  if((delim = parse_include()) == EOS) {
    cerror("DEFPACKAGE syntax error", NULLST);
    goto macerr;
  }
  if (findinclude(work, (delim == '"'), R_OK) == FALSE) {
    cerror("Cannot open package header file \"%s\"", work);
    goto macerr;
  }
  pkgfile = savestring(work);
					  /* Get options */
  while ((c=skipws()) != '\n' && c != EOF_CHAR) {
    char** p;
    if (c == ',')			  /* Skip over commas */
      if ((c=skipws()) == '\n' || c == EOF_CHAR)
	break;
    scanid(c);
    np = 0;
    p = defpackage_options;
    for (; *p != NULL; p++, np++) 
      if(strcmp(tokenbuf, *p) == 0) break;
    if (*p == NULL) {
      sprintf(errmsg, "In DEFPACKAGE %s, unknown option \"%s\"",
	      pkgname, tokenbuf);
      cerror(errmsg, NULLST);
      goto macerr;
    } else if ((c = skipws()) != '=') {
      sprintf(errmsg, "In DEFPACKAGE %s, Missing = after %s option",
	      pkgname, tokenbuf);
      cerror(errmsg, NULLST);
      goto macerr;
    } else {
      c = skipws();
      scanid(c);
      options[np] = savestring(tokenbuf);
    }
  }
  unget();  /* Force nl after includee */
					  /* Convert numeric options */
  for(np=2; np<8; np++) {
    char* endp[1];
    long val = strtol(options[np], endp, 0);
    if(**endp != EOS) {
      sprintf(errmsg, "In DEFPACKAGE %s, Illegal value %s for %s option",
	      pkgname, options[np], defpackage_options[np]);
      cwarn(errmsg, NULLST);
    }
    loptions[np-2] = val;
  }
  package_define(pkgname, pkgfile, 
		 options[0], options[1], loptions[0], loptions[1],
		 loptions[2], loptions[3], loptions[4], loptions[5]);
  return;

 macerr:
  skipnl();			/* Skip to end of line */
  unget();			/* Force nl */
  return;
}
