cpp5.c

类PASCAL语言的编译器,LINUX环境的,我没试过是否正确.

#ifdef RCS
static char rcsid[]="$Id: cpp5.c,v 1.2 1994/01/24 09:35:02 start Exp $";
#endif
/******************************************************************************
 *                               FREXXWARE
 * ----------------------------------------------------------------------------
 *
 * Project: Frexx C Preprocessor
 * $Source: /home/user/start/cpp/RCS/cpp5.c,v $
 * $Revision: 1.2 $
 * $Date: 1994/01/24 09:35:02 $
 * $Author: start $
 * $State: Exp $
 * $Locker:  $
 *
 * ----------------------------------------------------------------------------
 * $Log: cpp5.c,v $
 * Revision 1.2  1994/01/24  09:35:02  start
 * Made a bunch of functions FILE_LOCAL and INLINE.
 *
 * Revision 1.1  1993/11/03  09:13:08  start
 * Initial revision
 *
 *
 *****************************************************************************/
/*
 *			    C P P 5 . C
 *		E x p r e s s i o n   E v a l u a t i o n
 *
 * Edit History
 * 31-Aug-84	MM	USENET net.sources release
 * 04-Oct-84	MM	__LINE__ and __FILE__ must call ungetstring()
 *			so they work correctly with token concatenation.
 *			Added string formal recognition.
 * 25-Oct-84	MM	"Short-circuit" evaluate #if's so that we
 *			don't print unnecessary error messages for
 *			#if !defined(FOO) && FOO != 0 && 10 / FOO ...
 * 31-Oct-84	ado/MM	Added token concatenation
 *  6-Nov-84	MM	Split from #define stuff, added sizeof stuff
 * 19-Nov-84	ado	#if error returns TRUE for (sigh) compatibility
 * 21-Oct-85	RMS	Rename `token' to `tokenbuf'
 * 23-Oct-85	RMS	Treat undefined symbols as having value zero.
 * 14-Mar-86	FNF	Incorporate macro based C debugging package.
 *			Port to Commodore Amiga.
 * 20-Aug-88	Ois	Conditionally compile sizeof stuff.
 */

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

INLINE FILE_LOCAL ReturnCode evallex(struct Global *, int, int *);
INLINE FILE_LOCAL ReturnCode dosizeof(struct Global *, int *);
INLINE FILE_LOCAL int bittest(int);
INLINE FILE_LOCAL int evalnum(struct Global *, int);
INLINE FILE_LOCAL int evalchar(struct Global *, int);
INLINE FILE_LOCAL int *evaleval(struct Global *, int *, int, int);

/*
 * Evaluate an #if expression.
 */

static char *opname[] = {		/* For debug and error messages */
  "end of expression", "val", "id",
  "+",   "-",  "*",  "/",  "%",
  "<<", ">>",  "&",  "|",  "^",
  "==", "!=",  "<", "<=", ">=",  ">",
  "&&", "||",  "?",  ":",  ",",
  "unary +", "unary -", "~", "!",  "(",  ")", "(none)",
};

/*
 * opdope[] has the operator precedence:
 *     Bits
 *	  7	Unused (so the value is always positive)
 *	6-2	Precedence (000x .. 017x)
 *	1-0	Binary op. flags:
 *	    01	The binop flag should be set/cleared when this op is seen.
 *	    10	The new value of the binop flag.
 * Note:  Expected, New binop
 * constant	0	1	Binop, end, or ) should follow constants
 * End of line	1	0	End may not be preceeded by an operator
 * binary	1	0	Binary op follows a value, value follows.
 * unary	0	0	Unary op doesn't follow a value, value follows
 *   (          0       0       Doesn't follow value, value or unop follows
 *   )		1	1	Follows value.	Op follows.
 */

static char opdope[OP_MAX] = {
  0001, 				/* End of expression		*/
  0002, 				/* Digit			*/
  0000, 				/* Letter (identifier)          */
  0141, 0141, 0151, 0151, 0151, 	/* ADD, SUB, MUL, DIV, MOD	*/
  0131, 0131, 0101, 0071, 0071, 	/* ASL, ASR, AND,  OR, XOR	*/
  0111, 0111, 0121, 0121, 0121, 0121,	/*  EQ,  NE,  LT,  LE,	GE,  GT */
  0061, 0051, 0041, 0041, 0031, 	/* ANA, ORO, QUE, COL, CMA	*/
  /*
   * Unary op's follow
   */
  0160, 0160, 0160, 0160,		/* NEG, PLU, COM, NOT		*/
  0170, 0013, 0023,			/* LPA, RPA, END		*/
};
/*
 * OP_QUE and OP_RPA have alternate precedences:
 */
#define OP_RPA_PREC	0013
#define OP_QUE_PREC	0034

/*
 * S_ANDOR and S_QUEST signal "short-circuit" boolean evaluation, so that
 *	#if FOO != 0 && 10 / FOO ...
 * doesn't generate an error message.  They are stored in optab.skip.
 */
#define S_ANDOR 	2
#define S_QUEST 	1

typedef struct optab {
  char	op;			/* Operator			*/
  char	prec;			/* Its precedence		*/
  char	skip;			/* Short-circuit: TRUE to skip	*/
} OPTAB;
     
#ifdef	nomacargs
     FILE_LOCAL int
       isbinary(op)
     int op;
{
  return (op >= FIRST_BINOP && op <= LAST_BINOP);
}

FILE_LOCAL int
  isunary(op)
int op;
{
  return (op >= FIRST_UNOP && op <= LAST_UNOP);
}
#else
#define isbinary(op)    (op >= FIRST_BINOP && op <= LAST_BINOP)
#define isunary(op)     (op >= FIRST_UNOP  && op <= LAST_UNOP)
#endif

/*
 * The following definitions are used to specify basic variable sizes.
 */

#if OK_SIZEOF

#ifndef S_CHAR
#define S_CHAR		(sizeof (char))
#endif
#ifndef S_SINT
#ifdef manx		/* Aztec/Manx C does not like "short int" */
#define S_SINT		(sizeof (short))
#else
#define S_SINT		(sizeof (short int))
#endif
#endif
#ifndef S_INT
#define S_INT		(sizeof (int))
#endif
#ifndef S_LINT
#define S_LINT		(sizeof (long int))
#endif
#ifndef S_FLOAT
#define S_FLOAT 	(sizeof (float))
#endif
#ifndef S_DOUBLE
#define S_DOUBLE	(sizeof (double))
#endif
#ifndef S_PCHAR
#define S_PCHAR 	(sizeof (char *))
#endif
#ifndef S_PSINT
#ifdef manx		/* Aztec/Manx C does not like "short int" */
#define S_PSINT 	(sizeof (short *))
#else
#define S_PSINT 	(sizeof (short int *))
#endif
#endif
#ifndef S_PINT
#define S_PINT		(sizeof (int *))
#endif
#ifndef S_PLINT
#define S_PLINT 	(sizeof (long int *))
#endif
#ifndef S_PFLOAT
#define S_PFLOAT	(sizeof (float *))
#endif
#ifndef S_PDOUBLE
#define S_PDOUBLE	(sizeof (double *))
#endif
#ifndef S_PFPTR
#define S_PFPTR 	(sizeof (int (*)()))
#endif


typedef struct types {
  short	type;			/* This is the bit if		*/
  char	*name;			/* this is the token word	*/
} TYPES;

static TYPES basic_types[] = {
  { T_CHAR,	"char",         },
  { T_INT,	"int",          },
  { T_FLOAT,	"float",        },
  { T_DOUBLE,	"double",       },
  { T_SHORT,	"short",        },
  { T_LONG,	"long",         },
  { T_SIGNED,	"signed",       },
  { T_UNSIGNED,	"unsigned",     },
  { 0,		NULL,		},	/* Signal end		*/
};

/*
 * Test_table[] is used to test for illegal combinations.
 */
static short test_table[] = {
  T_FLOAT | T_DOUBLE | T_LONG | T_SHORT,
  T_FLOAT | T_DOUBLE | T_CHAR | T_INT,
  T_FLOAT | T_DOUBLE | T_SIGNED | T_UNSIGNED,
  T_LONG  | T_SHORT  | T_CHAR,
  0						/* end marker	*/
  };

/*
 * The order of this table is important -- it is also referenced by
 * the command line processor to allow run-time overriding of the
 * built-in size values.  The order must not be changed:
 *	char, short, int, long, float, double (func pointer)
 */
SIZES size_table[] = {
  { T_CHAR,	S_CHAR, 	S_PCHAR 	},	/* char 	*/
  { T_SHORT,	S_SINT, 	S_PSINT 	},	/* short int	*/
  { T_INT,	S_INT,		S_PINT		},	/* int		*/
  { T_LONG,	S_LINT, 	S_PLINT 	},	/* long 	*/
  { T_FLOAT,	S_FLOAT,	S_PFLOAT	},	/* float	*/
  { T_DOUBLE,	S_DOUBLE,	S_PDOUBLE	},	/* double	*/
  { T_FPTR,	0,		S_PFPTR 	},	/* int (*())    */
  { 0,		0,		0		},	/* End of table */
};

#endif /* OK_SIZEOF */

ReturnCode eval(struct Global *global, int *eval)
{
  /*
   * Evaluate an expression.  Straight-forward operator precedence.
   * This is called from control() on encountering an #if statement.
   * It calls the following routines:
   * evallex	Lexical analyser -- returns the type and value of
   *		the next input token.
   * evaleval	Evaluate the current operator, given the values on
   *		the value stack.  Returns a pointer to the (new)
   *		value stack.
   * For compatiblity with older cpp's, this return returns 1 (TRUE)
   * if a syntax error is detected.
   */
  int op;		/* Current operator		*/
  int *valp;		/* -> value vector		*/
  OPTAB *opp;		/* Operator stack		*/
  int prec;		/* Op precedence		*/
  int binop;		/* Set if binary op. needed	*/
  int op1;		/* Operand from stack		*/
  int skip;		/* For short-circuit testing	*/
  int value[NEXP];	/* Value stack			*/
  OPTAB opstack[NEXP];	/* Operand stack		*/
  ReturnCode ret;
  char again=TRUE;
  
  valp = value;
  opp = opstack;
  opp->op = OP_END;		/* Mark bottom of stack 	*/
  opp->prec = opdope[OP_END];	/* And its precedence		*/
  opp->skip = 0;		/* Not skipping now		*/
  binop = 0;

  while(again) {
    ret=evallex(global, opp->skip, &op);
    if(ret)
      return(ret);
    if (op == OP_SUB && binop == 0)
      op = OP_NEG;			/* Unary minus		*/
    else if (op == OP_ADD && binop == 0)
      op = OP_PLU;			/* Unary plus		*/
    else if (op == OP_FAIL) {
      *eval=1;                    	/* Error in evallex     */
      return(FPP_OK);
    }
    if (op == DIG) {                      /* Value?               */
      if (binop != 0) {
	cerror(global, ERROR_MISPLACED_CONSTANT);
	*eval=1;
	return(FPP_OK);
      } else if (valp >= &value[NEXP-1]) {
	cerror(global, ERROR_IF_OVERFLOW);
	*eval=1;
	return(FPP_OK);
      } else {
	*valp++ = global->evalue;
	binop = 1;
      }
      again=TRUE;
      continue;
    } else if (op > OP_END) {
      cerror(global, ERROR_ILLEGAL_IF_LINE);
      *eval=1;
      return(FPP_OK);
    }
    prec = opdope[op];
    if (binop != (prec & 1)) {
      cerror(global, ERROR_OPERATOR, opname[op]);
      *eval=1;
      return(FPP_OK);
    }
    binop = (prec & 2) >> 1;
    do {
      if (prec > opp->prec) {
	if (op == OP_LPA)
	  prec = OP_RPA_PREC;
	else if (op == OP_QUE)
	  prec = OP_QUE_PREC;
	op1 = opp->skip;		/* Save skip for test	*/
	/*
	 * Push operator onto op. stack.
	 */
	opp++;
	if (opp >= &opstack[NEXP]) {
	  cerror(global, ERROR_EXPR_OVERFLOW, opname[op]);
	  *eval=1;
	  return(FPP_OK);
	}
	opp->op = op;
	opp->prec = prec;
	skip = (valp[-1] != 0);         /* Short-circuit tester */
	/*
	 * Do the short-circuit stuff here.  Short-circuiting
	 * stops automagically when operators are evaluated.
	 */
	if ((op == OP_ANA && !skip)
	    || (op == OP_ORO && skip))
	  opp->skip = S_ANDOR;	/* And/or skip starts	*/
	else if (op == OP_QUE)          /* Start of ?: operator */
	  opp->skip = (op1 & S_ANDOR) | ((!skip) ? S_QUEST : 0);
	else if (op == OP_COL) {        /* : inverts S_QUEST    */
	  opp->skip = (op1 & S_ANDOR)
	    | (((op1 & S_QUEST) != 0) ? 0 : S_QUEST);
	}
	else {				/* Other ops leave	*/
	  opp->skip = op1;		/*  skipping unchanged. */
	}
	again=TRUE;
	continue;
      }
      /*
       * Pop operator from op. stack and evaluate it.
       * End of stack and '(' are specials.
       */
      skip = opp->skip;			/* Remember skip value	*/
      switch ((op1 = opp->op)) {          /* Look at stacked op   */
      case OP_END:			/* Stack end marker	*/
	if (op == OP_EOE) {
	  *eval=valp[-1];     		/* Finished ok.         */
	  return(FPP_OK);
	}
	/* Read another op.	*/
	again=TRUE;
	continue;
      case OP_LPA:			/* ( on stack           */
	if (op != OP_RPA) {             /* Matches ) on input   */
	  cerror(global, ERROR_UNBALANCED_PARENS, opname[op]);
	  *eval=1;
	  return(FPP_OK);
	}
	opp--;				/* Unstack it		*/
	/* -- Fall through 	*/
      case OP_QUE:
	/* Evaluate true expr.	*/
	again=TRUE;
	continue;
      case OP_COL:			/* : on stack.		*/
	opp--;				/* Unstack :		*/
	if (opp->op != OP_QUE) {        /* Matches ? on stack?  */
	  cerror(global, ERROR_MISPLACED, opname[opp->op]);
	  *eval=1;
	  return(FPP_OK);
	}
	/*
	 * Evaluate op1.
	 */
      default:				/* Others:		*/
	opp--;				/* Unstack the operator */
	valp = evaleval(global, valp, op1, skip);
	again=FALSE;
      }					/* op1 switch end	*/
    } while (!again);			/* Stack unwind loop	*/
  }
  return(FPP_OK);
}

INLINE FILE_LOCAL
ReturnCode evallex(struct Global *global,
		   int skip,	/* TRUE if short-circuit evaluation */
		   int *op)
{
  /*
   * Set *op to next eval operator or value. Called from eval(). It
   * calls a special-purpose routines for 'char' strings and
   * numeric values:
   * evalchar	called to evaluate 'x'
   * evalnum	called to evaluate numbers.
   */

  int c, c1, t;
  ReturnCode ret;
  char loop;
  
  do { /* while(loop); */
  /* again: */
    loop=FALSE;
    do {					/* Collect the token	*/
      c = skipws(global);
      if(ret=macroid(global, &c))
      return(ret);
      if (c == EOF_CHAR || c == '\n') {
	unget(global);
	*op=OP_EOE;           /* End of expression    */
	return(FPP_OK);
      }
    } while ((t = type[c]) == LET && catenate(global, &ret) && !ret);
    if(ret)
      /* If the loop was broken because of a fatal error! */
      return(ret);
    if (t == INV) {                         /* Total nonsense       */
      if (!skip) {
	if (isascii(c) && isprint(c))
	  cerror(global, ERROR_ILLEGAL_CHARACTER, c);
	else
	  cerror(global, ERROR_ILLEGAL_CHARACTER2, c);
      }
      return(FPP_ILLEGAL_CHARACTER);
    } else if (t == QUO) {                  /* ' or "               */
      if (c == '\'') {                    /* Character constant   */
	global->evalue = evalchar(global, skip);  /* Somewhat messy       */
	*op=DIG;                          /* Return a value       */
	return(FPP_OK);
      }
      cerror(global, ERROR_STRING_IN_IF);
      return(FPP_CANT_USE_STRING_IN_IF);
    } else if (t == LET) {                  /* ID must be a macro   */
      if (streq(global->tokenbuf, "defined")) {   /* Or defined name      */
	c1 = c = skipws(global);
	if (c == '(')                     /* Allow defined(name)  */
	  c = skipws(global);
	if (type[c] == LET) {
	  global->evalue = (lookid(global, c) != NULL);
	  if (c1 != '('                   /* Need to balance      */
	      || skipws(global) == ')') { /* Did we balance?      */
	    *op=DIG;
	    return(FPP_OK);               /* Parsed ok            */
	  }
	}
	cerror(global, ERROR_DEFINED_SYNTAX);
	return(FPP_BAD_IF_DEFINED_SYNTAX);
      }