1353 lines
36 KiB
C
1353 lines
36 KiB
C
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: init.c *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: initializing a prolog session *
|
|
* *
|
|
*************************************************************************/
|
|
#ifdef SCCS
|
|
static char SccsId[] = "%W% %G%";
|
|
#endif
|
|
|
|
/*
|
|
* The code from this file is used to initialize the environment for prolog
|
|
*
|
|
*/
|
|
|
|
#include "Yap.h"
|
|
#include "yapio.h"
|
|
#include "alloc.h"
|
|
#include "clause.h"
|
|
#include "Foreign.h"
|
|
#ifdef LOW_LEVEL_TRACER
|
|
#include "tracer.h"
|
|
#endif
|
|
#ifdef YAPOR
|
|
#include "or.macros.h"
|
|
#endif /* YAPOR */
|
|
#if defined(YAPOR) || defined(TABLING)
|
|
#if HAVE_SYS_TYPES_H
|
|
#include <sys/types.h>
|
|
#endif
|
|
#if HAVE_SYS_STAT_H
|
|
#include <sys/stat.h>
|
|
#endif
|
|
#if HAVE_FCNTL_H
|
|
#include <fcntl.h>
|
|
#endif
|
|
#endif /* YAPOR || TABLING */
|
|
#if HAVE_STRING_H
|
|
#include <string.h>
|
|
#endif
|
|
|
|
#ifdef DEBUG
|
|
|
|
#define LOGFILE "logfile"
|
|
|
|
int Yap_output_msg = FALSE;
|
|
|
|
#ifdef MACC
|
|
STATIC_PROTO(void InTTYLine, (char *));
|
|
#endif
|
|
#endif
|
|
STATIC_PROTO(void SetOp, (int, int, char *, Term));
|
|
STATIC_PROTO(void InitOps, (void));
|
|
STATIC_PROTO(void InitDebug, (void));
|
|
#ifdef CUT_C
|
|
STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate, CPredicate));
|
|
#else
|
|
STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate));
|
|
#endif
|
|
STATIC_PROTO(void InitStdPreds,(void));
|
|
STATIC_PROTO(void InitFlags, (void));
|
|
STATIC_PROTO(void InitCodes, (void));
|
|
STATIC_PROTO(void InitVersion, (void));
|
|
|
|
|
|
STD_PROTO(void exit, (int));
|
|
|
|
/************** YAP PROLOG GLOBAL VARIABLES *************************/
|
|
|
|
/************* variables related to memory allocation ***************/
|
|
|
|
#if defined(THREADS)
|
|
|
|
ADDR Yap_HeapBase;
|
|
|
|
struct restore_info rinfo[MAX_THREADS];
|
|
|
|
struct thread_globs Yap_thread_gl[MAX_THREADS];
|
|
|
|
#else
|
|
|
|
struct restore_info rinfo;
|
|
|
|
ADDR Yap_HeapBase,
|
|
Yap_LocalBase,
|
|
Yap_GlobalBase,
|
|
Yap_TrailBase,
|
|
Yap_TrailTop;
|
|
|
|
/************ variables concerned with Error Handling *************/
|
|
char *Yap_ErrorMessage; /* used to pass error messages */
|
|
Term Yap_Error_Term; /* used to pass error terms */
|
|
yap_error_number Yap_Error_TYPE; /* used to pass the error */
|
|
UInt Yap_Error_Size; /* used to pass a size associated with an error */
|
|
|
|
/******************* storing error messages ****************************/
|
|
char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
|
|
|
|
/* if we botched in a LongIO operation */
|
|
jmp_buf Yap_IOBotch;
|
|
|
|
/* if we botched in the compiler */
|
|
jmp_buf Yap_CompilerBotch;
|
|
|
|
/************ variables concerned with Error Handling *************/
|
|
sigjmp_buf Yap_RestartEnv; /* used to restart after an abort execution */
|
|
|
|
/********* IO support *****/
|
|
|
|
/********* parsing ********************************************/
|
|
|
|
TokEntry *Yap_tokptr, *Yap_toktide;
|
|
VarEntry *Yap_VarTable, *Yap_AnonVarTable;
|
|
int Yap_eot_before_eof = FALSE;
|
|
|
|
/******************* intermediate buffers **********************/
|
|
|
|
char Yap_FileNameBuf[YAP_FILENAME_MAX],
|
|
Yap_FileNameBuf2[YAP_FILENAME_MAX];
|
|
|
|
#endif /* THREADS */
|
|
|
|
/******** whether Yap is responsible for signal handling******************/
|
|
int Yap_PrologShouldHandleInterrupts;
|
|
|
|
/********* readline support *****/
|
|
#if HAVE_LIBREADLINE
|
|
|
|
char *_line = (char *) NULL;
|
|
|
|
#endif
|
|
|
|
#ifdef MPWSHELL
|
|
/********** informing if we are in the MPW shell ********************/
|
|
|
|
int mpwshell = FALSE;
|
|
|
|
#endif
|
|
|
|
#ifdef EMACS
|
|
|
|
int emacs_mode = FALSE;
|
|
char emacs_tmp[256], emacs_tmp2[256];
|
|
|
|
#endif
|
|
|
|
/********* Prolog State ********************************************/
|
|
|
|
Int Yap_PrologMode = BootMode;
|
|
|
|
int Yap_CritLocks = 0;
|
|
|
|
/********* streams ********************************************/
|
|
|
|
int Yap_c_input_stream, Yap_c_output_stream, Yap_c_error_stream;
|
|
|
|
YP_FILE *Yap_stdin;
|
|
YP_FILE *Yap_stdout;
|
|
YP_FILE *Yap_stderr;
|
|
|
|
|
|
/************** Access to yap initial arguments ***************************/
|
|
|
|
char **Yap_argv;
|
|
int Yap_argc;
|
|
|
|
/************** Extensions to Terms ***************************************/
|
|
|
|
#ifdef COROUTINING
|
|
/* array with the ops for your favourite extensions */
|
|
ext_op attas[attvars_ext+1];
|
|
#endif
|
|
|
|
/************** declarations local to init.c ************************/
|
|
static char *optypes[] =
|
|
{"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"};
|
|
|
|
/* OS page size for memory allocation */
|
|
int Yap_page_size;
|
|
|
|
#if USE_THREADED_CODE
|
|
/* easy access to instruction opcodes */
|
|
void **Yap_ABSMI_OPCODES;
|
|
#endif
|
|
|
|
#if USE_SOCKET
|
|
int Yap_sockets_io=0;
|
|
#endif
|
|
|
|
#if DEBUG
|
|
#if COROUTINING
|
|
int Yap_Portray_delays = FALSE;
|
|
#endif
|
|
#endif
|
|
|
|
#define xfx 1
|
|
#define xfy 2
|
|
#define yfx 3
|
|
#define xf 4
|
|
#define yf 5
|
|
#define fx 6
|
|
#define fy 7
|
|
|
|
int
|
|
Yap_IsOpType(char *type)
|
|
{
|
|
int i;
|
|
|
|
for (i = 1; i <= 7; ++i)
|
|
if (strcmp(type, optypes[i]) == 0)
|
|
break;
|
|
return (i <= 7);
|
|
}
|
|
|
|
static int
|
|
OpDec(int p, char *type, Atom a, Term m)
|
|
{
|
|
int i;
|
|
AtomEntry *ae = RepAtom(a);
|
|
OpEntry *info;
|
|
|
|
if (m == TermProlog)
|
|
m = PROLOG_MODULE;
|
|
else if (m == USER_MODULE)
|
|
m = PROLOG_MODULE;
|
|
for (i = 1; i <= 7; ++i)
|
|
if (strcmp(type, optypes[i]) == 0)
|
|
break;
|
|
if (i > 7) {
|
|
Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER,MkAtomTerm(Yap_LookupAtom(type)),"op/3");
|
|
return(FALSE);
|
|
}
|
|
if (p) {
|
|
if (i == 1 || i == 2 || i == 4)
|
|
p |= DcrlpFlag;
|
|
if (i == 1 || i == 3 || i == 6)
|
|
p |= DcrrpFlag;
|
|
}
|
|
WRITE_LOCK(ae->ARWLock);
|
|
info = Yap_GetOpPropForAModuleHavingALock(ae, m);
|
|
if (EndOfPAEntr(info)) {
|
|
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
|
|
info->KindOfPE = Ord(OpProperty);
|
|
info->NextOfPE = RepAtom(a)->PropsOfAE;
|
|
info->OpModule = m;
|
|
info->OpName = a;
|
|
LOCK(OpListLock);
|
|
info->OpNext = OpList;
|
|
OpList = info;
|
|
UNLOCK(OpListLock);
|
|
RepAtom(a)->PropsOfAE = AbsOpProp(info);
|
|
INIT_RWLOCK(info->OpRWLock);
|
|
WRITE_LOCK(info->OpRWLock);
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
info->Prefix = info->Infix = info->Posfix = 0;
|
|
} else {
|
|
WRITE_LOCK(info->OpRWLock);
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
}
|
|
if (i <= 3) {
|
|
if (yap_flags[STRICT_ISO_FLAG] &&
|
|
info->Posfix != 0) /* there is a posfix operator */ {
|
|
/* ISO dictates */
|
|
WRITE_UNLOCK(info->OpRWLock);
|
|
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
|
|
return FALSE;
|
|
}
|
|
info->Infix = p;
|
|
} else if (i <= 5) {
|
|
if (yap_flags[STRICT_ISO_FLAG] &&
|
|
info->Infix != 0) /* there is an infix operator */ {
|
|
/* ISO dictates */
|
|
WRITE_UNLOCK(info->OpRWLock);
|
|
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
|
|
return FALSE;
|
|
}
|
|
info->Posfix = p;
|
|
} else {
|
|
info->Prefix = p;
|
|
}
|
|
WRITE_UNLOCK(info->OpRWLock);
|
|
return (TRUE);
|
|
}
|
|
|
|
int
|
|
Yap_OpDec(int p, char *type, Atom a, Term m)
|
|
{
|
|
return(OpDec(p,type,a,m));
|
|
}
|
|
|
|
static void
|
|
SetOp(int p, int type, char *at, Term m)
|
|
{
|
|
#ifdef DEBUG
|
|
if (Yap_Option[5])
|
|
fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at);
|
|
#endif
|
|
OpDec(p, optypes[type], Yap_LookupAtom(at), m);
|
|
}
|
|
|
|
/* Gets the info about an operator in a prop */
|
|
Atom
|
|
Yap_GetOp(OpEntry *pp, int *prio, int fix)
|
|
{
|
|
int n;
|
|
SMALLUNSGN p;
|
|
|
|
if (fix == 0) {
|
|
p = pp->Prefix;
|
|
if (p & DcrrpFlag)
|
|
n = 6, *prio = (p ^ DcrrpFlag);
|
|
else
|
|
n = 7, *prio = p;
|
|
} else if (fix == 1) {
|
|
p = pp->Posfix;
|
|
if (p & DcrlpFlag)
|
|
n = 4, *prio = (p ^ DcrlpFlag);
|
|
else
|
|
n = 5, *prio = p;
|
|
} else {
|
|
p = pp->Infix;
|
|
if ((p & DcrrpFlag) && (p & DcrlpFlag))
|
|
n = 1, *prio = (p ^ (DcrrpFlag | DcrlpFlag));
|
|
else if (p & DcrrpFlag)
|
|
n = 3, *prio = (p ^ DcrrpFlag);
|
|
else if (p & DcrlpFlag)
|
|
n = 2, *prio = (p ^ DcrlpFlag);
|
|
else
|
|
n = 4, *prio = p;
|
|
}
|
|
return Yap_LookupAtom(optypes[n]);
|
|
}
|
|
|
|
typedef struct OPSTRUCT {
|
|
char *opName;
|
|
short int opType, opPrio;
|
|
} Opdef;
|
|
|
|
static Opdef Ops[] = {
|
|
{":-", xfx, 1200},
|
|
{"-->", xfx, 1200},
|
|
{"?-", fx, 1200},
|
|
{":-", fx, 1200},
|
|
{"dynamic", fx, 1150},
|
|
{"thread_local", fx, 1150},
|
|
{"initialization", fx, 1150},
|
|
{"volatile", fx, 1150},
|
|
{"mode", fx, 1150},
|
|
{"public", fx, 1150},
|
|
{"multifile", fx, 1150},
|
|
{"meta_predicate", fx, 1150},
|
|
{"module_transparent", fx, 1150},
|
|
{"discontiguous", fx, 1150},
|
|
#ifdef YAPOR
|
|
{"sequential", fx, 1150},
|
|
#endif /* YAPOR */
|
|
#ifdef TABLING
|
|
{"table", fx, 1150},
|
|
#endif /* TABLING */
|
|
#ifndef UNCUTABLE
|
|
{"uncutable", fx, 1150},
|
|
#endif /*UNCUTABLE ceh:*/
|
|
{"|", xfy, 1105},
|
|
{";", xfy, 1100},
|
|
/* {";", yf, 1100}, not allowed in ISO */
|
|
{"->", xfy, 1050},
|
|
{"*->", xfy, 1050},
|
|
{",", xfy, 1000},
|
|
{".", xfy, 999},
|
|
{"\\+", fy, 900},
|
|
{"not", fy, 900},
|
|
{"=", xfx, 700},
|
|
{"\\=", xfx, 700},
|
|
{"is", xfx, 700},
|
|
{"=..", xfx, 700},
|
|
{"==", xfx, 700},
|
|
{"\\==", xfx, 700},
|
|
{"@<", xfx, 700},
|
|
{"@>", xfx, 700},
|
|
{"@=<", xfx, 700},
|
|
{"@>=", xfx, 700},
|
|
{"=@=", xfx, 700},
|
|
{"\\=@=", xfx, 700},
|
|
{"=:=", xfx, 700},
|
|
{"=\\=", xfx, 700},
|
|
{"<", xfx, 700},
|
|
{">", xfx, 700},
|
|
{"=<", xfx, 700},
|
|
{">=", xfx, 700},
|
|
{"as", xfx, 600},
|
|
{":", xfy, 600},
|
|
{"+", yfx, 500},
|
|
{"-", yfx, 500},
|
|
{"/\\", yfx, 500},
|
|
{"\\/", yfx, 500},
|
|
{"><", yfx, 500},
|
|
{"#", yfx, 500},
|
|
{"xor", yfx, 400},
|
|
{"rdiv", yfx, 400},
|
|
{"*", yfx, 400},
|
|
{"/", yfx, 400},
|
|
{"//", yfx, 400},
|
|
{"<<", yfx, 400},
|
|
{">>", yfx, 400},
|
|
{"mod", yfx, 400},
|
|
{"rem", yfx, 400},
|
|
{"+", fx, 200},
|
|
{"-", fy, 200},
|
|
{"\\", fy, 200},
|
|
{"//", yfx, 400},
|
|
{"**", xfx, 200},
|
|
{"^", xfy, 200}
|
|
};
|
|
|
|
static void
|
|
InitOps(void)
|
|
{
|
|
unsigned int i;
|
|
for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++i)
|
|
SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName, PROLOG_MODULE);
|
|
}
|
|
|
|
#ifdef DEBUG
|
|
#ifdef HAVE_ISATTY
|
|
#include <unistd.h>
|
|
#endif
|
|
#endif
|
|
|
|
static void
|
|
InitDebug(void)
|
|
{
|
|
Atom At;
|
|
#ifdef DEBUG
|
|
int i;
|
|
|
|
for (i = 1; i < 20; ++i)
|
|
Yap_Option[i] = 0;
|
|
if (Yap_output_msg) {
|
|
char ch;
|
|
|
|
#if HAVE_ISATTY
|
|
if (!isatty (0)) {
|
|
return;
|
|
}
|
|
#endif
|
|
fprintf(stderr,"absmi address:%p\n", FunAdr(Yap_absmi));
|
|
fprintf(stderr,"Set Trace Options:\n");
|
|
fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
|
|
fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
|
|
fprintf(stderr,"m Machine\t p parser\n");
|
|
while ((ch = YP_putchar(YP_getchar())) != '\n')
|
|
if (ch >= 'a' && ch <= 'z')
|
|
Yap_Option[ch - 'a' + 1] = 1;
|
|
if (Yap_Option['l' - 96]) {
|
|
Yap_logfile = fopen(LOGFILE, "w");
|
|
if (Yap_logfile == NULL) {
|
|
fprintf(stderr,"can not open %s\n", LOGFILE);
|
|
getchar();
|
|
exit(0);
|
|
}
|
|
fprintf(stderr,"logging session to file 'logfile'\n");
|
|
#ifdef MAC
|
|
Yap_SetTextFile(LOGFILE);
|
|
lp = my_line;
|
|
curfile = Nill;
|
|
#endif
|
|
}
|
|
}
|
|
#endif
|
|
/* Set at full leash */
|
|
At = AtomLeash;
|
|
Yap_PutValue(At, MkIntTerm(15));
|
|
}
|
|
|
|
void
|
|
Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags)
|
|
{
|
|
Atom atom = NIL;
|
|
PredEntry *pe = NULL;
|
|
yamop *p_code;
|
|
StaticClause *cl = NULL;
|
|
Functor f = NULL;
|
|
|
|
while (atom == NIL) {
|
|
atom = Yap_FullLookupAtom(Name);
|
|
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (Arity) {
|
|
while (!f) {
|
|
f = Yap_MkFunctor(atom,Arity);
|
|
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
while (pe == NULL) {
|
|
if (Arity)
|
|
pe = RepPredProp(PredPropByFunc(f,CurrentModule));
|
|
else
|
|
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
|
|
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (pe->PredFlags & CPredFlag) {
|
|
/* already exists */
|
|
cl = ClauseCodeToStaticClause(pe->CodeOfPred);
|
|
if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) {
|
|
Yap_ClauseSpace -= cl->ClSize;
|
|
Yap_FreeCodeSpace((ADDR)cl);
|
|
cl = NULL;
|
|
}
|
|
}
|
|
p_code = cl->ClCode;
|
|
while (!cl) {
|
|
UInt sz;
|
|
|
|
if (flags & SafePredFlag) {
|
|
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code,Osbpp),p),l);
|
|
} else {
|
|
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code,e),p),Osbpp),p),l);
|
|
}
|
|
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
|
|
if (!cl) {
|
|
if (!Yap_growheap(FALSE, sz, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
} else {
|
|
Yap_ClauseSpace += sz;
|
|
cl->ClFlags = StaticMask;
|
|
cl->ClNext = NULL;
|
|
cl->ClSize = sz;
|
|
cl->usc.ClPred = pe;
|
|
p_code = cl->ClCode;
|
|
}
|
|
}
|
|
pe->CodeOfPred = p_code;
|
|
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
|
pe->cs.f_code = code;
|
|
if (!(flags & SafePredFlag)) {
|
|
p_code->opc = Yap_opcode(_allocate);
|
|
p_code = NEXTOP(p_code,e);
|
|
}
|
|
if (flags & UserCPredFlag)
|
|
p_code->opc = Yap_opcode(_call_usercpred);
|
|
else
|
|
p_code->opc = Yap_opcode(_call_cpred);
|
|
p_code->u.Osbpp.bmap = NULL;
|
|
p_code->u.Osbpp.s = -Signed(RealEnvSize);
|
|
p_code->u.Osbpp.p =
|
|
p_code->u.Osbpp.p0 =
|
|
pe;
|
|
p_code = NEXTOP(p_code,Osbpp);
|
|
if (!(flags & SafePredFlag)) {
|
|
p_code->opc = Yap_opcode(_deallocate);
|
|
p_code->u.p.p = pe;
|
|
p_code = NEXTOP(p_code,p);
|
|
}
|
|
p_code->opc = Yap_opcode(_procceed);
|
|
p_code->u.p.p = pe;
|
|
p_code = NEXTOP(p_code,p);
|
|
p_code->opc = Yap_opcode(_Ystop);
|
|
p_code->u.l.l = cl->ClCode;
|
|
pe->OpcodeOfPred = pe->CodeOfPred->opc;
|
|
}
|
|
|
|
void
|
|
Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, UInt flags)
|
|
{
|
|
Atom atom = NIL;
|
|
PredEntry *pe = NULL;
|
|
yamop *p_code = NULL;
|
|
StaticClause *cl = NULL;
|
|
Functor f = NULL;
|
|
|
|
while (atom == NIL) {
|
|
atom = Yap_FullLookupAtom(Name);
|
|
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (Arity) {
|
|
while (!f) {
|
|
f = Yap_MkFunctor(atom,Arity);
|
|
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
while (pe == NULL) {
|
|
if (Arity)
|
|
pe = RepPredProp(PredPropByFunc(f,CurrentModule));
|
|
else
|
|
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
|
|
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (pe->PredFlags & CPredFlag) {
|
|
p_code = pe->CodeOfPred;
|
|
/* already exists */
|
|
} else {
|
|
while (!cl) {
|
|
UInt sz = sizeof(StaticClause)+(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL),plxxs),p),l);
|
|
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
|
|
if (!cl) {
|
|
if (!Yap_growheap(FALSE, sz, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
} else {
|
|
Yap_ClauseSpace += sz;
|
|
cl->ClFlags = StaticMask;
|
|
cl->ClNext = NULL;
|
|
cl->ClSize = sz;
|
|
cl->usc.ClPred = pe;
|
|
p_code = cl->ClCode;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
|
pe->CodeOfPred = p_code;
|
|
pe->cs.d_code = cmp_code;
|
|
pe->ModuleOfPred = CurrentModule;
|
|
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
|
|
p_code->u.plxxs.p = pe;
|
|
p_code->u.plxxs.f = FAILCODE;
|
|
p_code->u.plxxs.x1 = Yap_emit_x(1);
|
|
p_code->u.plxxs.x2 = Yap_emit_x(2);
|
|
p_code->u.plxxs.flags = Yap_compile_cmp_flags(pe);
|
|
p_code = NEXTOP(p_code,plxxs);
|
|
p_code->opc = Yap_opcode(_procceed);
|
|
p_code->u.p.p = pe;
|
|
p_code = NEXTOP(p_code,p);
|
|
p_code->opc = Yap_opcode(_Ystop);
|
|
p_code->u.l.l = cl->ClCode;
|
|
}
|
|
|
|
void
|
|
Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, UInt flags)
|
|
{
|
|
Atom atom = NIL;
|
|
PredEntry *pe = NULL;
|
|
Functor f = NULL;
|
|
|
|
while (atom == NIL) {
|
|
atom = Yap_FullLookupAtom(Name);
|
|
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (Arity) {
|
|
while (!f) {
|
|
f = Yap_MkFunctor(atom,Arity);
|
|
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
while (pe == NULL) {
|
|
if (Arity)
|
|
pe = RepPredProp(PredPropByFunc(f,CurrentModule));
|
|
else
|
|
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
|
|
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
pe->PredFlags = flags | AsmPredFlag | StandardPredFlag | (code);
|
|
pe->cs.f_code = def;
|
|
pe->ModuleOfPred = CurrentModule;
|
|
if (def != NULL) {
|
|
yamop *p_code = ((StaticClause *)NULL)->ClCode;
|
|
StaticClause *cl;
|
|
|
|
if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) {
|
|
if (flags & SafePredFlag) {
|
|
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),p),l));
|
|
} else {
|
|
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),Osbpp),p),p),l));
|
|
}
|
|
if (!cl) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitAsmPred");
|
|
return;
|
|
}
|
|
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),p),l);
|
|
} else {
|
|
cl = ClauseCodeToStaticClause(pe->CodeOfPred);
|
|
}
|
|
cl->ClFlags = StaticMask;
|
|
cl->ClNext = NULL;
|
|
if (flags & SafePredFlag) {
|
|
cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),e),e);
|
|
} else {
|
|
cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),Osbpp),p),e),e);
|
|
}
|
|
cl->usc.ClPred = pe;
|
|
p_code = cl->ClCode;
|
|
pe->CodeOfPred = p_code;
|
|
if (!(flags & SafePredFlag)) {
|
|
p_code->opc = Yap_opcode(_allocate);
|
|
p_code = NEXTOP(p_code,e);
|
|
}
|
|
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
|
|
p_code->u.Osbpp.bmap = NULL;
|
|
p_code->u.Osbpp.s = -Signed(RealEnvSize);
|
|
p_code->u.Osbpp.p = p_code->u.Osbpp.p0 = pe;
|
|
p_code = NEXTOP(p_code,Osbpp);
|
|
if (!(flags & SafePredFlag)) {
|
|
p_code->opc = Yap_opcode(_deallocate);
|
|
p_code->u.p.p = pe;
|
|
p_code = NEXTOP(p_code,p);
|
|
}
|
|
p_code->opc = Yap_opcode(_procceed);
|
|
p_code->u.p.p = pe;
|
|
p_code = NEXTOP(p_code,p);
|
|
p_code->opc = Yap_opcode(_Ystop);
|
|
p_code->u.l.l = cl->ClCode;
|
|
} else {
|
|
pe->OpcodeOfPred = Yap_opcode(_undef_p);
|
|
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
|
|
}
|
|
}
|
|
|
|
|
|
static void
|
|
#ifdef CUT_C
|
|
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut)
|
|
#else
|
|
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
|
|
#endif
|
|
{
|
|
yamop *code;
|
|
if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
|
|
pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause ||
|
|
pe->CodeOfPred != pe->cs.p_code.FirstClause) {
|
|
Yap_Error(SYSTEM_ERROR,TermNil,
|
|
"initiating a C Pred with backtracking");
|
|
return;
|
|
}
|
|
code = (yamop *)(pe->cs.p_code.FirstClause);
|
|
if (pe->PredFlags & UserCPredFlag)
|
|
code->opc = Yap_opcode(_try_userc);
|
|
else
|
|
code->opc = Yap_opcode(_try_c);
|
|
#ifdef YAPOR
|
|
INIT_YAMOP_LTT(code, 2);
|
|
PUT_YAMOP_SEQ(code);
|
|
#endif /* YAPOR */
|
|
code->u.OtapFs.f = Start;
|
|
code = NEXTOP(code,OtapFs);
|
|
if (pe->PredFlags & UserCPredFlag)
|
|
code->opc = Yap_opcode(_retry_userc);
|
|
else
|
|
code->opc = Yap_opcode(_retry_c);
|
|
#ifdef YAPOR
|
|
INIT_YAMOP_LTT(code, 1);
|
|
PUT_YAMOP_SEQ(code);
|
|
#endif /* YAPOR */
|
|
code->u.OtapFs.f = Cont;
|
|
#ifdef CUT_C
|
|
code = NEXTOP(code,OtapFs);
|
|
if (pe->PredFlags & UserCPredFlag)
|
|
code->opc = Yap_opcode(_cut_c);
|
|
else
|
|
code->opc = Yap_opcode(_cut_userc);
|
|
code->u.OtapFs.f = Cut;
|
|
#endif
|
|
}
|
|
|
|
|
|
#ifdef CUT_C
|
|
void
|
|
Yap_InitCPredBack(char *Name, unsigned long int Arity,
|
|
unsigned int Extra, CPredicate Start,
|
|
CPredicate Cont, UInt flags){
|
|
Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,NULL,flags);
|
|
}
|
|
|
|
void
|
|
Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
|
|
unsigned int Extra, CPredicate Start,
|
|
CPredicate Cont,CPredicate Cut, UInt flags){
|
|
Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags);
|
|
}
|
|
#else
|
|
Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
|
|
unsigned int Extra, CPredicate Start,
|
|
CPredicate Cont,CPredicate Cut, UInt flags){
|
|
Yap_InitCPredBack(Name,Arity,Extra,Start,Cont,flags);
|
|
}
|
|
#endif /* CUT_C */
|
|
|
|
void
|
|
#ifdef CUT_C
|
|
Yap_InitCPredBack_(char *Name, unsigned long int Arity,
|
|
unsigned int Extra, CPredicate Start,
|
|
CPredicate Cont, CPredicate Cut, UInt flags)
|
|
#else
|
|
Yap_InitCPredBack(char *Name, unsigned long int Arity,
|
|
unsigned int Extra, CPredicate Start,
|
|
CPredicate Cont, UInt flags)
|
|
#endif
|
|
{
|
|
PredEntry *pe = NULL;
|
|
Atom atom = NIL;
|
|
Functor f = NULL;
|
|
|
|
while (atom == NIL) {
|
|
atom = Yap_FullLookupAtom(Name);
|
|
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (Arity) {
|
|
while (!f) {
|
|
f = Yap_MkFunctor(atom,Arity);
|
|
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
while (pe == NULL) {
|
|
if (Arity)
|
|
pe = RepPredProp(PredPropByFunc(f,CurrentModule));
|
|
else
|
|
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
|
|
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
|
|
return;
|
|
}
|
|
}
|
|
if (pe->cs.p_code.FirstClause != NIL)
|
|
{
|
|
#ifdef CUT_C
|
|
CleanBack(pe, Start, Cont, Cut);
|
|
#else
|
|
CleanBack(pe, Start, Cont);
|
|
#endif /*CUT_C*/
|
|
}
|
|
else {
|
|
StaticClause *cl;
|
|
yamop *code = ((StaticClause *)NULL)->ClCode;
|
|
if (flags & UserCPredFlag)
|
|
pe->PredFlags = UserCPredFlag | CompiledPredFlag | StandardPredFlag | flags;
|
|
else
|
|
pe->PredFlags = CompiledPredFlag | StandardPredFlag;
|
|
|
|
#ifdef YAPOR
|
|
pe->PredFlags |= SequentialPredFlag;
|
|
#endif /* YAPOR */
|
|
|
|
#ifdef CUT_C
|
|
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l));
|
|
#else
|
|
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l));
|
|
#endif
|
|
|
|
if (cl == NULL) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
|
|
return;
|
|
}
|
|
cl->ClFlags = StaticMask;
|
|
cl->ClNext = NULL;
|
|
#ifdef CUT_C
|
|
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
|
|
cl->ClSize =
|
|
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e);
|
|
#else
|
|
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l);
|
|
cl->ClSize =
|
|
(CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),e);
|
|
#endif
|
|
cl->usc.ClPred = pe;
|
|
|
|
code = cl->ClCode;
|
|
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
|
|
pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
|
|
if (flags & UserCPredFlag)
|
|
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
|
|
else
|
|
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
|
|
code->u.OtapFs.f = Start;
|
|
code->u.OtapFs.p = pe;
|
|
code->u.OtapFs.s = Arity;
|
|
code->u.OtapFs.extra = Extra;
|
|
#ifdef YAPOR
|
|
INIT_YAMOP_LTT(code, 2);
|
|
PUT_YAMOP_SEQ(code);
|
|
#endif /* YAPOR */
|
|
code = NEXTOP(code,OtapFs);
|
|
if (flags & UserCPredFlag)
|
|
code->opc = Yap_opcode(_retry_userc);
|
|
else
|
|
code->opc = Yap_opcode(_retry_c);
|
|
code->u.OtapFs.f = Cont;
|
|
code->u.OtapFs.p = pe;
|
|
code->u.OtapFs.s = Arity;
|
|
code->u.OtapFs.extra = Extra;
|
|
#ifdef YAPOR
|
|
INIT_YAMOP_LTT(code, 1);
|
|
PUT_YAMOP_SEQ(code);
|
|
#endif /* YAPOR */
|
|
code = NEXTOP(code,OtapFs);
|
|
#ifdef CUT_C
|
|
if (flags & UserCPredFlag)
|
|
code->opc = Yap_opcode(_cut_userc);
|
|
else
|
|
code->opc = Yap_opcode(_cut_c);
|
|
code->u.OtapFs.f = Cut;
|
|
code->u.OtapFs.p = pe;
|
|
code->u.OtapFs.s = Arity;
|
|
code->u.OtapFs.extra = Extra;
|
|
code = NEXTOP(code,OtapFs);
|
|
#endif /* CUT_C */
|
|
code->opc = Yap_opcode(_Ystop);
|
|
code->u.l.l = cl->ClCode;
|
|
}
|
|
}
|
|
|
|
|
|
static void
|
|
InitStdPreds(void)
|
|
{
|
|
Yap_InitCPreds();
|
|
Yap_InitBackCPreds();
|
|
}
|
|
|
|
static void
|
|
InitFlags(void)
|
|
{
|
|
/* note that Yap_heap_regs must be set first */
|
|
|
|
#if USE_GMP
|
|
yap_flags[YAP_INT_BOUNDED_FLAG] = 0;
|
|
#else
|
|
yap_flags[YAP_INT_BOUNDED_FLAG] = 1;
|
|
#endif
|
|
yap_flags[MAX_ARITY_FLAG] = -1;
|
|
yap_flags[INTEGER_ROUNDING_FLAG] = 0;
|
|
yap_flags[YAP_MAX_INTEGER_FLAG] = (Int)(~((CELL)1 << (sizeof(Int)*8-1)));
|
|
yap_flags[YAP_MIN_INTEGER_FLAG] = (Int)(((CELL)1 << (sizeof(Int)*8-1)));
|
|
yap_flags[CHAR_CONVERSION_FLAG] = 1;
|
|
yap_flags[YAP_DOUBLE_QUOTES_FLAG] = 1;
|
|
yap_flags[YAP_TO_CHARS_FLAG] = QUINTUS_TO_CHARS;
|
|
yap_flags[LANGUAGE_MODE_FLAG] = 0;
|
|
yap_flags[STRICT_ISO_FLAG] = FALSE;
|
|
yap_flags[SOURCE_MODE_FLAG] = FALSE;
|
|
yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
|
|
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
|
|
#if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR
|
|
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE;
|
|
#else
|
|
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE;
|
|
#endif
|
|
yap_flags[GENERATE_DEBUG_INFO_FLAG] = TRUE;
|
|
/* current default */
|
|
yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
|
|
yap_flags[TABLING_MODE_FLAG] = 0;
|
|
yap_flags[QUIET_MODE_FLAG] = FALSE;
|
|
}
|
|
|
|
static void
|
|
InitPredHash(void)
|
|
{
|
|
UInt i;
|
|
|
|
PredHash = (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) * PredHashInitialSize);
|
|
PredHashTableSize = PredHashInitialSize;
|
|
if (PredHash == NULL) {
|
|
Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial predicate hash table");
|
|
}
|
|
for (i = 0; i < PredHashTableSize; ++i) {
|
|
PredHash[i] = NULL;
|
|
}
|
|
INIT_RWLOCK(PredHashRWLock);
|
|
}
|
|
|
|
static void
|
|
InitEnvInst(yamop start[2], yamop **instp, op_numbers opc, PredEntry *pred)
|
|
{
|
|
yamop *ipc = start;
|
|
|
|
/* make it look like the instruction is preceeded by a call instruction */
|
|
ipc->opc = Yap_opcode(_call);
|
|
ipc->u.Osbpp.s = -Signed(RealEnvSize);
|
|
ipc->u.Osbpp.bmap = NULL;
|
|
ipc->u.Osbpp.p = pred;
|
|
ipc->u.Osbpp.p0 = pred;
|
|
ipc = NEXTOP(ipc, Osbpp);
|
|
ipc->opc = Yap_opcode(opc);
|
|
*instp = ipc;
|
|
}
|
|
|
|
static void
|
|
InitOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe)
|
|
{
|
|
yamop *ipc = start;
|
|
|
|
/* this is a place holder, it should not really be used */
|
|
ipc->opc = Yap_opcode(opc);
|
|
ipc->u.Otapl.s = 0;
|
|
ipc->u.Otapl.p = pe;
|
|
ipc->u.Otapl.d = NULL;
|
|
#ifdef YAPOR
|
|
INIT_YAMOP_LTT(ipc, 1);
|
|
#endif /* YAPOR */
|
|
#ifdef TABLING
|
|
ipc->u.Otapl.te = NULL;
|
|
#endif /* TABLING */
|
|
}
|
|
|
|
static void
|
|
InitDBErasedMarker(void)
|
|
{
|
|
Yap_heap_regs->db_erased_marker =
|
|
(DBRef)Yap_AllocCodeSpace(sizeof(DBStruct));
|
|
Yap_LUClauseSpace += sizeof(DBStruct);
|
|
Yap_heap_regs->db_erased_marker->id = FunctorDBRef;
|
|
Yap_heap_regs->db_erased_marker->Flags = ErasedMask;
|
|
Yap_heap_regs->db_erased_marker->Code = NULL;
|
|
Yap_heap_regs->db_erased_marker->DBT.DBRefs = NULL;
|
|
Yap_heap_regs->db_erased_marker->Parent = NULL;
|
|
}
|
|
|
|
static void
|
|
InitLogDBErasedMarker(void)
|
|
{
|
|
Yap_heap_regs->logdb_erased_marker =
|
|
(LogUpdClause *)Yap_AllocCodeSpace(sizeof(LogUpdClause)+(UInt)NEXTOP((yamop*)NULL,e));
|
|
Yap_LUClauseSpace += sizeof(LogUpdClause)+(UInt)NEXTOP((yamop*)NULL,e);
|
|
Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef;
|
|
Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask;
|
|
Yap_heap_regs->logdb_erased_marker->ClSource = NULL;
|
|
Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
|
|
Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause;
|
|
Yap_heap_regs->logdb_erased_marker->ClExt = NULL;
|
|
Yap_heap_regs->logdb_erased_marker->ClPrev = NULL;
|
|
Yap_heap_regs->logdb_erased_marker->ClNext = NULL;
|
|
Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
|
|
Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail);
|
|
INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker);
|
|
}
|
|
|
|
static void
|
|
InitAtoms(void)
|
|
{
|
|
int i;
|
|
AtomHashTableSize = MaxHash;
|
|
HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
|
|
if (HashChain == NULL) {
|
|
Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial atom table");
|
|
}
|
|
for (i = 0; i < MaxHash; ++i) {
|
|
INIT_RWLOCK(HashChain[i].AERWLock);
|
|
HashChain[i].Entry = NIL;
|
|
}
|
|
NOfAtoms = 0;
|
|
#if THREADS
|
|
SF_STORE->AtFoundVar = Yap_LookupAtom("**");
|
|
Yap_ReleaseAtom(AtomFoundVar);
|
|
SF_STORE->AtFreeTerm = Yap_LookupAtom("?");
|
|
Yap_ReleaseAtom(AtomFreeTerm);
|
|
SF_STORE->AtNil = Yap_LookupAtom("[]");
|
|
SF_STORE->AtDot = Yap_LookupAtom(".");
|
|
#else
|
|
Yap_LookupAtomWithAddress("**",&(SF_STORE->AtFoundVar));
|
|
Yap_ReleaseAtom(AtomFoundVar);
|
|
Yap_LookupAtomWithAddress("?",&(SF_STORE->AtFreeTerm));
|
|
Yap_ReleaseAtom(AtomFreeTerm);
|
|
Yap_LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
|
|
Yap_LookupAtomWithAddress(".",&(SF_STORE->AtDot));
|
|
#endif
|
|
}
|
|
|
|
static void
|
|
InitWideAtoms(void)
|
|
{
|
|
int i;
|
|
|
|
WideAtomHashTableSize = MaxWideHash;
|
|
WideHashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxWideHash);
|
|
if (WideHashChain == NULL) {
|
|
Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating wide atom table");
|
|
}
|
|
for (i = 0; i < MaxWideHash; ++i) {
|
|
INIT_RWLOCK(WideHashChain[i].AERWLock);
|
|
WideHashChain[i].Entry = NIL;
|
|
}
|
|
NOfWideAtoms = 0;
|
|
}
|
|
|
|
static void
|
|
InitInvisibleAtoms(void)
|
|
{
|
|
/* initialise invisible chain */
|
|
Yap_heap_regs->invisiblechain.Entry = NIL;
|
|
INIT_RWLOCK(Yap_heap_regs->invisiblechain.AERWLock);
|
|
}
|
|
|
|
#ifdef THREADS
|
|
static void
|
|
InitThreadHandles(void)
|
|
{
|
|
int i;
|
|
for (i=0; i < MAX_THREADS; i++) {
|
|
Yap_heap_regs->thread_handle[i].in_use = FALSE;
|
|
Yap_heap_regs->thread_handle[i].zombie = FALSE;
|
|
Yap_heap_regs->thread_handle[i].local_preds = NULL;
|
|
#ifdef LOW_LEVEL_TRACER
|
|
Yap_heap_regs->thread_handle[i].thread_inst_count = 0LL;
|
|
#endif
|
|
pthread_mutex_init(&Yap_heap_regs->thread_handle[i].tlock, NULL);
|
|
}
|
|
Yap_heap_regs->thread_handle[0].id = 0;
|
|
Yap_heap_regs->thread_handle[0].in_use = TRUE;
|
|
Yap_heap_regs->thread_handle[0].default_yaam_regs =
|
|
&Yap_standard_regs;
|
|
Yap_heap_regs->thread_handle[0].handle = pthread_self();
|
|
Yap_heap_regs->thread_handle[0].handle = pthread_self();
|
|
pthread_mutex_init(&ThreadHandle[0].tlock, NULL);
|
|
pthread_mutex_init(&ThreadHandle[0].tlock_status, NULL);
|
|
Yap_heap_regs->thread_handle[0].tdetach = MkAtomTerm(AtomFalse);
|
|
}
|
|
#endif
|
|
|
|
static void
|
|
InitCodes(void)
|
|
{
|
|
#include "ihstruct.h"
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
{
|
|
int i;
|
|
for (i=0; i < MAX_AGENTS; i++) {
|
|
INIT_LOCK(Yap_heap_regs->wl[i].signal_lock);
|
|
Yap_heap_regs->wl[i].active_signals = 0;
|
|
Yap_heap_regs->wl[i].scratchpad.ptr = NULL;
|
|
Yap_heap_regs->wl[i].scratchpad.sz = SCRATCH_START_SIZE;
|
|
Yap_heap_regs->wl[i].scratchpad.msz = SCRATCH_START_SIZE;
|
|
Yap_heap_regs->wl[i].dynamic_arrays = NULL;
|
|
Yap_heap_regs->wl[i].static_arrays = NULL;
|
|
Yap_heap_regs->wl[i].global_variables = NULL;
|
|
Yap_heap_regs->wl[i].global_arena = 0L;
|
|
Yap_heap_regs->wl[i].global_arena_overflows = 0;
|
|
Yap_heap_regs->wl[i].global_delay_arena = 0L;
|
|
Yap_heap_regs->wl[i].allow_restart = FALSE;
|
|
Yap_heap_regs->wl[i].tot_gc_time = 0;
|
|
Yap_heap_regs->wl[i].tot_gc_recovered = 0;
|
|
Yap_heap_regs->wl[i].gc_calls = 0;
|
|
Yap_heap_regs->wl[i].last_gc_time = 0;
|
|
Yap_heap_regs->wl[i].last_ss_time = 0;
|
|
Yap_heap_regs->wl[i].consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity);
|
|
if (Yap_heap_regs->wl[i].consultlow == NULL) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes");
|
|
return;
|
|
}
|
|
Yap_heap_regs->wl[i].consultcapacity = InitialConsultCapacity;
|
|
Yap_heap_regs->wl[i].consultbase = Yap_heap_regs->wl[i].consultsp =
|
|
Yap_heap_regs->wl[i].consultlow + Yap_heap_regs->wl[i].consultcapacity;
|
|
Yap_heap_regs->wl[i].Gc_timestamp = 0;
|
|
}
|
|
Yap_heap_regs->wl[i].ball_term = NULL;
|
|
}
|
|
#else
|
|
Yap_heap_regs->wl.dynamic_arrays = NULL;
|
|
Yap_heap_regs->wl.static_arrays = NULL;
|
|
Yap_heap_regs->wl.global_variables = NULL;
|
|
Yap_heap_regs->wl.global_arena = 0L;
|
|
Yap_heap_regs->wl.global_arena_overflows = 0;
|
|
Yap_heap_regs->wl.allow_restart = FALSE;
|
|
Yap_heap_regs->wl.global_delay_arena = 0L;
|
|
Yap_heap_regs->wl.tot_gc_time = 0;
|
|
Yap_heap_regs->wl.tot_gc_recovered = 0;
|
|
Yap_heap_regs->wl.gc_calls = 0;
|
|
Yap_heap_regs->wl.last_gc_time = 0;
|
|
Yap_heap_regs->wl.last_ss_time = 0;
|
|
Yap_heap_regs->wl.consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity);
|
|
if (Yap_heap_regs->wl.consultlow == NULL) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes");
|
|
return;
|
|
}
|
|
Yap_heap_regs->wl.consultcapacity = InitialConsultCapacity;
|
|
Yap_heap_regs->wl.consultbase = Yap_heap_regs->wl.consultsp =
|
|
Yap_heap_regs->wl.consultlow + Yap_heap_regs->wl.consultcapacity;
|
|
Yap_heap_regs->wl.ball_term = NULL;
|
|
#endif /* YAPOR */
|
|
|
|
/* make sure no one else can use these two atoms */
|
|
CurrentModule = 0;
|
|
Yap_ReleaseAtom(AtomOfTerm(Yap_heap_regs->term_refound_var));
|
|
/* make sure we have undefp defined */
|
|
/* predicates can only be defined after this point */
|
|
{
|
|
/* make sure we know about the module predicate */
|
|
PredEntry *modp = RepPredProp(PredPropByFunc(FunctorModule,PROLOG_MODULE));
|
|
modp->PredFlags |= MetaPredFlag;
|
|
}
|
|
#ifdef YAPOR
|
|
Yap_heap_regs->getwork_code->u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
|
|
Yap_heap_regs->getwork_seq_code->u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
|
|
#endif /* YAPOR */
|
|
|
|
}
|
|
|
|
|
|
static void
|
|
InitVersion(void)
|
|
{
|
|
Yap_PutValue(AtomVersionNumber,
|
|
MkAtomTerm(Yap_LookupAtom(YAP_SVERSION)));
|
|
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
|
|
Yap_PutValue(AtomMyddasVersionName,
|
|
MkAtomTerm(Yap_LookupAtom(MYDDAS_VERSION)));
|
|
#endif
|
|
}
|
|
|
|
void
|
|
Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_size,
|
|
int n_workers, int sch_loop, int delay_load)
|
|
{
|
|
int i;
|
|
|
|
/* initialise system stuff */
|
|
|
|
#if PUSH_REGS
|
|
#ifdef THREADS
|
|
pthread_key_create(&Yap_yaamregs_key, NULL);
|
|
pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
|
|
#else
|
|
/* In this case we need to initialise the abstract registers */
|
|
Yap_regp = &Yap_standard_regs;
|
|
/* the emulator will eventually copy them to its own local
|
|
register array, but for now they exist */
|
|
#endif
|
|
#endif /* PUSH_REGS */
|
|
|
|
#ifdef THREADS
|
|
Yap_regp->worker_id_ = 0;
|
|
#endif
|
|
/* Init signal handling and time */
|
|
/* also init memory page size, required by later functions */
|
|
Yap_InitSysbits ();
|
|
|
|
if (Heap < MinHeapSpace)
|
|
Heap = MinHeapSpace;
|
|
Heap = AdjustPageSize(Heap * K);
|
|
/* sanity checking for data areas */
|
|
if (Trail < MinTrailSpace)
|
|
Trail = MinTrailSpace;
|
|
Trail = AdjustPageSize(Trail * K);
|
|
if (Stack < MinStackSpace)
|
|
Stack = MinStackSpace;
|
|
Stack = AdjustPageSize(Stack * K);
|
|
if (!Atts)
|
|
Atts = 2048*sizeof(CELL);
|
|
else
|
|
Atts = AdjustPageSize(Atts * K);
|
|
#if defined(YAPOR) && !defined(THREADS)
|
|
worker_id = 0;
|
|
if (n_workers > MAX_WORKERS)
|
|
Yap_Error(INTERNAL_ERROR, TermNil, "excessive number of workers (Yap_InitWorkspace)");
|
|
#ifdef ENV_COPY
|
|
INFORMATION_MESSAGE("YapOr: copy model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
|
|
#elif ACOW
|
|
INFORMATION_MESSAGE("YapOr: acow model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
|
|
#else /* SBA */
|
|
INFORMATION_MESSAGE("YapOr: sba model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
|
|
#endif /* ENV_COPY - ACOW - SBA */
|
|
map_memory(Heap, Stack+Atts, Trail, n_workers);
|
|
#else
|
|
Yap_InitMemory (Trail, Heap, Stack+Atts);
|
|
#endif /* YAPOR && !THREADS */
|
|
#if defined(YAPOR) || defined(TABLING)
|
|
Yap_init_global(max_table_size, n_workers, sch_loop, delay_load);
|
|
#endif /* YAPOR || TABLING */
|
|
Yap_AttsSize = Atts;
|
|
|
|
Yap_InitTime ();
|
|
/* InitAbsmi must be done before InitCodes */
|
|
/* This must be done before initialising predicates */
|
|
for (i = 0; i <= LAST_FLAG; i++) {
|
|
yap_flags[i] = 0;
|
|
}
|
|
ActiveSignals = 0;
|
|
DoingUndefp = FALSE;
|
|
DelayArenaOverflows = 0;
|
|
ArenaOverflows = 0;
|
|
DepthArenas = 0;
|
|
DBErasedList = NULL;
|
|
DBErasedIList = NULL;
|
|
Yap_heap_regs->IntLUKeys = NULL;
|
|
#ifdef MPW
|
|
Yap_InitAbsmi(REGS, FunctorList);
|
|
#else
|
|
Yap_InitAbsmi();
|
|
#endif
|
|
InitCodes();
|
|
InitOps();
|
|
InitDebug();
|
|
InitVersion();
|
|
Yap_InitSysPath();
|
|
InitStdPreds();
|
|
/* make sure tmp area is available */
|
|
{
|
|
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
|
|
}
|
|
}
|
|
|
|
void
|
|
Yap_exit (int value)
|
|
{
|
|
#if defined(YAPOR) && !defined(THREADS)
|
|
unmap_memory();
|
|
#endif /* YAPOR */
|
|
|
|
#ifdef LOW_PROF
|
|
remove("PROFPREDS");
|
|
remove("PROFILING");
|
|
#endif
|
|
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
|
|
Yap_MYDDAS_delete_all_myddas_structs();
|
|
#endif
|
|
if (! (Yap_PrologMode & BootMode) )
|
|
Yap_ShutdownLoadForeign();
|
|
exit(value);
|
|
}
|
|
|