whole lot of fixes:
- memory leak in indexing - memory management in WIN32 now supports holes - extend Yap interface, more support for SWI-Interface - new predicate mktime in system - buffer console I/O in WIN32 git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1113 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
23f85a3453
commit
1781ff9420
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2004-07-23 21:08:44 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-08-11 16:14:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.141 2004/07/23 21:08:44 vsc
|
||||
* windows fixes
|
||||
*
|
||||
* Revision 1.140 2004/07/22 21:32:20 vsc
|
||||
* debugger fixes
|
||||
* initial support for JPL
|
||||
@ -1929,6 +1932,7 @@ Yap_absmi(int inp)
|
||||
B = B->cp_b;
|
||||
}
|
||||
trim_trail:
|
||||
HBREG = PROTECT_FROZEN_H(B->cp_b);
|
||||
{
|
||||
tr_fr_ptr pt1, pt0;
|
||||
pt1 = pt0 = B->cp_tr;
|
||||
@ -1984,7 +1988,6 @@ Yap_absmi(int inp)
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
ENDD(d0);
|
||||
GONext();
|
||||
|
||||
107
C/alloc.c
107
C/alloc.c
@ -12,7 +12,7 @@
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: allocating space *
|
||||
* version:$Id: alloc.c,v 1.55 2004-07-28 22:09:01 vsc Exp $ *
|
||||
* version:$Id: alloc.c,v 1.56 2004-08-11 16:14:51 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
@ -565,27 +565,42 @@ Yap_ExpandPreAllocCodeSpace(UInt sz)
|
||||
/* #define MAX_WORKSPACE 0x40000000L */
|
||||
#define MAX_WORKSPACE 0x80000000L
|
||||
|
||||
#define ALLOC_SIZE (64*1024)
|
||||
|
||||
static LPVOID brk;
|
||||
|
||||
static int
|
||||
ExtendWorkSpace(Int s)
|
||||
ExtendWorkSpace(Int s, int fixed_allocation)
|
||||
{
|
||||
LPVOID b = brk;
|
||||
prolog_exec_mode OldPrologMode = Yap_PrologMode;
|
||||
|
||||
s = ((s+ (ALLOC_SIZE-1))/ALLOC_SIZE)*ALLOC_SIZE;
|
||||
Yap_PrologMode = ExtendStackMode;
|
||||
b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
|
||||
if (b) {
|
||||
brk = (LPVOID) ((Int) brk + s);
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
return TRUE;
|
||||
if (fixed_allocation)
|
||||
b = VirtualAlloc(b, s, MEM_RESERVE, PAGE_NOACCESS);
|
||||
else {
|
||||
b = VirtualAlloc(NULL, s, MEM_RESERVE, PAGE_NOACCESS);
|
||||
if (b && b < brk) {
|
||||
return ExtendWorkSpace(s, fixed_allocation);
|
||||
}
|
||||
}
|
||||
Yap_ErrorMessage = Yap_ErrorSay;
|
||||
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
|
||||
"VirtualAlloc could not commit %ld bytes",
|
||||
(long int)s);
|
||||
if (!b) {
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
return FALSE;
|
||||
}
|
||||
b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
|
||||
if (!b) {
|
||||
Yap_ErrorMessage = Yap_ErrorSay;
|
||||
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
|
||||
"VirtualAlloc could not commit %ld bytes",
|
||||
(long int)s);
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
return FALSE;
|
||||
}
|
||||
brk = (LPVOID) ((Int) brk + s);
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static MALLOC_T
|
||||
@ -597,27 +612,30 @@ InitWorkSpace(Int s)
|
||||
|
||||
GetSystemInfo(&si);
|
||||
Yap_page_size = si.dwPageSize;
|
||||
|
||||
|
||||
s = ((s+ (ALLOC_SIZE-1))/ALLOC_SIZE)*ALLOC_SIZE;
|
||||
brk = NULL;
|
||||
for (max_mem = MAX_WORKSPACE; max_mem >= s; max_mem = max_mem - (max_mem >> 2)) {
|
||||
b = VirtualAlloc((LPVOID)MMAP_ADDR, max_mem, MEM_RESERVE, PAGE_NOACCESS);
|
||||
if (b == NULL) {
|
||||
b = VirtualAlloc(NULL, max_mem, MEM_RESERVE, PAGE_NOACCESS);
|
||||
if (b != NULL) {
|
||||
brk = b;
|
||||
fprintf(stderr,"%% Warning: YAP reserving space at variable address %p\n", brk);
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
brk = BASE_ADDRESS;
|
||||
break;
|
||||
b = VirtualAlloc((LPVOID)MMAP_ADDR, s, MEM_RESERVE, PAGE_NOACCESS);
|
||||
if (b == NULL) {
|
||||
b = VirtualAlloc(NULL, max_mem, MEM_RESERVE, PAGE_NOACCESS);
|
||||
if (!b) {
|
||||
fprintf(stderr,"%% Warning: YAP reserving space at variable address %p\n", brk);
|
||||
return NULL;
|
||||
}
|
||||
b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
|
||||
if (b== NULL) {
|
||||
fprintf(stderr,"%% Warning: YAP failed to reserve space at %p\n", brk);
|
||||
return NULL;
|
||||
}
|
||||
} else {
|
||||
b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
|
||||
if (!b) {
|
||||
fprintf(stderr,"%% Warning: YAP failed to reserve space at %p\n", brk);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
if (brk && ExtendWorkSpace(s)) {
|
||||
return (MALLOC_T)b;
|
||||
}
|
||||
Yap_Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
|
||||
return NULL;
|
||||
brk = (LPVOID) ((Int) b + s);
|
||||
return b;
|
||||
}
|
||||
|
||||
int
|
||||
@ -1299,11 +1317,18 @@ Yap_InitExStacks(int Trail, int Stack)
|
||||
{
|
||||
}
|
||||
|
||||
#if defined(_WIN32)
|
||||
#define WorkSpaceTop brk
|
||||
#define MAP_FIXED 1
|
||||
#endif
|
||||
|
||||
int
|
||||
Yap_ExtendWorkSpace(Int s)
|
||||
{
|
||||
#if USE_MMAP
|
||||
return ExtendWorkSpace(s, MAP_FIXED);
|
||||
#elif defined(_WIN32)
|
||||
return ExtendWorkSpace(s, MAP_FIXED);
|
||||
#else
|
||||
return ExtendWorkSpace(s);
|
||||
#endif
|
||||
@ -1312,9 +1337,27 @@ Yap_ExtendWorkSpace(Int s)
|
||||
UInt
|
||||
Yap_ExtendWorkSpaceThroughHole(UInt s)
|
||||
{
|
||||
#if USE_MMAP
|
||||
#if USE_MMAP || defined(_WIN32)
|
||||
MALLOC_T WorkSpaceTop0 = WorkSpaceTop;
|
||||
|
||||
#if SIZEOF_INT_P==4
|
||||
while (WorkSpaceTop < (MALLOC_T)0xc0000000L) {
|
||||
/* progress 1 MB */
|
||||
WorkSpaceTop += 512*1024;
|
||||
if (ExtendWorkSpace(s, MAP_FIXED)) {
|
||||
return WorkSpaceTop-WorkSpaceTop0;
|
||||
}
|
||||
#if defined(_WIN32)
|
||||
/* 487 happens when you step over someone else's memory */
|
||||
if (GetLastError() != 487) {
|
||||
/* I could not manage to allocate the memory*/
|
||||
fprintf(stderr,"I am in trouble here\n");
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
WorkSpaceTop = WorkSpaceTop0;
|
||||
#endif
|
||||
if (ExtendWorkSpace(s, 0))
|
||||
return WorkSpaceTop-WorkSpaceTop0;
|
||||
#endif
|
||||
@ -1324,7 +1367,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s)
|
||||
void
|
||||
Yap_AllocHole(UInt actual_request, UInt total_size)
|
||||
{
|
||||
#if USE_MMAP
|
||||
#if USE_MMAP || defined(_WIN32)
|
||||
/* where we were when the hole was created,
|
||||
also where is the hole store */
|
||||
ADDR WorkSpaceTop0 = WorkSpaceTop-total_size;
|
||||
|
||||
@ -10,8 +10,11 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2004-07-23 03:37:16 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-08-11 16:14:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.52 2004/07/23 03:37:16 vsc
|
||||
* fix heap overflow in YAP_LookupAtom
|
||||
*
|
||||
* Revision 1.51 2004/07/22 21:32:20 vsc
|
||||
* debugger fixes
|
||||
* initial support for JPL
|
||||
@ -49,6 +52,7 @@
|
||||
|
||||
#define Bool int
|
||||
#define flt double
|
||||
#define YAP_Term Term
|
||||
#define C_INTERFACE
|
||||
|
||||
#include "Yap.h"
|
||||
@ -138,6 +142,7 @@ X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int));
|
||||
X_API char *STD_PROTO(YAP_CompileClause, (Term));
|
||||
X_API void STD_PROTO(YAP_PutValue, (Atom,Term));
|
||||
X_API Term STD_PROTO(YAP_GetValue, (Atom));
|
||||
X_API int STD_PROTO(YAP_CompareTerms, (Term,Term));
|
||||
X_API int STD_PROTO(YAP_Reset, (void));
|
||||
X_API void STD_PROTO(YAP_Exit, (int));
|
||||
X_API void STD_PROTO(YAP_InitSocks, (char *, long));
|
||||
@ -155,12 +160,15 @@ X_API void STD_PROTO(YAP_Throw,(Term));
|
||||
X_API void STD_PROTO(YAP_Halt,(int));
|
||||
X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void));
|
||||
X_API void *STD_PROTO(YAP_Predicate,(Atom,unsigned long int,int));
|
||||
X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,int *));
|
||||
X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,Term *));
|
||||
X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int));
|
||||
X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
|
||||
X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,Term));
|
||||
X_API Int STD_PROTO(YAP_CurrentModule,(void));
|
||||
X_API Term STD_PROTO(YAP_CurrentModule,(void));
|
||||
X_API Term STD_PROTO(YAP_CreateModule,(Atom));
|
||||
X_API int STD_PROTO(YAP_ThreadSelf,(void));
|
||||
X_API int STD_PROTO(YAP_GetThreadRefCount,(int));
|
||||
X_API void STD_PROTO(YAP_SetThreadRefCount,(int,int));
|
||||
X_API int STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *));
|
||||
X_API int STD_PROTO(YAP_ThreadAttachEngine,(int));
|
||||
X_API int STD_PROTO(YAP_ThreadDetachEngine,(int));
|
||||
@ -1120,6 +1128,12 @@ YAP_GetValue(Atom at)
|
||||
return(Yap_GetValue(at));
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_CompareTerms(Term t1, Term t2)
|
||||
{
|
||||
return Yap_compare_terms(t1, t2);
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_Reset(void)
|
||||
{
|
||||
@ -1223,7 +1237,7 @@ YAP_Predicate(Atom a, unsigned long int arity, int m)
|
||||
}
|
||||
|
||||
X_API void
|
||||
YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, int* m)
|
||||
YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
|
||||
{
|
||||
PredEntry *pd = (PredEntry *)p;
|
||||
if (pd->ArityOfPE) {
|
||||
@ -1269,12 +1283,18 @@ YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, Term
|
||||
CurrentModule = cm;
|
||||
}
|
||||
|
||||
X_API Int
|
||||
X_API Term
|
||||
YAP_CurrentModule(void)
|
||||
{
|
||||
return(CurrentModule);
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YAP_CreateModule(Atom at)
|
||||
{
|
||||
return Yap_Module(MkAtomTerm(at));
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadSelf(void)
|
||||
{
|
||||
|
||||
18
C/dbase.c
18
C/dbase.c
@ -570,7 +570,7 @@ typedef struct {
|
||||
}
|
||||
|
||||
/* no checking for overflow while building DB terms yet */
|
||||
#define CheckDBOverflow() if (CodeMax+1024 >= (CELL *)visited) { \
|
||||
#define CheckDBOverflow(X) if (CodeMax+X >= (CELL *)visited-1024) { \
|
||||
goto error; \
|
||||
}
|
||||
|
||||
@ -717,13 +717,13 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#else
|
||||
*StoPoint++ = AbsAppl(CodeMax);
|
||||
#endif
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(3);
|
||||
CodeMax = copy_long_int(CodeMax, ap2);
|
||||
++pt0;
|
||||
continue;
|
||||
#ifdef USE_GMP
|
||||
case (CELL)FunctorBigInt:
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(3);
|
||||
/* first thing, store a link to the list before we move on */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(CodeMax)|MBIT;
|
||||
@ -738,7 +738,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
{
|
||||
CELL *st = CodeMax;
|
||||
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(4);
|
||||
/* first thing, store a link to the list before we move on */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(st)|MBIT;
|
||||
@ -779,7 +779,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
pt0_end = ap2 + d0;
|
||||
/* prepare for our new compound term */
|
||||
/* first the functor */
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(d0);
|
||||
*CodeMax++ = (CELL)f;
|
||||
/* we'll be working here */
|
||||
StoPoint = CodeMax;
|
||||
@ -834,7 +834,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
pt0_end = RepPair(d0) + 1;
|
||||
/* reserve space for our new list */
|
||||
CodeMax += 2;
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(2);
|
||||
continue;
|
||||
} else if (IsAtomOrIntTerm(d0)) {
|
||||
*StoPoint++ = d0;
|
||||
@ -869,7 +869,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
/* store previous value */
|
||||
visited --;
|
||||
visited->addr = ptd0;
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(1);
|
||||
/* variables need to be offset at read time */
|
||||
*ptd0 = (CELL)StoPoint;
|
||||
#if SBA
|
||||
@ -947,7 +947,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
to_visit -= 3;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(1);
|
||||
StoPoint = to_visit[2];
|
||||
#endif
|
||||
goto loop;
|
||||
@ -965,7 +965,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
StoPoint = CodeMax;
|
||||
*StoPoint++ = RepAppl(ConstraintsTerm)[0];
|
||||
ConstraintsTerm = AbsAppl(CodeMax);
|
||||
CheckDBOverflow();
|
||||
CheckDBOverflow(1);
|
||||
CodeMax += 5;
|
||||
goto loop;
|
||||
}
|
||||
|
||||
@ -297,7 +297,7 @@ dump_stack(void)
|
||||
fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global\n");
|
||||
} else {
|
||||
if (b_ptr != NULL) {
|
||||
fprintf(stderr," [ Goals with alternatives open:\n");
|
||||
fprintf(stderr," [ Goals with open alternatives:\n");
|
||||
while (b_ptr != NULL) {
|
||||
cl_position(b_ptr->cp_ap);
|
||||
b_ptr = b_ptr->cp_b;
|
||||
@ -355,6 +355,7 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
|
||||
char *tp = tmpbuf;
|
||||
int psize = YAP_BUF_SIZE;
|
||||
|
||||
|
||||
if (type == INTERRUPT_ERROR) {
|
||||
fprintf(stderr,"%% YAP exiting: cannot handle signal %d\n",
|
||||
(int)IntOfTerm(where));
|
||||
@ -367,7 +368,7 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
|
||||
/* now build the error string */
|
||||
if (format != NULL) {
|
||||
#if HAVE_VSNPRINTF
|
||||
(void) vsnprintf(tmpbuf, 512, format, ap);
|
||||
(void) vsnprintf(tmpbuf, YAP_BUF_SIZE, format, ap);
|
||||
#else
|
||||
(void) vsprintf(tmpbuf, format, ap);
|
||||
#endif
|
||||
|
||||
2
C/exec.c
2
C/exec.c
@ -1286,11 +1286,13 @@ Yap_RunTopGoal(Term t)
|
||||
READ_LOCK(ppe->PRWLock);
|
||||
CodeAdr = ppe->CodeOfPred;
|
||||
READ_UNLOCK(ppe->PRWLock);
|
||||
#if !USE_MALLOC
|
||||
if (Yap_TrailTop - HeapTop < 2048) {
|
||||
Yap_PrologMode = BootMode;
|
||||
Yap_Error(SYSTEM_ERROR,TermNil,
|
||||
"unable to boot because of too little heap space");
|
||||
}
|
||||
#endif
|
||||
goal_out = do_goal(t, CodeAdr, arity, pt, TRUE);
|
||||
return(goal_out);
|
||||
}
|
||||
|
||||
59
C/grow.c
59
C/grow.c
@ -510,7 +510,7 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
|
||||
{
|
||||
UInt start_growth_time, growth_time;
|
||||
int gc_verbose;
|
||||
UInt hole = 0L;
|
||||
UInt minimal_request = 0L;
|
||||
|
||||
/* adjust to a multiple of 256) */
|
||||
size = AdjustPageSize(size);
|
||||
@ -519,7 +519,7 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
|
||||
Int min_size = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap);
|
||||
|
||||
if (size < min_size) size = min_size;
|
||||
hole = size;
|
||||
minimal_request = size;
|
||||
size = Yap_ExtendWorkSpaceThroughHole(size);
|
||||
if (size < 0) {
|
||||
strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
|
||||
@ -557,8 +557,8 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
|
||||
AdjustRegs(MaxTemps);
|
||||
YAPLeaveCriticalSection();
|
||||
ASP += 256;
|
||||
if (hole)
|
||||
Yap_AllocHole(hole, size);
|
||||
if (minimal_request)
|
||||
Yap_AllocHole(minimal_request, size);
|
||||
growth_time = Yap_cputime()-start_growth_time;
|
||||
total_heap_overflow_time += growth_time;
|
||||
if (gc_verbose) {
|
||||
@ -837,17 +837,33 @@ Yap_growglobal(CELL **ptr)
|
||||
|
||||
|
||||
static int
|
||||
execute_growstack(long size, int from_trail)
|
||||
execute_growstack(long size0, int from_trail)
|
||||
{
|
||||
char *MyGlobalBase = Yap_GlobalBase;
|
||||
UInt minimal_request = 0L;
|
||||
long size = size0;
|
||||
ADDR old_Yap_GlobalBase = Yap_GlobalBase;
|
||||
|
||||
if (!Yap_ExtendWorkSpace(size)) {
|
||||
strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
|
||||
return(FALSE);
|
||||
/* make sure stacks and trail are contiguous */
|
||||
Int minimal_request = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap+size0);
|
||||
|
||||
size = Yap_ExtendWorkSpaceThroughHole(minimal_request);
|
||||
if (size < 0) {
|
||||
strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
|
||||
return FALSE;
|
||||
}
|
||||
YAPEnterCriticalSection();
|
||||
GDiff = DelayDiff = size-size0;
|
||||
} else {
|
||||
YAPEnterCriticalSection();
|
||||
if (Yap_GlobalBase != old_Yap_GlobalBase) {
|
||||
GDiff = DelayDiff = Yap_GlobalBase-old_Yap_GlobalBase;
|
||||
Yap_GlobalBase=old_Yap_GlobalBase;
|
||||
} else {
|
||||
GDiff = DelayDiff = 0;
|
||||
}
|
||||
}
|
||||
YAPEnterCriticalSection();
|
||||
XDiff = HDiff = 0;
|
||||
GDiff = DelayDiff = Yap_GlobalBase-MyGlobalBase;
|
||||
#if USE_SYSTEM_MALLOC
|
||||
if (from_trail) {
|
||||
TrDiff = LDiff = GDiff;
|
||||
@ -857,9 +873,6 @@ execute_growstack(long size, int from_trail)
|
||||
#else
|
||||
TrDiff = LDiff = size;
|
||||
#endif
|
||||
if (GDiff) {
|
||||
Yap_GlobalBase = (char *)MyGlobalBase;
|
||||
}
|
||||
ASP -= 256;
|
||||
if (GDiff) {
|
||||
SetHeapRegs();
|
||||
@ -872,9 +885,14 @@ execute_growstack(long size, int from_trail)
|
||||
if (LDiff) {
|
||||
MoveLocalAndTrail();
|
||||
}
|
||||
if (GDiff)
|
||||
AdjustGlobal();
|
||||
if (LDiff) {
|
||||
if (GDiff) {
|
||||
MoveGlobal();
|
||||
AdjustStacksAndTrail();
|
||||
AdjustRegs(MaxTemps);
|
||||
#ifdef TABLING
|
||||
fix_tabling_info();
|
||||
#endif /* TABLING */
|
||||
} else if (LDiff) {
|
||||
AdjustGrowStack();
|
||||
AdjustRegs(MaxTemps);
|
||||
#ifdef TABLING
|
||||
@ -883,6 +901,8 @@ execute_growstack(long size, int from_trail)
|
||||
}
|
||||
YAPLeaveCriticalSection();
|
||||
ASP += 256;
|
||||
if (minimal_request)
|
||||
Yap_AllocHole(minimal_request, size);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
@ -901,7 +921,7 @@ growstack(long size)
|
||||
stack_overflows++;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% Stack Overflow %d\n", stack_overflows);
|
||||
fprintf(Yap_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H);
|
||||
fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H);
|
||||
fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
|
||||
fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n",
|
||||
(unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
|
||||
@ -1022,7 +1042,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
|
||||
stack_overflows++;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% Stack overflow %d\n", stack_overflows);
|
||||
fprintf(Yap_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H);
|
||||
fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H);
|
||||
fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
|
||||
fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n",
|
||||
(unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
|
||||
@ -1078,8 +1098,7 @@ static int do_growtrail(long size)
|
||||
execute_growstack(size, TRUE);
|
||||
#else
|
||||
if (!Yap_ExtendWorkSpace(size)) {
|
||||
strncat(Yap_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
|
||||
return FALSE;
|
||||
execute_growstack(size, TRUE);
|
||||
}
|
||||
YAPEnterCriticalSection();
|
||||
Yap_TrailTop += size;
|
||||
|
||||
@ -3213,7 +3213,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
|
||||
/* expand the stack if effectiveness is less than 20 % */
|
||||
if (ASP - H < gc_margin/sizeof(CELL) ||
|
||||
effectiveness < 20) {
|
||||
return (Yap_growstack(gc_margin));
|
||||
return Yap_growstack(gc_margin);
|
||||
}
|
||||
/*
|
||||
* debug for(save_total=1; save_total<=N; ++save_total)
|
||||
|
||||
10
C/index.c
10
C/index.c
@ -11,8 +11,11 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2004-07-29 18:15:18 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-08-11 16:14:52 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.94 2004/07/29 18:15:18 vsc
|
||||
* fix severe bug in indexing of floating point numbers
|
||||
*
|
||||
* Revision 1.93 2004/07/23 19:01:14 vsc
|
||||
* fix bad ref count in expand_clauses when copying indexing block
|
||||
*
|
||||
@ -5280,7 +5283,10 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
|
||||
nbegin->u.xl.x = begin->u.xl.x;
|
||||
nbegin->u.xl.l = begin->u.xl.l;
|
||||
if (nbegin->u.xl.l->opc == Yap_opcode(_expand_clauses)) {
|
||||
nbegin->u.xl.l->u.sp.s3++;
|
||||
if (!(blk->ClFlags & ErasedMask)) {
|
||||
/* we haven't done erase yet */
|
||||
nbegin->u.xl.l->u.sp.s3++;
|
||||
}
|
||||
}
|
||||
begin = NEXTOP(begin, xl);
|
||||
nbegin = NEXTOP(nbegin, xl);
|
||||
|
||||
@ -3540,7 +3540,7 @@ format_putc(int sno, int ch) {
|
||||
format_buf_size = new_max_size;
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at format");
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at format");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -46,7 +46,7 @@ Yap_Module_Name(PredEntry *ap)
|
||||
return TermProlog;
|
||||
}
|
||||
|
||||
static Term
|
||||
static int
|
||||
LookupModule(Term a)
|
||||
{
|
||||
unsigned int i;
|
||||
@ -66,6 +66,12 @@ LookupModule(Term a)
|
||||
return (i);
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_Module(Term tmod)
|
||||
{
|
||||
return ModuleName[LookupModule(tmod)];
|
||||
}
|
||||
|
||||
struct pred_entry *
|
||||
Yap_ModulePred(Term mod)
|
||||
{
|
||||
|
||||
@ -457,10 +457,11 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
|
||||
}
|
||||
while (chtype[ch] == NU) {
|
||||
Int oval = val;
|
||||
if (ch != '0')
|
||||
if (!(val == 0 && ch == '0')) {
|
||||
*sp++ = ch;
|
||||
}
|
||||
if (ch - '0' >= base)
|
||||
return (MkIntegerTerm(val));
|
||||
return MkIntegerTerm(val);
|
||||
val = val * base + ch - '0';
|
||||
if (val/base != oval || val -oval*base != ch-'0') /* overflow */
|
||||
has_overflow = (has_overflow || TRUE);
|
||||
|
||||
@ -124,7 +124,7 @@ Yap_WinError(char *yap_error)
|
||||
{
|
||||
char msg[256];
|
||||
/* Error, we could not read time */
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(),
|
||||
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
|
||||
NULL);
|
||||
@ -1040,7 +1040,7 @@ SearchForTrailFault(void)
|
||||
/* my_signal_info(SIGSEGV, HandleSIGSEGV); */
|
||||
} else
|
||||
#endif /* OS_HANDLES_TR_OVERFLOW */
|
||||
Yap_Error(FATAL_ERROR, TermNil,
|
||||
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil,
|
||||
"likely bug in YAP, segmentation violation");
|
||||
}
|
||||
|
||||
|
||||
13
C/threads.c
13
C/threads.c
@ -194,12 +194,16 @@ p_create_thread(void)
|
||||
static Int
|
||||
p_thread_self(void)
|
||||
{
|
||||
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
|
||||
return Yap_unify(MkIntegerTerm(-1), ARG1);
|
||||
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
|
||||
}
|
||||
|
||||
int
|
||||
Yap_thread_self(void)
|
||||
{
|
||||
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
|
||||
return -1;
|
||||
return worker_id;
|
||||
}
|
||||
|
||||
@ -223,6 +227,11 @@ int
|
||||
Yap_thread_attach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
if (ThreadHandle[wid].ref_count &&
|
||||
ThreadHandle[wid].handle != pthread_self()) {
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
return FALSE;
|
||||
}
|
||||
ThreadHandle[wid].handle = pthread_self();
|
||||
ThreadHandle[wid].ref_count++;
|
||||
worker_id = wid;
|
||||
@ -234,7 +243,8 @@ int
|
||||
Yap_thread_detach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
ThreadHandle[wid].handle = 0;
|
||||
if (ThreadHandle[wid].handle == worker_id)
|
||||
ThreadHandle[wid].handle = 0;
|
||||
ThreadHandle[wid].ref_count--;
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
return TRUE;
|
||||
@ -254,6 +264,7 @@ Yap_thread_destroy_engine(int wid)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_thread_join(void)
|
||||
{
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.53 2004-07-22 21:32:21 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.54 2004-08-11 16:14:52 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -216,6 +216,7 @@ Term STD_PROTO(Yap_ReadTimedVar,(Term));
|
||||
Term STD_PROTO(Yap_UpdateTimedVar,(Term, Term));
|
||||
|
||||
/* modules.c */
|
||||
Term STD_PROTO(Yap_Module, (Term));
|
||||
Term STD_PROTO(Yap_Module_Name, (struct pred_entry *));
|
||||
struct pred_entry *STD_PROTO(Yap_ModulePred, (Term));
|
||||
void STD_PROTO(Yap_NewModulePred, (Term, struct pred_entry *));
|
||||
|
||||
@ -5,6 +5,8 @@ typedef struct{
|
||||
} thread_attr;
|
||||
|
||||
Int STD_PROTO(Yap_thread_self,(void));
|
||||
int STD_PROTO(Yap_get_thread_ref_count,(int));
|
||||
void STD_PROTO(Yap_set_thread_ref_count,(int,int));
|
||||
Int STD_PROTO(Yap_thread_create_engine,(thread_attr *));
|
||||
Int STD_PROTO(Yap_thread_attach_engine,(int));
|
||||
Int STD_PROTO(Yap_thread_detach_engine,(int));
|
||||
|
||||
18
docs/yap.tex
18
docs/yap.tex
@ -7987,6 +7987,24 @@ on local time. This function uses the WIN32
|
||||
X = datime(2001,5,28,15,29,46) ?
|
||||
@end example
|
||||
|
||||
@item mktime(datime(+@var{Year}, +@var{Month}, +@var{DayOfTheMonth},
|
||||
+@var{Hour}, +@var{Minute}, +@var{Second}), -@var{Seconds})
|
||||
@findex mktime/2
|
||||
@snindex mktime/2
|
||||
@cnindex mktime/2
|
||||
The @code{mktime/1} procedure returns the number of @var{Seconds}
|
||||
elapsed since 00:00:00 on January 1, 1970, Coordinated Universal Time
|
||||
(UTC). The user provides information on @var{Year}, @var{Month},
|
||||
@var{DayOfTheMonth}, @var{Hour}, @var{Minute}, and @var{Second}. The
|
||||
@var{Hour} is returned on local time. This function uses the WIN32
|
||||
@code{GetLocalTime} function or the Unix @code{mktime} function.
|
||||
|
||||
@example
|
||||
?- mktime(datime(2001,5,28,15,29,46),X).
|
||||
|
||||
X = 991081786 ? ;
|
||||
@end example
|
||||
|
||||
@item delete_file(+@var{File})
|
||||
@findex delete_file/1
|
||||
@syindex delete_file/1
|
||||
|
||||
@ -337,16 +337,23 @@ extern X_API YAP_Term *PROTO(YAP_TopOfLocalStack,(void));
|
||||
extern X_API void *PROTO(YAP_Predicate,(YAP_Atom,unsigned long int,int));
|
||||
|
||||
/* int YAP_Predicate() */
|
||||
extern X_API void PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,int*));
|
||||
extern X_API void PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,YAP_Module*));
|
||||
|
||||
/* int YAP_CurrentModule() */
|
||||
extern X_API int PROTO(YAP_CurrentModule,(void));
|
||||
extern X_API YAP_Module PROTO(YAP_CurrentModule,(void));
|
||||
|
||||
extern X_API int PROTO(YAP_ThreadSelf,(void));
|
||||
extern X_API int PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
|
||||
extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
|
||||
/* int YAP_CurrentModule() */
|
||||
extern X_API YAP_Module PROTO(YAP_CreateModule,(YAP_Atom));
|
||||
|
||||
/* thread stuff */
|
||||
extern X_API int PROTO(YAP_ThreadSelf,(void));
|
||||
extern X_API int PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
|
||||
extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
|
||||
|
||||
/* term comparison */
|
||||
extern X_API int PROTO(YAP_CompareTerms,(YAP_Term, YAP_Term));
|
||||
|
||||
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
|
||||
|
||||
|
||||
@ -34,6 +34,8 @@ typedef int YAP_Bool;
|
||||
|
||||
typedef YAP_CELL YAP_Term;
|
||||
|
||||
typedef YAP_Term YAP_Module;
|
||||
|
||||
typedef struct FunctorEntry *YAP_Functor;
|
||||
|
||||
typedef struct AtomEntry *YAP_Atom;
|
||||
@ -101,6 +103,7 @@ typedef struct {
|
||||
typedef struct {
|
||||
unsigned long int ssize;
|
||||
unsigned long int tsize;
|
||||
YAP_Term alias;
|
||||
int (*cancel)(int);
|
||||
} YAP_thread_attr;
|
||||
|
||||
|
||||
@ -39,6 +39,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
|
||||
$(srcdir)/rbtrees.yap \
|
||||
$(srcdir)/regexp.yap \
|
||||
$(srcdir)/splay.yap \
|
||||
$(srcdir)/swi.yap \
|
||||
$(srcdir)/system.yap \
|
||||
$(srcdir)/terms.yap \
|
||||
$(srcdir)/tries.yap \
|
||||
|
||||
@ -42,7 +42,7 @@
|
||||
system/0,
|
||||
system/1,
|
||||
system/2,
|
||||
time/1,
|
||||
mktime/2,
|
||||
tmpnam/1,
|
||||
wait/2,
|
||||
working_directory/2
|
||||
@ -58,6 +58,32 @@ datime(X) :-
|
||||
datime(X, Error),
|
||||
handle_system_error(Error, off, datime(X)).
|
||||
|
||||
mktime(V, A) :- var(V), !,
|
||||
throw(error(instantiation_error,mktime(V,A))).
|
||||
mktime(In,Out) :-
|
||||
check_mktime_inp(In, mktime(In,Out)),
|
||||
In = datime(Y,Mo,D,H,Mi,S),
|
||||
mktime(Y, Mo, D, H, Mi, S, Out, Error),
|
||||
handle_system_error(Error, off, mktime(In,Out)).
|
||||
|
||||
check_mktime_inp(V, Inp) :- var(V), !,
|
||||
throw(error(instantiation_error,Inp)).
|
||||
check_mktime_inp(datime(Y,Mo,D,H,Mi,S), Inp) :- !,
|
||||
check_int(Y, Inp),
|
||||
check_int(Mo, Inp),
|
||||
check_int(D, Inp),
|
||||
check_int(H, Inp),
|
||||
check_int(Mi, Inp),
|
||||
check_int(S, Inp).
|
||||
check_mktime_inp(T, Inp) :-
|
||||
throw(error(domain_error(mktime,T),Inp)).
|
||||
|
||||
check_int(I, _) :- integer(I), !.
|
||||
check_int(I, Inp) :- var(I),
|
||||
throw(error(instantiation_error,Inp)).
|
||||
check_int(I, Inp) :-
|
||||
throw(error(type_error(integer,I),Inp)).
|
||||
|
||||
% file operations
|
||||
|
||||
delete_file(File) :-
|
||||
|
||||
@ -8,8 +8,11 @@
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* $Id: sys.c,v 1.20 2004-07-23 19:02:09 vsc Exp $ *
|
||||
* $Id: sys.c,v 1.21 2004-08-11 16:14:54 vsc Exp $ *
|
||||
* mods: $Log: not supported by cvs2svn $
|
||||
* mods: Revision 1.20 2004/07/23 19:02:09 vsc
|
||||
* mods: misc fixes
|
||||
* mods:
|
||||
* mods: Revision 1.19 2004/07/23 03:37:17 vsc
|
||||
* mods: fix heap overflow in YAP_LookupAtom
|
||||
* mods:
|
||||
@ -97,6 +100,66 @@ WinError(void)
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Return time in a structure */
|
||||
static int
|
||||
sysmktime(void)
|
||||
{
|
||||
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
SYSTEMTIME stime, stime0;
|
||||
FILETIME ftime, ftime0;
|
||||
|
||||
stime.wYear = YAP_IntOfTerm(YAP_ARG1);
|
||||
stime.wMonth = YAP_IntOfTerm(YAP_ARG2);
|
||||
stime.wDay = YAP_IntOfTerm(YAP_ARG3);
|
||||
stime.wHour = YAP_IntOfTerm(YAP_ARG4);
|
||||
stime.wMinute = YAP_IntOfTerm(YAP_ARG5);
|
||||
stime.wSecond = YAP_IntOfTerm(YAP_ARG6);
|
||||
stime.wMilliseconds = 0;
|
||||
stime0.wYear = 1970;
|
||||
stime0.wMonth = 1;
|
||||
stime0.wDay = 1;
|
||||
stime0.wHour = 12;
|
||||
stime0.wMinute = 0;
|
||||
stime0.wSecond = 0;
|
||||
stime0.wMilliseconds = 0;
|
||||
if (!SystemTimeToFileTime(&stime,&ftime)) {
|
||||
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
|
||||
}
|
||||
if (!SystemTimeToFileTime(&stime0,&ftime0)) {
|
||||
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
|
||||
}
|
||||
#if __GNUC__
|
||||
{
|
||||
unsigned long long f1 = (((unsigned long long)ftime.dwHighDateTime)<<32)+(unsigned long long)ftime.dwLowDateTime;
|
||||
unsigned long long f0 = (((unsigned long long)ftime0.dwHighDateTime)<<32)+(unsigned long long)ftime0.dwLowDateTime;
|
||||
return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000)));
|
||||
}
|
||||
#else
|
||||
return FALSE
|
||||
#endif
|
||||
#else
|
||||
#ifdef HAVE_MKTIME
|
||||
struct tm loc;
|
||||
time_t tim;
|
||||
|
||||
loc.tm_year = YAP_IntOfTerm(YAP_ARG1)-1900;
|
||||
loc.tm_mon = YAP_IntOfTerm(YAP_ARG2)-1;
|
||||
loc.tm_mday = YAP_IntOfTerm(YAP_ARG3);
|
||||
loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
|
||||
loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
|
||||
loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
|
||||
|
||||
if ((tim = mktime(&loc)) < 0) {
|
||||
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
|
||||
}
|
||||
return YAP_Unify(YAP_ARG7,YAP_MkIntTerm(tim));
|
||||
#else
|
||||
oops
|
||||
#endif /* HAVE_MKTIME */
|
||||
#endif /* WINDOWS */
|
||||
}
|
||||
|
||||
/* Return time in a structure */
|
||||
static int
|
||||
datime(void)
|
||||
@ -878,6 +941,7 @@ void
|
||||
init_sys(void)
|
||||
{
|
||||
YAP_UserCPredicate("datime", datime, 2);
|
||||
YAP_UserCPredicate("mktime", sysmktime, 8);
|
||||
YAP_UserCPredicate("list_directory", list_directory, 3);
|
||||
YAP_UserCPredicate("file_property", file_property, 7);
|
||||
YAP_UserCPredicate("unlink", p_unlink, 2);
|
||||
|
||||
@ -41,7 +41,7 @@ SOBJS=yap2swi@SHLIB_SUFFIX@
|
||||
|
||||
all: $(SOBJS)
|
||||
|
||||
yap2swi.o: $(srcdir)/yap2swi.c
|
||||
yap2swi.o: $(srcdir)/yap2swi.c $(srcdir)/yap2swi.h
|
||||
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/yap2swi.c -o yap2swi.o
|
||||
|
||||
@DO_SECOND_LD@@DO_SECOND_LD@%@SHLIB_SUFFIX@: %.o
|
||||
|
||||
@ -46,7 +46,7 @@ PL_agc_hook(PL_agc_hook_t entry)
|
||||
YAP: char* AtomName(Atom) */
|
||||
X_API char* PL_atom_chars(atom_t a) /* SAM check type */
|
||||
{
|
||||
return YAP_AtomName(a);
|
||||
return YAP_AtomName((YAP_Atom)a);
|
||||
}
|
||||
|
||||
|
||||
@ -108,7 +108,7 @@ X_API int PL_get_atom(term_t ts, atom_t *a)
|
||||
YAP_Term t = YAP_GetFromSlot(ts);
|
||||
if ( !YAP_IsAtomTerm(t))
|
||||
return 0;
|
||||
*a = YAP_AtomOfTerm(t);
|
||||
*a = (atom_t)YAP_AtomOfTerm(t);
|
||||
return 1;
|
||||
}
|
||||
|
||||
@ -323,28 +323,34 @@ X_API int PL_get_module(term_t ts, module_t *m)
|
||||
YAP_Term t = YAP_GetFromSlot(ts);
|
||||
if (!YAP_IsAtomTerm(t) )
|
||||
return 0;
|
||||
*m = YAP_LookupModule(t);
|
||||
*m = (module_t)YAP_LookupModule(t);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* SWI: int PL_new_module(term_t t, module_t *m) */
|
||||
X_API module_t PL_new_module(atom_t at)
|
||||
{
|
||||
return (module_t)YAP_CreateModule((YAP_Atom)at);
|
||||
}
|
||||
|
||||
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
|
||||
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
|
||||
X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity)
|
||||
{
|
||||
YAP_Term t = YAP_GetFromSlot(ts);
|
||||
if (YAP_IsAtomTerm(t)) {
|
||||
*name = YAP_AtomOfTerm(t);
|
||||
*name = (atom_t)YAP_AtomOfTerm(t);
|
||||
*arity = 0;
|
||||
return 1;
|
||||
}
|
||||
if (YAP_IsApplTerm(t)) {
|
||||
YAP_Functor f = YAP_FunctorOfTerm(t);
|
||||
*name = YAP_NameOfFunctor(f);
|
||||
*name = (atom_t)YAP_NameOfFunctor(f);
|
||||
*arity = YAP_ArityOfFunctor(f);
|
||||
return 1;
|
||||
}
|
||||
if (YAP_IsPairTerm(t)) {
|
||||
*name = YAP_LookupAtom(".");
|
||||
*name = (atom_t)YAP_LookupAtom(".");
|
||||
*arity = 2;
|
||||
return 1;
|
||||
}
|
||||
@ -410,16 +416,16 @@ X_API int PL_get_tail(term_t ts, term_t tl)
|
||||
*/
|
||||
X_API atom_t PL_new_atom(const char *c)
|
||||
{
|
||||
return YAP_LookupAtom((char *)c);
|
||||
return (atom_t)YAP_LookupAtom((char *)c);
|
||||
}
|
||||
|
||||
X_API functor_t PL_new_functor(atom_t name, int arity)
|
||||
{
|
||||
functor_t f;
|
||||
if (arity == 0) {
|
||||
f = (functor_t)YAP_MkAtomTerm(name);
|
||||
f = (functor_t)YAP_MkAtomTerm((YAP_Atom)name);
|
||||
} else {
|
||||
f = (functor_t)YAP_MkFunctor(name,arity);
|
||||
f = (functor_t)YAP_MkFunctor((YAP_Atom)name,arity);
|
||||
}
|
||||
return f;
|
||||
}
|
||||
@ -427,9 +433,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
|
||||
X_API atom_t PL_functor_name(functor_t f)
|
||||
{
|
||||
if (YAP_IsAtomTerm(f)) {
|
||||
return YAP_AtomOfTerm(f);
|
||||
return (atom_t)YAP_AtomOfTerm(f);
|
||||
} else {
|
||||
return YAP_NameOfFunctor((YAP_Functor)f);
|
||||
return (atom_t)YAP_NameOfFunctor((YAP_Functor)f);
|
||||
}
|
||||
}
|
||||
|
||||
@ -494,7 +500,7 @@ X_API void PL_cons_list(term_t d, term_t h, term_t t)
|
||||
|
||||
X_API void PL_put_atom(term_t t, atom_t a)
|
||||
{
|
||||
YAP_PutInSlot(t,YAP_MkAtomTerm(a));
|
||||
YAP_PutInSlot(t,YAP_MkAtomTerm((YAP_Atom)a));
|
||||
}
|
||||
|
||||
X_API void PL_put_atom_chars(term_t t, const char *s)
|
||||
@ -531,6 +537,11 @@ X_API void PL_put_list(term_t t)
|
||||
YAP_PutInSlot(t,YAP_MkNewPairTerm());
|
||||
}
|
||||
|
||||
X_API void PL_put_list_chars(term_t t, const char *s)
|
||||
{
|
||||
YAP_PutInSlot(t,YAP_BufferToString((char *)s));
|
||||
}
|
||||
|
||||
X_API void PL_put_nil(term_t t)
|
||||
{
|
||||
YAP_PutInSlot(t,YAP_MkAtomTerm(YAP_LookupAtom("[]")));
|
||||
@ -583,7 +594,7 @@ X_API int PL_unify(term_t t1, term_t t2)
|
||||
YAP long int unify(YAP_Term* a, Term* b) */
|
||||
X_API int PL_unify_atom(term_t t, atom_t at)
|
||||
{
|
||||
YAP_Term cterm = YAP_MkAtomTerm(at);
|
||||
YAP_Term cterm = YAP_MkAtomTerm((YAP_Atom)at);
|
||||
return YAP_Unify(YAP_GetFromSlot(t),cterm);
|
||||
}
|
||||
|
||||
@ -679,7 +690,7 @@ get_term(arg_types **buf)
|
||||
t = YAP_MkVarTerm();
|
||||
break;
|
||||
case PL_ATOM:
|
||||
t = YAP_MkAtomTerm(ptr->arg.a);
|
||||
t = YAP_MkAtomTerm((YAP_Atom)ptr->arg.a);
|
||||
break;
|
||||
case PL_INTEGER:
|
||||
t = YAP_MkIntTerm(ptr->arg.l);
|
||||
@ -800,11 +811,38 @@ X_API int PL_unify_term(term_t l,...)
|
||||
|
||||
/* end PL_unify_* functions =============================*/
|
||||
|
||||
/* SWI: void PL_register_atom(atom_t atom)
|
||||
YAP: NO EQUIVALENT */
|
||||
/* SAM TO DO */
|
||||
X_API void PL_register_atom(atom_t atom)
|
||||
{
|
||||
YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
|
||||
if (ti == YAP_MkAtomTerm(YAP_LookupAtom("[]"))) {
|
||||
YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(1));
|
||||
} else if (YAP_IsIntTerm(ti)) {
|
||||
long int i = YAP_IntOfTerm(ti);
|
||||
YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i++));
|
||||
}
|
||||
}
|
||||
|
||||
/* SWI: void PL_unregister_atom(atom_t atom)
|
||||
YAP: NO EQUIVALENT */
|
||||
/* SAM TO DO */
|
||||
X_API void PL_unregister_atom(atom_t atom)
|
||||
{
|
||||
YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
|
||||
if (YAP_IsIntTerm(ti)) {
|
||||
long int i = YAP_IntOfTerm(ti);
|
||||
if (i == 1)
|
||||
YAP_PutValue((YAP_Atom)atom, YAP_MkAtomTerm(YAP_LookupAtom("[]")));
|
||||
YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i--));
|
||||
}
|
||||
}
|
||||
|
||||
X_API int PL_get_string_chars(term_t t, char **s, int *len)
|
||||
{
|
||||
/* there are no such objects in Prolog */
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
X_API int PL_term_type(term_t t)
|
||||
@ -907,11 +945,64 @@ X_API int PL_is_variable(term_t ts)
|
||||
return YAP_IsVarTerm(t);
|
||||
}
|
||||
|
||||
X_API int PL_compare(term_t ts1, term_t ts2)
|
||||
{
|
||||
YAP_Term t1 = YAP_GetFromSlot(ts1);
|
||||
YAP_Term t2 = YAP_GetFromSlot(ts2);
|
||||
return YAP_CompareTerms(t1, t2);
|
||||
}
|
||||
|
||||
X_API void PL_halt(int e)
|
||||
{
|
||||
YAP_Halt(e);
|
||||
}
|
||||
|
||||
X_API int PL_action(int action,...)
|
||||
{
|
||||
va_list ap;
|
||||
|
||||
va_start (ap, action);
|
||||
switch (action) {
|
||||
case PL_ACTION_TRACE:
|
||||
fprintf(stderr, "PL_ACTION_TRACE not supported\n");
|
||||
break;
|
||||
case PL_ACTION_DEBUG:
|
||||
fprintf(stderr, "PL_ACTION_DEBUG not supported\n");
|
||||
break;
|
||||
case PL_ACTION_BACKTRACE:
|
||||
fprintf(stderr, "PL_ACTION_BACKTRACE not supported\n");
|
||||
break;
|
||||
case PL_ACTION_HALT:
|
||||
{
|
||||
int halt_arg = va_arg(ap, int);
|
||||
YAP_Halt(halt_arg);
|
||||
}
|
||||
break;
|
||||
case PL_ACTION_ABORT:
|
||||
{
|
||||
YAP_Throw(YAP_MkAtomTerm(YAP_LookupAtom("abort")));
|
||||
}
|
||||
break;
|
||||
case PL_ACTION_BREAK:
|
||||
fprintf(stderr, "PL_ACTION_BREAK not supported\n");
|
||||
break;
|
||||
case PL_ACTION_GUIAPP:
|
||||
fprintf(stderr, "PL_ACTION_GUIAPP not supported\n");
|
||||
break;
|
||||
case PL_ACTION_WRITE:
|
||||
fprintf(stderr, "PL_ACTION_WRITE not supported\n");
|
||||
break;
|
||||
case PL_ACTION_FLUSH:
|
||||
fprintf(stderr, "PL_ACTION_WRITE not supported\n");
|
||||
break;
|
||||
case PL_ACTION_ATTACH_CONSOLE:
|
||||
fprintf(stderr, "PL_ACTION_WRITE not supported\n");
|
||||
break;
|
||||
}
|
||||
va_end (ap);
|
||||
return 0;
|
||||
}
|
||||
|
||||
X_API fid_t
|
||||
PL_open_foreign_frame(void)
|
||||
{
|
||||
@ -944,7 +1035,7 @@ PL_exception(qid_t q)
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_initialise(int myargc, char **myargv, char **myenviron)
|
||||
PL_initialise(int myargc, char **myargv)
|
||||
{
|
||||
YAP_init_args init_args;
|
||||
|
||||
@ -964,13 +1055,19 @@ PL_initialise(int myargc, char **myargv, char **myenviron)
|
||||
return YAP_Init(&init_args);
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_is_initialised(int *argc, char ***argv)
|
||||
{
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API predicate_t PL_pred(functor_t f, module_t m)
|
||||
{
|
||||
if (YAP_IsAtomTerm(f)) {
|
||||
return YAP_Predicate(YAP_AtomOfTerm(f),0,m);
|
||||
return YAP_Predicate(YAP_AtomOfTerm(f),0,(YAP_Module)m);
|
||||
} else {
|
||||
YAP_Functor tf = (YAP_Functor)f;
|
||||
return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),m);
|
||||
return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),(YAP_Module)m);
|
||||
}
|
||||
}
|
||||
|
||||
@ -988,7 +1085,7 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m)
|
||||
|
||||
X_API void PL_predicate_info(predicate_t p,atom_t *name, int *arity, module_t *m)
|
||||
{
|
||||
YAP_PredicateInfo(p, name, (unsigned long int *)arity, (int *)m);
|
||||
YAP_PredicateInfo(p, (YAP_Atom *)name, (unsigned long int *)arity, (YAP_Module *)m);
|
||||
}
|
||||
|
||||
typedef struct open_query_struct {
|
||||
@ -1003,7 +1100,7 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
|
||||
{
|
||||
atom_t name;
|
||||
unsigned long int arity;
|
||||
int m;
|
||||
YAP_Module m;
|
||||
YAP_Term t[2];
|
||||
|
||||
/* ignore flags and module for now */
|
||||
@ -1012,12 +1109,12 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
|
||||
}
|
||||
execution.open=1;
|
||||
execution.state=0;
|
||||
YAP_PredicateInfo(p, &name, &arity, &m);
|
||||
YAP_PredicateInfo(p, (YAP_Atom *)&name, &arity, &m);
|
||||
t[0] = YAP_ModuleName(m);
|
||||
if (arity == 0) {
|
||||
t[1] = YAP_MkAtomTerm(name);
|
||||
t[1] = YAP_MkAtomTerm((YAP_Atom)name);
|
||||
} else {
|
||||
YAP_Functor f = YAP_MkFunctor(name, arity);
|
||||
YAP_Functor f = YAP_MkFunctor((YAP_Atom)name, arity);
|
||||
t[1] = YAP_MkApplTerm(f,arity,YAP_AddressFromSlot(t0));
|
||||
}
|
||||
execution.g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t);
|
||||
@ -1068,7 +1165,7 @@ X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0)
|
||||
X_API int PL_call(term_t tp, module_t m)
|
||||
{
|
||||
YAP_Term t[2], g;
|
||||
t[0] = YAP_ModuleName(m);
|
||||
t[0] = YAP_ModuleName((YAP_Module)m);
|
||||
t[1] = YAP_GetFromSlot(tp);
|
||||
g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t);
|
||||
return YAP_RunGoal(g);
|
||||
@ -1078,7 +1175,16 @@ X_API void PL_register_extensions(PL_extension *ptr)
|
||||
{
|
||||
/* ignore flags for now */
|
||||
while(ptr->predicate_name != NULL) {
|
||||
YAP_UserCPredicateWithArgs(ptr->predicate_name,ptr->function,ptr->arity,YAP_CurrentModule());
|
||||
YAP_UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
|
||||
ptr++;
|
||||
}
|
||||
}
|
||||
|
||||
X_API void PL_load_extensions(PL_extension *ptr)
|
||||
{
|
||||
/* ignore flags for now */
|
||||
while(ptr->predicate_name != NULL) {
|
||||
YAP_UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
|
||||
ptr++;
|
||||
}
|
||||
}
|
||||
@ -1090,10 +1196,95 @@ X_API int PL_thread_self(void)
|
||||
|
||||
X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
|
||||
{
|
||||
/* YAP_thread_attr yap; */
|
||||
return YAP_ThreadSelf();
|
||||
int wid = YAP_ThreadSelf();
|
||||
|
||||
if (wid < 0) {
|
||||
/* we do not have an engine */
|
||||
if (attr) {
|
||||
YAP_thread_attr yapt;
|
||||
int wid;
|
||||
|
||||
yapt.ssize = attr->local_size;
|
||||
yapt.tsize = attr->global_size;
|
||||
yapt.alias = (YAP_Term)attr->alias;
|
||||
yapt.cancel = attr->cancel;
|
||||
wid = YAP_ThreadCreateEngine(&yapt);
|
||||
} else {
|
||||
wid = YAP_ThreadCreateEngine(NULL);
|
||||
}
|
||||
if (wid < 0)
|
||||
return -1;
|
||||
if (YAP_ThreadAttachEngine(wid)) {
|
||||
return wid;
|
||||
}
|
||||
return -1;
|
||||
} else {
|
||||
/* attach myself again */
|
||||
YAP_ThreadAttachEngine(wid);
|
||||
return wid;
|
||||
}
|
||||
}
|
||||
|
||||
X_API int PL_thread_destroy_engine(void)
|
||||
{
|
||||
int wid = YAP_ThreadSelf();
|
||||
|
||||
if (wid < 0) {
|
||||
/* we do not have an engine */
|
||||
return FALSE;
|
||||
}
|
||||
YAP_ThreadDetachEngine(wid);
|
||||
return YAP_ThreadDestroyEngine(wid);
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_thread_at_exit(void (*function)(void *), void *closure, int global)
|
||||
{
|
||||
/* don't do nothing for now */
|
||||
fprintf(stderr,"%% YAP ERROR: PL_thread_at_exit not implemented yet\n");
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
X_API PL_engine_t
|
||||
PL_create_engine(const PL_thread_attr_t *attr)
|
||||
{
|
||||
if (attr) {
|
||||
YAP_thread_attr yapt;
|
||||
|
||||
yapt.ssize = attr->local_size;
|
||||
yapt.tsize = attr->global_size;
|
||||
yapt.alias = (YAP_Term)attr->alias;
|
||||
yapt.cancel = attr->cancel;
|
||||
return (PL_engine_t)YAP_ThreadCreateEngine(&yapt);
|
||||
} else {
|
||||
return (PL_engine_t)YAP_ThreadCreateEngine(NULL);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
X_API int
|
||||
PL_destroy_engine(PL_engine_t e)
|
||||
{
|
||||
return YAP_ThreadDestroyEngine((int)e);
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_set_engine(PL_engine_t engine, PL_engine_t *old)
|
||||
{
|
||||
int cwid = YAP_ThreadSelf();
|
||||
if (*old) *old = (PL_engine_t)cwid;
|
||||
if (engine == PL_ENGINE_CURRENT)
|
||||
return PL_ENGINE_SET;
|
||||
if (engine < 0) /* should really check if engine does not exist */
|
||||
return PL_ENGINE_INVAL;
|
||||
if (!(YAP_ThreadAttachEngine((int)engine))) {
|
||||
return PL_ENGINE_INUSE;
|
||||
}
|
||||
return PL_ENGINE_SET;
|
||||
}
|
||||
|
||||
|
||||
/* note: fprintf may be called from anywhere, so please don't try
|
||||
to be smart and allocate stack from somewhere else */
|
||||
X_API int Sprintf(char *format,...)
|
||||
@ -1114,6 +1305,33 @@ X_API int Sprintf(char *format,...)
|
||||
}
|
||||
|
||||
|
||||
/* note: fprintf may be called from anywhere, so please don't try
|
||||
to be smart and allocate stack from somewhere else */
|
||||
X_API int Sdprintf(char *format,...)
|
||||
{
|
||||
va_list ap;
|
||||
char buf[512];
|
||||
|
||||
va_start(ap,format);
|
||||
#ifdef HAVE_VSNPRINTF
|
||||
vsnprintf(buf,512,format,ap);
|
||||
#else
|
||||
vsprintf(buf,format,ap);
|
||||
#endif
|
||||
va_end(ap);
|
||||
|
||||
#if DEBUG
|
||||
fputs(buf, stderr);
|
||||
#endif
|
||||
return 1;
|
||||
}
|
||||
|
||||
int
|
||||
swi_install(void)
|
||||
{
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
#ifdef _WIN32
|
||||
|
||||
#include <windows.h>
|
||||
|
||||
@ -21,21 +21,22 @@
|
||||
#define X_API
|
||||
#endif
|
||||
|
||||
typedef unsigned int fid_t;
|
||||
typedef unsigned int term_t;
|
||||
typedef int module_t;
|
||||
typedef YAP_Atom atom_t;
|
||||
typedef unsigned long fid_t;
|
||||
typedef unsigned long term_t;
|
||||
typedef void *module_t;
|
||||
typedef unsigned long atom_t;
|
||||
typedef YAP_Term *predicate_t;
|
||||
typedef struct open_query_struct *qid_t;
|
||||
typedef long functor_t;
|
||||
typedef int (*PL_agc_hook_t)(atom_t);
|
||||
typedef unsigned long foreign_t; /* return type of foreign functions */
|
||||
|
||||
typedef int (*CPredicate)(void);
|
||||
typedef void *function_t;
|
||||
|
||||
typedef struct _PL_extension
|
||||
{ char *predicate_name; /* Name of the predicate */
|
||||
short arity; /* Arity of the predicate */
|
||||
CPredicate function; /* Implementing functions */
|
||||
function_t function; /* Implementing functions */
|
||||
short flags; /* Or of PL_FA_... */
|
||||
} PL_extension;
|
||||
|
||||
@ -49,6 +50,8 @@ typedef struct
|
||||
void * reserved[5]; /* reserved for extensions */
|
||||
} PL_thread_attr_t;
|
||||
|
||||
typedef void *PL_engine_t;
|
||||
|
||||
|
||||
#define PL_FA_NOTRACE (0x01) /* foreign cannot be traced */
|
||||
#define PL_FA_TRANSPARENT (0x02) /* foreign is module transparent */
|
||||
@ -95,10 +98,27 @@ typedef struct
|
||||
#define BUF_RING 0x0100
|
||||
#define BUF_MALLOC 0x0200
|
||||
|
||||
#define PL_ENGINE_CURRENT ((PL_engine_t)-1)
|
||||
|
||||
#define PL_ENGINE_SET 0 /* engine set successfully */
|
||||
#define PL_ENGINE_INVAL 2 /* engine doesn't exist */
|
||||
#define PL_ENGINE_INUSE 3 /* engine is in use */
|
||||
|
||||
#define PL_ACTION_TRACE 1 /* switch to trace mode */
|
||||
#define PL_ACTION_DEBUG 2 /* switch to debug mode */
|
||||
#define PL_ACTION_BACKTRACE 3 /* show a backtrace (stack dump) */
|
||||
#define PL_ACTION_BREAK 4 /* create a break environment */
|
||||
#define PL_ACTION_HALT 5 /* halt Prolog execution */
|
||||
#define PL_ACTION_ABORT 6 /* generate a Prolog abort */
|
||||
/* 7: Obsolete PL_ACTION_SYMBOLFILE */
|
||||
#define PL_ACTION_WRITE 8 /* write via Prolog i/o buffer */
|
||||
#define PL_ACTION_FLUSH 9 /* Flush Prolog i/o buffer */
|
||||
#define PL_ACTION_GUIAPP 10 /* Win32: set when this is a gui */
|
||||
#define PL_ACTION_ATTACH_CONSOLE 11 /* MT: Attach a console */
|
||||
|
||||
/* end from pl-itf.h */
|
||||
|
||||
/* copied from old SICStus/SWI interface */
|
||||
typedef int foreign_t;
|
||||
typedef void install_t;
|
||||
|
||||
extern X_API PL_agc_hook_t PL_agc_hook(PL_agc_hook_t);
|
||||
@ -109,7 +129,7 @@ extern X_API term_t PL_new_term_refs(int);
|
||||
extern X_API void PL_reset_term_refs(term_t);
|
||||
/* begin PL_get_* functions =============================*/
|
||||
extern X_API int PL_get_arg(int, term_t, term_t);
|
||||
extern X_API int PL_get_atom(term_t, YAP_Atom *);
|
||||
extern X_API int PL_get_atom(term_t, atom_t *);
|
||||
extern X_API int PL_get_atom_chars(term_t, char **);
|
||||
extern X_API int PL_get_chars(term_t, char **, unsigned);
|
||||
extern X_API int PL_get_functor(term_t, functor_t *);
|
||||
@ -120,6 +140,7 @@ extern X_API int PL_get_list(term_t, term_t, term_t);
|
||||
extern X_API int PL_get_long(term_t, long *);
|
||||
extern X_API int PL_get_list_chars(term_t, char **, unsigned);
|
||||
extern X_API int PL_get_module(term_t, module_t *);
|
||||
extern X_API module_t PL_new_module(atom_t);
|
||||
extern X_API int PL_get_name_arity(term_t, atom_t *, int *);
|
||||
extern X_API int PL_get_nil(term_t);
|
||||
extern X_API int PL_get_pointer(term_t, void **);
|
||||
@ -142,11 +163,13 @@ extern X_API void PL_put_float(term_t, double);
|
||||
extern X_API void PL_put_functor(term_t, functor_t t);
|
||||
extern X_API void PL_put_integer(term_t, long);
|
||||
extern X_API void PL_put_list(term_t);
|
||||
extern X_API void PL_put_list_chars(term_t, const char *);
|
||||
extern X_API void PL_put_nil(term_t);
|
||||
extern X_API void PL_put_pointer(term_t, void *);
|
||||
extern X_API void PL_put_string_chars(term_t, const char *);
|
||||
extern X_API void PL_put_term(term_t, term_t);
|
||||
extern X_API void PL_put_variable(term_t);
|
||||
extern X_API int PL_compare(term_t, term_t);
|
||||
/* end PL_put_* functions =============================*/
|
||||
/* begin PL_unify_* functions =============================*/
|
||||
extern X_API int PL_unify(term_t, term_t);
|
||||
@ -175,11 +198,13 @@ extern X_API int PL_is_variable(term_t);
|
||||
extern X_API int PL_term_type(term_t);
|
||||
/* end PL_is_* functions =============================*/
|
||||
extern X_API void PL_halt(int);
|
||||
extern X_API int PL_initialise(int, char **, char **);
|
||||
extern X_API int PL_initialise(int, char **);
|
||||
extern X_API int PL_is_initialised(int *, char ***);
|
||||
extern X_API void PL_close_foreign_frame(fid_t);
|
||||
extern X_API void PL_discard_foreign_frame(fid_t);
|
||||
extern X_API fid_t PL_open_foreign_frame(void);
|
||||
extern X_API int PL_raise_exception(term_t);
|
||||
extern X_API void PL_register_atom(atom_t);
|
||||
extern X_API void PL_unregister_atom(atom_t);
|
||||
extern X_API predicate_t PL_pred(functor_t, module_t);
|
||||
extern X_API predicate_t PL_predicate(const char *, int, const char *);
|
||||
@ -192,11 +217,21 @@ extern X_API term_t PL_exception(qid_t);
|
||||
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
|
||||
extern X_API int PL_call(term_t, module_t);
|
||||
extern X_API void PL_register_extensions(PL_extension *);
|
||||
extern X_API void PL_load_extensions(PL_extension *);
|
||||
extern X_API int PL_thread_self(void);
|
||||
extern X_API int PL_thread_attach_engine(const PL_thread_attr_t *);
|
||||
extern X_API int PL_thread_destroy_engine(void);
|
||||
extern X_API int PL_thread_at_exit(void (*)(void *), void *, int);
|
||||
extern X_API PL_engine_t PL_create_engine(const PL_thread_attr_t *);
|
||||
extern X_API int PL_destroy_engine(PL_engine_t);
|
||||
extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *);
|
||||
extern X_API int PL_get_string_chars(term_t, char **, int *);
|
||||
extern X_API int PL_action(int,...);
|
||||
|
||||
|
||||
|
||||
extern X_API int Sprintf(char *,...);
|
||||
extern X_API int Sdprintf(char *,...);
|
||||
|
||||
|
||||
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h.m4,v 1.62 2004-07-28 22:09:02 vsc Exp $ *
|
||||
* version: $Id: Yap.h.m4,v 1.63 2004-08-11 16:14:55 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -263,9 +263,9 @@ extern char Yap_Option[20];
|
||||
#elif __svr4__ || defined(__SVR4)
|
||||
#define MMAP_ADDR 0x02000000
|
||||
#elif defined(_WIN32)
|
||||
#define MMAP_ADDR 0x10040000L
|
||||
#define MMAP_ADDR 0x00480000L
|
||||
#elif defined(__CYGWIN__)
|
||||
#define MMAP_ADDR 0x30000000L
|
||||
#define MMAP_ADDR 0x00480000L
|
||||
#endif
|
||||
#endif /* !IN_SECOND_QUADRANT */
|
||||
|
||||
|
||||
@ -84,8 +84,11 @@ YAP_UserCPredicate
|
||||
YAP_UserBackCPredicate
|
||||
YAP_UserCPredicateWithArgs
|
||||
YAP_CurrentModule
|
||||
YAP_CreateModule
|
||||
YAP_ThreadSelf
|
||||
YAP_ThreadCreateEngine
|
||||
YAP_ThreadAttachEngine
|
||||
YAP_ThreadDetachEngine
|
||||
YAP_ThreadDestroyEngine
|
||||
YAP_CompareTerms
|
||||
|
||||
|
||||
10
pl/utils.yap
10
pl/utils.yap
@ -438,7 +438,7 @@ unknown(V0,V) :-
|
||||
'$unknown_warning'(P) :-
|
||||
P=M:F,
|
||||
functor(F,Na,Ar),
|
||||
'$print_message'(existence_error(P,0,procedure,M:F,0), [P,M,Na,Ar]),
|
||||
'$print_message'(error,error(existence_error(procedure,M:Na/Ar), [P])),
|
||||
fail.
|
||||
|
||||
%%% Some "dirty" predicates
|
||||
@ -487,7 +487,13 @@ atom_concat(X,Y,At) :-
|
||||
'$append'(S1,S2,S),
|
||||
atom_codes(At,S).
|
||||
|
||||
|
||||
atomic_concat(X,Y,At) :-
|
||||
atom(At), !,
|
||||
atom_length(At,Len),
|
||||
'$atom_contact_split'(At,0,Len,X,Y).
|
||||
/* Let atom_chars do our error handling */
|
||||
atomic_concat(X,Y,At) :-
|
||||
atomic_concat([X,Y],At).
|
||||
|
||||
'$atom_contact_split'(At,Len,Len,X,Y) :- !,
|
||||
'$atom_split'(At,Len,X,Y).
|
||||
|
||||
Reference in New Issue
Block a user