Logo Search packages:      
Sourcecode: nase-a60 version File versions

doeval.c

/*
 * Copyright (C) 1991,1999 Erik Schoenfelder (schoenfr@ibr.cs.tu-bs.de)
 *
 * This file is part of NASE A60.
 * 
 * NASE A60 is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * NASE A60 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.  See the GNU
 * General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with NASE A60; see the file COPYING.  If not, write to the Free
 * Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * doeval.c:                                    oct '90
 *
 * Erik Schoenfelder (schoenfr@ibr.cs.tu-bs.de)
 *
 * here is some code about runtime evaluation; it is mixed with 
 * eval.c and used from run.c
 */

#include "comm.h"
#include "a60.h"
#include "util.h"
#include "conv.h"
#include "run.h"
#include "eval.h"


/*
 * evaluate a switch expression.
 */

static void
do_eval_switchexpr (sym, ex)
SYMTAB *sym;
EXPR *ex;
{
      long idx = 0;
      SWACT *swact;
      EVALELM ev, *evp;

#ifdef DEBUG
      if (do_debug)
            printf ("** do_eval_switchexpr: sym is `%s' ...\n", sym->name);
#endif /* DEBUG */

      if (sym->tag == s_byname)
            xabort ("INTERNAL: do_eval_switchexpr: s_byname");

      swact = get_swact (sym);
      if (! swact) {
            a60_error (ex->source, ex->lineno,
                     "uninitialized switch list (symbol is `%s').\n",
                     sym->name);
            xabort ("runtime error");
      }

      /* now eval the index: */
      do_eval_expr (ex);
      DO_DEREF(ex->source, ex->lineno);
      ev = * POP_EVALST;
      if (ev.tag == ev_ival)
            idx = ev.u.ival;
      else if (ev.tag == ev_rval)
            idx = RVAL2IVAL (ev.u.rval);
      else {
            a60_error (ex->source, ex->lineno,
   "subscript of designational expression must be of numerical type.\n");
            a60_error (ex->source, ex->lineno,
                     "(but the type is `%s').\n", 
                     eval_tag_name [ev.tag]);
            xabort ("runtime error");
      }

#ifdef DEBUG
      if (do_debug)
            printf ("** do_eval_switchexpr: idx is %ld.\n", idx);
#endif /* DEBUG */
      
      if (idx < 1 || idx > swact->nelm) {
            /*
             * an undefined design. expr. leads to a dummy
             */

            /* +++++ add runtime warning +++++ */

#ifdef DEBUG
            if (do_debug)
                  printf ("** index out of range: dummy.\n");
#endif /* DEBUG */

            evp = PUSH_EVALST(ex->source, ex->lineno, ev_label);
            evp->u.sym = (SYMTAB *) 0;
      }
      else {
            evp = PUSH_EVALST(ex->source, ex->lineno, ev_label);
            /* ***** 16 bit idx ***** */
            evp->u.sym = swact->targs [(int) idx - 1];
      }
}


static void
do_eval_arrval (lhelm)
LHELM *lhelm;
{
      SYMTAB *sym = lhelm->sym;
      MINDEX *mindex;
      CBLOCK *cb;
      ACTIV *act;
      ACT_BOUND *bound;
      EVALELM *ev;
      long idx = 0;
#ifdef MEMORY_STATISTICS
      DO_STACK_STAT;
#endif

      mindex = lhelm->mindex;
      if (! mindex)
            xabort ("INTERNAL: do_eval_arrval: no mindex");

      while (sym->tag == s_byname) {
            CBLOCK *cb = act_cblock;
            ACTIV *act;
#ifdef DEBUG
            if (do_debug)
                  printf ("* do_eval_arrval: sym is `%s'...\n",
                        sym->name);
#endif /* DEBUG */
            while (cb->block != sym->block)
                  cb = cb->next;
            act = cb->activ + sym->actidx;
            if (act->data->u.pexpr.expr->tag != e_symbol)
                  xabort ("INTERNAL: do_eval_arrval: no symbol");
            sym = act->data->u.pexpr.expr->u.lhelm->sym;
      }
      
#ifdef DEBUG
      if (do_debug) 
            printf ("* do_eval_arrval: sym is `%s' !\n", sym->name);
#endif /* DEBUG */

      if (sym->type == ty_switch) {
            /*
             * got you: this is parsed as an array access, but
             * actual ans des-expression.
             * its a bad hack - yeh.
             */

#ifdef DEBUG
            if (do_debug)
                  printf ("** do_eval_arrval: is a switch ...\n");
#endif /* DEBUG */

            do_eval_switchexpr (sym, mindex->expr);
            return;
      }

      if (! TIS_ARR(sym->type)) {
            a60_error (lhelm->source, lhelm->lineno,
                     "not an array: `%s'\n", sym->name);
            xabort ("runtime error");
      }

      cb = act_cblock;
      while (cb->block != sym->block)
            cb = cb->next;
      act = cb->activ + sym->actidx;
      /*
       * this can happen, if the array declaration is interrupted by
       * an goto :-)
       */
      if (! act || ! act->arract) {
            a60_error (lhelm->source, lhelm->lineno,
                     "uninitialized array\n");
            xabort ("runtime error");
      }
      
      bound = act->arract->act_bound;

      while (mindex) {
            do_eval_expr (mindex->expr);
            DO_DEREF(mindex->expr->source, mindex->expr->lineno);
            ev = POP_EVALST;

            if (ev->tag == ev_rval) {
                  ev->tag = ev_ival;
                  ev->u.ival = RVAL2IVAL(ev->u.rval);
            }
            else if (ev->tag != ev_ival) {
                  a60_error (ev->source, ev->lineno,
               "array index must be of numerical type (found `%s')\n",
                           eval_tag_name[ev->tag]);
                  xabort ("runtime error");
            }

            if (ev->u.ival < bound->from
                || ev->u.ival > bound->til) {
                  a60_error (ev->source, ev->lineno,
      "index not in bound; index is %ld, bounds are [%ld : %ld]\n",
                           ev->u.ival, bound->from, bound->til);
                  xabort ("runtime error");
            }

            idx = idx + (ev->u.ival - bound->from) * bound->mpl;
            
            mindex = mindex->next;
            bound = bound->next;
      }

#ifdef DEBUG
      if (do_debug)
            printf ("* do_eval_arrval: idx is %ld.\n", idx);
#endif /* DEBUG */

      push_valaddr (lhelm->source, lhelm->lineno, sym, idx);
}



void
do_push_lhelm (lhelm)
LHELM *lhelm;
{
      SYMTAB *sym = lhelm->sym;


      if (lhelm->mindex) {
            do_eval_arrval (lhelm);
            return;
      }

#ifdef DEBUG
      if (do_debug)
            printf ("* do_push_lhelm: sym is `%s'...\n", sym->name);
#endif /* DEBUG */

      while (sym->tag == s_byname) {
            CBLOCK *cb = act_cblock;
            ACTIV *act;
            ENUM expr_tag tag;
            while (cb->block != sym->block)
                  cb = cb->next;
            act = cb->activ + sym->actidx;
            tag = act->data->u.pexpr.expr->tag;
            if (tag != e_symbol && tag != e_fcall) {
                  a60_error (lhelm->source, lhelm->lineno,
                        "no valid lefthand type (type is `%s')\n",
                         sym->name);
                  xabort ("runtime error");
            }
            if (act->data->u.pexpr.expr->u.lhelm->mindex) {
                  do_eval_arrval (act->data->u.pexpr.expr->u.lhelm);
                  return;
            }
            sym = act->data->u.pexpr.expr->u.lhelm->sym;
      }


#ifdef DEBUG
      if (do_debug)
            printf ("* do_push_lhelm: sym is `%s' !\n", sym->name);
#endif /* DEBUG */

      if (! TIS_SVALT(sym->type)) {
            a60_error (lhelm->source, lhelm->lineno,
               "illegal lefthand side (type is `%s')\n",
                     type_tag_name[sym->type]);
            xabort ("runtime error");
      }

      push_valaddr (lhelm->source, lhelm->lineno, sym, (long) 0);
}



void
do_eval_lhelm (lhelm)
LHELM *lhelm;
{
      SYMTAB *sym = lhelm->sym;
      ENUM expr_tag tag;
#ifdef MEMORY_STATISTICS
      DO_STACK_STAT;
#endif

      if (lhelm->mindex) {
            do_eval_arrval (lhelm);
            return;
      }

#ifdef DEBUG
      if (do_debug)
            printf ("* do_eval_lhelm: sym is `%s'...\n", sym->name);
#endif /* DEBUG */

      if (sym->tag == s_byname) {
            CBLOCK *cb = act_cblock;
            ACTIV *act;
            while (cb->block != sym->block)
                  cb = cb->next;
            act = cb->activ + sym->actidx;
            tag = act->data->u.pexpr.expr->tag;
            if (tag != e_symbol) {
                  do_eval_pexpr (& act->data->u.pexpr);
                  return;
            }
            do_eval_pexpr (& act->data->u.pexpr);
            return;
      }

#ifdef DEBUG
      if (do_debug)
            printf ("* do_eval_lhelm: sym is `%s' !\n", sym->name);
#endif /* DEBUG */

      if (TIS_BASET(sym->type) || TIS_FUNC(sym->type)) {
            push_valaddr (lhelm->source, lhelm->lineno, sym, (long) 0);
      }
      else if (TIS_SPECT(sym->type)) {
            push_spec (lhelm->source, lhelm->lineno, sym);
      }
      else if (TIS_ARR(sym->type)) {
            push_spec (lhelm->source, lhelm->lineno, sym);
      }
      else
            a60_error (lhelm->source, lhelm->lineno,
               "INTERNAL: do_eval_lhelm: bad sym type `%s'\n", 
                     sym_tag_name[sym->type]);
}


void
do_eval_expr (ex)
EXPR *ex;
{
      ENUM expr_tag tag = ex->tag;
      EVALELM *ev, top_ev;
      SYMTAB *sym;
#ifdef MEMORY_STATISTICS
      DO_STACK_STAT;
#endif

#ifdef DEBUG
      if (do_debug)
            printf ("** do_eval_expr: have here a `%s' (type is `%s').\n",
                  expr_tag_name [tag], type_tag_name [ex->type]);
#endif /* DEBUG */

      if (tag == e_switch) {
            sym = ex->u.eswitch->sym;
            while (sym->tag == s_byname) {

                  while (sym->tag == s_byname) {
                        CBLOCK *cb = act_cblock;
                        ACTIV *act;
#ifdef DEBUG
                        if (do_debug)
                              printf (
                  "* do_eval_expr: switch sym is `%s'...\n",
                                    sym->name);
#endif /* DEBUG */
                        while (cb->block != sym->block)
                              cb = cb->next;
                        act = cb->activ + sym->actidx;
                        if (act->data->u.pexpr.expr->tag != e_symbol)
                              xabort (
                        "INTERNAL: do_eval_expr: switch: no symbol");
                        sym = act->data->u.pexpr.expr->u.lhelm->sym;
#ifdef DEBUG
                        if (do_debug)
                              printf (
                        "* do_eval_expr: now it is  `%s'...\n",
                                    sym->name);
#endif /* DEBUG */
                  }
            }
            do_eval_switchexpr (sym, ex->u.eswitch->expr);
            return;
      }
      else if (tag == e_label) {
            sym = ex->u.label;
            while (sym->tag == s_byname) {
                  DATA *data;

#ifdef DEBUG
                  if (do_debug)
                        printf ("** label with s_byname (%s)...\n",
                              sym->name);
#endif /* DEBUG */

                  data = get_sym_data (sym);
                  do_eval_pexpr (&(data->u.pexpr));
                  return;
            }
            ev = PUSH_EVALST(ex->source, ex->lineno, ev_label);
            ev->u.sym = sym;
      }
      else if (tag == e_symbol) {
            /*
             * hmmm - may be its a numerical expression or it is a
             * designational expression...
             */
            do_eval_lhelm (ex->u.lhelm);
      }
      else if (tag == e_fcall) {
            if (trace)
                  printf ("line %d: executing func call (`%s')\n",
                        ex->lineno, ex->u.lhelm->sym->name);

            sym = ex->u.lhelm->sym;
            while ((TIS_PROC(sym->type) || sym->type == ty_unknown) 
                   && sym->tag == s_byname) {
                  DATA *data;
                  EVALELM ev;
#ifdef DEBUG
                  if (do_debug)
                        printf ("** call with func parm (%s):\n",
                              sym->name);
#endif /* DEBUG */
                  data = get_sym_data (sym);
                  push_spec_pexpr (&(data->u.pexpr));
                  ev = * POP_EVALST;
                  sym = ev.u.sym;
#ifdef DEBUG
                  if (do_debug)
                        printf ("   -> now it is func parm (%s).\n",
                              sym->name);
#endif /* DEBUG */
            }

            if (! TIS_FUNC(sym->type) && sym->tag == s_defined) {
                  a60_error (ex->source, ex->lineno,
               "must return a value (`%s')\n",
                           ex->u.lhelm->sym->name);
                  xabort ("runtime error");
            }

            exec_fcall (ex->source, ex->lineno,
                      sym, ex->u.lhelm->u.fcall);
      }
      else if (tag == e_ival) {
            ev = PUSH_EVALST(ex->source, ex->lineno, ev_ival);
            ev->u.ival = ex->u.ival;
      }
      else if (tag == e_rval) {
            ev = PUSH_EVALST(ex->source, ex->lineno, ev_rval);
            ev->u.rval = ex->u.rval;
      }
      else if (tag == e_bool) {
            ev = PUSH_EVALST(ex->source, ex->lineno, ev_bool);
            ev->u.bool = ex->u.bool;
      }
      else if (tag == e_string) {
            ev = PUSH_EVALST(ex->source, ex->lineno, ev_string);
            ev->u.string = ex->u.string;
      }
      else if (EIS_UNEXP(tag)) {
            do_eval_expr (ex->u.expr[0]);
            DO_DEREF(ex->source, ex->lineno);
            do_unop (tag);
      }
      else if (EIS_BINEXP(tag)) {
            do_eval_expr (ex->u.expr[1]);
            DO_DEREF(ex->source, ex->lineno);
            do_eval_expr (ex->u.expr[0]);
            DO_DEREF(ex->source, ex->lineno);
            do_binop (tag);
      }
      else if (tag == e_condexpr) {
            do_eval_expr (ex->u.expr[0]);
            DO_DEREF(ex->source, ex->lineno);
            top_ev = * POP_EVALST;
            if (top_ev.tag != ev_bool)
                  a60_error ("INTERNAL", 0, "INTERNAL: No Bool!\n");
            if (top_ev.u.bool)
                  do_eval_expr (ex->u.expr[1]);
            else
                  do_eval_expr (ex->u.expr[2]);
      }
      else if (EIS_NOP(tag)) {
            do_eval_expr (ex->u.expr[0]);
      }
      else {
            a60_error (ex->source, ex->lineno,
                     "INTERNAL: do_eval_expr: unknown expr_tag `%s'\n",
                     expr_tag_name[tag]);
            xabort ("INTERNAL error");
      }
}


void
do_eval_pexpr (pex)
PEXPR *pex;
{
      if (pex->cblock)
            push_cblock (pex->cblock);

      do_eval_expr (pex->expr);

      if (pex->cblock)
            pop_cblock ();

}

/* end of doeval.c */

Generated by  Doxygen 1.6.0   Back to index