/*


 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 2 . C
 *
 *			   Process #control lines
 *
 * Edit history
 * 13-Nov-84	MM	Split from cpp1.c
 * 21-Oct-85	RMS	Do not turn on `instring' while reading #include arg.
 *			Rename `token' to `tokenbuf'.
 *			Flush tabs at end of #include line, like spaces.
 * 16-Mar-89	LGO	Split parse_file out from doinclude, so it can be 
 *                      shared by #pragma demacro.
 * 20-Mar-89	LGO	Ignore command errors in non-compiled code
 * 23-Mar-89	LGO	Add support for #error
 * 24-Sep-89    AFM     OS2, XENIX and AIX support.
 * 19-Jan-90    DKM     MVS support 
 * 23-Apr-90    MJF     Include file parsing ignore // or /* as comment
 * 01-May-90    MJF     unrecognized #pragma needs to output newline
 * 18-May-90    MBN     Conditional compilation for COOL to get "clean" cpp
 * 25-Jun-91	GPD	Remove #elif to make more portable.
 *			Added support for Interactive Unix.
 * 01-Jul-91	GPD	Fix search for include in local directory first.
 */

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

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

#if defined(vms)
#include        <file.h>
#else
#if defined(SYS_OSVS)
#include        <fcntl.h>
#else
#if !defined(DOS) && !defined(MSDOS)
#if defined(M_INTERACTIVE)
#include	<unistd.h>
#endif
#include        <sys/file.h>
#endif
#endif
#endif

#if defined(vms)
/*
 * Include the rms stuff.  (We can't just include rms.h as it uses the
 * VaxC-specific library include syntax that Decus CPP doesn't support.
 * By including things by hand, we can CPP ourself.)
 */
#include	<nam.h>
#include	<fab.h>
#include	<rab.h>
#include	<rmsdef.h>
#endif

#ifdef COOL
extern void define_external();      /* Define an external macro handler */
#endif

/*
 * Generate (by hand-inspection) a set of unique values for each control
 * operator.  Note that this is not guaranteed to work for non-Ascii
 * machines.  CPP won't compile if there are hash conflicts.
 */

#define	L_assert	('a' + ('s' << 1))
#define	L_define	('d' + ('f' << 1))
#define	L_elif		('e' + ('i' << 1))
#define	L_else		('e' + ('s' << 1))
#define	L_endif		('e' + ('d' << 1))
#define	L_if		('i' + (EOS << 1))
#define	L_ifdef		('i' + ('d' << 1))
#define	L_ifndef	('i' + ('n' << 1))
#define	L_include	('i' + ('c' << 1))
#define	L_line		('l' + ('n' << 1))
#define	L_nogood	(EOS + (EOS << 1))	/* To catch #i		*/
#define	L_pragma	('p' + ('a' << 1))
#define	L_error 	('e' + ('r' << 1))
#define L_undef		('u' + ('d' << 1))
#if DEBUG
#define	L_debug		('d' + ('b' << 1))	/* #debug		*/
#define	L_nodebug	('n' + ('d' << 1))	/* #nodebug		*/
#endif

int
control(counter)
int		counter;	/* Pending newline counter		*/
/*
 * Process #control lines.  Simple commands are processed inline,
 * while complex commands have their own subroutines.
 *
 * The counter is used to force out a newline before #line, and
 * #pragma commands.  This prevents these commands from ending up at
 * the end of the previous line if cpp is invoked with the -C option.
 */
{
	register int		c;
	register char		*tp;
	register int		hash;
	char			*ep;

	/* Copy all #xxx commands to output as comments */
	if (debug&2 && compiling && cflag) {
	  char* bufp = infile->bptr;
	  fputs("\n//#",stdout);
	  while(*bufp != '\n' && *bufp != EOS)
	    output(*bufp++);
	}

	c = skipws();
	if (c == '\n' || c == EOF_CHAR)
	    return (counter + 1);
	if (!isdigit(c))
	    scanid(c);			/* Get #word to tokenbuf	*/
	else {
	    unget();			/* Hack -- allow #123 as a	*/
	    strcpy(tokenbuf, "line");	/* synonym for #line 123	*/
	}
	hash = (tokenbuf[1] == EOS) ? L_nogood : (tokenbuf[0] +
						  (tokenbuf[2] << 1));
	switch (hash) {
	case L_assert:	tp = "assert";		break;
	case L_define:	tp = "define";		break;
	case L_elif:	tp = "elif";		break;
	case L_else:	tp = "else";		break;
	case L_endif:	tp = "endif";		break;
	case L_if:	tp = "if";		break;
	case L_ifdef:	tp = "ifdef";		break;
	case L_ifndef:	tp = "ifndef";		break;
	case L_include:	tp = "include";		break;
	case L_line:	tp = "line";		break;
	case L_pragma:	tp = "pragma";		break;
	case L_error:	tp = "error";		break;
	case L_undef:	tp = "undef";		break;
#if DEBUG
	case L_debug:	tp = "debug";		break;
	case L_nodebug:	tp = "nodebug";		break;
#endif
	default:	hash = L_nogood;
	case L_nogood:	tp = "";		break;
	}
	if (!streq(tp, tokenbuf))
	    hash = L_nogood;
	/*
	 * hash is set to a unique value corresponding to the
	 * control keyword (or L_nogood if we think it's nonsense).
	 */
#ifdef PARANOID
	if (infile->fp == NULL)
	    cwarn("Control line \"%s\" within macro expansion", tokenbuf);
#endif
	if (!compiling) {			/* Not compiling now	*/
	    switch (hash) {
	    case L_if:				/* These can't turn	*/
	    case L_ifdef:			/*  compilation on, but	*/
	    case L_ifndef:			/*   we must nest #if's	*/
		if (++ifptr >= &ifstack[BLK_NEST])
		    goto if_nest_err;
		*ifptr = 0;			/* !WAS_COMPILING	*/
	    case L_line:			/* Many			*/
	    case L_pragma:			/*  options		*/
	    case L_include:			/*   are uninteresting	*/
	    case L_define:			/*    if we		*/
	    case L_undef:			/*     aren't		*/
	    case L_assert:			/*      compiling.	*/
	    case L_error:
	    case L_nogood:
dump_line:	skipnl();			/* Ignore rest of line	*/
		return (counter + 1);
	    }
	}
	/*
	 * Make sure that #line and #pragma are output on a fresh line.
	 */
	if (counter > 0 && (hash == L_line || hash == L_pragma)) {
	    putchar('\n');
	    counter--;
	}
	switch (hash) {
	case L_line:
	    /*
	     * Parse the line to update the line number and "progname"
	     * field and line number for the next input line.
	     * Set wrongline to force it out later.
	     */
	    c = skipws();
	    workp = work;			/* Save name in work	*/
	    while (c != '\n' && c != EOF_CHAR) {
		save(c);
		c = get();
	    }
	    unget();			  /* put the newline back */
	    save(EOS);
	    /*
	     * Split #line argument into <line-number> and <name>
	     * We subtract 1 as we want the number of the next line.
	     */
	    line = atoi(work);			/* Reset line number	*/
	    for (tp = work; isdigit(*tp) || type[*tp] == SPA; tp++)
		;				/* Skip over digits	*/
	    if (*tp != EOS) {			/* Got a filename, so:	*/
		if (*tp == '"' && (ep = strrchr(tp + 1, '"')) != NULL) {
		    tp++;			/* Skip over left quote	*/
		    *ep = EOS;			/* And ignore right one	*/
		}
		if (infile->progname != NULL)	/* Give up the old name	*/
		    free(infile->progname);	/* if it's allocated.	*/
	        infile->progname = savestring(tp);
	    }
	    if (infile->fp == NULL) {		/* If inside a macro */
	      printf("#%s %d \"%s\"\n", LINE_PREFIX, line,
		     (infile->progname != NULL)
		     ? infile->progname : infile->filename);
	      counter--;		  /* Subtract for the \n added later */
	      wrongline = FALSE;
	    } else {
	      wrongline = TRUE;		  /* else Force output later */
	      line--;
	    }
	    break;

	case L_include:
	    doinclude();
	    break;

	case L_define:
	    dodefine();
	    break;

	case L_undef:
	    doundef();
	    break;

	case L_else:
	    if (ifptr == &ifstack[0])
		goto nest_err;
	    else if ((*ifptr & ELSE_SEEN) != 0)
		goto else_seen_err;
	    *ifptr |= ELSE_SEEN;
	    if ((*ifptr & WAS_COMPILING) != 0) {
		if (compiling || (*ifptr & TRUE_SEEN) != 0)
		    compiling = FALSE;
		else {
		    compiling = TRUE;
		}
	    }
	    break;

	case L_elif:
	    if (ifptr == &ifstack[0])
		goto nest_err;
	    else if ((*ifptr & ELSE_SEEN) != 0) {
else_seen_err:	cerror("#%s may not follow #else", tokenbuf);
		goto dump_line;
	    }
	    if ((*ifptr & (WAS_COMPILING | TRUE_SEEN)) != WAS_COMPILING) {
		compiling = FALSE;		/* Done compiling stuff	*/
		goto dump_line;			/* Skip this clause	*/
	    }
	    doif(L_if);
	    break;

	case L_if:
	case L_ifdef:
	case L_ifndef:
	    if (++ifptr >= &ifstack[BLK_NEST])
if_nest_err:	cfatal("Too many nested #%s statements", tokenbuf);
	    *ifptr = WAS_COMPILING;
	    doif(hash);
	    break;

	case L_endif:
	    if (ifptr == &ifstack[0]) {
nest_err:	cerror("#%s must be in an #if", tokenbuf);
		goto dump_line;
	    }
	    if (!compiling && (*ifptr & WAS_COMPILING) != 0)
		wrongline = TRUE;
	    compiling = ((*ifptr & WAS_COMPILING) != 0);
	    --ifptr;
	    break;

	case L_assert:
	    if (eval() == 0)
		cerror("Preprocessor assertion failure", NULLST);
	    break;

	case L_pragma:
	    /*
	     * #pragma is provided to pass "options" to later
	     * passes of the compiler.  cpp only has one: defmacro
	     */
	    c=skipws();
	    c = macroid(c);
#ifdef COOL
	    if(strcmp(tokenbuf, "defmacro") == 0) {
	      define_external();

#if (HOST == SYS_XENIX || HOST == SYS_OS2)
/*
 * munge pack(n) for Xenix and os2 Glockenspiels cfront by quotifying 
 * pack(n) to "pack(n)"
 */
	    } else if (strcmp(tokenbuf, "pack") == 0) {
	      fputs("#pragma \"", stdout);
	      while (c != '\n' && c != EOF_CHAR) {
		if (type[c] == LET) {
		  fputs(tokenbuf, stdout);
		} else cput(c);
		c = get();
		c = macroid(c);
	      }
	      putchar('"');
	      unget();			  /* Leave newline in buffer */
#endif
	    } else
#endif
	    { /* pass through undefined pragmas */
	      fputs("#pragma ", stdout);
	      while (c != '\n' && c != EOF_CHAR) {
		if (type[c] == LET) {
		  fputs(tokenbuf, stdout);
		} else cput(c);
		c = get();
		c = macroid(c);
	      }
	      putchar('\n');		  /* output newline */
	      unget();			  /* Leave newline in buffer */
	    }
	    break;

	  case L_error:
	    workp = work;
	    for(c=skipws(); c!='\n' && c!=EOF_CHAR; c=get())
	      *workp++ = c;	      
	    *workp = EOS;
	    unget();
	    cerror(work, NULLST);
	    break;

#if DEBUG
	case L_debug:
	    if (debug == 0)
		dumpdef("debug set on");
	    debug++;
	    break;

	case L_nodebug:
	    debug--;
	    break;
#endif

	default:
	    /*
	     * Undefined #control keyword.
	     * Note: the correct behavior may be to warn and
	     * pass the line to a subsequent compiler pass.
	     * This would allow #asm or similar extensions.
	     */
	    cerror("Illegal # command \"%s\"", tokenbuf);
	    break;
	}
	if (hash != L_include) {
#if OLD_PREPROCESSOR
	    /*
	     * Ignore the rest of the #control line so you can write
	     *		#if	foo
	     *		#endif	foo
	     */
	    goto dump_line;			/* Take common exit	*/
#else
	    switch (hash) {
	    case L_else:
	    case L_endif:
	      goto dump_line;			/* Take common exit	*/
	    default:
	      if (skipws() != '\n') {
		cwarn("Unexpected text in #control line ignored", NULLST);
		skipnl();
	      }
	    }
#endif
	}
	return (counter + 1);
}

FILE_LOCAL
doif(hash)
int		hash;
/*
 * Process an #if, #ifdef, or #ifndef.  The latter two are straightforward,
 * while #if needs a subroutine of its own to evaluate the expression.
 *
 * doif() is called only if compiling is TRUE.  If false, compilation
 * is always supressed, so we don't need to evaluate anything.  This
 * supresses unnecessary warnings.
 */
{
	register int		c;
	register int		found;

	if ((c = skipws()) == '\n' || c == EOF_CHAR) {
	    unget();
	    goto badif;
	}
	if (hash == L_if) {
	    unget();
	    found = (eval() != 0);	/* Evaluate expr, != 0 is  TRUE	*/
	    hash = L_ifdef;		/* #if is now like #ifdef	*/
	}
	else {
	    if (type[c] != LET)		/* Next non-blank isn't letter	*/
		goto badif;		/* ... is an error		*/
	    found = (lookid(c) != NULL); /* Look for it in symbol table	*/
	}
	if (found == (hash == L_ifdef)) {
	    compiling = TRUE;
	    *ifptr |= TRUE_SEEN;
	}
	else {
	    compiling = FALSE;
	}
	return(0);

badif:	cerror("#if, #ifdef, or #ifndef without an argument", NULLST);
#if !OLD_PREPROCESSOR
	skipnl();				/* Prevent an extra	*/
	unget();				/* Error message	*/
#endif
	return(0);
}

/*
 * Parse the file name in the #INCLUDE control line.
 * Leave the file name in work, and return the terminating delimiter
 * which is " or >. Returns EOS on error.
 */
int
parse_include()
{
	register int		c;
	register int		delim;

	delim = macroid(skipws());
	if (delim != '<' && delim != '"') {
	  strcpy(work, tokenbuf);
#if HOST == SYS_VMS
	  return(' ');
#else
	  return(EOS);
#endif
	}
	if (delim == '<')
	    delim = '>';
	workp = work;
	                                /* Grab the file name           */
        instring = TRUE;		/* ignore comment chars in filename */
	while ((c = get()) != delim) {
	  if(c=='\n' || c == EOF_CHAR) {
	    instring = FALSE;
	    return(EOS); /* Missing delimiter */
	  }
	  else 
	    save(c);			/* Put it away.			*/
	}
        instring = FALSE;
	*workp = EOS;			/* Terminate filename		*/
	return(delim);
}

FILE_LOCAL
doinclude()
/*
 * Process the #include control line.
 * There are three variations:
 *	#include "file"		search somewhere relative to the
 *				current source file, if not found,
 *				treat as #include <file>.
 *	#include <file>		Search in an implementation-dependent
 *				list of places.
 *	#include token		Expand the token, it must be one of
 *				"file" or <file>, process as such.
 *
 * Note: the November 12 draft forbids '>' in the #include <file> format.
 * This restriction is unnecessary and not implemented.
 */
{
  register int		c;
  register int		delim;
#ifdef VMS
  char                  def_filename[NAM$C_MAXRSS + 1];
#endif
  /* Get the file name into work  */
  if((delim = parse_include()) == EOS) goto incerr;
  c = skipws();
  if (c != '\n' && c != EOF_CHAR)
    goto incerr;		 /* Ensure nothing else to end of the line. */
  unget();			 /* Force nl after include         	    */
#if HOST == SYS_VMS
  /*
   * Assume the default .h filetype.
   */
  if (!vmsparse(work, ".H", def_filename)) {
    perror(work);			  /* Oops.			*/
    goto incerr;
  }
#endif

#if HOST == SYS_MVS
  if (findinclude_mvs(work, R_OK) == FALSE)
    goto openerr;
#else
  if (findinclude(work, (delim == '"'), R_OK) == FALSE)
    goto openerr;
#endif
  /*
   * Actually open the include file
   */

  if (debug&1) {
    FILEINFO* file;			  /* DEBUG */
    fprintf(stderr, "Line %4d", line);
    for(file = infile; file != NULL; file = file->parent)
      if(file->fp != NULL) fprintf(stderr, "  ");
    fprintf(stderr, "#include %s\n", work);
  }
  if (openfile(work))
    return(0);
  /*
   * No sense continuing if #include file isn't there.
   */
 openerr:
   cfatal("Cannot open include file \"%s\"", work);
        
 incerr:	cerror("#include syntax error", NULLST);
  return(0);
}


#if HOST == SYS_OS2
/* 
 * Ensure dir names and filename is less than 8 characters long
 */
char* truncate_filename(filename) 
  char* filename;
{
  char* p = filename;
  int   name_len = 0;
  char* dot;
  int   slash;

  slash = strcspn(p,"/\\");
  while (strlen(p) != slash)
    {
     if (slash == 0)    /* slash at start of name */
        slash = strcspn(++p,"/\\");

     if (strlen(p) != slash)  /* slash found */
       {
        if (slash < 9)        /* dir name within bounds */
           p += slash + 1;
        else                  /* else trnucate to eight */
	  {
           strcpy(p+8,p+slash);
           p += slash + 1;
	 }
        slash = strcspn(p,"/\\");  /* find next slash */
      }
   }

  dot = strchr(filename, '.');
  if (dot != NULL) {
    p = dot -1;
    while (p >= filename && type[*p]==LET) p--, name_len++;
    if (name_len > 8)
      strcpy(p+9, dot);
  }
  return filename;
}
#endif

int
findinclude(filename, searchlocal, permissions)
char		*filename;		/* Input file name		*/
int		searchlocal;		/* TRUE if #include "file"	*/
int             permissions;            /* std permission flags, R_OK, etc */
/*
 * Find an include file.  This routine is only called from
 * doinclude() above, but was written as a separate subroutine for
 * programmer convenience.  It searches the list of directories
 * and modifies filename to contain the entire pathname.
 * Returns TRUE if the file was found, else FALSE.
 * No error message is printed.
 */
{
	register char		**incptr;
#if HOST == SYS_VMS
#if NBUFF < (NAM$C_MAXRSS + 1)
    << error, NBUFF isn't greater than NAM$C_MAXRSS >>
#endif
#endif
	char			tmpname[NBUFF];	/* Filename work area	*/


#if HOST == SYS_OS2
#  if defined(SHORTFILE)
/*
 * For OS/2 truncate file name to 8.3 format for DOS partition if needed.
 */
   truncate_filename(filename);
#  endif
#endif

	if (searchlocal) {
	    /*
	     * Look in local directory first
	     */
	    if (!hasdirectory(filename, tmpname, TRUE)
	     && hasdirectory(infile->filename, tmpname, FALSE))
		strcat(tmpname, filename);
	    else {
		strcpy(tmpname, filename);
	    }
	    if (access (tmpname, permissions) == 0) {
                strcpy(filename, tmpname);
		return (TRUE);
            }
	}
	/*
	 * Look in any directories specified by -I command line
	 * arguments, then in the builtin search list.
	 */
	for (incptr = incdir; incptr < incend; incptr++) {
	    if (strlen(*incptr) + strlen(filename) >= (NBUFF - 1))
		cfatal("Filename work buffer overflow", NULLST);
	    else {
#if (HOST == SYS_UNIX || HOST == SYS_XENIX || HOST == SYS_AIX)
		if (filename[0] == '/')
		    strcpy(tmpname, filename);
		else {
		    sprintf(tmpname, "%s/%s", *incptr, filename);
		}
#else
#if (HOST == SYS_OS2)
		if ((filename[0] == '\\') || (filename[0] == '/') || (filename[1] == ':'))
		    strcpy(tmpname, filename);
		else {
		    sprintf(tmpname, "%s\\%s", *incptr, filename);
		}
#else
		if (!hasdirectory(filename, tmpname, FALSE))
		    sprintf(tmpname, "%s%s", *incptr, filename);
#endif
#endif
	        if (access (tmpname, permissions) == 0) {
                   strcpy(filename, tmpname);
		   return (TRUE);
                }
	    }
	}
	return (FALSE);
}

#if HOST == SYS_MVS

/* convert (unix) include string into suitable mvs string for fopen.
 * "foo"             ==> "syslib(foo)"
 * "foo.h"           ==> "syslib(foo)"
 * "foo.hxx"         ==> "syslib(foo)"
 * "foo.xxx"         ==> "xxx(foo)"
 * "ddname/foo"      ==> "ddname(foo)"
 * "ddname/foo.h"    ==> "ddname(foo)"
 * "ddname/foo.xxx"  ==> "ddname(foo)"
 *
 */
void parse_mvs(filename) 
  char *filename;                        /* This get clobbered!!! */
{
  char tmpname[NBUFF];			 /* Filename work area	*/
  char *dot, *dotstr, *slash, *memname, *sp;

  strcpy(tmpname,filename);		 /* copy to work buffer */
  dot   = strrchr(tmpname, '.');	 /* find location of "." */
  slash = strrchr(tmpname, '/');	 /* find location of "/" */
  dotstr = dot+1;                        /* points at string following dot */

  /* first see if a unix style directory node has been specified
   * If so, terminate the string at the "/" and copy max of 8 chars.
   * Note that multiple directory nodes will not work.  This overrides
   * any ddname specified via the dot.
   */
  memname = tmpname;			 /* init memname to beg of string */
  if (slash != NULL) {
    memname = slash+1;			 /* point member name after slash  */
    *slash = EOS;			 /* terminate ddname at slash */
    if (strlen(tmpname) > 8)		 /* truncate to 8 chars */
      *(tmpname+8) = EOS;
    strcpy(filename,tmpname);		 /* copy ddname from dir node */
    if (dot != 0)			 /* get rid of text beyond dot */
      *dot = EOS;
  }
  else
    /* see if a ddname has been specified (ignore .h and .hxx so
     * they don't get interpretted as a ddname).
     * Limit to max of 8 chars
     */
    if (dot != NULL) {			 /* if dot found*/
      *dot = EOS;                        /* terminate memname at dot */
      sp = strchr(dotstr,' ');		 /* see if any trailing spaces */
      if (sp != NULL)			 /* if there are */
	*sp = EOS;			 /*   get rid of them */
      if ((strcmp(dotstr,"h") == 0) ||	 /* ignore .h */
	  (strcmp(dotstr,"hxx") == 0) )  /*   or  .hxx */
	strcpy(filename,"syslib");	 /*  and default to syslib */
      else {
	if (strlen(dotstr) > 8)		 /* truncate ddname to 8 chars */
	  *(dotstr+8) = EOS;
	strcpy(filename, dotstr);	 /* add ddname to string */
      }
    }
    else
      strcpy(filename,"syslib");	 /* default syslib ddname */

/* Add the include file name as parenthesized member name
  strcat(filename, "(" );
  sp = strchr(memname,' ');		 /* see if any trailing spaces */
  if (sp != NULL)			 /* if spaces found */
    *sp = EOS;				 /*   get rid of them */
  if (strlen(memname) > 8)		 /* truncate to 8 chars */
    *(memname+8) = EOS;
  strcat(filename, memname);		 /* add include name */
  strcat(filename, ")" );
  return;
}
  
/* MVS does not handle a -I search list of include files.  Instead
 * it will allocate one or more logical DD names which point to a cancatenated
 * list of include libraries. Convert include string into suitable
 * MVS style string, and see if that member is there.
 */
int
findinclude_mvs (filename, permissions)
char		*filename;		/* Input file name		*/
int             permissions;            /* std permission flags, R_OK, etc */
{
  parse_mvs(filename);
  if (access (filename, permissions) == 0) 
    return (TRUE);
  else
    return (FALSE);
}


#endif

FILE_LOCAL int
hasdirectory(source, result, is_toplevel)
char		*source;	/* Directory to examine			*/
char		*result;	/* Put directory stuff here		*/
int             is_toplevel;    /* return true only when a complete path */
/*
 * If a device or directory is found in the source filename string, the
 * node/device/directory part of the string is copied to result and
 * hasdirectory returns TRUE.  Else, nothing is copied and it returns FALSE.
 */
{
#if (HOST == SYS_UNIX || HOST == SYS_XENIX || HOST == SYS_AIX)
	char* tp = strrchr(source, '/');
	if (is_toplevel ? (source[0] != '/') : (tp == NULL))
	  return (FALSE);
	strncpy(result, source, tp - source + 1);
	result[tp - source + 1] = EOS;
	return (TRUE);
#else
#if (HOST == SYS_OS2)
	char* tp = strrchr(source, '\\');
	if (is_toplevel ? (source[0]  != '\\') : (tp == NULL))
	  return (FALSE);
	strncpy(result, source, tp - source + 1);
	result[tp - source + 1] = EOS;
	return (TRUE);
#else
#if HOST == SYS_VMS
	if (vmsparse(source, NULLST, result)
	 && result[0] != EOS)
	    return (TRUE);
	else {
	    return (FALSE);
	}
#else
	/*
	 * Random DEC operating system (RSX, RT11, RSTS/E)
	 */
	register char		*tp;

	if ((tp = strrchr(source, ']')) == NULL
	 && (tp = strrchr(source, ':')) == NULL)
	    return (FALSE);
	else {
	    strncpy(result, source, tp - source + 1);
	    result[tp - source + 1] = EOS;
	    return (TRUE);
	}
#endif
#endif
#endif
}

#if HOST == SYS_VMS

/*
 * EXP_DEV is set if a device was specified, EXP_DIR if a directory
 * is specified.  (Both set indicate a file-logical, but EXP_DEV
 * would be set by itself if you are reading, say, SYS$INPUT:)
 */
#define DEVDIR (NAM$M_EXP_DEV | NAM$M_EXP_DIR)

FILE_LOCAL int
vmsparse(source, defstring, result)
char		*source;
char		*defstring;	/* non-NULL -> default string.		*/
char		*result;	/* Size is at least NAM$C_MAXRSS + 1	*/
/*
 * Parse the source string, applying the default (properly, using
 * the system parse routine), storing it in result.
 * TRUE if it parsed, FALSE on error.
 *
 * If defstring is NULL, there are no defaults and result gets
 * (just) the node::[directory] part of the string (possibly "")
 */
{
	struct FAB	fab = cc$rms_fab;	/* File access block	*/
	struct NAM	nam = cc$rms_nam;	/* File name block	*/
	char		fullname[NAM$C_MAXRSS + 1];
	register char	*rp;			/* Result pointer	*/

	fab.fab$l_nam = &nam;			/* fab -> nam		*/
	fab.fab$l_fna = source;			/* Source filename	*/
	fab.fab$b_fns = strlen(source);		/* Size of source	*/
	fab.fab$l_dna = defstring;		/* Default string	*/
	if (defstring != NULLST)
	    fab.fab$b_dns = strlen(defstring);	/* Size of default	*/
	nam.nam$l_esa = fullname;		/* Expanded filename	*/
	nam.nam$b_ess = NAM$C_MAXRSS;		/* Expanded name size	*/
	if (sys$parse(&fab) == RMS$_NORMAL) {	/* Parse away		*/
	    fullname[nam.nam$b_esl] = EOS;	/* Terminate string	*/
	    result[0] = EOS;			/* Just in case		*/
	    rp = &result[0];
	    /*
	     * Remove stuff added implicitly, accepting node names and
	     * dev:[directory] strings (but not process-permanent files).
	     */
	    if ((nam.nam$l_fnb & NAM$M_PPF) == 0) {
		if ((nam.nam$l_fnb & NAM$M_NODE) != 0) {
		    strncpy(result, nam.nam$l_node, nam.nam$b_node);
		    rp += nam.nam$b_node;
		    *rp = EOS;
		}
		if ((nam.nam$l_fnb & DEVDIR) == DEVDIR) {
		    strncpy(rp, nam.nam$l_dev, nam.nam$b_dev + nam.nam$b_dir);
		    rp += nam.nam$b_dev + nam.nam$b_dir;
		    *rp = EOS;
		}
	    }
	    if (defstring != NULLST) {
		strncpy(rp, nam.nam$l_name, nam.nam$b_name + nam.nam$b_type);
		rp += nam.nam$b_name + nam.nam$b_type;
		*rp = EOS;
		if ((nam.nam$l_fnb & NAM$M_EXP_VER) != 0) {
		    strncpy(rp, nam.nam$l_ver, nam.nam$b_ver);
		    rp[nam.nam$b_ver] = EOS;
		}
	    }
	    return (TRUE);
	}
	return (FALSE);
}
#endif

