arith0.c

Go to the documentation of this file.

/*************************************************************************
*                                    *
*    YAP Prolog                              *
*                                    *
*   Yap Prolog was developed at NCCUP - Universidade do Porto    *
*                                    *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997   *
*                                    *
**************************************************************************
*                                    *
* File:     eval.c                           *
* Last rev:                              *
* mods:                                  *
* comments: arithmetical expression evaluation           *
*                                    *
*************************************************************************/
#ifdef SCCS
static char     SccsId[] = "%W% %G%";
#endif
 
 
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "YapEval.h"
 
 
 
static Term
eval0(Int fi) {
  CACHE_REGS
  arith0_op fop = fi;
  switch (fop) {
  case op_pi:
    {
      RFLOAT(PI);
    }
  case op_e:
    {
      RFLOAT(M_E);
    }
  case op_epsilon:
    {
      RFLOAT(DBL_EPSILON);
    }
  case op_inf:
    {
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
      Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
      P = (yamop *)FAILCODE;
      RERROR();
#else
      if (isoLanguageFlag()) {/* iso */
    Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
    P = (yamop *)FAILCODE;
    RERROR();
      } else {
    RFLOAT(INFINITY);
      }
#endif
    }
  case op_nan:
    {
#ifdef _MSC_VER /* Microsoft's Visual C++ Compi<ler */
      Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
      RERROR();
#else
      if (isoLanguageFlag()) {/* iso */
    Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number");
    RERROR();
      } else {
    RFLOAT(NAN);
      }
#endif
    }
  case op_random:
    {
      RFLOAT(Yap_random());
    }
  case op_cputime:
    {
      RFLOAT((Float)Yap_cputime()/1000.0);
    }
  case op_heapused:
    RINT(HeapUsed);
  case op_localsp:
#if YAPOR_SBA
    RINT((Int)ASP);
#else
    RINT(LCL0 - ASP);
#endif
  case op_b:
#if YAPOR_SBA
    RINT((Int)B);
#else
    RINT(LCL0 - (CELL *)B);
#endif
  case op_env:
#if YAPOR_SBA
    RINT((Int)YENV);
#else
    RINT(LCL0 - YENV);
#endif
  case op_tr:
#if YAPOR_SBA
    RINT(TR);
#else
    RINT(((CELL *)TR)-LCL0);
#endif
  case op_stackfree:
    RINT(Unsigned(ASP) - Unsigned(HR));
  case op_globalsp:
#if YAPOR_SBA
    RINT((Int)HR);
#else
    RINT(HR - H0);
#endif
  }
  RERROR();
}
 
Term Yap_eval_atom(Int f)
{
  return eval0(f);
}
 
typedef struct init_const_eval {
  char          *OpName;
  arith0_op      f;
} InitConstEntry;
 
static InitConstEntry InitConstTab[] = {
  {"pi", op_pi},
  {"e", op_e},
  {"epsilon", op_epsilon},
  {"inf", op_inf},
  {"nan", op_nan},
  {"random", op_random},
  {"cputime", op_cputime},
  {"heapused", op_heapused},
  {"local_sp", op_localsp},
  {"global_sp", op_globalsp},
  {"$last_choice_pt", op_b},
  {"$env", op_env},
  {"$tr", op_tr},
  {"stackfree", op_stackfree},
};
 
void
Yap_InitConstExps(void)
{
  unsigned int    i;
  ExpEntry       *p;
 
  for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
    AtomEntry *ae = RepAtom(Yap_LookupAtom(InitConstTab[i].OpName));
    if (ae == NULL) {
      Yap_EvalError(RESOURCE_ERROR_HEAP,TermNil,"at InitConstExps");
      return;
    }
    WRITE_LOCK(ae->ARWLock);
    if (Yap_GetExpPropHavingLock(ae, 0)) {
      WRITE_UNLOCK(ae->ARWLock);
      break;
    }
    p = (ExpEntry *) Yap_AllocAtomSpace(sizeof(ExpEntry));
    p->KindOfPE = ExpProperty;
    p->ArityOfEE = 0;
    p->ENoOfEE = 0;
    p->FOfEE = InitConstTab[i].f;
    AddPropToAtom(ae, (PropEntry *)p);
    WRITE_UNLOCK(ae->ARWLock);
  }
}
 
/* This routine is called from Restore to make sure we have the same arithmetic operators */
int
Yap_ReInitConstExps(void)
{
  return TRUE;
}