ripreter.cpp

eC++编译器源码

#pragma ripreter
#include <ripreter.h>
#include <SYSTEM.h>
#include <stdio.h>
#include <Storage.h>
#include <characte.h>
#include <RType.h>
#include <cstring.h>
#include <Substring.h>
#include <Errors.h>
#include <SInOut.h>
#include <InOut.h>
/******************************************************************************/

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

/*
 *This  function  takes  character string and translate characters into
 *corresponding meaning  data,  then  represent  them with binary code,
 *and store them into another character string  for consequently faseter
 *access.
*/
void Conv_to_Bin(STRING s1,  STRING &s2)
{
 unsigned int   i,j,k,m;
 unsigned int   *pu1,*pu2;
 long           *pl;
 long           ll;
 float          *pf;
 float          ff;
  
 i = 0;
 j = 0;

 do
   switch (s1[i]) {              
      case lil:                        /*translate characters into long*/
        	s2[j] = s1[i];         /*and store binary code*/
		i++;
		j++;
		k = (ORD(s1[i]) - ORD('0'))*10 + ORD(s1[i+1])-ORD('0'); 
		INC(i,2);
       
	        m = i;
		if (!(ReadLongInt(s1,m,ll))) printf("bad constant read");
		pl  = ADR(s2) + LONG(j);
		*pl = ll;              
		INC(j,4);
		INC(i,k);
		break;

      case lkf:                   /*translate four characteres into two*/
		s2[j] = s1[i];    /*unsigned int and store it in binary*/
		i++;
		j++;
		k = (ORD(s1[i]) - ORD('0'))*10 + ORD(s1[i+1])-ORD('0'); 
		pu1  = ADR(s2) + LONG(j);     
		*pu1 = k;
		INC(i,2);
		INC(j,2);
		k = (ORD(s1[i]) - ORD('0'))*10 + ORD(s1[i+1])-ORD('0'); 
		pu2  = ADR(s2) + LONG(j);
		*pu2 = k;
		INC(i,2);
		INC(j,2);
		break;

       case lis,lic,call,jpt:     /*translate two characteres into single*/                    
		s2[j] = s1[i];    /*unsigned int and store it in binary*/
		i++;
		j++;
		k  = (ORD(s1[i]) - ORD('0'))*10 + ORD(s1[i+1])-ORD('0'); 
		pu1  = ADR(s2) + LONG(j);     
		*pu1 = k;
		INC(i,2);
		INC(j,2);
		break;

        case lir:                      /*translate characters into real*/
		s2[j] = s1[i];         /*and store binary code*/
		i++;
		j++;
		k = (ORD(s1[i]) - ORD('0'))*10 + ORD(s1[i+1])-ORD('0'); 
		INC(i,2);

		m = i;       
		if (!(ReadReal(s1,m,ff)))  printf("Bad ReadReal");
		pf  = ADR(s2) + LONG(j);
		*pf = ff;              
		INC(j,4);
		INC(i,k);
		break;

	default:                                    /*parsing character*/
	        s2[j] = s1[i];
		i++;
		j++;
		break;
	};/*end switch*/
 while (s1[i] != EOS);
};/*end Conv_to_Bin*/

/*initialize expression*/
void ROpen(Expression &e, STRING s, AttributeProc p, ADDRESS arg, pStack ps)
{
  ALLOCATE(e, sizeof(Exp));
  if ((e == NULL) || (ps == NULL)) printf("RInterpret.Open:out of space\n");
  
  Conv_to_Bin(s,(e->code1));
  
  e->ip = 0;  
  e->op = 0; 
  e->dp = 1;                   /* can't have a zero starting position */
  e->operands    = ps;
  e->attrProc    = p;
  e->attrArg     = arg;
};

void RClose(Expression &e)
{
  DEALLOCATE(e, sizeof(Exp));
};

/*compare two character string*/
void compare(pStack p, unsigned int  tos)
{
  int        out;
  pOperand   pl,pr;

  pl = ADR(p->s[tos-1]);
  pr = ADR(p->s[tos]);

  if ((pl->ot == IChar) && (pr->ot == IChar)){
       out = CompareSS(*(pl->p), pl->ioffset,pl->type.il,
		       *(pr->p), pr->ioffset,pr->type.il);
       if   (out > 0)  (pl->type.l) = 1L;
            else if (out < 0)  (pl->type.l) = -1L;
                 else (pl->type.l) = 0L;
       (pl->ot) = Long;
       }
  else{
       p->top = tos+1;
       Invoke(pl->ot, ORD(cmp), p);
       tos = p->top;};
};


pStack RInterpret(Expression &e)
{
  int              j;
  unsigned int     i, k;
  unsigned int     *ppu1,*ppu2;
  Operand          temp;
  typedef char     string[10];
  string           *pc;                                 /****/
  long             *ppl;
  float            *ppf;
   
  (e->op)  =  ((e->operands)->top);

  for(;;) {
   switch  (e->code1[e->ip]) {
   case nop: 
   case lit:  
	      
	      ((e->operands)->s[e->op]).ot = Bool;
	      ((e->operands)->s[e->op]).type.b  = true;
	      INC(e->op);
              INC(e->ip);
	      break;               

   case lif:  (e->operands)->s[e->op].ot = Bool;
	      ((e->operands)->s[e->op]).type.b  = false;
	      INC(e->op);
              INC(e->ip);
	      break;

   case lis:   (e->operands)->s[e->op].ot = IChar;
	       (e->operands)->s[e->op].p  = ADR(e->code1);
	       ppu1 = ADR(e->code1) + LONG((e->ip)+1);
	       (e->operands)->s[e->op].type.il = *ppu1;
	       (e->operands)->s[e->op].ioffset = (e->ip)+3;
	       INC((e->ip), ((e->operands)->s[(e->op)].type.il+3));
	       INC(e->op);
               break;

   case lic:DEC(e->op);
	    if (((e->operands)->s[e->op]).ot != IChar) 
	      SoftwareError("RInterpret.Interpret:type constant not a string");
	    ppu1 = ADR(e->code1) + LONG((e->ip)+1);
	    INC((e->ip),3);
	    i =  *ppu1;
	    if (!(Inout(i, NULL, CONVERT, (e->operands)->s[e->op].p,
       	    (e->operands)->s[e->op].ioffset,(e->operands)->s[e->op].type.il,
            (e->operands)->s[e->op])))
	    SoftwareError("RInterpret.Interpret:bad type constant");
	    INC(e->op);
 	    break;

   case lil:((e->operands)->s[e->op]).ot = Long;
	    ppl = ADR(e->code1) + LONG((e->ip)+1);
	    ((e->operands)->s[e->op]).type.l = *ppl;
	    INC((e->ip),5);
	    INC(e->op);
            break;

   case lir: (e->operands)->s[e->op].ot = Real;
	     ppf = ADR(e->code1) + LONG((e->ip)+1);
	     ((e->operands)->s[e->op]).type.r = *ppf;
	     INC((e->ip),5);
	     INC(e->op);
	     break;

   case and: DEC(e->op);
	     if (((e->operands)->s[e->op].ot != Bool) ||
		 ((e->operands)->s[(e->op)-1].ot != Bool))
        	      SoftwareError("RInterpret.Interpret:bad types on and");

	     (e->operands)->s[(e->op)-1].type.b =
      				(((e->operands)->s[(e->op)-1].type.b)
	       		     && ((e->operands)->s[e->op].type.b));
              INC(e->ip);
	      break;

   case or:  DEC(e->op);
	     if (((e->operands)->s[e->op].ot != Bool) ||
  		 ((e->operands)->s[(e->op)-1].ot != Bool))
	      SoftwareError("RInterpret.Interpret:bad types on or");

  	     (e->operands)->s[(e->op)-1].type.b =
				(((e->operands)->s[(e->op)-1].type.b)
			     || ((e->operands)->s[e->op].type.b));
             INC(e->ip);
	     break;

   case not: 
	     if ((e->operands)->s[(e->op)-1].ot != Bool) 
	       SoftwareError("RInterpret.Interpret:bad type on not");
	     (e->operands)->s[(e->op)-1].type.b =
			       !((e->operands)->s[(e->op)-1].type.b);
              INC(e->ip);
	      break;

   case eql:
	     if ((e->operands)->s[(e->op)-1].ot != Long) 
	       SoftwareError("RInterpret.Interpret:bad type on eql");
	     (e->operands)->s[(e->op)-1].ot = Bool;
	     (e->operands)->s[(e->op)-1].type.b  =
			  ((e->operands)->s[(e->op)-1].type.l == 0L);
              INC(e->ip);
	      break;
	
   case neq: 
	      if ((e->operands)->s[(e->op)-1].ot != Long) 
	       SoftwareError("RInterpret.Interpret:bad type on neq");

	      ((e->operands)->s[(e->op)-1]).ot = Bool;
	      ((e->operands)->s[(e->op)-1]).type.b  =
			  ((e->operands)->s[(e->op)-1].type.l != 0L);
              INC(e->ip);
	      break;