This is trees.c in view mode; [Download] [Up]
/*
* intermediate representation
*/
#include "defs.h"
#include <stdio.h>
double *disp_args;
int arg_count;
double *arg_list_stack[MAXSTACK];
int arg_count_stack[MAXSTACK];
int stack_ptr;
double parse_dispatch();
char buf[500];
extern Tree tp1,tp2,tp3;
extern int i1,i2,i3;
extern double f1,f2,f3;
/*
* floating point comparisons:
* f1 < f2 ==> -1
* f1 = f2 ==> 0
* f1 > f2 ==> 1
*/
/* useless funtion */
foo(){};
foo2(){};
cmp (f1,f2)
double f1,f2;
{
foo();
if (fabs(f1-f2)< EPS){// printf("cmp=%g %g %g \n",f1,f2,fabs(f1-f2));
return (0);
}
if ((f1-f2) > EPS) { //printf("cmp > %g %g %g \n",f1,f2,fabs(f1-f2));
return (1);
}
if ((f2-f1) > EPS) {// printf("cmp <%g %g %g \n",f1,f2,fabs(f1-f2));
return (-1);
}
}
Tree node(op,kind)
int op;
int kind;
{
Tree tp1;
tp1 = (Tree) emalloc(sizeof(struct tree));
tp1->op = op;
tp1->kind = kind;
tp1->u.child[0] = NULL;
tp1->u.child[1] = NULL;
tp1->u.child[2] = NULL;
tp1->u.child[3] = NULL;
return tp1;
}
/*
Tree tproc(){};
*/
Tree tnoop()
{
Tree tp1;
foo();
tp1=node(FREE,TNOOP);
return (tp1);
}
Tree tseq(e1,e2)
Tree e1,e2;
{
Tree tp1;
foo();
tp1=node(FREE,SEQ);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
Tree top(op,e1,e2)
Tree e1,e2;
int op;
{
Tree tp1;
foo();
tp1 =node (op,OP);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
Tree tunop(op,e1)
Tree e1;
int op;
{
Tree tp1;
foo();
tp1 = node(op,UNOP);
tp1->u.child[0] = e1;
return tp1;
}
Tree tconvert(op,e1)
int op;
Tree e1;
{
Tree tp1;
foo();
tp1=node (op,CONVERT);
tp1->u.child[0] = e1;
return tp1;
}
/*
Tree tfetch(){};
*/
Tree tstore(e1,e2)
Tree e1,e2;
{
Tree tp1;
foo();
tp1 = node(FREE,STORE);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
/*
Tree tmove(){};
*/
/* not used *********************
Tree teseq(stm,e1)
Tree stm,e1;
{
Tree tp1;
foo();
tp1 = node(FREE,ESEQ);
tp1->u.child[0] = stm;
tp1->u.child[1] = e1;
return tp1;
}
*/
/*
Tree tbool(){}
*/
/*
* converts symbol table entry into tree
* or initialize tree node to a symbol entry
*/
Tree tname(sym)
SYMBOL *sym;
{
Tree tp1;
foo();
tp1 = node(FREE,NAME);
tp1->u.sym = sym;
return tp1;
}
Tree tconst(ival)
int ival;
{
Tree tp1;
foo();
tp1 = node(FREE,CONST);
tp1->u.ival = ival;
return tp1;
}
Tree tconstf(fval)
double fval;
{
Tree tp1;
foo();
tp1 = node(FREE,CONSTF);
tp1->u.fval = fval;
return tp1;
}
/*
Tree falloc(){}
Tree ttemp(){}
*/
Tree tcall(e1,str)
Tree e1; /*arguments*/
char *str; /* name of function to call */
{
Tree tp1;
foo();
tp1 = node(FREE,CALL);
tp1->x.fctname = str;
tp1->u.child[0] = e1;
return tp1;
}
Tree tcand(test1,test2)
Tree test1,test2;
{
Tree tp1;
foo();
tp1 = node(FREE,CAND);
tp1->u.child[0] = test1;
tp1->u.child[1] = test2;
return tp1;
}
Tree tcor(test1,test2)
Tree test1,test2;
{
Tree tp1;
foo();
tp1 = node(FREE,COR);
tp1->u.child[0] = test1;
tp1->u.child[1] = test2;
return tp1;
}
Tree tnot(test1)
Tree test1;
{
Tree tp1;
foo();
tp1 = node(FREE,NOT);
tp1->u.child[0] = test1;
return tp1;
}
Tree trel(op,e1,e2)
int op;
Tree e1,e2;
{
Tree tp1;
foo();
tp1 = node (op,REL);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
Tree targ(e1,args)
Tree e1,args;
{
Tree tp1;
foo();
tp1 = node(FREE,ARG);
tp1->u.child[0] = e1;
tp1->u.child[1] = args;
return tp1;
}
Tree tnoargs()
{
Tree tp1;
foo();
tp1 = node(FREE,NOARGS);
return tp1;
}
Tree tif(e1,e2)
Tree e1,e2;
{
Tree tp1;
foo();
tp1 = node (FREE,TIF);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
Tree tifelse(e1,e2,e3)
Tree e1,e2,e3;
{
Tree tp1;
foo();
tp1 = node (FREE,TIFELSE);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
tp1->u.child[2] = e3;
return tp1;
}
Tree tfor(e1,e2,e3,e4)
Tree e1,e2,e3,e4;
{
Tree tp1;
foo();
tp1 = node (FREE,TFOR);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
tp1->u.child[2] = e3;
tp1->u.child[3] = e4;
return tp1;
}
Tree twhile(e1,e2)
Tree e1,e2;
{
Tree tp1;
foo();
tp1 = node (FREE,TWHILE);
tp1->u.child[0] = e1;
tp1->u.child[1] = e2;
return tp1;
}
/*
*
*
* This recursive function interprets the intermediate code
*
*/
Tree exct(tp)
Tree tp;
{
int i;
if (tp == NULL) return (NULL);
switch (tp->kind) {
case SEQ: {
exct(tp->u.child[0]);
exct(tp->u.child[1]);
break;
}
/* puts value and type into symbol pted to by child[0]u.sym */
case STORE: {
/* TBD: include handlng of different types */
tp->u.child[0]->u.sym->v.fval = exct(tp->u.child[1])->v.fval;
tp->u.child[0]->u.sym->type = tp->u.child[1]->type;
tp->v.fval = tp->u.child[0]->u.sym->v.fval;
tp->type = tp->u.child[1]->type;
break;
}
/* assign what's in the symobol into tree's value field */
case NAME: {
tp->type = tp->u.sym->type;
tp->v.fval = tp->u.sym->v.fval;
break;
}
case CONST: {
tp->type = T_INT;
tp->v.ival = tp->u.ival;
break;
}
case CONSTF: {
tp->type = T_FLOAT;
tp->v.fval = tp->u.fval;
break;
}
case ARG: {
exct(tp->u.child[0]);
if (arg_count ==MAXDISPARGS)
i_error("exeeded maximum number of arguments for a function call");
disp_args[arg_count++] = exct(tp->u.child[1])->v.fval;
break;
}
case NOARGS: { /* do nothing */
break;
}
case CALL: {
/* TBD: distinguish between internal or dispatcher function */
push_args ();
exct(tp->u.child[0]);
for (i=arg_count;i<MAXDISPARGS;i++) disp_args[i]=0;
tp->v.fval = parse_dispatch (tp->x.fctname,
disp_args,arg_count);
pop_args ();
tp->type = T_FLOAT;
break;
}
case NOT: {
tp->type = T_FLOAT;
if(cmp(0.0,exct(tp->u.child[0])->v.fval)==0)
tp->v.fval = 1.0;
else tp->v.fval = 0.0;
break;
}
case CAND: {
tp->type = T_FLOAT;
tp->v.fval = 0.0;
if(cmp(0.0,exct(tp->u.child[0])->v.fval)!= 0)
if(cmp(0.0,exct(tp->u.child[1])->v.fval)!= 0)
{ tp->type = T_FLOAT;
tp->v.fval = 1.0;
}
break;
}
case REL: {
tp->type = T_FLOAT;
switch((int)tp->op) {
case EQ: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)== 0)
tp->v.fval = 1.0;
else
tp->v.fval = 0.0;
break;
}
case NEQ: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)== 0)
tp->v.fval = 0.0;
else
tp->v.fval = 1.0;
break;
}
case LT: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)== -1)
tp->v.fval = 1.0;
else
tp->v.fval = 0.0;
break;
}
case GT: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)== 1)
tp->v.fval = 1.0;
else
tp->v.fval = 0.0;
break;
}
case LEQ: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)<= 0)
tp->v.fval = 1.0;
else
tp->v.fval = 0.0;
break;
}
case GEQ: {
if(cmp(exct(tp->u.child[0])->v.fval,
exct(tp->u.child[1])->v.fval)>= 0)
tp->v.fval = 1.0;
else
tp->v.fval = 0.0;
break;
}
default: {
foo2();
sprintf(buf,"kind: %d; op: %d; u.fval: %f; v.fval: %f; type: %d",tp->kind,tp->op,tp->u.fval,tp->v.fval,tp->type);
msg(buf);
i_warning("tried to execute illegal REL in exct");
}
}
break; /* switch REL */
}
case OP:{
tp->type = T_FLOAT;
switch ((int)tp->op){
case PLUS: {
tp->v.fval=exct(tp->u.child[0])->v.fval +
exct(tp->u.child[1])->v.fval;
break;
}
case MINUS: {
tp->v.fval=exct(tp->u.child[0])->v.fval -
exct(tp->u.child[1])->v.fval;
break;
}
case MUL: {
tp->v.fval=exct(tp->u.child[0])->v.fval *
exct(tp->u.child[1])->v.fval;
break;
}
case DIV: {
tp->v.fval=exct(tp->u.child[0])->v.fval /
exct(tp->u.child[1])->v.fval;
break;
}
case POW: {
tp->v.fval=pow(exct(tp->u.child[0])->v.fval ,
exct(tp->u.child[1])->v.fval);
break;
}
default: {
foo2();
sprintf(buf,"kind: %d; op: %d; u.fval: %f; v.fval: %f; type: %d",tp->kind,tp->op,tp->u.fval,tp->v.fval,tp->type);
msg(buf);
i_warning("tried to execute illegal OP in exct");
}
}
break; /* switch OP */
}
case CONVERT: {
tp->type = T_FLOAT;
switch (tp->op) {
/****** TBD: THE CONVERSION FUNCTIONS NEED TO BE COMPLETED ******/
case CVTOC: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
case CVTOL: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
case CVTLO: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
case CVTLC: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
case CVTCL: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
case CVTCO: { tp->v.fval=exct(tp->u.child[0])->v.fval;
break;
}
default: {
foo2();
sprintf(buf,"kind: %d; op: %d; u.fval: %f; v.fval: %f; type: %d",tp->kind,tp->op,tp->u.fval,tp->v.fval,tp->type);
msg(buf);
i_warning("tried to execute illegal CVT in exct");
}
}
break; /* switch CONVERT */
}
case UNOP: {
tp->type = T_FLOAT;
if (tp->op == NEG)
tp->v.fval= - exct(tp->u.child[0])->v.fval;
break;
}
case COR: {
tp->type = T_FLOAT;
tp->v.fval = 0;
if((cmp(0.0,exct(tp->u.child[0])->v.fval)!= 0) ||
(cmp(0.0,exct(tp->u.child[1])->v.fval)!= 0))
{ tp->v.fval = 1;
}
break;
}
case TIF: {
if (cmp(0.0,exct(tp->u.child[0])->v.fval)!= 0)
exct(tp->u.child[1]);
break;
}
case TIFELSE: {
if (cmp(0.0,exct(tp->u.child[0])->v.fval)!= 0)
exct(tp->u.child[1]);
else
exct(tp->u.child[2]);
break;
}
case TWHILE: {
while (cmp(0.0,exct(tp->u.child[0])->v.fval)!= 0)
exct(tp->u.child[1]);
break;
}
case TNOOP: {break;}
case TFOR: {
/*
for (exct(tp->u.child[0]);cmp(0.0,exct(tp->u.child[1])->v.fval)!= 0;
exct(tp->u.child[2]))
*/
exct(tp->u.child[0]);
while (cmp(0.0,exct(tp->u.child[1])->v.fval)!= 0) {
exct(tp->u.child[3]);
exct(tp->u.child[2]);
}
break;
}
default: {
foo2();
sprintf(buf,"kind: %d; op: %d; u.fval: %f; v.fval: %f; type: %d",tp->kind,tp->op,tp->u.fval,tp->v.fval,tp->type);
msg(buf);
i_warning("tried to execute illegal node in exct");
}
} /* switch kind */
return (tp);
}
/* keeps a stack of dispatch argument lists */
push_args ()
{
char *malloc();
if (stack_ptr >= MAXSTACK)
i_error ("stack overflow: too many nested function calls");
arg_list_stack[stack_ptr] = disp_args;
arg_count_stack[stack_ptr++] = arg_count;
disp_args = (double *) malloc (sizeof(double) * MAXDISPARGS);
arg_count = 0;
}
pop_args ()
{
free (disp_args);
if (stack_ptr == 0 )
i_error ("stack underflow");
disp_args = arg_list_stack[--stack_ptr];
arg_count = arg_count_stack[stack_ptr];
}
/*
*
*
* This recursive function frees space.
*
*/
free_tree(tp)
Tree tp;
{
if (tp == NULL) return (NULL);
switch (tp->kind) {
case SEQ: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case STORE: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case NAME: {
break;
}
case CONST: {
break;
}
case CONSTF: {
break;
}
case ARG: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case NOARGS: {
break;
}
case CALL: {
free_tree(tp->u.child[0]);
break;
}
case NOT: {
free_tree(tp->u.child[0]);
break;
}
case CAND: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case REL: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case OP:{
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case CONVERT: {
free_tree(tp->u.child[0]);
break;
}
case UNOP: {
free_tree(tp->u.child[0]);
break;
}
case COR: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case TIF: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case TIFELSE: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
free_tree(tp->u.child[2]);
break;
}
case TWHILE: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
break;
}
case TNOOP: {
break;
}
case TFOR: {
free_tree(tp->u.child[0]);
free_tree(tp->u.child[1]);
free_tree(tp->u.child[2]);
free_tree(tp->u.child[3]);
break;
}
} /* switch kind */
free(tp); /* actually free space */
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.