Logo Search packages:      
Sourcecode: tela version File versions  Download package

prg.C

/*
 * This file is part of tela the Tensor Language.
 * Copyright (c) 1994-2002 Pekka Janhunen
 */

#ifdef __GNUC__
#  pragma implementation "prg.H"
#endif

#define CHECK_INTERNAL_ERRORS 0
// This was defined as 1 for over half a year and never we got any internal error.
// Maybe it's now safe to supress these checks, which may slow the thing down
// a little bit.

/*
  TO DO:
  ------
  Fix getin, getout, nin, nout, setout.
  They should work similar to ctfiles, count also named args.
  */

#include "prg.H"
#include "objarithm.H"
#include <ctype.h>
#include <fstream.h>

#ifdef __GNUC__
#  ifndef alloca
#    define alloca __builtin_alloca
#  endif
#  ifndef HAVE_ALLOCA
#    define HAVE_ALLOCA
#  endif
#elif HAVE_ALLOCA_H
#  include <alloca.h>
#  ifndef HAVE_ALLOCA
#    define HAVE_ALLOCA
#  endif
#elif C_ALLOCA
   extern "C" void *alloca(unsigned int);
#elif defined(CONVEX)
#  include <stdlib.h>
   extern "C" char *alloca(int);
#endif

// These stacks are declared extern in prg.H and defined here:
TObjectStack theStack;
TCodeStack theCodeStack;

static int PC=0;

#define COMPTYPE Toperand
#define DEFAULT_COMPVALUE Toperand()
#define LINEARLIST TInstructionList1

#include "templ/tLL.C"

// TInstructionList members

void TInstructionList::add(Tcode code, const Toperand& op1) {
      append(Toperand(code,1));
      append(op1);
      maxNops = max(maxNops,1);
}

void TInstructionList::add(Tcode code, const Toperand& op1, const Toperand& op2) {
      append(Toperand(code,2));
      append(op1);
      append(op2);
      maxNops = max(maxNops,2);
}

void TInstructionList::add(Tcode code, const Toperand& op1, const Toperand& op2, const Toperand& op3) {
      append(Toperand(code,3));
      append(op1);
      append(op2);
      append(op3);
      maxNops = max(maxNops,3);
}

void TInstructionList::add(Tcode code, const Toperand& op1, const Toperand& op2, const Toperand& op3, const Toperand& op4) {
      append(Toperand(code,4));
      append(op1);
      append(op2);
      append(op3);
      append(op4);
      maxNops = max(maxNops,4);
}

void TInstructionList::add(Tcode code, int Noperands) {
      if (Noperands > MAX_NOPERANDS) {
            err << "Internal: TInstructionList::add, Noperands=" << Noperands << " > " << MAX_NOPERANDS << "\n";
            error();
      }
      append(Toperand(code,Noperands));
      maxNops = max(maxNops,Noperands);
}

ostream& operator<<(ostream& o, const TInstructionList& il) {
      o << '\n';
      for (int i=0; i<il.length(); i++) {
            if (il[i].IsOpcode()) {
                  int N = il[i].Noperands();
                  o << i << '\t' << il[i] << '\t';
                  for (int j=0; j<N; j++) {
                        o << il[i+1+j];
                        if (j<N-1) o << ',';
                  }
                  i+= N;
                  if (i<il.length()-1) o << '\n';
            } else {
                  err << "Internal error in disassembly: syntax error in instruction list\n";
                  error();
            }
      }
      return o;
}     

// TObjectStack members

void TObjectStack::pop(int N) {
      // Shorten the stack by N objects
      int L = LL.length();
      LL = L - N;
}

TObjectStack::~TObjectStack() {
      /*
      TObjectPtr *p=LL.Ptr();
      for (int i=0; i<LL.length(); i++) delete p[i];
      // Commented this out since it would be called only at exit,
      // and it seems to cause core dumps sometimes ...
      // If you ever declare TObjectStacks other than theStack, you
      // should rethink this destructor.
      */
}

// Tprg members

Tprg::Tprg(const Tchar *fn) : ol(0), linenums(0), nargin(0), nargout(0), nargin_min(0), nargout_min(0), nlocal(0), ntemp(0), inputellipsis(0), outputellipsis(0), symptr(0) {
      global::NTprg++;
      CalcStack();
      MakeCurrent();
      filename = strdup(fn);
}

Tprg::Tprg(const Tchar *fn, int in, int out) : ol(0), linenums(0), nargin(in), nargout(out), nargin_min(0), nargout_min(0), nlocal(0), ntemp(0), inputellipsis(0), outputellipsis(0), symptr(0) {
      global::NTprg++;
      CalcStack();
      MakeCurrent();
      filename = strdup(fn);
}

Tprg::Tprg(const Tchar *fn, int in, int out, int loc) : ol(0), linenums(0), nargin(in), nargout(out), nargin_min(0), nargout_min(0), nlocal(loc), ntemp(0), inputellipsis(0), outputellipsis(0), symptr(0) {
      global::NTprg++;
      CalcStack();
      MakeCurrent();
      filename = strdup(fn);
}

Tprg::Tprg(const Tchar *fn, int in, int out, int minin, int minout, int loc, const Tsymbol* sympointer) : ol(0), linenums(0), nargin(in), nargout(out), nargin_min(minin), nargout_min(minout), nlocal(loc), ntemp(0), inputellipsis(0), outputellipsis(0), symptr(sympointer) {
      global::NTprg++;
      CalcStack();
      MakeCurrent();
      filename = strdup(fn);
}

Tprg::~Tprg() {
      global::NTprg--;
      Toperand::objLLptr=old_olptr;                   // recover previous static object list
      // Unallocate static objects in static object list 'ol'
      TObjectPtr *p=ol.Ptr();
      for (int i=0; i<ol.length(); i++) {
            /*
            clog << "Deleting ";
            if (p[i])
                  clog << *p[i];
            else
                  clog << "(null)";
            clog << '\n';
            */
            delete p[i];
      }
      if (filename) free(filename); // filename was created with strdup
}

void Tprg::CalcStack() {
      nstack = nargin+nargout+nlocal+ntemp+(inputellipsis!=0)+(outputellipsis!=0) + 1;
}     // the +1 is the AnsVariable space

int Tprg::FindLineNumber(int startPC) const {
      int instruction_count = 0;
      int startingPC = startPC ? startPC : PC;
    int pc;
      for (pc=startingPC-1; pc>=0; pc--) if (il[pc].IsOpcode()) break;
    int i;
      for (i=0; i<il.length(); i++) {
            if (i >= pc) {
                  if (instruction_count < linenums.length())
                        return linenums[instruction_count];
                  else
                        return linenums[0];
            }
            if (il[i].IsOpcode()) {
                  int N = il[i].Noperands();
                  i+= N;
                  instruction_count++;
            } else {
                  cerr << "Internal error in FindLineNumber: Syntax error in instruction list\n";
                  exit(1);
            }
      }
      return linenums[0];
}     

Tcode Tprg::LastOpcode() const {
      for (int i=length()-1; i>=0; i--)
            if (operator[](i).IsOpcode()) return operator[](i).opcode();
      return Klit;
}

ostream& operator<<(ostream& o, Tprg& prg) {
      //o << '\n';
      if (prg.symptr)
            o << "Disassembly of '" << *prg.symptr << "', ";
      o << "Source file: \"" << (char*)prg.filename << "\"\n";
      if (prg.HasInputEllipsis()) {
            o << prg.Nargin() << "+ input args, ";
      } else {
            if (prg.Nargin()==0)
                  o << "no input args, ";
            else if (prg.Nargin()==1)
                  o << "1 input arg, ";
            else
                  o << prg.Nargin() << " input args, ";
      }
      if (prg.Nargout()==0)
            o << "no output args, ";
      else if (prg.Nargout()==1)
            o << "1 output arg, ";
      else
            o << prg.Nargout() << " output args, ";
      if (prg.Nlocal()==0)
            o << "no locals, ";
      else if (prg.Nlocal()==1)
            o << "1 local, ";
      else
            o << prg.Nlocal() << " locals, ";
      o << "stack frame size " << prg.StackFrameSize() << ".\n";
      o << "Maximum number of operands is " << prg.MaxNops() << ".";
      Toperand::objLLptr = &prg.ol;
      /*
      o << "[";
      for (int i=0; i<prg.ol.length(); i++) {
            o << *prg.ol[i];
            if (i<prg.ol.length()-1) o << ", ";
      }
      o << ']';
      */
      //o << '\n' << prg.linenums;
      return o << prg.il;
}

static int ErrorMessageLineMatch(Tchar *s, int ret) {
      Tchar pattern[20];
      sprintf((char*)pattern,"%d:",ret);
      Tchar *startptr=strstr(s,pattern);
      if (!startptr) return 0;
      for (Tchar*p=s; p<startptr; p++) if (!isspace(*p)) return 0;
      return 1;
}

extern FILE *FindAndOpenFile(const Tchar* fn);   // defined in tela.C
extern void GenerateInterrupt();                      // defined in tela.C

static void GiveErrorMessage(ostream& o, const TCFunctionInfo*p, int ret) {
      long help1 = p->helpstart;
      long help2 = p->helpend;
      if (help1 >= help2) {
            o << "Return code " << ret << " (no error message file).\n";
      } else {
            FILE *fp = FindAndOpenFile(p->helpfile);
            if (fp) {
                  fseek(fp,help1,SEEK_SET);
                  int StartLooking=0, found=0;
                  while (ftell(fp) < help2) {
                        Tchar s1[512+1];
                        fgets((char*)s1,512,fp);
                        if (StartLooking) {
                              if (ErrorMessageLineMatch(s1,ret)) {
                                    Tchar *sptr = s1;
                                    for (int i=0; s1[i]; i++) if (s1[i]==':') sptr=s1+i+2;
                                    int L = strlen(s1);
                                    if (s1[L-1]=='\n') s1[L-1] = '\0';
                                    if (s1[L-3]=='*' && s1[L-2]=='/') s1[L-3] = '\0';
                                    o << sptr;
                                    found=1;
                                    break;
                              }
                        }
                        if (!StartLooking) {if (strstr(s1,(const Tchar*)"Error codes:")) StartLooking=1;}
                  }
                  if (!found) o << "Return code " << ret << " (no verbal message for this code).\n";
                  fclose(fp);
            } else {
                  o << "Return code " << ret << " (cannot open error message file '" << p->helpfile << "').\n";
            }
      }
}

void Call(const Tobject& fn,
              const TConstObjectPtr inputs[], const int Ninputs,
              const TObjectPtr outputs[], const int Noutputs,
              const Tsymbol* symptr,
              bool check_that_first_output_not_obligatory)
// General call interface. Fn may be either T- or C-function.
// symptr should point to the Fn symbol (used for error messages).
{
      const Tkind k = fn.kind();
      if (k == Kfunction) {
            Tprg* p = fn.FunctionValue();
            if (check_that_first_output_not_obligatory) {
                  if (p->NMinArgout() > 0) {
                        cerr << "*** Warning: Calling function with obligatory output arg(s) with non-bracketed call form on line "
                               <<  p->FindLineNumber();
                        if (p->symptr) cerr << " in " << *p->symptr;
                        if (p->filename) cerr << " (" << (char*)p->filename << ")";
                        cerr << ".\n";
                  }
            }
            p->execute(inputs,Ninputs,outputs,Noutputs,symptr);
      } else if (k == KCfunction) {
            TCFunctionPtr p = fn.CFunctionPtr();
            const TCFunctionInfo* infop = fn.CFunctionInfoPtr();
            if (Ninputs < infop->minin) {
                  err << "Too few (" << Ninputs << ") input args to " << infop->Cfname
                        << " (min=" << infop->minin << ")\n";
                  error();
            }
            if (infop->maxin>=0) {
                  if (Ninputs > infop->maxin) {
                        err << "Too many input args ("<< Ninputs <<") to " << infop->Cfname
                              << " (max="<<infop->maxin<<")\n";
                        error();
                  }
            }
            if (Noutputs < infop->minout) {
                  err << "Too few output args ("<< Noutputs <<") to " << infop->Cfname
                        << " (min="<<infop->minout<<")\n";
                  error();
            }
            int NoutputsToPass = Noutputs;
            int make_outputs0_void = 0;
            if (infop->maxout>=0) {
                  if (Noutputs == 1 && infop->maxout == 0) {
                        NoutputsToPass = 0;
                        make_outputs0_void = 1;
                  } else if (Noutputs > infop->maxout) {
                        err << "Too many output args ("<< Noutputs <<") to " << infop->Cfname
                              << " (max="<<infop->maxout<<")\n";
                        error();
                  }
            }
            const int ret = (*p)(inputs,Ninputs,outputs,NoutputsToPass);
            if (make_outputs0_void) outputs[0]->SetToVoid();
            if (ret > 0) {
                  clog << "Warning from C-function '" << infop->Cfname << "':\n  ";
                  GiveErrorMessage(clog,infop,ret);
                  clog << ".\n" << flush;
            } else if (ret < 0) {
                  err << "Fatal error from C-function '" << infop->Cfname << "':\n  ";
                  GiveErrorMessage(err,infop,ret);
                  err << ".\n";
                  error();
            }
      } else {
            err << Tshort(fn) << " is not a function\n";
            error();
      }
}

#if SUPPORT_LOOP_TILING
INLINE int StudyTileArrays(const TObjectPtr d[], int N, int NIOs, Tint& array_size)
// If all objects d[0..N-1] are either numerical arrays or scalars
// and if all those that are arrays are of the same length and if
// that length is at least 1.5*TILE_BLOCKSIZE, return 1,
// and return array length in array_size. Otherwise return 0,
// and array_size remains unmodified.
// Also, if any of the first NIOs arguments is not-a-numerical-array, return 0.
{
      int i;
      int got_arraysize = 0;
      for (i=0; i<N; i++) {
            if (d[i]->IsNumericalArray()) {
                  if (got_arraysize) {
                        if (d[i]->length() != array_size) {
//                            cout << "not tiling, array_size=" << array_size << ", L=" << d[i]->length() << "\n";
                              return 0;
                        }
                  } else {
                        array_size = d[i]->length();
                        if (array_size < (3*TILE_BLOCKSIZE)/2) {
//                            cout << "not tiling, too small\n";
                              return 0;
                        }
                        got_arraysize = 1;
                  }
            } else {
                  if (i < NIOs) {
//                      cout << "not tiling, non-array " << *d[i] << " gets modified\n";
                        return 0;
                  }
            }
      }
      return got_arraysize;
}
#endif

static TFixedHash *profhashptr = 0;

static void ProfilingRecord(const char *name, Treal cputime, Treal flops, Treal Ncalls)
{
      static int FirstTime = 1;
      if (FirstTime) {
            profhashptr = new TFixedHash(1113);
            FirstTime = 0;
      }
      const THashEntryPtr hashentryptr = profhashptr->add((const Tchar*)name);
      Tobject& obj = *hashentryptr->value();
      if (obj.kind() != KRealArray) obj.rzeros(3);          // components: cputime, flops, Ncalls
      obj.RealPtr()[0]+= cputime;
      obj.RealPtr()[1]+= flops;
      obj.RealPtr()[2]+= Ncalls;
}

static void ProfilingReport(ostream& o)
{
      const Treal dt = 30e-3;
      const int strwidth = 35;
      const int numwidth = 12;
      if (!profhashptr) return;
      THashEntryPtr p;
      int old_width = o.width();
      std::ios::fmtflags old_flags = o.flags();
      o << "             Detailed profiling report:\n";
      o.width(strwidth); o.setf(ios::left); o << " " << ' ';
      o.width(numwidth); o << "sec";
      o.width(numwidth); o << "ms/call";
      o << "Mflops\n";
      static char tmp_fn[MAXFILENAME] = "";
      tmpnam(tmp_fn);
      ofstream fp(tmp_fn);
      Treal totaltime=0, totalflops=0, totalcalls=0;
      for (p=profhashptr->first(); p; p=profhashptr->next()) {
            const Tobject& obj = *p->value();
            Treal t = obj.RealPtr()[0], f = obj.RealPtr()[1], c = obj.RealPtr()[2];
            totalflops+= f;
            totaltime+= t;
            totalcalls+= c;
            Treal Mflops = 1e-6*f/max(dt,t);
            if (t < dt) continue;
            fp.width(strwidth);
            fp.setf(ios::left);
            char name[80];
            strcpy(name,p->name());
            int i,slashpos = -1;
            const int L = strlen(name);
            for (i=L-1; i>=0; i--) if (name[i] == '/') {slashpos=i; break;}
            if (slashpos >= 0) {
                  int colonpos = -1;
                  for (i=slashpos+1; i<L; i++) if (name[i] == ':') {colonpos=i; break;}
                  if (colonpos > slashpos) {
                        memmove(&name[slashpos+1],&name[colonpos+1],L-colonpos);
                  }
                  name[slashpos] = ':';
            }
            fp << name;
            fp << ' ';
            fp.width(numwidth);
            fp << t;
            fp.width(numwidth);
            fp << 1e3*t/max(1.0,c);
            fp.width(numwidth);
            if (Mflops >= 0) fp << Mflops; else fp << "*";
            fp << "\n";
      }
      fp.close();
      char *s = new char [strlen(tmp_fn) + 80];
      sprintf(s,"sort -g -r -k 2 %s",tmp_fn);
      system(s);
      remove(tmp_fn);
      delete [] s;
      o.width(strwidth); o.setf(ios::left); o << "   Total :" << ' ';
      o.width(numwidth); o << totaltime;
      o.width(numwidth); o << "  ";
      o.width(numwidth); o << 1e-6*totalflops/max(dt,totaltime) << "\n";
      o.flags(old_flags);
      o.width(old_width);
}

static Treal CurrentFlops()
{
      const int L = int(Fnop) - int(Fadd) + 2;
      int i,c;
      Treal result = 0.0;
      for (i=1,c=Fadd; i<L; i++,c++) {
            result+= HPM[c].Nops;
      }
      return result;
}

INLINE void Tprg::executeInstructionSequence() {
      int i,oldPC,Nop;
      Toperand *f,*arg;
      TObjectPtr *d = new TObjectPtr [MaxNops()];
      static Tobject TheObject(0);
      static Tobject TheVoidObject;
      static int FirstTime = 1;
      if (FirstTime) {TheVoidObject.SetToVoid(); FirstTime=0;}
      Treal stack_cputime1,stack_cputime1cum,
            stack_flops1,stack_flops1cum,
            stack_Ncalls1,stack_Ncalls1cum;           // g++ can warn here about uninitialized variable, but it is safe, ignore it
      static Treal static_cputime1=0,static_cputime1cum=0;  // cum=cumulative, called func time included
      static Treal static_flops1=0,static_flops1cum=0;
      static Treal static_Ncalls1=0,static_Ncalls1cum=0;
      static Treal call_counter = 0;
      if (flags::profiling) {
            stack_cputime1 = static_cputime1;
            stack_cputime1cum = static_cputime1cum;
            stack_flops1 = static_flops1;
            stack_flops1cum = static_flops1cum;
            stack_Ncalls1 = static_Ncalls1;
            stack_Ncalls1cum = static_Ncalls1cum;
            static_cputime1 = static_cputime1cum = CPUSeconds();
            static_flops1 = static_flops1cum = CurrentFlops();
            static_Ncalls1 = static_Ncalls1cum = call_counter++;
      }
      for (PC=0; PC<il.length(); ) {
            oldPC = PC;
            f = &il[PC++];
#           if CHECK_INTERNAL_ERRORS
            if (!f->IsOpcode()) {err << "Internal: " << *f << " is not an opcode\n"; error();}
#           endif
            Nop = f->Noperands();
            // Load flatcode words (operands) beginning at PC to array d.
            // Nop is the number of operands to convert.
#           ifdef UNICOS
#           pragma _CRI align
#           endif
            for (i=0; i<Nop; i++) {
                  arg = &il[PC++];
                  // Replaced switch statement by successive if's /Pj 18.3.2001. Seems to be faster...
                  // Notice that we test first those types that are likely to occur most often.
                  const Tcode argkind = arg->kind();
                  if (argkind == Kobj) {              // Local variables
                        d[i] = ol[arg->offset()];
                  } else if (argkind == Kpar) { // Function parameters
                        d[i] = theStack[arg->offset()];
                  } else if (argkind == Ksym) { // Global variables
                        d[i] = arg->symbol().value();
                  } else if (argkind == Klit) { // Literal constants
                        TheObject = arg->literal();
                        d[i] = &TheObject;
                  } else /* if (argkind == Kallrange)*/ {   // VOID objects
                        d[i] = &TheVoidObject;
                  }
#if 0
                  switch (arg->kind()) {
                      case Kpar:
                              d[i] = theStack[arg->offset()];
                              break;
                      case Kobj:
                              d[i] = ol[arg->offset()];
                              break;
                      case Ksym:
                              d[i] = arg->symbol().value();
                              break;
                      case Klit:
                              TheObject = arg->literal();
                              d[i] = &TheObject;
                              break;
                      case Kallrange:
                                // Denote ':' object by just a void
                                // object. This is bad practice but we
                                // want to avoid introducing more and
                                // more Tobject kinds, because they
                                // grow the switch statements in
                                // object.C in both source and object
                                // code.
                              d[i] = &TheVoidObject;
                              break;
                      default:
                              err << "Internal error in loadoperands: "
                                    << *arg << " should not be operand\n";
                              error();
                  }
#endif
            }
            
            global::nops = 0;
            
#           define pair(opcode,Nargs) EncodeOpcode(opcode,Nargs)
            
            switch (f->rawcode()) {
                  
            case pair(Fadd,2):
                  Add(*d[0],*d[1]); break;
            case pair(Fadd,3):
                  Add(*d[0],*d[1],*d[2]); break;
                  
            case pair(Finc,1):
                  Inc(*d[0]);
                  break;
                  
            case pair(Fsub,2):
                  Sub(*d[0],*d[1]); break;
            case pair(Fsub,3):
                  Sub(*d[0],*d[1],*d[2]); break;
                  
            case pair(Fdec,1):
                  Dec(*d[0]);
                  break;
                  
            case pair(Fmul,2):
                  Mul(*d[0],*d[1]); break;
            case pair(Fmul,3):
                  Mul(*d[0],*d[1],*d[2]); break;
                  
            case pair(Fdiv,2):
                  Div(*d[0],*d[1]); break;
            case pair(Fdiv,3):
                  Div(*d[0],*d[1],*d[2]); break;

            case pair(Fmod,3):
                  Mod(*d[0],*d[1],*d[2]); break;
                  
            case pair(Fpow,2):
                  Pow(*d[0],*d[1]); break;
            case pair(Fpow,3):
                  Pow(*d[0],*d[1],*d[2]); break;
                  
            case pair(Fneg,1):
                  Neg(*d[0]); break;
            case pair(Fneg,2):
                  Neg(*d[0],*d[1]); break;
            case pair(Fabs,1):
                  Abs(*d[0]); break;
            case pair(Fabs,2):
                  Abs(*d[0],*d[1]); break;
                  
            case pair(Fmove,2):
                  if (d[1]->kind()==Kundef) {
                        err << "Assigning undefined value " << Tshort(*d[1]) << '\n';
                        error();
                  }
                  if (d[0] != d[1])
                        *d[0] = *d[1];
                  break;
                  
            case pair(Fgt,3):
                  Gt(*d[0],*d[1],*d[2]); break;
            case pair(Flt,3):
                  Lt(*d[0],*d[1],*d[2]); break;
            case pair(Fge,3):
                  Ge(*d[0],*d[1],*d[2]); break;
            case pair(Fle,3):
                  Le(*d[0],*d[1],*d[2]); break;
            case pair(Feq,3):
                  Eq(*d[0],*d[1],*d[2]); break;
            case pair(Fne,3):
                  Ne(*d[0],*d[1],*d[2]); break;

            case pair(Fjngt,3):
                  if (!TestGt(*d[1],*d[2]))  {
#                       if CHECK_INTERNAL_ERRORS
                        if (d[0]->kind() != Kint) {
                              err << "Internal: illegal JGT offset: " << Tshort(*d[0]) << '\n';
                              error();
                        }
#                       endif
                        PC = d[0]->IntValue();
                  }
                  break;
            case pair(Fjnlt,3):
                  if (!TestLt(*d[1],*d[2]))  {
#                       if CHECK_INTERNAL_ERRORS
                        if (d[0]->kind() != Kint) {
                              err << "Internal: illegal JLT offset: " << Tshort(*d[0]) << '\n';
                              error();
                        }
#                       endif
                        PC = d[0]->IntValue();
                  }
                  break;
            case pair(Fjnge,3):
                  if (!TestGe(*d[1],*d[2]))  {
#                       if CHECK_INTERNAL_ERRORS
                        if (d[0]->kind() != Kint) {
                              err << "Internal: illegal JGE offset: " << Tshort(*d[0]) << '\n';
                              error();
                        }
#                       endif
                        PC = d[0]->IntValue();
                  }
                  break;
            case pair(Fjnle,3):
                  if (!TestLe(*d[1],*d[2]))  {
#                       if CHECK_INTERNAL_ERRORS
                        if (d[0]->kind() != Kint) {
                              err << "Internal: illegal JLE offset: " << Tshort(*d[0]) << '\n';
                              error();
                        }
#                       endif
                        PC = d[0]->IntValue();
                  }
                  break;

            case pair(Fand,3):
                  And(*d[0],*d[1],*d[2]); break;
            case pair(Fand,2):
                  And(*d[0],*d[0],*d[1]); break;
            case pair(For,3):
                  Or(*d[0],*d[1],*d[2]); break;
            case pair(For,2):
                  Or(*d[0],*d[0],*d[1]); break;
            case pair(Fnot,2):
                  Not(*d[0],*d[1]); break;
            case pair(Fnot,1):
                  Not(*d[0],*d[0]); break;

            case pair(Fmin,3):
                  Min(*d[0],*d[1],*d[2]); break;
            case pair(Fmax,3):
                  Max(*d[0],*d[1],*d[2]); break;
            case pair(Fmin,2):
                  Min(*d[0],*d[1]); break;
            case pair(Fmax,2):
                  Max(*d[0],*d[1]); break;

            case pair(Fnin,1):
                  *d[0] = thePCstack.top(3); break;
            case pair(Fnout,1):
                  *d[0] = thePCstack.top(2); break;
            case pair(Fmmpos,1):
                  *d[0] = MinMaxPosition(); break;

            case pair(Fgetin,2):
                  {
                        if (d[1]->kind() != Kint) {
                              err << "In argin(n), n must be integer scalar.\n";
                              error();
                        }
                        Tint n = d[1]->IntValue() - ArrayBase;
                        if (n < 0) {
                              err << "In argin(n), n must not be smaller than " << ArrayBase << ". Was " << n << ".\n";
                              error();
                        }
                        if (!HasInputEllipsis()) {
                              err << "argin() may only be used in functions with input ellipsis (...)\n";
                              error();
                        }
                        Tint maxn = theStack[Nargin()+1]->ObjectPtrPtr()[0]->IntValue();
                        if (n >= maxn) {
                              err << "argin(" << n+ArrayBase << ") called, while the function was called with only "
                                    << maxn << " optional arg";
                              if (maxn>1) err << "s";
                              err << ".\n";
                              error();
                        }
                        *d[0] = *(theStack[Nargin()+1]->ObjectPtrPtr()[n+1]);
                  }
                  break;
            case pair(Fgetout,2):
                  {
                        int i = Nargin();
                        if (HasInputEllipsis()) i++;
                        i+= Nargout()+1;
                        if (d[1]->kind() != Kint) {
                              err << "In argout(n), n must be integer scalar.\n";
                              error();
                        }
                        Tint n = d[1]->IntValue() - ArrayBase;
                        if (n < 0) {
                              err << "In argout(n), n must not be smaller than " << ArrayBase << ". Was " << n << ".\n";
                              error();
                        }
                        if (!HasOutputEllipsis()) {
                              err << "argout() may only be used in functions with output ellipsis [...]\n";
                              error();
                        }
                        Tint maxn = theStack[i]->ObjectPtrPtr()[0]->IntValue();
                        if (n >= maxn) {
                              err << "argout(" << n+ArrayBase << ") called, while the function was called with only "
                                    << maxn << " optional output arg";
                              if (maxn>1) err << "s";
                              err << ".\n";
                              error();
                        }
                        *d[0] = *(theStack[i]->ObjectPtrPtr()[n+1]);
                  }
                  break;
            case pair(Fsetout,2):
                  {
                        int i = Nargin();
                        if (HasInputEllipsis()) i++;
                        i+= Nargout()+1;
                        if (d[0]->kind() != Kint) {
                              err << "In SetArgOut(n,x), n must be integer scalar.\n";
                              error();
                        }
                        Tint n = d[0]->IntValue() - ArrayBase;
                        if (n < 0) {
                              err << "In SetArgOut(n,x), n must not be smaller than " << ArrayBase << ". Was " << n << ".\n";
                              error();
                        }
                        if (!HasOutputEllipsis()) {
                              err << "SetArgOut() may only be used in functions with output ellipsis [...]\n";
                              error();
                        }
                        Tint maxn = theStack[i]->ObjectPtrPtr()[0]->IntValue();
                        if (n >= maxn) {
                              err << "SetArgOut(" << n+ArrayBase << ",x) called, while the function was called with only "
                                    << maxn << " optional output arg";
                              if (maxn>1) err << "s";
                              err << ".\n";
                              error();
                        }
                        *(theStack[i]->ObjectPtrPtr()[n+1]) = *d[1];
                  }
                  break;
//          case pair(Fbra,1):
//#               if CHECK_INTERNAL_ERRORS
//                if (d[0]->kind() != Kint) {
//                      err << "Internal: illegal branch offset: " << Tshort(*d[0]) << '\n';
//                      error();
//                }
//#               endif
//                PC+= d[0]->IntValue() - 1;
//                break;
            case pair(Fjmp,1):
#                 if CHECK_INTERNAL_ERRORS
                  if (d[0]->kind() != Kint) {
                        err << "Internal: illegal jump offset: " << Tshort(*d[0]) << '\n';
                        error();
                  }
#                 endif
                  PC = d[0]->IntValue();
                  break;
            case pair(Fincjmp,2):
#                 if CHECK_INTERNAL_ERRORS
                  if (d[0]->kind() != Kint) {
                        err << "Internal: illegal incjump offset: " << Tshort(*d[0]) << '\n';
                        error();
                  }
#                 endif
                  Inc(*d[1]);
                  PC = d[0]->IntValue();
                  break;
//          case pair(Fbif,2):
//#               if CHECK_INTERNAL_ERRORS
//                if (d[0]->kind() != Kint) {
//                      err << "Internal: illegal BIF offset: " << Tshort(*d[0]) << '\n';
//                      error();
//                }
//#               endif
//                if (d[1]->IsNonzero()) PC+= d[0]->IntValue()-1;
//                break;
//          case pair(Fbifn,2):
//#               if CHECK_INTERNAL_ERRORS
//                if (d[0]->kind() != Kint) {
//                      err << "Internal: illegal BIFN offset: " << Tshort(*d[0]) << '\n';
//                      error();
//                }
//#               endif
//                if (!d[1]->IsNonzero()) PC+= d[0]->IntValue()-1;
//                break;
            case pair(Fjif,2):
#                 if CHECK_INTERNAL_ERRORS
                  if (d[0]->kind() != Kint) {
                        err << "Internal: illegal JIF offset: " << Tshort(*d[0]) << '\n';
                        error();
                  }
#                 endif
                  if (d[1]->IsNonzero()) PC = d[0]->IntValue();
                  break;
            case pair(Fjifn,2):
#                 if CHECK_INTERNAL_ERRORS
                  if (d[0]->kind() != Kint) {
                        err << "Internal: illegal JIFN offset: " << Tshort(*d[0]) << '\n';
                        error();
                  }
#                 endif
                  if (!d[1]->IsNonzero()) PC = d[0]->IntValue();
                  break;
                  
            case pair(Fpri,1):
                  if (d[0]->kind()!=Kvoid) cout << *d[0] << '\n'; // avoid printing empty line in case of void object
                  break;
                  
            case pair(Fnop,0):
                  break;
                  
            case pair(Fgath,0):
                  {
                        TConstObjectPtr indices[MAX_NOPERANDS];
                        for (i=2; i<Nop; i++)
                              indices[i-2] = d[i];
                        Gather(*d[0],*d[1],indices,Nop-2);
                  }
                  break;
            case pair(Fscat,0):
                  {
                        TConstObjectPtr indices[MAX_NOPERANDS];
                        for (i=2; i<Nop; i++)
                              indices[i-2] = d[i];
                        Scatter(*d[0],*d[1],indices,Nop-2);
                  }
                  break;

            case pair(Fmgath,0):
            case pair(Fmscat,0):
                  MGatScat(*d[0],*d[1],d+2,Nop-2,f->opcode()==Fmscat);
                  break;
            case pair(Frange,0):
                  Range(d);
                  break;
            case pair(Farray,0):    // ARRAY result,arg1,arg2,...,argN
                  {
                        TConstObjectPtr args[MAX_NOPERANDS];
                        for (i=1; i<Nop; i++)
                              args[i-1] = d[i];
                        BuildArray(*d[0],args,Nop-1);
                  }
                  break;
            case pair(Fappend,0):   // APPEND result,arg1,arg2,...,argN
                  {
                        TConstObjectPtr args[MAX_NOPERANDS];
                        for (i=1; i<Nop; i++)
                              args[i-1] = d[i];
                        PasteArrays(*d[0],args,Nop-1);
                  }
                  break;
            case pair(Fcall,0):           // CALL fn, Noutputs, out1,out2,...outN, in1,in2,...,inM
            case pair(Fscall,0):    // almost same as CALL but checks that first output arg is not obligatory
                  {
                        const Tkind k = d[0]->kind();
#if 0
                        if (d[0]->IsNumerical()) {
                              cout << *d[0] << '\n' << flush;
                              break;
                        }
#endif
#                       if CHECK_INTERNAL_ERRORS
                        if (d[1]->kind()!=Kint) {err<<"Internal: 2nd operand of CALL must be integer\n"; error();}
#                       endif
                        const int Noutputs = d[1]->IntValue();
                        const int Ninputs = Nop - Noutputs - 2;
                        const Tsymbol* symptr = 0;
                        if (k == Kfunction) {
                              if (il[oldPC+1].kind() == Ksym) symptr = &(il[oldPC+1].symbol());
                        }
                        Call(*d[0],d+2+Noutputs,Ninputs,d+2,Noutputs,symptr,f->rawcode() == pair(Fscall,0));
                  }
                  break;
            case pair(Fizeros,0):
            case pair(Frzeros,0):
            case pair(Fczeros,0):
            case pair(Fozeros,0):
                  {
                        Tint indices[MAX_NOPERANDS];
                        int ndims;
                        // Accept also one integer vector argument a'la zeros(size(a))
                        if (Nop == 2 && d[1]->kind()==KIntArray) {
                              if (d[1]->rank() != 1) {
                                    err << "Non-vector integer argument " << Tshort(*d[1]) << " to ZEROS\n";
                                    error();
                              }
                              if (d[1]->length() > MAXRANK) {
                                    err << "More than MAXRANK=" << MAXRANK << " elements in vector arg " << Tshort(*d[1]) << " to ZEROS\n";
                                    error();
                              }
                              for (i=0; i<d[1]->length(); i++) {
                                    indices[i] = d[1]->IntPtr()[i];
                                    if (indices[i] < 0) {
                                          err << "Negative dimension " << indices[i] << " in ZEROS\n";
                                          error();
                                    }
                              }
                              ndims = d[1]->length();
                        } else {
                              if (Nop-1 > MAXRANK) {
                                    err << "More than MAXRANK=" << MAXRANK << " arguments to ZEROS\n";
                                    error();
                              }
                              for (i=1; i<Nop; i++) {
                                    if (d[i]->kind()!=Kint || d[i]->IntValue() < 0) {
                                          err << "Operands of ZEROS must be nonnegative integers, not " << Tshort(*d[i]) << "\n";
                                          error();
                                    }
                                    indices[i-1] = d[i]->IntValue();
                              }
                              ndims = Nop-1;
                        }
                        void (Tobject::*fn)(const TDimPack&);
                        switch (f->opcode()) {
                        case Fizeros: fn = &Tobject::izeros; break;
                        case Frzeros: fn = &Tobject::rzeros; break;
                        case Fczeros: fn = &Tobject::czeros; break;
                        default :     fn = &Tobject::voids; break;      // this could as well be case Fozeros
                        }
                        (d[0]->*fn)(TDimPack(indices,ndims));
                  }
                  break;
#           if SUPPORT_LOOP_TILING
            case pair(Fvloop,0):
            {
#                 if CHECK_INTERNAL_ERRORS
                  if (d[0]->kind()!=Kint) {err<<"Internal: 1st operand of VLOOP must be integer\n"; error();}
#                 endif
                  if (global::tile_in_use) {
                        err << "Nested VLOOP instruction\n";
                        error();
                  }
                  Tint array_size;
                  const int all_arrays_of_same_size = StudyTileArrays(d+1,Nop-1,d[0]->IntValue(),array_size);
                  if (all_arrays_of_same_size) {
                        global::tile_in_use = 1;
                        global::tile_start = 0;
                        global::tile_end = ((TILE_BLOCKSIZE < array_size) ? TILE_BLOCKSIZE : array_size) - 1;
                        global::tile_i = 0;
                        global::tile_Ntiles = (array_size+TILE_BLOCKSIZE-1)/TILE_BLOCKSIZE;
                        global::tile_arraylength = array_size;
//                      cout << "Executing VLOOP, tile=" << global::tile_start << ".." << global::tile_end << "\n";
                  } /*else
                        cout << "Passing through VLOOP\n";*/
            }
            break;
            case pair(Fendv,1):
            {
                  if (global::tile_in_use) {
                        if (++global::tile_i < global::tile_Ntiles) {
                              global::tile_start+= TILE_BLOCKSIZE;
                              global::tile_end+= TILE_BLOCKSIZE;
                              if (global::tile_end >= global::tile_arraylength) global::tile_end = global::tile_arraylength-1;
//                            cout << "Executing ENDV, tile=" << global::tile_start << ".." << global::tile_end << "\n";
                              // Branch to beginning of tile
#                             if CHECK_INTERNAL_ERRORS
                              if (d[0]->kind() != Kint) {
                                    err << "Internal: illegal branch offset in ENDV: " << Tshort(*d[0]) << '\n';
                                    error();
                              }
#                             endif
                              PC+= d[0]->IntValue() - 2;
                        } else {
                              // Last tile executed, exit tile mode
                              global::tile_in_use = 0;
                        }
                  } /*else
                        cout << "Passing through ENDV\n";*/
            }
            break;
#           endif       /* SUPPORT_LOOP_TILING */
#           if CHECK_INTERNAL_ERRORS                  
            default:
                  err << "Internal: illegal instruction\n";
                  error();
#           endif
            }
            
#           undef pair  

            Thpm& hpmref = HPM[f->opcode()];
            hpmref.Ninstr+= 1;                        // record that we issued this-and-this instruction
            hpmref.Nops+= global::nops;         // record number of operations involved in instruction

            if (global::interrupted) {
                  if (global::debugging) {
                        SetControlGInterruptHandler();
                  global::interrupted = 0;
                        cout << "User break, entering debug shell, type cont to continue:\n" << flush;
                        extern void InterpreterLoop(int ContWillExit=0);      // from tela.C
                        InterpreterLoop(1);
                  global::debugging = 0;
                  } else
                        break /*GenerateInterrupt()*/;
            }

      }     // end of the big for loop

      delete [] d;
      if (flags::profiling) {
            const Treal cputime2 = CPUSeconds();
            const Treal flops2 = CurrentFlops();
            const int maxfilename = 39;
            const int maxfuncname = 39;
            static char s[maxfilename+maxfuncname+2];
            const char *const funcname = (symptr ? (char*)*symptr : "TOPLEVEL");
            const int Lf = strlen((char*)filename);
            const int L = strlen(funcname) + 1 + Lf;
            memset(s,0,maxfilename+maxfuncname+2);
            int leaveout = 0;
            if (Lf > maxfilename) leaveout = Lf-maxfilename;
            strncpy(s,((char*)filename)+leaveout,maxfilename); s[maxfilename] = '\0';
            strcat(s,"/");
            strncat(s,funcname,maxfuncname);
            const Treal cputime = cputime2 - static_cputime1;
            const Treal flops = flops2 - static_flops1;
            const Treal Ncalls = call_counter - static_Ncalls1;
            ProfilingRecord(s,cputime,flops,Ncalls);
            const Treal cputime_cum = cputime2 - static_cputime1cum;
            const Treal flops_cum = flops2 - static_flops1cum;
            const Treal Ncalls_cum = call_counter - static_Ncalls1cum;
            static_cputime1 = stack_cputime1 + cputime_cum;
            static_cputime1cum = stack_cputime1cum;
            static_flops1 = stack_flops1 + flops_cum;
            static_flops1cum = stack_flops1cum;
            static_Ncalls1 = stack_Ncalls1 + Ncalls_cum;
            static_Ncalls1cum = stack_Ncalls1cum;
      }
} // executeInstructionSequence


void Tprg::execute
      (const TConstObjectPtr argin[], int Nin, const TObjectPtr argout[], int Nout, const Tsymbol *fnsymptr)
{
      // Execute function with given input and output arguments lists.
      // Algorithm: Check that Nin,Nout do not exceed Nargin(), Nargout().
      // Check that Nin,Nout are no less than NMinArgin(), NMinArgout().
      // Set optional output args to Undefined (Added 24 Apr 1999) (REMOVED, CAUSES PROBLEMS)
      // Set up stack frame, and put argument lists on theStack.
      // Push Nin, Nout to thePCstack.
      // Push PC on thePCstack.
      // fnsymptr must point to the function symbol; it is used in error message.
      // Execute the instructions. Finally deallocate theStack and thePCstack.

      int i,j,k;
      int Nargin1 = Nargin();
      int Nargout1 = Nargout();
      if (HasInputEllipsis()) {
            Nargin1++;
      } else {
            // Check that there are not too many input arguments
            if (Nin > Nargin()) {
                  err << "Too many (" << Nin << ") input arguments ";
                  if (fnsymptr) err << "for " << *fnsymptr;
                  err << ", max is " << Nargin() << '\n';
                  error();
            }
      }
      // Check that there are not too few input arguments
      if (Nin < NMinArgin()) {
            err << "Too few (" << Nin << ") input arguments ";
            if (fnsymptr) err << "for " << *fnsymptr;
            err << ", min is " << NMinArgin() << '\n';
            error();
      }
      // Handle special case of one actual output arg and no formal output args
      // (this case is accepted, and the actual arg is set to void)
      int SingleVoidOutArg = 0;
      if (HasOutputEllipsis()) {
            Nargout1++;
      } else {
            if (Nout==1 && Nargout()==0) {
                  SingleVoidOutArg = 1;
                  Nout = 0;
            }
            // Check that there are not too many output arguments
            if (Nout > Nargout()) {
                  err << "Too many (" << Nout << ") output arguments ";
                  if (fnsymptr) err << "for " << *fnsymptr;
                  err << ", max is " << Nargout() << '\n';
                  error();
            }
      }
      // Check that there are not too few output arguments
      if (Nout < NMinArgout()) {
            err << "Too few (" << Nout << ") output arguments ";
            if (fnsymptr) err << "for " << *fnsymptr;
            err << ", min is " << NMinArgout() << '\n';
            error();
      }
      // Set optional output args to Undefined (Added 24 Apr 1999)
//    for (i=NMinArgout(); i<Nout; i++) argout[i]->SetToUndefined();
      // Reserve enough space from stack:
      theStack.push(StackFrameSize());
      // Allocate all new objects at once
      const int Nnewobjects = StackFrameSize()-min(Nout,Nargout())-min(Nin,Nargin());
      TObjectPtr newobjects = new Tobject [Nnewobjects];
      // Bottom of the stack contains the AnsVariable
      theStack[0] = newobjects;
      // Then follow input args:
      const int NRegularIn = min(Nin,Nargin());
      for (i=0; i<NRegularIn; i++) theStack[i+1] = TObjectPtr(argin[i]);
      // Then follow unused input args:
      for (i=NRegularIn,k=0; i<Nargin1; i++,k++) theStack[i+1] = newobjects+1+k;
      // If we have input ellipsis, the last input arg is a shallow object array.
      // Then we create the oarray and store its length as the first element
      // (which is 0 if no objects).
      TObjectPtr toBeDeleted1 = 0, toBeDeleted2 = 0;
      if (HasInputEllipsis()) {
            const int Nexcess = max(Nin-Nargin(),0);
            theStack[Nargin1]->ozeros_shallow(Nexcess+1);
            theStack[Nargin1]->ObjectPtrPtr()[0] = toBeDeleted1 = new Tobject(Nexcess);   // store length of oarray
            for (i=0; i<Nexcess; i++)
                  theStack[Nargin1]->ObjectPtrPtr()[i+1] = TObjectPtr(argin[Nargin()+i]);
            thePCstack.push(Nexcess);
      } else
            thePCstack.push(0);           // No optional input args
      // Then, output args:
      const int NRegularOut = min(Nout,Nargout());
      for (i=Nargin1,j=0; i<Nargin1+NRegularOut; i++,j++) theStack[i+1] = argout[j];
      // Unused output args and local objects:
      for (i=Nargin1+NRegularOut; i<StackFrameSize()-1; i++,k++) theStack[i+1] = newobjects+1+k;
      // If we have output ellipsis, the last output arg is an object array.
      // Then we create the oarray and store its length as the first element
      // (which is 0 if no objects).
      if (HasOutputEllipsis()) {
            const int Nexcess = max(Nout-Nargout(),0);
            theStack[Nargin1+Nargout1]->ozeros_shallow(Nexcess+1);
            theStack[Nargin1+Nargout1]->ObjectPtrPtr()[0] = toBeDeleted2 = new Tobject(Nexcess);      // store length of oarray
            for (i=0; i<Nexcess; i++)
                  theStack[Nargin1+Nargout1]->ObjectPtrPtr()[i+1] = argout[Nargout()+i];
            thePCstack.push(Nexcess);
      } else
            thePCstack.push(0);           // No optional output args
      // Push program counter on the PC stack
      thePCstack.push(PC);
      // Push pointer to this Tprg on its stack
      theCodeStack.push(this);
      executeInstructionSequence();
      // Pop codestack
      theCodeStack.pop();
      // Pop program counter
      PC = thePCstack.pop();
      // Pop Nin and Nout from the PC stack
      thePCstack.pop();
      thePCstack.pop();
      // Delete unused output args, unused input args, and local objects
      delete [] newobjects;
      // Delete other to-be-deleted objects created by ellipsis brances.
      // These can be NULL, but 'delete NULL' is harmless.
      delete toBeDeleted1;
      delete toBeDeleted2;
      // Correct stack:
      theStack.pop(StackFrameSize());
      // If there was one actual output arg but no formal ones, set it to void
      if (SingleVoidOutArg) argout[0]->SetToVoid();
      // Zero global operation counter to prevent last instruction ops to be counted twice
      global::nops = 0;
}

void Tprg::checkreadonlyoperand(const Toperand& op, int pc) const
{
      //cerr << "---checkreadonlyoperand " << op << "\n";
      if (op.kind() != Kpar) return;
      if (1 <= op.offset() && op.offset() <= nargin) {
            cerr << "*** Warning: Modifying input argument at line " << FindLineNumber(pc);
            if (symptr) cerr << " in " << *symptr;
            if (filename) cerr << " (" << (char*)filename << ")";
            cerr << ".\n";
      }
}

void Tprg::checkreadonlyvars() const
/* Check that input args (numbered 1..nargin) are not modified.
   Various flatcode instructions fall in four categories:
   1. Jump, branch, PRI and NOP instructions, except INCJMP.
      These do not modify any argument.
   2. INCJMP, SCAT and MSCAT. These modify only the second argument.
   3. CALL. This is special.
   4. All other instructions always modify their first argument.
 */
{
      if (!flags::checkRO) return;  // do nothing if the flag is off
      for (int i=0; i<il.length(); i++) {
            if (il[i].IsOpcode()) {
                  const int N = il[i].Noperands();
                  const Tcode c = il[i].opcode();
                  //cerr << "--checking " << il[i] << "(" << N << " operands) ..\n";
                  if (c==Fjngt || c==Fjnlt || c==Fjnge || c==Fjnle ||
                        /*c==Fbra  ||*/ c==Fjmp  /*|| c==Fbif  || c==Fbifn*/ ||
                        c==Fjif  || c==Fjifn || c==Fpri  || c==Fnop) {
                        ;     // do nothing, these instruction don't modify any operand
                  } else if (c==Fincjmp || c==Fscat || c==Fmscat) {
                        checkreadonlyoperand(il[i+2],i);
                  } else if (c==Fcall || c==Fscall) {
#                       if CHECK_INTERNAL_ERRORS
                        if (il[i+2].kind()!=Klit) {
                              err << "Internal error in checkreadonlyvars: 2nd arg of CALL is not literal int\n";
                              error();
                        }
#                       endif
                        const Tint noutputs = il[i+2].literal();
                        for (int j=3; j<3+noutputs; j++) checkreadonlyoperand(il[i+j],i);
                  } else {    // Else check that first arg is not read-only
                        checkreadonlyoperand(il[i+1],i);
                  }
                  i+= N;
            } else {
                  err << "Internal error in checkreadonlyvars: syntax error in instruction list\n";
                  error();
            }
      }
}     

// TCodeStack members

void TCodeStack::push(Tprg* ptr) {
      TCodeStackNode* n = new TCodeStackNode;
      n->next = p;
      n->prgptr = ptr;
      p = n;
}

Tprg* TCodeStack::top() const {
      if (!p) {cerr << "Internal: TCodeStack underflow\n"; exit(1);}
      return p->prgptr;
}

Tprg* TCodeStack::pop() {
      if (!p) {cerr << "Internal:: TCodeStack underflow\n"; exit(1);}
      Tprg *result = p->prgptr;
      TCodeStackNode* n = p;
      p = p->next;
      delete n;
      return result;
}

void PerformanceReport(int longflag)
{
      int k;
      Treal t=CPUSeconds();
      Treal totalinstr=0,totalops=0;
      if (longflag) {
            cout << "INSTR\tNissued\tNops\n";
            for (k=Fadd; k<=Fnop; k++) {
                  cout << instrinfo[k].mnemonic << '\t' << HPM[k].Ninstr << '\t' << HPM[k].Nops << '\n';
            }
      }
      for (k=Fadd; k<=Fnop; k++) {
            totalinstr+= HPM[k].Ninstr;
            if (instrinfo[k].isflop) totalops+= HPM[k].Nops;
      }
      cout << totalinstr << " instructions, " << totalops << " arithmetic ops.\n";
      cout << 1E-6*totalinstr/t << " MIPS, " << 1E-6*totalops/t << " MFLOPS.\n";
      if (flags::profiling) ProfilingReport(cout);
}


Generated by  Doxygen 1.6.0   Back to index