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 2004-08-11 16:14:55 +00:00
parent 23f85a3453
commit 1781ff9420
28 changed files with 627 additions and 131 deletions

View File

@ -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();

View File

@ -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);
}
}
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 TRUE;
}
static MALLOC_T
@ -598,26 +613,29 @@ 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);
b = VirtualAlloc((LPVOID)MMAP_ADDR, s, MEM_RESERVE, PAGE_NOACCESS);
if (b == NULL) {
b = VirtualAlloc(NULL, max_mem, MEM_RESERVE, PAGE_NOACCESS);
if (b != NULL) {
brk = b;
if (!b) {
fprintf(stderr,"%% Warning: YAP reserving space at variable address %p\n", brk);
break;
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 {
brk = BASE_ADDRESS;
break;
}
}
if (brk && ExtendWorkSpace(s)) {
return (MALLOC_T)b;
}
Yap_Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
if (!b) {
fprintf(stderr,"%% Warning: YAP failed to reserve space at %p\n", brk);
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;

View File

@ -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)
{

View File

@ -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;
}

View File

@ -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

View File

@ -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);
}

View File

@ -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;
}
}
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;

View File

@ -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)

View File

@ -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,8 +5283,11 @@ 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)) {
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);
}

View File

@ -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");
}
}
}

View File

@ -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)
{

View File

@ -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);

View File

@ -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");
}

View File

@ -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,6 +243,7 @@ int
Yap_thread_detach_engine(int wid)
{
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
if (ThreadHandle[wid].handle == worker_id)
ThreadHandle[wid].handle = 0;
ThreadHandle[wid].ref_count--;
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
@ -254,6 +264,7 @@ Yap_thread_destroy_engine(int wid)
}
}
static Int
p_thread_join(void)
{

View File

@ -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 *));

View File

@ -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));

View File

@ -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

View File

@ -337,17 +337,24 @@ 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));
/* 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)
__END_DECLS

View File

@ -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;

View File

@ -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 \

View File

@ -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) :-

View 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);

View File

@ -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

View File

@ -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>

View File

@ -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 *,...);

View File

@ -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 */

View File

@ -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

View File

@ -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).