statement.c

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

    case FPLSEND_GETLINE:
      *(long *)*tags=scr->prg;
      break;

    case FPLSEND_GETVIRFILE:
      *(uchar **)*tags=scr->virfile;
      break;

    case FPLSEND_GETVIRLINE:
      *(long *)*tags=scr->virprg;
      break;

    case FPLSEND_GETNEWLINE_HOOK:		/* OBSOLETE!!!! */
      break;

    case FPLSEND_GETRESULT:
      *(long *)*tags=scr->data;
      break;

    case FPLSEND_GETRETURNCODE:
      *(long *)*tags=scr->FPLret;
      break;

    case FPLSEND_GETRETURNINT: /* new from V10 */
      *(long **)*tags=scr->returnint;
      break;

    case FPLSEND_GETUSERDATA:
      *(long *)*tags=(long)scr->userdata;
      break;

    case FPLSEND_GETCOLUMN:
      if(scr->prog && scr->prog->running)
	*(long *)*tags=(scr->text-(&scr->prog->program)[scr->prg-1]+1);
      else if(scr->prog)
	/* we cannot count on this programs presence */
	*(long *)*tags=scr->prog->column;
      else
	*(long *)*tags=0; /* we don't know! */
      break;

    case FPLSEND_GETPROGNAME:
      if(scr->prog && scr->prog->name)
	*(uchar **)*tags=scr->prog->name;
      else /* we have no program information */
	*(uchar **)*tags=FPLTEXT_UNKNOWN_PROGRAM;
      break;

    case FPLSEND_GETPROG:
      if(scr->prog && scr->prog->program)
	*(uchar **)*tags=scr->prog->program;
      else /* we have no program information */
	*(uchar **)*tags=NULL;
      break;

    case FPLSEND_FLUSHCACHE:
      if(*tags)
	FlushFree(scr);
      break;

    case FPLSEND_FLUSHFILE:
      if(*tags) {
	prog=scr->programs;
	while(prog) {
	  if(prog->name && !strcmp(prog->name, (uchar *)*tags))
	    break;
	  prog=prog->next;
	}
	if(!prog)
	  return(FPLERR_INTERNAL_ERROR);
      } else
	prog=scr->programs;
      while(prog) {
	if(!(prog->running)) {
	  /* if the program isn't running right now! */
	  len=prog->flags;
	  prog->flags&=~PR_CACHEFILE; /* switch off the cache bit now */
	  CALL(LeaveProgram(scr, prog));
	  prog->flags=len; /* restore flag bits! */
	}
	if(*tags)
	  /* only the specified */
	  break;
	prog=prog->next;
      }
      break;

    case FPLSEND_FREEFILE:
      if(!(*tags))
        break;
      prog=scr->programs;
      while(prog) {
	if(prog->name && !strcmp(prog->name, (uchar *)*tags))
	  break;
	prog=prog->next;
      }
      if(!prog || prog->running || prog->openings)
	/* if not found or if the found one is currently in use! */
	return(FPLERR_ILLEGAL_PARAMETER);
      {
        for(mixed=0; mixed<scr->hash_size; mixed++) {
          register struct Identifier *nident;
          register struct Identifier *ident = scr->hash[mixed];
          while(ident) {
            nident=ident->next;
            if(!strcmp(ident->file, (uchar *)*tags))
              DelIdentifier(scr, NULL, ident);
            ident=nident;
          }
        }
      }
      DelProgram(scr, prog);
      break;

    case FPLSEND_STEP:
      if(*tags>0) {
	while((*tags)--) {
	  if(!*scr->text)
	    CALL(Newline(scr));
	  scr->text++;
	}
      } else if((signed int)(*tags)<0) {
	while((*tags)++) {
	  if( (scr->text-(&scr->prog->program)[scr->prg-1])>=0)
	    scr->text--;
	  else
	    if(scr->prg>1)
	      scr->text=(&scr->prog->program)[--scr->prg-1];
	    else
	      return(FPLERR_UNEXPECTED_END);
	}
      }
      break;
    case FPLSEND_GETSYMBOL_FUNCTIONS:
      CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION|FPL_INSIDE_FUNCTION,
		      FPL_EXPORT_SYMBOL,
		      (struct fplSymbol **)*tags));
      break;
    case FPLSEND_GETSYMBOL_MYFUNCTIONS:
      CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION, FPL_FUNCTION,
		      (struct fplSymbol **)*tags));
      break;
    case FPLSEND_GETSYMBOL_FPLFUNCTIONS:
      CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_INSIDE_FUNCTION,
		      (struct fplSymbol **)*tags));
      break;
    case FPLSEND_GETSYMBOL_VARIABLES:
      CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_VARIABLE,
		      (struct fplSymbol **)*tags));
      break;
    case FPLSEND_GETSYMBOL_ALLVARIABLES:
      CALL(GetSymbols(scr, ~0, FPL_VARIABLE, (struct fplSymbol **)*tags));
      break;

    case FPLSEND_GETSYMBOL_ALLFUNCTIONS:
      CALL(GetSymbols(scr, ~0, FPL_FUNCTION, (struct fplSymbol **)*tags));
      break;

    case FPLSEND_GETSYMBOL_CACHEDFILES:
      prog=scr->programs;
      mixed=0;
      while(prog) {
	if(prog->flags&PR_CACHEFILE)
	  mixed++;
	prog=prog->next;
      }

      GETMEM(symbol, sizeof(struct fplSymbol));
      symbol->num=mixed;
      GETMEM(symbol->array, mixed*sizeof(uchar *));

      mixed=0;
      prog=scr->programs;
      while(prog) {
	if(prog->flags&PR_CACHEFILE)
	  symbol->array[mixed++]=prog->name;
	prog=prog->next;
      }
      *(struct fplSymbol **)*tags=symbol;

#ifdef DEBUG
      CheckMem(scr, symbol);
      CheckMem(scr, symbol->array);
#endif

      break;

      /* ----------------  new from V10: --------------------- */

    case FPLSEND_RESULT:
      resultcode = (long *)(*tags); /* long to store result in! */
      break;

    case FPLSEND_IS_FILE_CACHED:
      if(resultcode) {
        prog=scr->programs;
        while(prog) {
          if(prog->name && !strcmp(prog->name, (uchar *)(*tags))) {
            *resultcode = TRUE;
            break;
          }
          prog=prog->next;
        }
        *resultcode = FALSE;
      }
      break;
    
      /* --------------------------------------------------- */

    case FPLSEND_GETSYMBOL_FREE:
#ifdef DEBUG
      CheckMem(scr, (void *)(*tags));
      CheckMem(scr, ((struct fplSymbol *)*tags)->array);
#endif
      FREE(((struct fplSymbol *)*tags)->array);
      FREE(*tags);
      break;

#if defined(AMIGA) && defined(SHARED)
    case FPLSEND_GETSTACKSIZE:
      *(long *)*tags=scr->stack_size;
      break;
    case FPLSEND_GETSTACKUSED:
      *(long *)*tags=GetStackUsed(scr);
      break;
#endif

    case FPLSEND_SETPROGNAME:
      if(scr->prog) {
	if(scr->prog->name)
	  FREEA(scr->prog->name);
	STRDUPA(scr->prog->name, *tags);
      }
      break;

    case FPLSEND_SETFILENAMEGET:
      if(scr->prog) {
	if(*tags)
	  scr->prog->flags|=PR_FILENAMEFLUSH;
	else
	  scr->prog->flags&=~PR_FILENAMEFLUSH;
      }
      break;
    case FPLSEND_GETVERSION:
      *(long *)(*tags) = FPL_VERSION; /* as defined in FPL.h */
      break;
    case FPLSEND_GETREVISION:
      *(long *)(*tags) = FPL_REVISION; /* as defined in FPL.h */
      break;
    }
    tags++;
  }
  if(!msg.type)
    /*
     * There is no message to send. Everything we had to do is done!
     */
    return(FPL_OK);

  if(msg.type==FPLMSG_RETURN && (msg.flags == FPLMSG_FLG_STRING)) {
    if(len<0)
      if(data)
	len=strlen(data);
    if(!len || !data)
      /* this really is a zero length string! */
      msg.message[0]=NULL;
    else {
      if(!fplallocstring) {
        /* we have to duplicate the data */
        GETMEM(msg.message[0], len+sizeof(struct fplStr));
        string=msg.message[0];
        string->len=len;
        string->alloc=len;
        memcpy(string->string, data, len); /* copy string! */
        string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
      } else {
        /* the data was sent as fplAllocString() data! */
        string= (struct fplStr *)(data - offsetof(struct fplStr, string));
        string->len=len;
        string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
        SwapMem(scr, string, MALLOC_DYNAMIC); /* convert */
        msg.message[0]=string;
      }
    }
  }
  CALL(SendMessage(scr, &msg));
  return(ret);
}


/*********************************************************************
 *
 * fplConvertString()
 *
 * Returns the number of characters converted from the FPL format
 * string to the binary sting stored in a buffer.
 *
 * The output string always get zero terminated!
 *
 *****/

long PREFIX
fplConvertString(AREG(0) struct Data *scr,
                 AREG(1) uchar *string,
                 AREG(2) uchar *buffer)
{
  long prg=scr->prg;
  uchar *text=scr->text;
  long line;
  uchar *base;
  long a;
  long number=0;

#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplConvertString");
#endif

  if(!scr->prog) {
    /*
     * There is no program at the moment!
     * create a pseudo program for now!
     */
    scr->prog=(struct Program *)MALLOC(sizeof(struct Program));
    if(!scr->prog)
      return(0); /* no characters in output! */
    scr->prog->flags|=PR_TEMPORARY;
  }
  
  base=scr->prog->name;
  line=scr->prog->lines;
/*
  if(*string==CHAR_QUOTATION_MARK)
    string++;
*/

  scr->prg=1;
  scr->text=string;
  scr->prog->lines=1;
  scr->prog->name=NULL; /* we have no file ID yet! */

  while(/* *scr->text!=CHAR_QUOTATION_MARK && */
	!ReturnChar(scr, &a, TRUE)) { /* returns non-zero when an ascii zero is
				         found! */
    *buffer++=(uchar)a;
    number++;
  }
  
  *buffer=CHAR_ASCII_ZERO;

  scr->prg=prg;
  scr->text=text;
  scr->prog->lines=line;
  scr->prog->name=base;
  
  if(scr->prog->flags&PR_TEMPORARY) {
    FREE(scr->prog);
    scr->prog=NULL;
  }

  return(number);
}

/**********************************************************************
 *
 * GetSymbols();
 *
 * Allocates a structure and data, which is a list of name pointers
 * that match the flag parameter.
 *
 *******/

static ReturnCode REGARGS
GetSymbols(struct Data *scr,
           long flag1,
           long flag2,
           struct fplSymbol **get)
{
  long i;
  long num;
  struct Identifier *ident;
  struct fplSymbol *symbol;

  for(i=num=0; i<scr->hash_size; i++) {
    ident=scr->hash[i];
    while(ident) {
      if(ident->flags&flag1 && ident->flags&flag2)
	num++;
      ident=ident->next;
    }
  }

  GETMEM(symbol, sizeof(struct fplSymbol));
  symbol->num=num;

  GETMEM(symbol->array, sizeof(uchar *)*symbol->num);

  for(i=num=0; i<scr->hash_size; i++) {
    ident=scr->hash[i];
    while(ident) {
      if(ident->flags&flag1 && ident->flags&flag2)
	symbol->array[num++]=ident->name;
      ident=ident->next;
    }
  }
  *get=symbol;

#ifdef DEBUG
  CheckMem(scr, symbol->array);
#endif
  return(FPL_OK);
}


/**********************************************************************
 *
 * SendMessage();
 *
 * Add a member to the message queue. Allocate a new struct and copy the
 * data of from second parameter message pointer.
 *
 ******/

static ReturnCode INLINE
SendMessage(struct Data *scr,
            struct fplMsg *msg)
{
  struct fplMsg *NewMsg, *ptr;

  GETMEM(NewMsg, sizeof(struct fplMsg));

  *NewMsg=*msg; /* copy all data from source */

  /* Queue the message: */
  if(ptr=scr->msg)
    ptr->prev=NewMsg; /* this message becomes the previous for this */

  scr->msg=NewMsg;
  NewMsg->next=ptr;
  NewMsg->prev=NULL; /* no previous, this is first! */

  return(FPL_OK);
}

/**********************************************************************
 *
 * DeleteMessage();
 *
 * Deletes specified or current message (NULL).
 *
 *****/

ReturnCode REGARGS
DeleteMessage(struct Data *scr,
              struct fplMsg *msg)
{
  struct fplMsg *ptr=scr->msg;
  if(msg) 
    ptr=msg;
  if(ptr) {
    if(ptr->next)
      ptr->next->prev=ptr->prev; /* redirect next message's prev pointer */
    else if(!ptr->prev) /* is this the only message? */
      scr->msg=NULL;
    if(ptr->prev)
      ptr->prev->next=ptr->next; /* redirect previous message's next pointer */
    FREE(ptr);  /* free message */
  }
  return(FPL_OK);
}

/**********************************************************************
 *
 * GetMessage()
 *
 * Returns the first message of the requested type in the pointer
 * in the third argument!
 *
 ****/

ReturnCode REGARGS
GetMessage(struct Data *scr,
           uchar type,
           struct fplMsg **get)
{
  struct fplMsg *msg=scr->msg;
  while(*get=msg) {
    if(msg->type==type)
      break;
    msg=msg->next;
  }
  return(FPL_OK);
}

/**********************************************************************
 *
 * GetProgram();
 *
 * Whenever we want to access a program in the program list, we do it
 * using this function. This enables heavy program swapping capabilities.
 * Programs that are not being used can be flushed from memory and brought
 * back whenever we need it!
 *
 ******/

ReturnCode REGARGS
GetProgram(struct Data *scr,
           struct Program *prog)
{
  struct fplArgument *arg;
  ReturnCode ret;
  struct fplMsg *msg;
  struct fplStr *string;
  if(!prog->program) {
    /*
     * The program is not currently in memory. Get it!
     */
    
    if(prog->flags&PR_FILENAMEFLUSH) {
      /*
       * We know that the program is simply to load from the file the program
       * name specifies.
       */
      CALL(ReadFile(scr, prog->name, prog));