statement.c

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

/******************************************************************************
 *		           FREXX PROGRAMMING LANGUAGE    		      *
 ******************************************************************************

 statement.c

 Support routines to the Expression() function.

 *****************************************************************************/

/************************************************************************
 *                                                                      *
 * fpl.library - A shared library interpreting script langauge.         *
 * Copyright (C) 1992-1994 FrexxWare                                    *
 * Author: Daniel Stenberg                                              *
 *                                                                      *
 * This program is free software; you may redistribute for non          *
 * commercial purposes only. Commercial programs must have a written    *
 * permission from the author to use FPL. FPL is *NOT* public domain!   *
 * Any provided source code is only for reference and for assurance     *
 * that users should be able to compile FPL on any operating system     *
 * he/she wants to use it in!                                           *
 *                                                                      *
 * You may not change, resource, patch files or in any way reverse      *
 * engineer anything in the FPL package.                                *
 *                                                                      *
 * This program is distributed in the hope that it will be useful,      *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
 *                                                                      *
 * Daniel Stenberg                                                      *
 * Ankdammsgatan 36, 4tr                                                *
 * S-171 43 Solna                                                       *
 * Sweden                                                               *
 *                                                                      *
 * FidoNet 2:201/328    email:[e-mail]                       *
 *                                                                      *
 ************************************************************************/

#ifdef AMIGA
#include <exec/types.h>
#include <proto/exec.h>
#include <stdlib.h>

#include <proto/dos.h>
#include <exec/execbase.h>
#include <dos.h>

#include "/funclib/funclib.h"

#else
#include <sys/types.h>
#ifdef SUNOS
#include <varargs.h>
#else
#include <stdarg.h>
#endif
#endif

#include "script.h"
#include "debug.h"
#include <stdio.h>
#include <stddef.h>
#include <limits.h>

static ReturnCode INLINE SendMessage(struct Data *, struct fplMsg *);
static ReturnCode REGARGS Ltostr(struct Data *scr, struct fplStr **,
			         long, long);
static ReturnCode REGARGS GetSymbols(struct Data *, long, long,
                                     struct fplSymbol **);

/**********************************************************************
 *
 * ReturnCode CmpAssign()
 *
 * Performs a compound assign to the value the third argument points to.
 * The assign performed is the one with the operator specified in the fourth
 * argument eg, x, +, /, &, %, | etc, etc...
 *
 ***************/

ReturnCode REGARGS
CmpAssign(struct Data *scr,
          long val,	/* right operand */
	  long *value,	/* return value pointer */
	  long flags,	/* variable flags */
	  uchar operation)
{
  ReturnCode ret;
  switch(operation) { /* check the type of the assign */
  case CHAR_PLUS:
    *value+=val;
    break;
  case CHAR_MINUS:
    *value-=val;
    break;
  case CHAR_MULTIPLY:
    *value*=val;
    break;
  case CHAR_DIVIDE:
    *value/=val;
    break;
  case CHAR_AND:
    *value&=val;
    break;
  case CHAR_OR:
    *value|=val;
    break;
  case CHAR_REMAIN:
    *value%=val;
    break;
  case CHAR_XOR:
    *value^=val;
    break;
  case CHAR_LESS_THAN:
    *value<<=val;
    break;
  case CHAR_GREATER_THAN:
    *value>>=val;
    break;
  case CHAR_ASSIGN:
    *value=val;
    break;
  default:
    CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN)); /* >warning< */
    *value=val; /* perform a straight assign! */
    break;
  }
  if(flags&FPL_VARIABLE_LESS32) {
    /* if using less than 32 bit */
    if(flags&FPL_CHAR_VARIABLE)
      *value=(long)((signed char)*value);
    else
      *value=(long)((signed short)*value);
  }
  return(FPL_OK);
}


/**********************************************************************
 *
 * StrAssign();
 *
 * Assign a string variable.
 *
 ********/

ReturnCode REGARGS
StrAssign(struct fplStr *app,
          struct Data *scr,
	  struct fplStr **string,
	  uchar append) /* TRUE or FALSE if append */
{
  ReturnCode ret;

  if(!append) { /* if not append */
    /* Exchange this string with the old one in the variable! */
    if(*string) {
      /*
       * There is a string! Free any type!
       */
      FREE_KIND(*string);
    }
    if(!app) {
      GETMEM(app, sizeof(struct fplStr));
      memset(app, 0, sizeof(struct fplStr)); /* clean it! */
    }
    *string = app;

  } else { /* append string */
    if(! (app?app->len:0))
      /* we don't append zero length strings! */
      return FPL_OK;

    CALL(AppendStringToString(scr, string, app->string, app->len));

  }
  return(FPL_OK);
}

/************************************************************************
 *
 * AppendStringToString()
 *
 * Append a generic string to a fplStr.
 *
 */

ReturnCode REGARGS
AppendStringToString(struct Data *scr,  /* common data struct */
		     struct fplStr **string, /* variable to append to */
		     uchar *append, /* string to append */
		     long applen)  /* length of append string */
{
    long length;
    long alloc;
    long ln;
    struct fplStr *pek;
    void *dest;
    uchar type = *string?TypeMem(*string):MALLOC_DYNAMIC;

    length=*string?(*string)->len:0;
    alloc=*string?(*string)->alloc:0;

    ln = applen + length; /* total length */
    if (ln>=alloc) { /* do we have that much memory allocated? */
      /*
       * Allocate new memory for string.
       */

      GETMEM(pek, sizeof(struct fplStr)+ln+ADDSTRING_INC);
      if(MALLOC_STATIC == type)
        SwapMem(scr, pek, MALLOC_STATIC);

      if(*string) {
        memcpy(pek, (*string), length+sizeof(struct fplStr));
        FREE_KIND(*string);
      } else
	pek->len=0;
#ifdef DEBUG
      CheckMem(scr, pek);
#endif
      (*string)=pek;			  /* the new pointer */
      (*string)->alloc=ln+ADDSTRING_INC;  /* new allocated size */
    }

    dest=(void *)&(*string)->string[length];

    /* no string function... only mem-versions! */
    memcpy(dest, (void *)append, applen);

    (*string)->len += applen;
 
    (*string)->string[(*string)->len]=CHAR_ASCII_ZERO; /* zero terminate */

    return FPL_OK;
}


/************************************************************************
 *
 * ReturnChar()
 *
 * Returns the ASCII code of the character scr->text points to.
 *
 * Supports 100% ANSI C escape sequences.
 */

ReturnCode REGARGS
ReturnChar(struct Data *scr,
           long *num,
           uchar string) /* is this is within quotes */
{
  ReturnCode ret=FPL_OK;
  long cont=TRUE, steps;
  *num=256;
  while(cont) {
    cont=FALSE;
    if(*scr->text==CHAR_BACKSLASH) {
      steps=2;
      switch(scr->text[1]) {
      case CHAR_B:
	*num=CHAR_BACKSPACE;
	break;
      case CHAR_T:
	*num=CHAR_TAB;
	break;
      case CHAR_N:
	*num=CHAR_NEWLINE;
	break;
      case CHAR_F:
	*num=CHAR_FORMFEED;
	break;
      case CHAR_BACKSLASH:
	*num=CHAR_BACKSLASH;
	break;
      case CHAR_QUOTATION_MARK:
	*num=CHAR_QUOTATION_MARK;
	break;
      case CHAR_APOSTROPHE:
	*num=CHAR_APOSTROPHE;
	break;
      case CHAR_A:
	*num=CHAR_ALERT;
	/*   ^^^^ causes warnings ('warning: \a is ANSI C "alert" character')
	 * on some compilers. Ignore and look happy!
	 */
	break;
      case CHAR_R:
	*num=CHAR_CARRIAGE_RETURN;
	break;
      case CHAR_V:
	*num=CHAR_VERTICAL_TAB;
	break;
      case CHAR_QUESTION:
	*num=CHAR_QUESTION;
	break;
      case CHAR_X:
	steps=*num=0;
	for(scr->text+=2; steps++<2 && isxdigit(*scr->text); scr->text++)
	  *num=*num*16+ (isdigit(*scr->text)?
                         *scr->text-CHAR_ZERO:
                         UPPER(*scr->text)-CHAR_UPPER_A+10);
        if(!steps)
	  return(FPLERR_SYNTAX_ERROR); /* no number followed \x sequence */
	steps=0;
	break;
      case CHAR_ZERO:
      case CHAR_ONE:
      case CHAR_TWO:
      case CHAR_THREE:
      case CHAR_FOUR:
      case CHAR_FIVE:
      case CHAR_SIX:
      case CHAR_SEVEN:
	*num=steps=0;
	for(scr->text++;steps++<3 && isodigit(*scr->text);)
	  *num=*num*8+ *scr->text++ - CHAR_ZERO;
	steps=0;
	break;
      case CHAR_NEWLINE:
	/* After a line continuation backslash, a newline is required!
	   This is made to apply to the ANSI C escape sequence standard.
	   (added 930113-1305 / DaSt) */
	cont=TRUE;
	scr->virprg++;
	break;
      case CHAR_ASCII_ZERO:
        /* Added 950603 to make the fplConvertString() work better if the
           string to convert ends with a backslash! */
        cont=TRUE;
        CALL(Newline(scr));
        steps=0;
        break;
      default:
	/* Any character not identified as a escape sequence character
	   will simply ignore the backslah character!
	   (added 930113-1307 / DaSt) */
	*num=scr->text[1];
	break;
      }
      scr->text+=steps;
    } else if(!string && *scr->text== CHAR_NEWLINE) {
      /* This won't occur if the script is preprocessed! */
      cont=TRUE;
      scr->text++;
    } else if(*scr->text== CHAR_ASCII_ZERO) {
      /* This won't occur if the script is preprocessed! */
      cont=TRUE;
      CALL(Newline(scr));
    } else {
      *num=*scr->text;
      scr->text++;
    }
  }
  return(ret);
}

/**********************************************************************
 *
 * ReturnCode NewMember(struct Expr **);
 *
 * This function adds a new member in the linked list which keeps
 * track on every operand and it's opertor in the expression.
 *
 *******/

ReturnCode REGARGS
NewMember(struct Data *scr,
          struct Expr **expr)
{
  GETMEM((*expr)->next, sizeof(struct Expr));

  (*expr)=(*expr)->next;
  (*expr)->val.val=0;
  (*expr)->unary=NULL;
  (*expr)->operator=OP_NOTHING;
  (*expr)->flags=FPL_OPERAND;
  (*expr)->next=NULL;
  return(FPL_OK);
}


/**********************************************************************
 *
 * ReturnCode Warn();
 *
 * This routines calls the interface function to ask for permission to
 * continue the execution, even though error(s) has/have been found in
 * the interpreted program.
 *
 ******/

ReturnCode REGARGS
Warn(struct Data *scr,
     ReturnCode rtrn)
{
  struct fplArgument *pass;
  struct fplMsg *msg;
  ReturnCode ret;

  GETMEM(pass, sizeof(struct fplArgument));
  pass->ID=FPL_WARNING;
  pass->key=scr;
  pass->argc=1;
  pass->argv=(void **)&rtrn; /* first ->argv member holds the error/warning number! */

  ret=InterfaceCall(scr, pass, scr->function);

  FREE(pass);
  GetMessage(scr, FPLMSG_CONFIRM, &msg);
  if(msg) {
    if(msg->message[0]) {
      rtrn=ret;
      scr->prog->warnings++;
    }
    DeleteMessage(scr, msg);
  }
  return(rtrn);
}


#ifndef AMIGA /* if not using SAS/C on Amiga */

#ifdef VARARG_FUNCTIONS
long fplSendTags(void *anchor, ...)
{
  va_list tags;
  long ret;
#ifdef SUNOS
  va_start(tags); /* get parameter list */
#else
  va_start(tags, anchor); /* get parameter list */
#endif
  ret = fplSend(anchor, (unsigned long *)tags);
  va_end(tags);
  return ret;
}
#else
long PREFIX fplSendTags(void *anchor, unsigned long tags, ...)
{
  return(fplSend(anchor, &tags));
}
#endif

#endif

/**********************************************************************
 *
 * fplSend()
 *
 * Send a message to FPL.
 *
 ******/

ReturnCode PREFIX fplSend(AREG(0) struct Data *scr,
			  AREG(1) unsigned long *tags)
{
#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplSend");
#endif
  return Send(scr, tags);
}

ReturnCode REGARGS Send(struct Data *scr,
			unsigned long *tags)
{
  struct fplMsg msg;
  long len=-1;
  struct Program *prog;
  uchar *data=NULL;
  ReturnCode ret;
  struct fplSymbol *symbol;
  struct fplStr *string;
  long mixed;
  static long *resultcode=NULL;
  uchar fplallocstring=FALSE;
  if(!scr)
    return(FPLERR_ILLEGAL_ANCHOR);

  memset(&msg, 0, sizeof(struct fplMsg));

  while(tags && *tags) {
    switch(*tags++) {

    case FPLSEND_STRING:
      /* FPLSEND_PROGRAMFILE is the same tag */
      data=(void *)*tags;
      msg.type=FPLMSG_RETURN;
      msg.flags = FPLMSG_FLG_STRING;
      break;

    case FPLSEND_STRLEN:
      len=(long)*tags;
      break;

    case FPLSEND_DONTCOPY_STRING: /* the string sent is fplAllocString()'ed */
      fplallocstring=(uchar)*tags;
      break;

    case FPLSEND_INT:
      msg.message[0]=(void *)*tags;
      msg.type=FPLMSG_RETURN;
      msg.flags = FPLMSG_FLG_INT;
      break;

    case FPLSEND_PROGRAM:
      msg.message[0]=(void *)*tags;
      msg.type=FPLMSG_PROGRAM;
      break;

    case FPLSEND_CONFIRM:
      msg.type=FPLMSG_CONFIRM;
      msg.message[0]=(void *)*tags;
      break;

    case FPLSEND_GETINTERVAL:
      *(long *)*tags=(long)scr->interfunc;
      break;

    case FPLSEND_GETFUNCTION:
      *(long *)*tags=(long)scr->function;
      break;