diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

stack overflow patches:

Browse Source 
process overflows as high-level as possible;
   introduce overflow related errors
   ExpandWorkSpace should never call Error: use ErrorMessage instead,
   format_putc should never release memory, causes memory corruption,
   Linux does not like MAP_FIXED, it can overwrite the actual program
code.
   condor: twick configure to disable readline with condor.
----------------------------------------------------------------------


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@632 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-10-10 05:58:49 +00:00
parent 3e662aca31
commit 523fae9544
27 changed files with 502 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
C/absmi.c
View File

@ -299,7 +299,7 @@ absmi(int inp)
#endif
if (!growheap(FALSE)) {
saveregs();
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", ErrorMessage);
setregs();
FAIL();
}
@ -1918,7 +1918,9 @@ absmi(int inp)
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
gc(((PredEntry *)SREG)->ArityOfPE, Y, NEXTOP(PREG, sla));
if (!gc(((PredEntry *)SREG)->ArityOfPE, Y, NEXTOP(PREG, sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
}
setregs();
JMPNext();
@ -1990,7 +1992,9 @@ absmi(int inp)
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
gc(0, Y, NEXTOP(PREG, sla));
if (!gc(0, Y, NEXTOP(PREG, sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
}
setregs();
JMPNext();
@ -2072,7 +2076,9 @@ absmi(int inp)
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
gc(((PredEntry *)(SREG))->ArityOfPE, (CELL *)Y[E_E], (yamop *)Y[E_CP]);
if (!gc(((PredEntry *)(SREG))->ArityOfPE, (CELL *)Y[E_E], (yamop *)Y[E_CP])) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
}
setregs();
/* hopefully, gc will succeeded, and we will retry
* the instruction */
@ -2086,7 +2092,9 @@ absmi(int inp)
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG);
if (!gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
}
setregs();
/* hopefully, gc will succeeded, and we will retry
* the instruction */
@ -10564,8 +10572,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,xxx),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s;
}
while ((Int)d1--) {
@ -10672,8 +10685,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,xcx),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s_cv;
}
while ((Int)d1--) {
@ -10777,8 +10795,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,xxc),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s_vc;
}
while ((Int)d1--) {
@ -10879,8 +10902,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,yxx),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s_y;
}
while ((Int)d1--) {
@ -11009,8 +11037,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,ycx),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s_y_cv;
}
while ((Int)d1--) {
@ -11148,8 +11181,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(0, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
if (!gc(0, Y, NEXTOP(NEXTOP(PREG,yxc),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_func2s_y_vc;
}
while ((Int)d1--) {
@ -11533,8 +11571,13 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,e),sla));
if (!gc(3, Y, NEXTOP(NEXTOP(PREG,e),sla))) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
setregs();
JMPNext();
} else {
setregs();
}
goto restart_functor;
}
while ((Int)d1--) {

174
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.22 2002-09-02 17:33:00 vsc Exp $ *
* version:$Id: alloc.c,v 1.23 2002-10-10 05:58:48 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -48,6 +48,15 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
#if !HAVE_SNPRINTF
#define snprintf(A,B,C) sprintf(A,C)
#define snprintf(A,B,C,D) sprintf(A,C,D)
#define snprintf(A,B,C,D,E) sprintf(A,C,D,E)
#define snprintf(A,B,C,D,E,F) sprintf(A,C,D,E,F)
#define snprintf(A,B,C,D,E,F,G) sprintf(A,C,D,E,F,G)
#define snprintf(A,B,C,D,E,F,G,H) sprintf(A,C,D,E,F,G,H)
#endif
STATIC_PROTO(void FreeBlock, (BlockHeader *));
STATIC_PROTO(BlockHeader *GetBlock, (unsigned int));
STATIC_PROTO(char *AllocHeap, (unsigned int));
@ -390,12 +399,26 @@ int
ExtendWorkSpace(Int s)
{
LPVOID b;
prolog_exec_mode OldPrologMode = PrologMode;
PrologMode = ExtendStackMode;
s = ((s-1)/page_size+1)*page_size;
b = VirtualAlloc(brk, s, MEM_COMMIT, PAGE_READWRITE);
if (b) {
brk = (LPVOID) ((Int) brk + s);
PrologMode = OldPrologMode;
return TRUE;
}
ErrorMessage = ErrorSay;
#if HAVE_STRERROR
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"VirtualAlloc could not commit %ld bytes",
s);
#else
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file);
#endif /* HAVE_STRERROR */
PrologMode = OldPrologMode;
return FALSE;
}
@ -412,8 +435,8 @@ InitWorkSpace(Int s)
YP_fprintf(YP_stderr,"[ Warning: YAP reserving space at a variable address ]\n");
b = VirtualAlloc(0x0, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS);
if (b == NULL) {
YP_fprintf(YP_stderr,"[ FATAL ERROR: YAP failed to reserve space ]\n");
exit(1);
Error(FATAL_ERROR,"VirtualAlloc failed");
return(0);
}
}
brk = BASE_ADDRESS;
@ -421,8 +444,8 @@ InitWorkSpace(Int s)
if (ExtendWorkSpace(s)) {
return BASE_ADDRESS;
} else {
YP_fprintf(YP_stderr,"[ FATAL ERROR: YAP failed to reserve space ]\n");
exit(1);
Error(FATAL_ERROR,"VirtualAlloc Failed");
return(0);
}
}
@ -468,14 +491,14 @@ InitWorkSpace(Int s)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0);
if (a != (MALLOC_T)MMAP_ADDR) {
Error(SYSTEM_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR, a);
Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR, a);
return(NULL);
}
#elif defined(__APPLE__)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
if (a != (MALLOC_T)MMAP_ADDR) {
Error(SYSTEM_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR,a );
Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR,a );
return(NULL);
}
#else
@ -486,9 +509,9 @@ InitWorkSpace(Int s)
strncpy(file,"/tmp/YAP.TMPXXXXXX", 256);
if (mkstemp(file) == -1) {
#if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, "mkstemp could not create temporary file %s (%s)", file, strerror(errno));
Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s (%s)", file, strerror(errno));
#else
Error(SYSTEM_ERROR, TermNil, "mkstemp could not create temporary file %s", file);
Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s", file);
#endif
return NULL;
}
@ -503,19 +526,22 @@ InitWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR);
if (fd < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not open %s", file);
Error(FATAL_ERROR, TermNil, "mmap could not open %s", file);
return NULL;
}
if (lseek(fd, s, SEEK_SET) < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not lseek in mmapped file %s", file);
Error(FATAL_ERROR, TermNil, "mmap could not lseek in mmapped file %s", file);
close(fd);
return FALSE;
}
if (write(fd, "", 1) < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not write in mmapped file %s", file);
Error(FATAL_ERROR, TermNil, "mmap could not write in mmapped file %s", file);
close(fd);
return NULL;
}
if (unlink(file) < 0) {
Error(SYSTEM_ERROR,TermNil, "mmap could not unlink mmapped file %s", file);
Error(FATAL_ERROR,TermNil, "mmap could not unlink mmapped file %s", file);
close(fd);
return NULL;
}
}
@ -523,7 +549,7 @@ InitWorkSpace(Int s)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_FIXED, fd, 0);
if (a != (MALLOC_T)MMAP_ADDR) {
Error(SYSTEM_ERROR, TermNil, "mmap could not map at %p, got %p", (void *)MMAP_ADDR, a);
Error(FATAL_ERROR, TermNil, "mmap could not map at %p, got %p", (void *)MMAP_ADDR, a);
return NULL;
}
#else
@ -535,7 +561,7 @@ InitWorkSpace(Int s)
return NULL;
}
if (close(fd) == -1) {
Error(SYSTEM_ERROR, TermNil, "while closing mmaped file");
Error(FATAL_ERROR, TermNil, "while closing mmaped file");
return NULL;
}
#endif
@ -563,27 +589,36 @@ ExtendWorkSpace(Int s)
#else
MALLOC_T a;
prolog_exec_mode OldPrologMode = PrologMode;
#if defined(_AIX) || defined(__hpux)
PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
#elif defined(__APPLE__)
PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
#else
int fd;
PrologMode = ExtendStackMode;
fd = open("/dev/zero", O_RDWR);
if (fd < 0) {
#if HAVE_MKSTEMP
char file[256];
strncpy(file,"/tmp/YAP.TMPXXXXXX",256);
if (mkstemp(file) == -1) {
ErrorMessage = ErrorSay;
#if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, "mkstemp could not create temporary file %s (%s)", file, strerror(errno));
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s (%s)",
file, strerror(errno));
#else
Error(SYSTEM_ERROR, TermNil, "mkstemp could not create temporary file %s", file);
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file);
#endif /* HAVE_STRERROR */
PrologMode = OldPrologMode;
return FALSE;
}
#else
@ -597,47 +632,79 @@ ExtendWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR);
if (fd < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not open %s", file);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not open %s", file);
PrologMode = OldPrologMode;
return FALSE;
}
if (lseek(fd, s, SEEK_SET) < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not lseek in mmapped file %s", file);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not lseek in mmapped file %s", file);
PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
if (write(fd, "", 1) < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not write in mmapped file %s", file);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not write in mmapped file %s", file);
PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
if (unlink(file) < 0) {
Error(SYSTEM_ERROR, TermNil, "mmap could not unlink mmapped file %s", file);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not unlink mmapped file %s", file);
PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
}
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_FIXED, fd, 0);
if (close(fd) == -1) {
#if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, "mmap could not close file (%s) ]\n", strerror(errno));
#else
Error(SYSTEM_ERROR, TermNil, "mmap could not close file ]\n");
MAP_PRIVATE
#ifndef __linux
/* use MAP_FIXED, otherwise God knows where you will be placed */
|MAP_FIXED
#endif
, fd, 0);
if (close(fd) == -1) {
ErrorMessage = ErrorSay;
#if HAVE_STRERROR
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not close file (%s) ]\n", strerror(errno));
#else
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not close file ]\n");
#endif
PrologMode = OldPrologMode;
return FALSE;
}
#endif
if (a == (MALLOC_T) - 1) {
ErrorMessage = ErrorSay;
#if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, "could not allocate %d bytes (%s)", (int)s, strerror(errno));
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes (%s)", (int)s, strerror(errno));
#else
Error(SYSTEM_ERROR, TermNil, "could not allocate %d bytes", (int)s);
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", (int)s);
#endif
PrologMode = OldPrologMode;
return FALSE;
}
if (a != WorkSpaceTop) {
Error(SYSTEM_ERROR, TermNil, "mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
PrologMode = OldPrologMode;
return FALSE;
}
WorkSpaceTop = (char *) a + s;
PrologMode = OldPrologMode;
return TRUE;
#endif /* YAPOR */
}
@ -688,21 +755,33 @@ ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
int shm_id;
prolog_exec_mode OldPrologMode = PrologMode;
PrologMode = ExtendStackMode;
/* mapping heap area */
if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) {
Error(SYSTEM_ERROR, TermNil, "could not shmget %d bytes", s);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmget %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if((ptr = (MALLOC_T)shmat(shm_id, WorkSpaceTop, 0)) == (MALLOC_T) -1) {
Error(SYSTEM_ERROR, TermNil, "could not shmat at %p", MMAP_ADDR);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmat at %p", MMAP_ADDR);
PrologMode = OldPrologMode;
return(FALSE);
}
if (shmctl(shm_id, IPC_RMID, 0) != 0) {
Error(SYSTEM_ERROR, TermNil, "could not remove shm segment", shm_id);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not remove shm segment", shm_id);
PrologMode = OldPrologMode;
return(FALSE);
}
WorkSpaceTop = (char *) ptr + s;
PrologMode = OldPrologMode;
return(TRUE);
}
@ -751,10 +830,17 @@ int
ExtendWorkSpace(Int s)
{
MALLOC_T ptr = (MALLOC_T)sbrk(s);
prolog_exec_mode OldPrologMode = PrologMode;
PrologMode = ExtendStackMode;
if (ptr == ((MALLOC_T) - 1)) {
Error(SYSTEM_ERROR, TermNil, "could not expand stacks over %d bytes", s);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
, "could not expand stacks over %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
PrologMode = OldPrologMode;
return TRUE;
}
@ -874,22 +960,34 @@ int
ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
total_space += s;
prolog_exec_mode OldPrologMode = PrologMode;
PrologMode = ExtendStackMode;
total_space += s;
if (total_space < MAX_SPACE) return(TRUE);
ptr = (MALLOC_T)realloc((void *)HeapBase, total_space);
if (ptr == NULL) {
Error(SYSTEM_ERROR, TermNil, "could not expand stacks %d bytes", s);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if (ptr != (MALLOC_T)HeapBase) {
Error(SYSTEM_ERROR, TermNil, "could not expand contiguous stacks %d bytes", s);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand contiguous stacks %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if ((CELL)ptr & MBIT) {
Error(SYSTEM_ERROR, TermNil, "memory at %p conflicts with MBIT %lx", ptr, MBIT);
ErrorMessage = ErrorSay;
snprintf(ErrorMessage, MAX_ERROR_MSG_SIZE,
"memory at %p conflicts with MBIT %lx", ptr, MBIT);
PrologMode = OldPrologMode;
return(FALSE);
}
PrologMode = OldPrologMode;
return TRUE;
}

5
C/amasm.c
View File

@ -2606,7 +2606,10 @@ assemble(int mode)
size = (CELL)code_p;
#endif
while ((code_addr = (CODEADDR) AllocCodeSpace(size)) == NULL) {
growheap(TRUE);
if (!growheap(TRUE)) {
Error_TYPE = SYSTEM_ERROR;
return (NIL);
}
}
do_pass();
YAPLeaveCriticalSection();

13
C/arrays.c
View File

@ -442,7 +442,7 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
while ((p->ValueOfVE.floats = (Float *) AllocAtomSpace(asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return;
}
YAPEnterCriticalSection();
@ -636,11 +636,14 @@ p_create_array(void)
farray = MkFunctor(AtomArray, size);
if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) {
Error(SYSTEM_ERROR,TermNil,"YAP could not grow stack in array/2");
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
return(FALSE);
} else {
if (H+1+size > ASP-1024) {
growstack( sizeof(CELL) * (size+1-(H-ASP-1024)));
if (!growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return FALSE;
}
}
}
goto restart;
@ -666,7 +669,7 @@ p_create_array(void)
if (H+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock);
if (!gc(2, ENV, P)) {
Error(SYSTEM_ERROR,TermNil,"YAP could not grow stack in array/2");
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
return(FALSE);
} else
goto restart;
@ -684,7 +687,7 @@ p_create_array(void)
else {
if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) {
Error(SYSTEM_ERROR,TermNil,"YAP could not grow stack in array/2");
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
return(FALSE);
} else
goto restart;

5
C/attvar.c
View File

@ -353,7 +353,10 @@ BuildNewAttVar(Term t, Int i, Term tatt)
H[0] = t;
H[1] = tatt;
H += 2;
growglobal(NULL);
if (!growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage);
return FALSE;
}
H -= 2;
t = H[0];
tatt = H[1];

2
C/c_interface.c
View File

@ -602,7 +602,7 @@ YAP_AllocSpaceFromYap(unsigned int size)
if ((ptr = AllocCodeSpace(size)) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(NULL);
}
}

4
C/cdmgr.c
View File

@ -87,8 +87,6 @@ STATIC_PROTO(void list_all_predicates_in_use, (void));
static int compile_mode = 1;
static char ErrorSay[256];
/******************************************************************
EXECUTING PROLOG CLAUSES
@ -733,7 +731,7 @@ static void expand_consult(void)
/* I assume it always works ;-) */
while ((new_cl = (consult_obj *)AllocCodeSpace(sizeof(consult_obj)*ConsultCapacity)) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR,TermNil,"Could not expand consult space: Heap crashed against Stacks");
Error(SYSTEM_ERROR,TermNil,ErrorMessage);
return;
}
}

7
C/compiler.c
View File

@ -141,8 +141,6 @@ jmp_buf CompilerBotch;
#define IsNewVar(v) (Addr(v)<freep0 || Addr(v)>freep)
static char ErrorSay[80];
inline static void pop_code(void);
inline static void
@ -2768,15 +2766,13 @@ cclause(Term inp_clause, int NOfArgs, int mod)
Int osize = 2*sizeof(CELL)*(ASP-H);
ARG1 = my_clause;
if (!gc(2, ENV, P)) {
Error_TYPE = SYSTEM_ERROR;
Error_TYPE = OUT_OF_STACK_ERROR;
Error_Term = my_clause;
ErrorMessage = "not enough stack";
}
if (osize > ASP-H) {
if (!growstack(2*sizeof(CELL)*(ASP-H))) {
Error_TYPE = SYSTEM_ERROR;
Error_Term = my_clause;
ErrorMessage = "not enough stack";
}
}
my_clause = ARG1;
@ -2796,7 +2792,6 @@ cclause(Term inp_clause, int NOfArgs, int mod)
reset_vars();
Error_TYPE = SYSTEM_ERROR;
Error_Term = TermNil;
ErrorMessage = "not enough heap space to compile clause";
return(0);
}
restart_compilation:

5
C/corout.c
View File

@ -564,7 +564,10 @@ freeze_goal(Term t, Term g)
if (H0 - (CELL *)vs < 1024) {
ARG1 = t;
ARG2 = g;
growglobal(NULL);
if (!growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage);
return FALSE;
}
t = ARG1;
g = ARG2;
}

99
C/dbase.c
View File

@ -1657,7 +1657,7 @@ p_rcda(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recorda/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1666,7 +1666,7 @@ p_rcda(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recorda/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1696,7 +1696,7 @@ p_rcdap(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recorda/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1705,7 +1705,7 @@ p_rcdap(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recorda/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1735,7 +1735,7 @@ p_rcdz(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recordz/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1744,7 +1744,7 @@ p_rcdz(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recordz/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1774,7 +1774,7 @@ p_rcdzp(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recordz/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1783,7 +1783,7 @@ p_rcdzp(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recordz/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1821,7 +1821,7 @@ p_rcdstatp(void)
return (unify(ARG4,TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in record_stat_source/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1830,7 +1830,7 @@ p_rcdstatp(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in record_stat_source/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1863,7 +1863,7 @@ p_drcdap(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(4, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recorda/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1872,7 +1872,7 @@ p_drcdap(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recorda/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1906,7 +1906,7 @@ p_drcdzp(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(4, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recordz/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1915,7 +1915,7 @@ p_drcdzp(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recordz/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1951,7 +1951,7 @@ p_rcdaifnot(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recordaifnot/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -1960,7 +1960,7 @@ p_rcdaifnot(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recordzifnot/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -1993,7 +1993,7 @@ p_rcdzifnot(void)
return (unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in recordaifnot/3");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto recover_record;
@ -2002,7 +2002,7 @@ p_rcdzifnot(void)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in recordzifnot/3");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else
goto recover_record;
@ -2330,7 +2330,7 @@ i_log_upd_recorded(LogUpdDBProp AtProp)
if (AtProp->Index == NULL) {
if((AtProp->Index = new_lu_index(AtProp)) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
cut_fail();
}
twork = Deref(ARG2);
@ -2361,7 +2361,10 @@ i_log_upd_recorded(LogUpdDBProp AtProp)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep);
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
twork = Deref(ARG2);
}
@ -2405,7 +2408,10 @@ i_log_upd_recorded(LogUpdDBProp AtProp)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep);
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if(!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
}
if (unify(ARG2, TermDB))
@ -2555,7 +2561,10 @@ i_recorded(DBProp AtProp)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = (CELL)ref;
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
twork = Deref(ARG2);
t3 = Deref(ARG3);
}
@ -2614,7 +2623,10 @@ i_recorded(DBProp AtProp)
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(((Int)mask));
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(((Int)key));
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
READ_LOCK(AtProp->DBRWLock);
}
} while (TRUE);
@ -2676,7 +2688,10 @@ c_log_upd_recorded(DBRef *ep, int flags)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep);
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
}
unify(ARG2, TermDB);
@ -2704,7 +2719,10 @@ c_log_upd_recorded(DBRef *ep, int flags)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep);
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
}
if (unify(ARG2, TermDB))
@ -2815,7 +2833,10 @@ c_recorded(int flags)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = (CELL)ref;
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
}
unify(ARG2, TermDB);
@ -2845,7 +2866,10 @@ c_recorded(int flags)
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = (CELL)ref;
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, CP);
if (!gc(3, ENV, CP)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
PreviousHeap = H;
}
if (unify(ARG2, TermDB))
@ -3005,7 +3029,10 @@ p_first_instance(void)
#endif
while ((TermDB = GetDBTerm(ref)) == (CELL)0) {
/* oops, we are in trouble, not enough stack space */
gc(3, ENV, P);
if (!gc(3, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
}
if (IsVarTerm(TermDB)) {
unify(TermDB, ARG2);
@ -3701,7 +3728,10 @@ p_instance(void)
}
while ((TermDB = GetDBTerm(dbr)) == (CELL)0) {
/* oops, we are in trouble, not enough stack space */
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t1 = Deref(ARG1);
}
return (unify(ARG2, TermDB));
@ -3889,7 +3919,10 @@ FetchTermFromDB(DBRef ref, int args)
Term TDB;
while ((TDB = GetDBTerm(ref)) == (CELL)0) {
/* oops, we are in trouble, not enough stack space */
gc(args, ENV, P);
if (!gc(args, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(TermNil);
}
}
return(TDB);
}
@ -3916,7 +3949,7 @@ StoreTermInDB(int arg, int nargs)
break;
case SOVF_ERROR_IN_DB:
if (!gc(nargs, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in enqueue/2");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else {
t = Deref(XREGS[arg]);
@ -3927,7 +3960,7 @@ StoreTermInDB(int arg, int nargs)
return(FALSE);
case OVF_ERROR_IN_DB:
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in enqueue/2");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
} else {
t = Deref(XREGS[arg]);
@ -3953,7 +3986,7 @@ p_init_queue(void)
} else {
while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
}

57
C/errors.c
View File

@ -300,8 +300,7 @@ cl_position(yamop *ptr)
fprintf(stderr," %s\n", tp);
}
static void
error_exit_yap (int value)
static void dump_stack()
{
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
@ -324,6 +323,13 @@ error_exit_yap (int value)
}
fprintf(stderr," ]\n");
}
}
static void
error_exit_yap (int value)
{
dump_stack();
exit_yap(value);
}
@ -898,6 +904,45 @@ Error (yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case OUT_OF_HEAP_ERROR:
{
int i;
dump_stack();
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("out_of_stack_error"));
tp = tmpbuf+i;
psize -= i;
fun = MkFunctor(LookupAtom("error"),2);
serious = TRUE;
}
break;
case OUT_OF_STACK_ERROR:
{
int i;
dump_stack();
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("out_of_stack_error"));
tp = tmpbuf+i;
psize -= i;
fun = MkFunctor(LookupAtom("error"),2);
serious = TRUE;
}
break;
case OUT_OF_TRAIL_ERROR:
{
int i;
dump_stack();
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("out_of_trail_error"));
tp = tmpbuf+i;
psize -= i;
fun = MkFunctor(LookupAtom("error"),2);
serious = TRUE;
}
break;
case PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE:
{
int i;
@ -1505,7 +1550,15 @@ Error (yap_error_number type, Term where, char *format,...)
/* This is used by some complex procedures to detect there was an error */
ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE;
}
switch (type) {
case OUT_OF_HEAP_ERROR:
case OUT_OF_STACK_ERROR:
case OUT_OF_TRAIL_ERROR:
nt[1] = MkAtomTerm(LookupAtom(tmpbuf));
break;
default:
nt[1] = MkPairTerm(MkAtomTerm(LookupAtom(tmpbuf)), all_calls());
}
if (serious) {
if (type == PURE_ABORT)
JumpToEnv(MkAtomTerm(LookupAtom("abort")));

20
C/grow.c
View File

@ -26,6 +26,10 @@
#include <string.h>
#endif
#if !HAVE_STRNCAT
#define strncat(s0,s1,sz) strcat(s0,s1)
#endif
static int heap_overflows = 0;
static Int total_heap_overflow_time = 0;
@ -476,7 +480,9 @@ local_growheap(long size, int fix_code)
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
@ -522,7 +528,9 @@ local_growglobal(long size, CELL **ptr)
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": global crashed against local", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
@ -654,7 +662,11 @@ growheap(int fix_code)
#ifdef TABLING
fix_tabling_info();
#endif
return(sz >= sizeof(CELL) * 16 * 1024L);
if (sz >= sizeof(CELL) * 16 * 1024L) {
return (TRUE);
}
/* failed */
return(FALSE);
}
int
@ -686,7 +698,9 @@ growstack(long size)
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
@ -803,7 +817,9 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": parser stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
@ -861,7 +877,9 @@ growtrail(long size)
YP_fprintf(YP_stderr, "[TO] Trail overflow %d\n", trail_overflows);
YP_fprintf(YP_stderr, "[TO] growing the trail %ld bytes\n", size);
}
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
YAPEnterCriticalSection();

19
C/heapgc.c
View File

@ -742,6 +742,9 @@ vsc_stop(void) {
return(1);
}
#endif
#ifdef CHECK_GLOBAL
static void
check_global(void) {
CELL *current;
@ -814,8 +817,9 @@ check_global(void) {
vars[gc_susp] = 0;
#endif
}
#endif
#else
#define check_global()
#endif /* CHECK_GLOBAL */
/* mark a heap object and all heap objects accessible from it */
@ -2975,7 +2979,10 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#if COROUTINING
if (H0 - (CELL *)ReadTimedVar(DelayedVars) < 1024+(2*NUM_OF_ATTS)) {
growglobal(&current_env);
if (!growglobal(&current_env)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return FALSE;
}
}
#endif
#ifdef INSTRUMENT_GC
@ -3028,7 +3035,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
if (HeapTop >= GlobalBase - MinHeapGap) {
*--ASP = (CELL)current_env;
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap before garbage collection");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
current_env = (CELL *)*ASP;
@ -3086,9 +3093,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
YP_fprintf(YP_stderr, "[GC] Left %ld cells free in stacks.\n",
(unsigned long int)(ASP-H));
}
#ifdef DEBUG
check_global();
#endif
return(effectiveness);
}
@ -3171,9 +3176,7 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
gc_margin = gap;
while (gc_margin >= gap && !growstack(gc_margin))
gc_margin = gc_margin/2;
#ifdef DEBUG
check_global();
#endif
return(gc_margin >= gap);
}
/*

2
C/index.c
View File

@ -1415,7 +1415,7 @@ PredIsIndexable(PredEntry *ap)
#endif
if ((indx_out = assemble(ASSEMBLING_INDEX)) == NIL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto restart_index;

3
C/init.c
View File

@ -112,6 +112,9 @@ int optimizer_on = TRUE;
int compile_mode = 0;
/******************* storing error messages ****************************/
char ErrorSay[MAX_ERROR_MSG_SIZE];
/******************* intermediate buffers **********************/
char FileNameBuf[YAP_FILENAME_MAX], FileNameBuf2[YAP_FILENAME_MAX];

20
C/iopreds.c
View File

@ -1901,7 +1901,7 @@ p_open_mem_read_stream (void) /* $open_mem_read_stream(+List,-Stream) */
}
while ((nbuf = (char *)AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in open_mem_read_stream");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
}
@ -1955,7 +1955,7 @@ p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */
while ((nbuf = (char *)AllocAtomSpace(page_size*sizeof(char))) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in open_mem_write_stream");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
}
@ -2412,7 +2412,7 @@ p_peek_mem_write_stream (void)
if (H + 1024 >= ASP) {
H = HI;
if (!gc(3, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in peek_mem_write_stream/2");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
i = 0;
@ -3516,6 +3516,8 @@ static pads pad_entries[16], *pad_max = pad_entries;
static int
format_putc(int sno, int ch) {
if (format_buf_size == -1)
return(EOF);
if (ch == 10) {
char *ptr = format_base;
#if MAC || _MSC_VER
@ -3537,7 +3539,7 @@ format_putc(int sno, int ch) {
char *newbuf;
if ((newbuf = AllocAtomSpace(new_max_size*sizeof(char))) == NULL) {
FreeAtomSpace(format_base);
format_buf_size = -1;
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap for format/2");
return(EOF);
}
@ -3678,6 +3680,10 @@ format(Term tail, Term args, int sno)
format_error = FALSE;
while (!IsVarTerm (head) && IsIntTerm (head))
{
if (format_buf_size == -1) {
FreeAtomSpace(format_base);
return(FALSE);
}
ch = IntOfTerm (head);
if (ch == '~')
{
@ -4330,6 +4336,10 @@ format(Term tail, Term args, int sno)
head = HeadOfTerm (tail);
tail = TailOfTerm (tail);
}
if (format_buf_size == -1) {
FreeAtomSpace(format_base);
return(FALSE);
}
for (ptr = format_base; ptr < format_ptr; ptr++) {
Stream[sno].stream_putc(sno, *ptr);
}
@ -4650,7 +4660,7 @@ p_char_conversion(void)
CharConversionTable2 = AllocCodeSpace(NUMBER_OF_CHARS*sizeof(char));
while (CharConversionTable2 == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in char_conversion/2");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
}

2
C/sort.c
View File

@ -59,7 +59,7 @@ build_new_list(CELL *pt, Term t)
pt += 2;
if (pt > ASP - 4096) {
if (!gc(2, ENV, P)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow stack in sort/2");
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);

12
C/stdpreds.c
View File

@ -668,7 +668,7 @@ p_atom_concat(void)
if (cptr+sz >= top-1024) {
ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap in atom_concat/2 ]\n");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto restart;
@ -1179,7 +1179,10 @@ p_univ(void)
if (H > ASP - 1024) {
/* restore space */
H = Ar;
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
twork = TailOfTerm(Deref(ARG2));
goto build_compound;
}
@ -1244,7 +1247,10 @@ p_univ(void)
#endif
{
if (H+arity*2 > ASP-1024) {
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
tin = Deref(ARG1);
}
twork = ArrayToList(RepAppl(tin) + 1, arity);

19
C/sysbits.c
View File

@ -1018,6 +1018,10 @@ SearchForTrailFault(void)
static RETSIGTYPE
HandleSIGSEGV(int sig)
{
if (PrologMode & ExtendStackMode) {
fprintf(stderr, "[ FATAL ERROR: OS memory allocation crashed: bailing out ]~n");
exit(1);
}
SearchForTrailFault();
}
@ -1914,27 +1918,32 @@ static Int p_putenv(void)
/* set a variable in YAP's environment */
static Int p_file_age(void)
{
#if HAVE_LSTAT
struct stat buf;
char *file_name = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (strcmp(file_name,"user_input") == 0) {
return(unify(ARG2,MkIntTerm(-1)));
}
#if HAVE_LSTAT
{
struct stat buf;
if (lstat(file_name, &buf) == -1) {
/* file does not exist, but was opened? Return -1 */
return(unify(ARG2, MkIntTerm(-1)));
}
return(unify(ARG2, MkIntegerTerm(buf.st_mtime)));
}
#elif defined(__MINGW32__) || _MSC_VER
/* for some weird reason _stat did not work with mingw32 */
{
struct _stat buf;
char *file_name = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (_stat(file_name, &buf) != 0) {
/* return an error number */
return(unify(ARG2, MkIntTerm(-1)));
}
return(unify(ARG2, MkIntegerTerm(buf.st_mtime)));
}
#else
return(unify(ARG2, MkIntTerm(0)));
return(unify(ARG2, MkIntTerm(-1)));
#endif
}

7
C/tracer.c
View File

@ -113,14 +113,13 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
vsc_count++;
/* if (vsc_count < 24200) return; */
/* if (vsc_count == 24340) {
/* if (vsc_count == 80) {
printf("Here I go\n");
}
*/
} */
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
#if defined(__GNUC__)
YP_fprintf(YP_stderr,"%llu, %p ", vsc_count, H);
YP_fprintf(YP_stderr,"%llu ", vsc_count);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {

6
C/unify.c
View File

@ -1616,7 +1616,10 @@ p_functor(void) /* functor(?,?,?) */
*pt1++ = d0;
d0 = AbsAppl(H);
if (pt1+d1 > ENV - CreepFlag) {
gc(3, ENV, P);
if (!gc(3, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
goto restart;
}
while (d1-- > 0) {
@ -1650,6 +1653,7 @@ p_functor(void) /* functor(?,?,?) */
ENDD(d1);
BEGP(pt1);
deref_body(d0, pt1, func_var_2unk, func_var_2nvar);
Error(INSTANTIATION_ERROR,(CELL)pt1,"functor/3");
ENDP(pt1);

35
C/utilpreds.c
View File

@ -309,12 +309,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) {
ARG1 = t;
if (res == -1) { /* handle overflow */
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_attached;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -342,12 +345,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) {
ARG1 = t;
if (res == -1) { /* handle overflow */
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -374,12 +380,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {
ARG1 = t;
if (res == -1) {
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -604,12 +613,15 @@ CopyTermNoDelays(Term inp) {
res = copy_complex_term_no_delays(ap-1, ap+1, H-2, H-2);
if (res) {
if (res == -1) { /* handle overflow */
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -633,12 +645,15 @@ CopyTermNoDelays(Term inp) {
res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0);
if (res) {
if (res == -1) {
gc(2, ENV, P);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve space in growheap");
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);

4
H/rheap.h
View File

@ -1073,7 +1073,7 @@ RestoreClause(Clause *Cl, int mode)
i = pc->u.s.s;
startcode = oldcode = (CELL *)NEXTOP(pc,s);
for (j = 0; j < i; ++j) {
for (j = 0; j < i; j++) {
Functor oldfunc = (Functor)(oldcode[0]);
CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
if (oldfunc != NULL) {
@ -1100,7 +1100,7 @@ RestoreClause(Clause *Cl, int mode)
startcode =
#endif
oldcode = (CELL *)NEXTOP(pc,s);
for (j = 0; j < i; ++j) {
for (j = 0; j < i; j++) {
#if !USE_OFFSETS
Term oldatom = oldcode[0];
#endif

11
configure vendored
View File

@ -2444,6 +2444,7 @@ if test "$use_condor" = yes
then
use_malloc="yes"
CC="condor_compile $CC"
yap_cv_readline="no"
fi
if test "$GCC" = "yes"
@ -4611,6 +4612,14 @@ _ACEOF
INSTALL_DLLS="#"
fi
fi
#do not use realloc() from HP-UX 10.20 together with MPI
if test ${target_os} = hpux10.20
then
cat >>confdefs.h <<\_ACEOF
#define MPI_AVOID_REALLOC 1
_ACEOF
fi
;;
*aix*)
# To actually use dlls in AIX I'd need to build YAP as a DLL first.
@ -4836,7 +4845,7 @@ fi
if test "$use_april" = "yes"
then
YAP_EXTRAS="$YAP_EXTRAS -DDEPTH_LIMIT=1 -DAPRIL"
LDFLAGS="$LDFLAGS -L./"
LDFLAGS="$LDFLAGS -L."
LIBS="$LIBS -lApril"
fi

2
configure.in
View File

@ -168,6 +168,8 @@ if test "$use_condor" = yes
then
use_malloc="yes"
CC="condor_compile $CC"
dnl no readline with condor.
yap_cv_readline="no"
fi
dnl Compilation Flags

12
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.31 2002-09-23 17:06:13 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.32 2002-10-10 05:58:49 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -434,6 +434,9 @@ typedef enum {
EXISTENCE_ERROR_SOURCE_SINK,
EXISTENCE_ERROR_STREAM,
INSTANTIATION_ERROR,
OUT_OF_HEAP_ERROR,
OUT_OF_STACK_ERROR,
OUT_OF_TRAIL_ERROR,
PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE,
PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM,
PERMISSION_ERROR_CREATE_ARRAY,
@ -762,6 +765,10 @@ typedef struct opcode_tab_entry {
/******************* controlling the compiler ****************************/
extern int optimizer_on;
/******************* storing error messages ****************************/
#define MAX_ERROR_MSG_SIZE 256
extern char ErrorSay[MAX_ERROR_MSG_SIZE];
/********************* how to write a Prolog term ***********************/
/********* Prolog may be in several modes *******************************/
@ -773,7 +780,8 @@ typedef enum {
AbortMode = 8, /* expecting to abort */
InterruptMode = 16, /* under an interrupt */
InErrorMode = 32, /* under an interrupt */
ConsoleGetcMode = 64 /* blocked reading from console */
ConsoleGetcMode = 64, /* blocked reading from console */
ExtendStackMode = 128 /* trying to extend stack */
} prolog_exec_mode;
extern prolog_exec_mode PrologMode;

16
pl/errors.yap
View File

@ -52,10 +52,13 @@ print_message(Level, Mss) :-
user:portray_message(Severity, Msg), !.
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :- !,
'$prepare_loc'(Info,Where,Location),
'$output_error_message'(Msg, Location), !,
'$do_stack_dump'(Envs, CPs).
% old format: don't want a stack dump.
'$print_message'(error,error(Type,Where)) :- !,
'$output_error_message'(Type, Where).
'$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :-
@ -198,6 +201,8 @@ print_message(Level, Mss) :-
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$undefp',1,prolog,ClNo,Gs,NGs) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$repeat',0,prolog,ClNo,Gs,[cl(repeat,0,prolog,ClNo)|NGs]) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$consult',2,prolog,ClNo,Gs,[cl(consult,1,prolog,ClNo)|NGs]) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$findall_with_common_vars',_,prolog,ClNo,Gs,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
@ -393,6 +398,15 @@ print_message(Level, Mss) :-
'$output_error_message'(instantiation_error, Where) :-
'$format'(user_error,"[ INSTANTIATION ERROR- ~w: expected bound value ]~n",
[Where]).
'$output_error_message'(out_of_heap_error, Where) :-
'$format'(user_error,"[ OUT OF HEAP SPACE ERROR- ~w ]~n",
[Where]).
'$output_error_message'(out_of_stack_error, Where) :-
'$format'(user_error,"[ OUT OF STACK SPACE ERROR- ~w ]~n",
[Where]).
'$output_error_message'(out_of_trail_error, Where) :-
'$format'(user_error,"[ OUT OF TRAIL SPACE ERROR- ~w ]~n",
[Where]).
'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot see clauses for ~w ]~n",
[Where,P]).