This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/init.c

1539 lines
40 KiB
C
Raw Normal View History

/*************************************************************************
* *
* 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
/*
2015-02-03 02:36:51 +00:00
* The code from this file is used to initialize the environment for prolog
*
*/
2010-08-31 03:51:44 +01:00
#include <stdlib.h>
#include "Yap.h"
2013-11-25 10:22:44 +00:00
#include "clause.h"
2013-11-15 01:10:25 +00:00
#include "pl-shared.h"
#include "yapio.h"
#include "alloc.h"
#include "Foreign.h"
#include "SWI-Prolog.h"
#ifdef LOW_LEVEL_TRACER
#include "tracer.h"
#endif
#ifdef YAPOR
2011-06-02 17:01:00 +01:00
#ifdef YAPOR_COW
#include <signal.h>
#endif /* YAPOR_COW */
#include "or.macros.h"
2011-06-02 17:01:00 +01:00
#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
2013-11-16 00:27:02 +00:00
int Yap_output_msg = FALSE;
2013-11-15 18:25:33 +00:00
#if DEBUG
#define LOGFILE "logfile"
#ifdef MACC
2013-04-25 23:15:04 +01:00
static void InTTYLine(char *);
#endif
#endif
2013-04-25 23:15:04 +01:00
static void SetOp(int, int, char *, Term);
static void InitOps(void);
static void InitDebug(void);
static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
static void InitStdPreds(void);
static void InitFlags(void);
static void InitCodes(void);
static void InitVersion(void);
void exit(int);
2011-03-11 19:49:32 +00:00
static void InitWorker(int wid);
/************** YAP PROLOG GLOBAL VARIABLES *************************/
/************* variables related to memory allocation ***************/
2009-10-30 23:59:00 +00:00
ADDR Yap_HeapBase;
/************** 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 DEBUG
#if COROUTINING
int Yap_Portray_delays = FALSE;
#endif
#endif
2014-09-15 09:13:50 +01:00
/**
@defgroup Operators Summary of YAP Predefined Operators
@ingroup Syntax
@{
2015-02-03 02:36:51 +00:00
2014-09-15 09:13:50 +01:00
The Prolog syntax caters for operators of three main kinds:
+ prefix;
+ infix;
+ postfix.
2015-02-03 02:36:51 +00:00
Each operator has precedence in the range 1 to 1200, and this
precedence is used to disambiguate expressions where the structure of the
term denoted is not made explicit using brackets. The operator of higher
2014-09-15 09:13:50 +01:00
precedence is the main functor.
2015-02-03 02:36:51 +00:00
If there are two operators with the highest precedence, the ambiguity
is solved analyzing the types of the operators. The possible infix types are:
2014-09-15 09:13:50 +01:00
_xfx_, _xfy_, and _yfx_.
2015-02-03 02:36:51 +00:00
With an operator of type _xfx_ both sub-expressions must have lower
precedence than the operator itself, unless they are bracketed (which
assigns to them zero precedence). With an operator type _xfy_ only the
left-hand sub-expression must have lower precedence. The opposite happens
2014-09-15 09:13:50 +01:00
for _yfx_ type.
2015-02-03 02:36:51 +00:00
A prefix operator can be of type _fx_ or _fy_.
A postfix operator can be of type _xf_ or _yf_.
2014-09-15 09:13:50 +01:00
The meaning of the notation is analogous to the above.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
a + b * c
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
means
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
a + (b * c)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
as + and \* have the following types and precedences:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:-op(500,yfx,'+').
:-op(400,yfx,'*').
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Now defining
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:-op(700,xfy,'++').
:-op(700,xfx,'=:=').
a ++ b =:= c
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
means
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
a ++ (b =:= c)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following is the list of the declarations of the predefined operators:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:-op(1200,fx,['?-', ':-']).
:-op(1200,xfx,[':-','-->']).
:-op(1150,fx,[block,dynamic,mode,public,multifile,meta_predicate,
sequential,table,initialization]).
:-op(1100,xfy,[';','|']).
:-op(1050,xfy,->).
:-op(1000,xfy,',').
:-op(999,xfy,'.').
:-op(900,fy,['\+', not]).
:-op(900,fx,[nospy, spy]).
:-op(700,xfx,[@>=,@=<,@<,@>,<,=,>,=:=,=\=,\==,>=,=<,==,\=,=..,is]).
:-op(500,yfx,['\/','/\','+','-']).
:-op(500,fx,['+','-']).
:-op(400,yfx,['<<','>>','//','*','/']).
:-op(300,xfx,mod).
:-op(200,xfy,['^','**']).
:-op(50,xfx,same).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
#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);
}
2015-02-03 02:36:51 +00:00
static int
2014-05-25 20:46:04 +01:00
OpDec(int p, const char *type, Atom a, Term m)
{
int i;
AtomEntry *ae = RepAtom(a);
OpEntry *info;
2009-11-20 00:33:14 +00:00
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);
2009-11-20 00:33:14 +00:00
info = Yap_GetOpPropForAModuleHavingALock(ae, m);
if (EndOfPAEntr(info)) {
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
info->KindOfPE = Ord(OpProperty);
info->OpModule = m;
info->OpName = a;
//LOCK(OpListLock);
info->OpNext = OpList;
OpList = info;
//UNLOCK(OpListLock);
AddPropToAtom(ae, (PropEntry *)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) {
2013-11-15 15:45:55 +00:00
GET_LD
2015-02-03 02:36:51 +00:00
if (truePrologFlag(PLFLAG_ISO) &&
info->Posfix != 0) /* there is a posfix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
2009-11-20 00:33:14 +00:00
return FALSE;
}
info->Infix = p;
} else if (i <= 5) {
2013-11-15 15:45:55 +00:00
GET_LD
2015-02-03 02:36:51 +00:00
if (truePrologFlag(PLFLAG_ISO) &&
info->Infix != 0) /* there is an infix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
2009-11-20 00:33:14 +00:00
return FALSE;
}
info->Posfix = p;
} else {
info->Prefix = p;
}
WRITE_UNLOCK(info->OpRWLock);
return (TRUE);
}
2015-02-03 02:36:51 +00:00
int
Yap_OpDec(int p, char *type, Atom a, Term m)
{
return(OpDec(p,type,a,m));
}
2015-02-03 02:36:51 +00:00
static void
SetOp(int p, int type, char *at, Term m)
{
2013-11-15 18:25:33 +00:00
#if DEBUG
if (GLOBAL_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 */
2015-02-03 02:36:51 +00:00
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:*/
2009-11-27 15:55:46 +00:00
{"|", 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},
{"rdiv", yfx, 400},
2010-08-31 03:51:44 +01:00
{"div", yfx, 400},
2012-02-13 09:37:16 +00:00
{"xor", yfx, 400},
{"*", yfx, 400},
{"/", yfx, 400},
2008-08-24 00:46:20 +01:00
{"//", yfx, 400},
{"<<", yfx, 400},
{">>", yfx, 400},
{"mod", yfx, 400},
{"rem", yfx, 400},
{"+", fy, 200},
2009-11-11 10:54:38 +00:00
{"-", fy, 200},
{"\\", fy, 200},
{"//", yfx, 400},
{"**", xfx, 200},
{"^", xfy, 200}
};
2015-02-03 02:36:51 +00:00
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);
}
2014-09-15 09:13:50 +01:00
/// @}
2013-11-15 18:25:33 +00:00
#if DEBUG
#ifdef HAVE_ISATTY
#include <unistd.h>
#endif
#endif
2015-02-03 02:36:51 +00:00
static void
InitDebug(void)
{
Atom At;
2013-11-15 18:25:33 +00:00
#if DEBUG
int i;
for (i = 1; i < 20; ++i)
GLOBAL_Option[i] = 0;
2011-06-20 14:49:24 +01:00
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')
GLOBAL_Option[ch - 'a' + 1] = 1;
if (GLOBAL_Option['l' - 96]) {
GLOBAL_logfile = fopen(LOGFILE, "w");
if (GLOBAL_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));
}
2015-02-03 02:36:51 +00:00
static UInt
update_flags_from_prolog(UInt flags, PredEntry *pe)
{
if (pe->PredFlags & MetaPredFlag)
flags |= MetaPredFlag;
if (pe->PredFlags & SourcePredFlag)
flags |= SourcePredFlag;
if (pe->PredFlags & SequentialPredFlag)
flags |= SequentialPredFlag;
if (pe->PredFlags & UDIPredFlag)
flags |= UDIPredFlag;
if (pe->PredFlags & ModuleTransparentPredFlag)
flags |= ModuleTransparentPredFlag;
2015-03-04 09:54:08 +00:00
if (pe->PredFlags & StandardPredFlag)
flags |= StandardPredFlag;
return flags;
}
2015-02-03 02:36:51 +00:00
void
Yap_InitCPred(const char *Name, UInt Arity, CPredicate code, pred_flags_t flags)
{
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
yamop *p_code;
StaticClause *cl = NULL;
2008-10-07 23:52:26 +01:00
Functor f = NULL;
while (atom == NIL) {
if (flags & UserCPredFlag)
atom = Yap_LookupAtom(Name);
else
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
return;
}
}
2008-10-07 23:52:26 +01:00
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)
2008-10-07 23:52:26 +01:00
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;
}
2015-02-03 02:36:51 +00:00
}
if (pe->PredFlags & CPredFlag) {
/* already exists */
flags = update_flags_from_prolog(flags, pe);
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.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
}
}
pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
2014-02-09 11:00:01 +00:00
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
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);
2014-05-30 01:06:09 +01:00
p_code->y_u.Osbpp.bmap = NULL;
p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
p_code->y_u.Osbpp.p =
p_code->y_u.Osbpp.p0 =
pe;
p_code = NEXTOP(p_code,Osbpp);
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate);
2014-05-30 01:06:09 +01:00
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code,p);
}
p_code->opc = Yap_opcode(_procceed);
2014-05-30 01:06:09 +01:00
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
2014-05-30 01:06:09 +01:00
p_code->y_u.l.l = cl->ClCode;
pe->OpcodeOfPred = pe->CodeOfPred->opc;
}
2015-02-09 01:53:28 +00:00
bool
Yap_AddCallToFli( PredEntry *pe, CPredicate call )
{
yamop *p_code;
if (pe->PredFlags & BackCPredFlag) {
p_code = (yamop *)(pe->cs.p_code.FirstClause);
p_code->y_u.OtapFs.f = call;
return true;
} else if (pe->PredFlags & CPredFlag) {
pe->cs.f_code = call;
return true;
} else {
return false;
}
}
bool
Yap_AddRetryToFli( PredEntry *pe, CPredicate re )
{
yamop *p_code;
if (pe->PredFlags & BackCPredFlag) {
p_code = (yamop *)(pe->cs.p_code.FirstClause);
p_code = NEXTOP(p_code,OtapFs);
p_code->y_u.OtapFs.f = re;
return true;
} else {
return false;
}
}
bool
Yap_AddCutToFli( PredEntry *pe, CPredicate CUT )
{
yamop *p_code;
if (pe->PredFlags & BackCPredFlag) {
p_code = (yamop *)(pe->cs.p_code.FirstClause);
p_code = NEXTOP(p_code,OtapFs);
p_code = NEXTOP(p_code,OtapFs);
p_code->y_u.OtapFs.f = CUT;
return true;
} else {
return false;
}
}
2015-02-03 02:36:51 +00:00
void
Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, pred_flags_t flags)
{
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
yamop *p_code = NULL;
2015-02-03 02:36:51 +00:00
StaticClause *cl = NULL;
2008-10-07 23:52:26 +01:00
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;
}
}
2008-10-07 23:52:26 +01:00
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)
2008-10-07 23:52:26 +01:00
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;
}
2015-02-03 02:36:51 +00:00
}
2014-10-02 14:34:51 +01:00
if (pe->PredFlags & BinaryPredFlag) {
flags = update_flags_from_prolog(flags, pe);
p_code = pe->CodeOfPred;
/* already exists */
} else {
while (!cl) {
2008-08-21 13:38:25 +01:00
UInt sz = sizeof(StaticClause)+(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL),plxxs),p),l);
2015-02-03 02:36:51 +00:00
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;
2015-03-04 09:54:08 +00:00
cl->ClFlags = StaticMask|StandardPredFlag;
cl->ClNext = NULL;
cl->ClSize = sz;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
break;
}
}
}
2014-10-02 14:34:51 +01:00
//pe->PredFlags = flags | StandardPredFlag;
pe->CodeOfPred = p_code;
pe->cs.d_code = cmp_code;
pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
2014-05-30 01:06:09 +01:00
p_code->y_u.plxxs.p = pe;
p_code->y_u.plxxs.f = FAILCODE;
p_code->y_u.plxxs.x1 = Yap_emit_x(1);
p_code->y_u.plxxs.x2 = Yap_emit_x(2);
p_code->y_u.plxxs.flags = Yap_compile_cmp_flags(pe);
2008-08-21 13:38:25 +01:00
p_code = NEXTOP(p_code,plxxs);
p_code->opc = Yap_opcode(_procceed);
2014-05-30 01:06:09 +01:00
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
2014-05-30 01:06:09 +01:00
p_code->y_u.l.l = cl->ClCode;
}
2015-02-03 02:36:51 +00:00
void
Yap_InitAsmPred(const char *Name, UInt Arity, int code, CPredicate def, pred_flags_t flags)
{
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
2008-10-07 23:52:26 +01:00
Functor f = NULL;
2015-02-03 02:36:51 +00:00
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;
}
}
2008-10-07 23:52:26 +01:00
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)
2008-10-07 23:52:26 +01:00
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;
}
2015-02-03 02:36:51 +00:00
}
flags |= AsmPredFlag | StandardPredFlag | (code);
if (pe->PredFlags & AsmPredFlag) {
flags = update_flags_from_prolog(flags, pe);
/* already exists */
}
pe->PredFlags = flags;
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));
2015-02-03 02:36:51 +00:00
}
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.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
pe->CodeOfPred = p_code;
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate);
p_code = NEXTOP(p_code,e);
}
2012-05-07 06:53:27 +01:00
p_code->opc = Yap_opcode(_call_cpred);
2014-05-30 01:06:09 +01:00
p_code->y_u.Osbpp.bmap = NULL;
p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
p_code = NEXTOP(p_code,Osbpp);
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate);
2014-05-30 01:06:09 +01:00
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code,p);
}
p_code->opc = Yap_opcode(_procceed);
2014-05-30 01:06:09 +01:00
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
2014-05-30 01:06:09 +01:00
p_code->y_u.l.l = cl->ClCode;
2012-05-07 06:53:27 +01:00
pe->OpcodeOfPred = pe->CodeOfPred->opc;
} else {
pe->OpcodeOfPred = Yap_opcode(_undef_p);
2015-02-03 02:36:51 +00:00
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
}
}
2015-02-03 02:36:51 +00:00
static void
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut)
{
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,
2015-02-09 01:53:28 +00:00
"initiating a C Pred with backtracking");
return;
}
code = (yamop *)(pe->cs.p_code.FirstClause);
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.p = pe;
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 */
2014-05-30 01:06:09 +01:00
code->y_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 */
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.f = Cont;
code = NEXTOP(code,OtapFs);
if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_cut_c);
else
code->opc = Yap_opcode(_cut_userc);
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.f = Cut;
}
2015-02-03 02:36:51 +00:00
void
2014-05-25 20:46:04 +01:00
Yap_InitCPredBack(const char *Name, UInt Arity,
unsigned int Extra, CPredicate Start,
CPredicate Cont, pred_flags_t flags){
Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,NULL,flags);
}
void
2014-05-25 20:46:04 +01:00
Yap_InitCPredBackCut(const char *Name, UInt Arity,
unsigned int Extra, CPredicate Start,
CPredicate Cont,CPredicate Cut, pred_flags_t flags){
Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags);
}
void
2014-05-25 20:46:04 +01:00
Yap_InitCPredBack_(const char *Name, UInt Arity,
unsigned int Extra, CPredicate Start,
CPredicate Cont, CPredicate Cut, pred_flags_t flags)
{
CACHE_REGS
PredEntry *pe = NULL;
Atom atom = NIL;
2008-10-07 23:52:26 +01:00
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;
}
}
2008-10-07 23:52:26 +01:00
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)
2008-10-07 23:52:26 +01:00
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;
}
2015-02-03 02:36:51 +00:00
}
if (pe->cs.p_code.FirstClause != NIL)
{
2015-02-03 02:36:51 +00:00
flags = update_flags_from_prolog(flags, pe);
CleanBack(pe, Start, Cont, Cut);
}
else {
StaticClause *cl;
yamop *code = ((StaticClause *)NULL)->ClCode;
UInt sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
2015-02-03 02:36:51 +00:00
if (flags & UserCPredFlag)
2015-03-04 09:54:08 +00:00
pe->PredFlags = UserCPredFlag | BackCPredFlag| CompiledPredFlag | flags;
else
2011-08-31 21:59:30 +01:00
pe->PredFlags = CompiledPredFlag | StandardPredFlag | BackCPredFlag;
#ifdef YAPOR
pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
2015-02-03 02:36:51 +00:00
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
2015-02-03 02:36:51 +00:00
if (cl == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
return;
}
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
Yap_ClauseSpace += sz;
2015-02-03 02:36:51 +00:00
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e);
cl->usc.ClLine = Yap_source_line_no();
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);
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.f = Start;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_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);
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.f = Cont;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_u.OtapFs.extra = Extra;
#ifdef YAPOR
INIT_YAMOP_LTT(code, 1);
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
code = NEXTOP(code,OtapFs);
if (flags & UserCPredFlag)
code->opc = Yap_opcode(_cut_userc);
else
code->opc = Yap_opcode(_cut_c);
2014-05-30 01:06:09 +01:00
code->y_u.OtapFs.f = Cut;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_u.OtapFs.extra = Extra;
code = NEXTOP(code,OtapFs);
code->opc = Yap_opcode(_Ystop);
2014-05-30 01:06:09 +01:00
code->y_u.l.l = cl->ClCode;
}
}
2015-02-03 02:36:51 +00:00
static void
InitStdPreds(void)
{
2013-03-20 02:25:46 +00:00
void initIO(void);
2015-02-03 02:36:51 +00:00
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
Yap_InitYaamRegs( 0 );
#if HAVE_MPE
Yap_InitMPE ();
#endif
initIO();
}
static void
InitFlags(void)
{
/* note that Yap_heap_regs must be set first */
yap_flags[LANGUAGE_MODE_FLAG] = 0;
yap_flags[FLOATING_POINT_EXCEPTION_MODE_FLAG] = TRUE;
yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
2011-04-29 19:29:22 +01:00
/* we do not garantee safe assert in parallel mode */
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE;
/* current default */
yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
yap_flags[TABLING_MODE_FLAG] = 0;
yap_flags[QUIET_MODE_FLAG] = FALSE;
yap_flags[INDEXING_TERM_DEPTH_FLAG] = 0L;
}
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);
2014-05-30 01:06:09 +01:00
ipc->y_u.Osbpp.s = -Signed(RealEnvSize);
ipc->y_u.Osbpp.bmap = NULL;
ipc->y_u.Osbpp.p = pred;
ipc->y_u.Osbpp.p0 = pred;
ipc = NEXTOP(ipc, Osbpp);
ipc->opc = Yap_opcode(opc);
*instp = ipc;
}
static void
2009-10-30 23:59:00 +00:00
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);
2014-05-30 01:06:09 +01:00
ipc->y_u.Otapl.s = 0;
ipc->y_u.Otapl.p = pe;
ipc->y_u.Otapl.d = NULL;
#ifdef YAPOR
INIT_YAMOP_LTT(ipc, 1);
#endif /* YAPOR */
#ifdef TABLING
2014-05-30 01:06:09 +01:00
ipc->y_u.Otapl.te = NULL;
#endif /* TABLING */
}
2015-02-03 02:36:51 +00:00
static void
2009-10-28 15:53:23 +00:00
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;
}
2015-02-03 02:36:51 +00:00
static void
2009-10-28 15:53:23 +00:00
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->lusl.ClSource = NULL;
2009-10-28 15:53:23 +00:00
Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
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);
}
2015-02-03 02:36:51 +00:00
static void
InitSWIAtoms(void)
{
extern atom_t ATOM_;
2013-10-08 13:04:30 +01:00
int j=0;
MaxAtomTranslations = 2*N_SWI_ATOMS ;
SWI_Atoms = (Atom *)malloc(sizeof(Atom)*MaxAtomTranslations);
2014-10-02 14:34:51 +01:00
SWI_Functors = (Functor *)malloc(sizeof(Functor)*2*N_SWI_ATOMS);
#include "iswiatoms.h"
Yap_InitSWIHash();
ATOM_ = PL_new_atom("");
}
2015-02-03 02:36:51 +00:00
static void
2013-04-30 21:23:01 +01:00
InitEmptyWakeups(void)
{
}
2015-02-03 02:36:51 +00:00
static void
2009-10-30 23:59:00 +00:00
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;
2015-03-16 17:25:09 +00:00
#if OLD_STYLE_INITIAL_ATOMS
2015-02-09 01:53:28 +00:00
Yap_LookupAtomWithAddress("**",(AtomEntry *)&(SF_STORE->AtFoundVar));
Yap_ReleaseAtom(AtomFoundVar);
Yap_LookupAtomWithAddress("?",(AtomEntry *)&(SF_STORE->AtFreeTerm));
2009-10-30 23:59:00 +00:00
Yap_ReleaseAtom(AtomFreeTerm);
2015-02-09 01:53:28 +00:00
Yap_LookupAtomWithAddress("[]",(AtomEntry *)&(SF_STORE->AtNil));
Yap_LookupAtomWithAddress(".",(AtomEntry *)&(SF_STORE->AtDot));
2015-03-16 17:25:09 +00:00
#else
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(".");
#endif
2009-10-30 23:59:00 +00:00
}
2015-02-03 02:36:51 +00:00
static void
2009-10-30 23:59:00 +00:00
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;
}
2015-02-03 02:36:51 +00:00
static void
2009-10-30 23:59:00 +00:00
InitInvisibleAtoms(void)
{
2009-03-24 13:27:36 +00:00
/* initialise invisible chain */
Yap_heap_regs->invisiblechain.Entry = NIL;
INIT_RWLOCK(Yap_heap_regs->invisiblechain.AERWLock);
2009-10-30 23:59:00 +00:00
}
#ifdef YAPOR
void Yap_init_yapor_workers(void) {
CACHE_REGS
int proc;
#ifdef YAPOR_THREADS
return;
#endif /* YAPOR_THREADS */
#ifdef YAPOR_COW
2011-06-02 17:01:00 +01:00
GLOBAL_master_worker = getpid();
if (GLOBAL_number_workers > 1) {
int son;
son = fork();
if (son == -1)
Yap_Error(FATAL_ERROR, TermNil, "fork error (Yap_init_yapor_workers)");
if (son > 0) {
/* I am the father, I must stay here and wait for my children to all die */
struct sigaction sigact;
sigact.sa_handler = SIG_DFL;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = SA_RESTART;
sigaction(SIGINT, &sigact, NULL);
pause();
exit(0);
} else
GLOBAL_worker_pid(0) = getpid();
}
#endif /* YAPOR_COW */
for (proc = 1; proc < GLOBAL_number_workers; proc++) {
int son;
son = fork();
if (son == -1)
Yap_Error(FATAL_ERROR, TermNil, "fork error (Yap_init_yapor_workers)");
2015-02-03 02:36:51 +00:00
if (son == 0) {
/* new worker */
worker_id = proc;
2011-06-02 17:01:00 +01:00
Yap_remap_yapor_memory();
LOCAL = REMOTE(worker_id);
2011-06-02 17:01:00 +01:00
memcpy(REMOTE(worker_id), REMOTE(0), sizeof(struct worker_local));
InitWorker(worker_id);
break;
} else
GLOBAL_worker_pid(proc) = son;
}
}
#endif /* YAPOR */
#ifdef THREADS
2010-06-19 14:38:04 +01:00
static void
InitThreadHandle(int wid)
2009-10-30 23:59:00 +00:00
{
REMOTE_ThreadHandle(wid).in_use = FALSE;
REMOTE_ThreadHandle(wid).zombie = FALSE;
REMOTE_ThreadHandle(wid).local_preds = NULL;
#ifdef LOW_LEVEL_TRACER
REMOTE_ThreadHandle(wid).thread_inst_count = 0LL;
#endif
2015-02-03 02:36:51 +00:00
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock), NULL);
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock_status), NULL);
REMOTE_ThreadHandle(wid).tdetach = (CELL)0;
REMOTE_ThreadHandle(wid).cmod = (CELL)0;
2014-10-13 12:34:52 +01:00
{
mbox_t * mboxp = &REMOTE_ThreadHandle(wid).mbox_handle;
pthread_mutex_t *mutexp;
pthread_cond_t *condp;
struct idb_queue *msgsp;
mboxp->name = MkIntTerm(0);
condp = & mboxp->cond;
pthread_cond_init(condp, NULL);
mutexp = & mboxp->mutex;
pthread_mutex_init(mutexp, NULL);
msgsp = & mboxp->msgs;
mboxp->nmsgs = 0;
mboxp->nclients = 0;
mboxp->open = true;
2014-10-13 12:34:52 +01:00
Yap_init_tqueue(msgsp);
}
2009-10-30 23:59:00 +00:00
}
2011-03-11 19:49:32 +00:00
int
Yap_InitThread(int new_id)
{
struct worker_local *new_s;
if (new_id) {
if (!(new_s = (struct worker_local *)calloc(sizeof(struct worker_local), 1)))
return FALSE;
Yap_local[new_id] = new_s;
if (!((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))) {
REGSTORE *rs = (REGSTORE *)calloc(sizeof(REGSTORE),1);
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
REMOTE_ThreadHandle(new_id).default_yaam_regs = rs;
2013-11-15 01:10:25 +00:00
REMOTE_ThreadHandle(new_id).current_yaam_regs = rs;
rs->worker_id_ = new_id;
rs->worker_local_ = REMOTE(new_id);
}
2011-03-11 19:49:32 +00:00
}
InitWorker(new_id);
return TRUE;
}
#endif
2009-10-30 23:59:00 +00:00
static void
InitScratchPad(int wid)
{
REMOTE_ScratchPad(wid).ptr = NULL;
REMOTE_ScratchPad(wid).sz = SCRATCH_START_SIZE;
REMOTE_ScratchPad(wid).msz = SCRATCH_START_SIZE;
}
2015-02-03 02:36:51 +00:00
static CELL *
InitHandles(int wid) {
size_t initial_slots = 1024;
CELL *handles;
2015-02-03 02:36:51 +00:00
REMOTE_CurSlot(wid) = 1;
REMOTE_NSlots(wid) = initial_slots;
handles = malloc(initial_slots * sizeof(CELL));
2015-02-03 02:36:51 +00:00
if(handles == NULL) {
Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "No space for handles at " __FILE__ " : %d", __LINE__);
}
2015-02-03 02:36:51 +00:00
RESET_VARIABLE(handles);
return handles;
}
void
Yap_CloseScratchPad(void)
{
CACHE_REGS
2011-05-04 10:11:41 +01:00
Yap_FreeCodeSpace(LOCAL_ScratchPad.ptr);
LOCAL_ScratchPad.sz = SCRATCH_START_SIZE;
LOCAL_ScratchPad.msz = SCRATCH_START_SIZE;
}
#include "iglobals.h"
2011-03-23 16:45:47 +00:00
#include "ilocals.h"
2009-10-30 23:59:00 +00:00
2011-04-29 14:59:17 +01:00
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
struct global_data *Yap_global;
2011-04-14 19:19:13 +01:00
long Yap_worker_area_size;
#else
struct global_data Yap_Global;
#endif
2011-03-24 16:47:34 +00:00
#if defined(THREADS)
struct worker_local *Yap_local[MAX_THREADS];
2011-03-24 16:47:34 +00:00
#elif defined(YAPOR)
struct worker_local *Yap_local;
#else /* !THREADS && !YAPOR */
struct worker_local Yap_local;
#endif
2015-02-03 02:36:51 +00:00
static void
InitCodes(void)
{
CACHE_REGS
2011-03-11 19:49:32 +00:00
#if THREADS
2011-03-21 17:07:58 +00:00
int wid;
2011-03-24 16:17:18 +00:00
for (wid = 1; wid < MAX_THREADS; wid++) {
Yap_local[wid] = NULL;
2011-03-11 19:49:32 +00:00
}
#endif
#include "ihstruct.h"
#if THREADS
2011-03-11 19:49:32 +00:00
Yap_InitThread(0);
2011-07-26 15:51:52 +01:00
#endif /* THREADS */
InitGlobal();
2011-07-26 15:51:52 +01:00
#if !THREADS
2011-03-11 19:49:32 +00:00
InitWorker(0);
2011-07-26 15:51:52 +01:00
#endif /* THREADS */
Yap_InitFirstWorkerThreadHandle();
/* make sure no one else can use these two atoms */
LOCAL_SourceModule = CurrentModule = 0;
Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));
/* 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
2014-05-30 01:06:09 +01:00
Yap_heap_regs->getwork_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
Yap_heap_regs->getwork_seq_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
#endif /* YAPOR */
2009-10-28 15:53:23 +00:00
}
2015-02-03 02:36:51 +00:00
static void
InitVersion(void)
{
Yap_PutValue(AtomVersionNumber,
2014-02-16 12:57:00 +00:00
MkAtomTerm(Yap_LookupAtom(YAP_FULL_VERSION)));
}
void
2015-02-03 02:36:51 +00:00
Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_size,
int n_workers, int sch_loop, int delay_load)
{
CACHE_REGS
int i;
/* initialise system stuff */
#if PUSH_REGS
#ifdef THREADS
if (!(Yap_local[0] = (struct worker_local *)calloc(sizeof(struct worker_local), 1)))
2011-03-11 19:49:32 +00:00
return;
pthread_key_create(&Yap_yaamregs_key, NULL);
pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
GLOBAL_master_thread = pthread_self();
#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 = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
LOCAL = REMOTE(0);
#endif /* THREADS */
2011-10-13 15:04:16 +01:00
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
LOCAL = REMOTE(0);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
Heap = AdjustPageSize(Heap * K);
2013-03-20 02:25:46 +00:00
Heap /= (K);
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
Trail = AdjustPageSize(Trail * K);
2013-03-20 02:25:46 +00:00
Trail /= (K);
if (Stack < MinStackSpace)
Stack = MinStackSpace;
Stack = AdjustPageSize(Stack * K);
2013-03-20 02:25:46 +00:00
Stack /= (K);
if (!Atts)
Atts = 2048*sizeof(CELL);
else
Atts = AdjustPageSize(Atts * K);
2013-03-20 02:25:46 +00:00
Atts /= (K);
2013-10-04 18:18:57 +01:00
#if defined(THREADS) || defined(YAPOR)
worker_id = 0;
#endif /* YAPOR || THREADS */
#ifdef YAPOR
if (n_workers > MAX_WORKERS)
2011-04-29 14:59:17 +01:00
Yap_Error(INTERNAL_ERROR, TermNil, "excessive number of workers");
2011-03-30 14:35:10 +01:00
#ifdef YAPOR_COPY
INFORMATION_MESSAGE("YapOr: copy model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
2011-03-30 16:39:09 +01:00
#elif YAPOR_COW
INFORMATION_MESSAGE("YapOr: acow model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
2011-04-29 14:59:17 +01:00
#elif YAPOR_SBA
INFORMATION_MESSAGE("YapOr: sba model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
2011-04-29 14:59:17 +01:00
#elif YAPOR_THREADS
INFORMATION_MESSAGE("YapOr: threads model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
#endif /* YAPOR_COPY - YAPOR_COW - YAPOR_SBA - YAPOR_THREADS */
#endif /* YAPOR */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
Yap_init_yapor_stacks_memory(Trail, Heap, Stack+Atts, n_workers);
#else
Yap_InitMemory(Trail, Heap, Stack+Atts);
2011-04-29 14:59:17 +01:00
#endif
#if defined(YAPOR) || defined(TABLING)
Yap_init_global_optyap_data(max_table_size, n_workers, sch_loop, delay_load);
#endif /* YAPOR || TABLING */
Yap_AttsSize = Atts;
Yap_InitTime( 0 );
/* InitAbsmi must be done before InitCodes */
/* This must be done before initialising predicates */
2013-01-09 09:20:41 +00:00
for (i = 0; i < NUMBER_OF_YAP_FLAGS; i++) {
yap_flags[i] = 0;
}
#ifdef MPW
Yap_InitAbsmi(REGS, FunctorList);
#else
Yap_InitAbsmi();
#endif
InitCodes();
InitOps();
InitDebug();
InitVersion();
#if THREADS
/* make sure we use the correct value of regcache */
regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
2013-11-15 01:10:25 +00:00
LOCAL_PL_local_data_p->reg_cache = regcache;
#endif
#if USE_SYSTEM_MALLOC
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
if (Stack < MinStackSpace)
Stack = MinStackSpace;
if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
Yap_Error(RESOURCE_ERROR_MEMORY, 0, "could not allocate stack space for main thread");
Yap_exit(1);
}
#if THREADS
/* don't forget this is a thread */
LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase;
LOCAL_ThreadHandle.tsize = Trail;
LOCAL_ThreadHandle.ssize = Stack;
#endif
#endif
GLOBAL_AllowGlobalExpansion = TRUE;
GLOBAL_AllowLocalExpansion = TRUE;
GLOBAL_AllowTrailExpansion = TRUE;
Yap_InitExStacks (0, Trail, Stack);
InitStdPreds();
/* make sure tmp area is available */
{
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
}
}
int
Yap_HaltRegisterHook (HaltHookFunc f, void * env)
{
struct halt_hook *h;
if (!(h = (struct halt_hook *)Yap_AllocCodeSpace(sizeof(struct halt_hook))))
return FALSE;
h->environment = env;
h->hook = f;
LOCK(GLOBAL_BGL);
h->next = GLOBAL_HaltHooks;
GLOBAL_HaltHooks = h;
UNLOCK(GLOBAL_BGL);
return TRUE;
}
static void
run_halt_hooks(int code)
{
struct halt_hook *hooke = GLOBAL_HaltHooks;
while (hooke) {
hooke->hook(code, hooke->environment);
hooke = hooke->next;
}
}
void
Yap_exit (int value)
{
CACHE_REGS
void closeFiles(int all);
2011-04-29 14:59:17 +01:00
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
2011-06-02 17:01:00 +01:00
Yap_unmap_yapor_memory();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
if (! (LOCAL_PrologMode & BootMode) ) {
#ifdef LOW_PROF
remove("PROFPREDS");
remove("PROFILING");
#endif
run_halt_hooks(value);
Yap_ShutdownLoadForeign();
}
closeFiles(TRUE);
exit(value);
}