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

some extra bug fixes for trail overflows: some cannot be recovered that easily,

Browse Source 
some can.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1219 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-12-28 22:20:37 +00:00
parent 7f6c6af7d5
commit ef6bbb1273
20 changed files with 167 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/absmi.c
View File

@ -10,8 +10,13 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-12-05 05:01:21 $,$Author: vsc $ * * Last rev: $Date: 2004-12-28 22:20:34 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.154 2004/12/05 05:01:21 vsc
* try to reduce overheads when running with goal expansion enabled.
* CLPBN fixes
* Handle overflows when allocating big clauses properly.
*
* Revision 1.153 2004/11/19 22:08:35 vsc * Revision 1.153 2004/11/19 22:08:35 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate. * replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
* *
@ -469,7 +474,7 @@ Yap_absmi(int inp)
ASP = YREG+E_CB; ASP = YREG+E_CB;
} }
saveregs(); saveregs();
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L); Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
setregs(); setregs();
FAIL(); FAIL();
@ -12638,7 +12643,7 @@ Yap_absmi(int inp)
} }
if (ActiveSignals & YAP_TROVF_SIGNAL) { if (ActiveSignals & YAP_TROVF_SIGNAL) {
saveregs_and_ycache(); saveregs_and_ycache();
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L); Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
setregs_and_ycache(); setregs_and_ycache();
FAIL(); FAIL();

8
C/amasm.c
View File

@ -11,8 +11,12 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2004-12-20 21:44:56 $ * * Last rev: $Date: 2004-12-28 22:20:35 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.69 2004/12/20 21:44:56 vsc
* more fixes to CLPBN
* fix some Yap overflows.
*
* Revision 1.68 2004/12/07 16:54:57 vsc * Revision 1.68 2004/12/07 16:54:57 vsc
* fix memory overflow * fix memory overflow
* *
@ -2970,7 +2974,7 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip)
case OUT_OF_TRAIL_ERROR: case OUT_OF_TRAIL_ERROR:
/* don't just return NULL */ /* don't just return NULL */
ARG1 = *tp; ARG1 = *tp;
if (!Yap_growtrail(64 * 1024L)) { if (!Yap_growtrail(64 * 1024L, FALSE)) {
return NULL; return NULL;
} }
Yap_Error_TYPE = YAP_NO_ERROR; Yap_Error_TYPE = YAP_NO_ERROR;

8
C/cdmgr.c
View File

@ -11,8 +11,12 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2004-12-20 21:44:57 $,$Author: vsc $ * * Last rev: $Date: 2004-12-28 22:20:35 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.146 2004/12/20 21:44:57 vsc
* more fixes to CLPBN
* fix some Yap overflows.
*
* Revision 1.145 2004/12/16 05:57:23 vsc * Revision 1.145 2004/12/16 05:57:23 vsc
* fix overflows * fix overflows
* *
@ -1993,7 +1997,7 @@ p_compile(void)
return (FALSE); return (FALSE);
YAPEnterCriticalSection(); YAPEnterCriticalSection();
codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments codeadr = Yap_cclause(t, 4, mod, Deref(ARG3)); /* vsc: give the number of arguments
to cclause in case there is overflow */ to cclause in case there is overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */
if (!Yap_ErrorMessage) if (!Yap_ErrorMessage)

4
C/dbase.c
View File

@ -276,7 +276,7 @@ recover_from_record_error(int nargs)
} }
goto recover_record; goto recover_record;
case OUT_OF_TRAIL_ERROR: case OUT_OF_TRAIL_ERROR:
if (!Yap_growtrail(64 * 1024L)) { if (!Yap_growtrail(64 * 1024L, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3"); Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE; return FALSE;
} }
@ -826,9 +826,9 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
d0 = ArityOfFunctor(f); d0 = ArityOfFunctor(f);
pt0 = ap2+1; pt0 = ap2+1;
pt0_end = ap2 + d0; pt0_end = ap2 + d0;
CheckDBOverflow(d0+1);
/* prepare for our new compound term */ /* prepare for our new compound term */
/* first the functor */ /* first the functor */
CheckDBOverflow(d0);
*CodeMax++ = (CELL)f; *CodeMax++ = (CELL)f;
/* we'll be working here */ /* we'll be working here */
StoPoint = CodeMax; StoPoint = CodeMax;

13
C/grow.c
View File

@ -1216,7 +1216,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
return(TRUE); return(TRUE);
} }
static int do_growtrail(long size) static int do_growtrail(long size, int contiguous)
{ {
UInt start_growth_time = Yap_cputime(), growth_time; UInt start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose(); int gc_verbose = Yap_is_gc_verbose();
@ -1243,6 +1243,11 @@ static int do_growtrail(long size)
#else #else
if (!Yap_ExtendWorkSpace(size)) { if (!Yap_ExtendWorkSpace(size)) {
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
if (contiguous) {
/* I can't expand in this case */
trail_overflows--;
return FALSE;
}
execute_growstack(size, TRUE); execute_growstack(size, TRUE);
} }
YAPEnterCriticalSection(); YAPEnterCriticalSection();
@ -1267,9 +1272,9 @@ static int do_growtrail(long size)
/* Used by do_goal() when we're short of stack space */ /* Used by do_goal() when we're short of stack space */
int int
Yap_growtrail(long size) Yap_growtrail(long size, int contiguous)
{ {
return do_growtrail(size); return do_growtrail(size, contiguous);
} }
CELL ** CELL **
@ -1293,7 +1298,7 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
return (CELL **)((char *)newb+(sz1+dsz)); return (CELL **)((char *)newb+(sz1+dsz));
#else #else
CELL **old_top = (CELL **)Yap_TrailTop; CELL **old_top = (CELL **)Yap_TrailTop;
if (do_growtrail(64 * 1024L)) { if (do_growtrail(64 * 1024L, FALSE)) {
CELL **dest = (CELL **)((char *)to_visit+64 * 1024L); CELL **dest = (CELL **)((char *)to_visit+64 * 1024L);
cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit)); cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit));
return dest; return dest;

4
C/heapgc.c
View File

@ -102,7 +102,7 @@ gc_growtrail(int committed)
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
TR = Yap_old_TR; TR = Yap_old_TR;
#endif #endif
if (!Yap_growtrail(64 * 1024L)) { if (!Yap_growtrail(64 * 1024L, TRUE)) {
/* could not find more trail */ /* could not find more trail */
longjmp(Yap_gc_restore, 2); longjmp(Yap_gc_restore, 2);
} }
@ -1563,7 +1563,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
CELL *cptr = (CELL *)trail_cell; CELL *cptr = (CELL *)trail_cell;
if ((ADDR)nsTR > Yap_TrailTop-1024) if ((ADDR)nsTR > Yap_TrailTop-1024)
Yap_growtrail(64 * 1024L); Yap_growtrail(64 * 1024L, TRUE);
TrailTerm(nsTR) = (CELL)NULL; TrailTerm(nsTR) = (CELL)NULL;
TrailTerm(nsTR+1) = *hp; TrailTerm(nsTR+1) = *hp;
TrailTerm(nsTR+2) = trail_cell; TrailTerm(nsTR+2) = trail_cell;

16
C/index.c
View File

@ -11,8 +11,12 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2004-12-21 17:17:15 $,$Author: vsc $ * * Last rev: $Date: 2004-12-28 22:20:35 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.111 2004/12/21 17:17:15 vsc
* miscounting of variable-only clauses in groups might lead to bug in indexing
* code.
*
* Revision 1.110 2004/12/06 04:50:22 vsc * Revision 1.110 2004/12/06 04:50:22 vsc
* fix bug in removing first clause of a try sequence (lu preds) * fix bug in removing first clause of a try sequence (lu preds)
* *
@ -486,7 +490,7 @@ sort_group(GroupDef *grp, CELL *top, struct intermediates *cint)
/* grow stack */ /* grow stack */
longjmp(cint->CompilerBotch,4); longjmp(cint->CompilerBotch,4);
#else #else
if (!Yap_growtrail(2*max*CellSize)) { if (!Yap_growtrail(2*max*CellSize, TRUE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld in growtrail", Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld in growtrail",
2*max*CellSize); 2*max*CellSize);
return; return;
@ -4047,7 +4051,7 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots)
} else if (setjres == 4) { } else if (setjres == 4) {
restore_machine_regs(); restore_machine_regs();
recover_from_failed_susp_on_cls(&cint, 0); recover_from_failed_susp_on_cls(&cint, 0);
if (!Yap_growtrail(Yap_Error_Size)) { if (!Yap_growtrail(Yap_Error_Size, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage);
return FAILCODE; return FAILCODE;
} }
@ -5001,7 +5005,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
} }
} else if (cb == 4) { } else if (cb == 4) {
restore_machine_regs(); restore_machine_regs();
if (!Yap_growtrail(Yap_Error_Size)) { if (!Yap_growtrail(Yap_Error_Size, FALSE)) {
save_machine_regs(); save_machine_regs();
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap); Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap);
@ -6835,7 +6839,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
save_machine_regs(); save_machine_regs();
} else if (cb == 4) { } else if (cb == 4) {
restore_machine_regs(); restore_machine_regs();
Yap_growtrail(Yap_Error_Size); Yap_growtrail(Yap_Error_Size, FALSE);
save_machine_regs(); save_machine_regs();
} }
if (cb) { if (cb) {
@ -7351,7 +7355,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
save_machine_regs(); save_machine_regs();
} else if (cb == 4) { } else if (cb == 4) {
restore_machine_regs(); restore_machine_regs();
Yap_growtrail(Yap_Error_Size); Yap_growtrail(Yap_Error_Size, FALSE);
save_machine_regs(); save_machine_regs();
} }
Yap_Error_Size = 0; Yap_Error_Size = 0;

4
C/init.c
View File

@ -588,7 +588,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
pe->ModuleOfPred = CurrentModule; pe->ModuleOfPred = CurrentModule;
if (def != NULL) { if (def != NULL) {
yamop *p_code = ((StaticClause *)NULL)->ClCode; yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),sla),e),e));
cl->ClFlags = 0; cl->ClFlags = 0;
p_code = cl->ClCode; p_code = cl->ClCode;
@ -599,6 +599,8 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
p_code->u.sla.sla_u.p = pe; p_code->u.sla.sla_u.p = pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
p_code = NEXTOP(p_code,e);
p_code->opc = Yap_opcode(_Ystop);
} else { } else {
pe->OpcodeOfPred = Yap_opcode(_undef_p); pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred)); pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));

2
C/save.c
View File

@ -966,7 +966,7 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries)
if (H + (NOfE*2) > ASP) { if (H + (NOfE*2) > ASP) {
basep = (CELL *)TR; basep = (CELL *)TR;
if (basep + (NOfE*2) > (CELL *)Yap_TrailTop) { if (basep + (NOfE*2) > (CELL *)Yap_TrailTop) {
if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-Yap_TrailTop)) { if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-Yap_TrailTop, TRUE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_Error(OUT_OF_TRAIL_ERROR, TermNil,
"not enough space to restore hash tables for indexing"); "not enough space to restore hash tables for indexing");
Yap_exit(1); Yap_exit(1);

143
C/scanner.c
View File

@ -57,7 +57,7 @@
STATIC_PROTO(int my_getch, (int (*) (int))); STATIC_PROTO(int my_getch, (int (*) (int)));
STATIC_PROTO(Term float_send, (char *)); STATIC_PROTO(Term float_send, (char *));
STATIC_PROTO(Term get_num, (int *, int *, int, int (*) (int), int (*) (int),UInt)); STATIC_PROTO(Term get_num, (int *, int *, int, int (*) (int), int (*) (int),char *,UInt));
/* token table with some help from Richard O'Keefe's PD scanner */ /* token table with some help from Richard O'Keefe's PD scanner */
static char chtype0[NUMBER_OF_CHARS+1] = static char chtype0[NUMBER_OF_CHARS+1] =
@ -122,6 +122,12 @@ EF,
#define chtype (chtype0+1) #define chtype (chtype0+1)
char *Yap_chtype = chtype0+1; char *Yap_chtype = chtype0+1;
/* in case there is an overflow */
typedef struct scanner_extra_alloc {
struct scanner_extra_alloc *next;
void *filler;
} ScannerExtraBlock;
static char * static char *
AllocScannerMemory(unsigned int size) AllocScannerMemory(unsigned int size)
{ {
@ -132,16 +138,55 @@ AllocScannerMemory(unsigned int size)
AuxSpScan = ScannerStack; AuxSpScan = ScannerStack;
size = AdjustSize(size); size = AdjustSize(size);
ScannerStack = AuxSpScan+size; if (ScannerExtraBlocks) {
if (Yap_TrailTop <= ScannerStack) { struct scanner_extra_alloc *ptr;
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
if (!(ptr = (struct scanner_extra_alloc *)malloc(size+sizeof(ScannerExtraBlock)))) {
return NULL; return NULL;
} }
ptr->next = ScannerExtraBlocks;
ScannerExtraBlocks = ptr;
return (char *)(ptr+1);
} else if (Yap_TrailTop <= AuxSpScan+size) {
UInt alloc_size = sizeof(CELL) * 16 * 1024L;
if (size > alloc_size)
alloc_size = size;
if(!Yap_growtrail (alloc_size, TRUE)) {
struct scanner_extra_alloc *ptr;
printf("In trouble\n");
if (!(ptr = (struct scanner_extra_alloc *)malloc(size+sizeof(ScannerExtraBlock)))) {
printf(" oops\n");
return NULL;
}
ptr->next = ScannerExtraBlocks;
ScannerExtraBlocks = ptr;
return (char *)(ptr+1);
}
} }
ScannerStack = AuxSpScan+size;
return AuxSpScan; return AuxSpScan;
#endif #endif
} }
static void
PopScannerMemory(char *block, unsigned int size)
{
#if USE_SYSTEM_MALLOC
return free(block);
#else
if (block == ScannerStack-size) {
ScannerStack -= size;
} else if (block == (char *)(ScannerExtraBlocks+1)) {
struct scanner_extra_alloc *ptr = ScannerExtraBlocks;
ScannerExtraBlocks = ptr->next;
free(ptr);
}
#endif
}
char * char *
Yap_AllocScannerMemory(unsigned int size) Yap_AllocScannerMemory(unsigned int size)
{ {
@ -377,9 +422,9 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
/* reads a number, either integer or float */ /* reads a number, either integer or float */
static Term static Term
get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*QuotedNxtch) (int), UInt max_size) get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*QuotedNxtch) (int), char *s, UInt max_size)
{ {
char *s = (char *)ScannerStack, *sp = s; char *sp = s;
int ch = *chp; int ch = *chp;
Int val = 0, base = ch - '0'; Int val = 0, base = ch - '0';
int might_be_float = TRUE, has_overflow = FALSE; int might_be_float = TRUE, has_overflow = FALSE;
@ -394,7 +439,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
*sp++ = ch; *sp++ = ch;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
base = 10 * base + ch - '0'; base = 10 * base + ch - '0';
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -402,12 +447,12 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
if (ch == '\'') { if (ch == '\'') {
if (base > 36) { if (base > 36) {
Yap_ErrorMessage = "Admissible bases are 0..36"; Yap_ErrorMessage = "Admissible bases are 0..36";
return (TermNil); return TermNil;
} }
might_be_float = FALSE; might_be_float = FALSE;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -422,7 +467,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
/* a quick way to represent ASCII */ /* a quick way to represent ASCII */
if (scan_extra) if (scan_extra)
*chp = Nxtch(inp_stream); *chp = Nxtch(inp_stream);
return (MkIntTerm(ascii)); return MkIntTerm(ascii);
} else if (base >= 10 && base <= 36) { } else if (base >= 10 && base <= 36) {
int upper_case = 'A' - 11 + base; int upper_case = 'A' - 11 + base;
int lower_case = 'a' - 11 + base; int lower_case = 'a' - 11 + base;
@ -431,7 +476,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
Int oval = val; Int oval = val;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
val = val * base + (chtype[ch] == NU ? ch - '0' : val = val * base + (chtype[ch] == NU ? ch - '0' :
@ -445,7 +490,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
might_be_float = FALSE; might_be_float = FALSE;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -453,7 +498,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
Int oval = val; Int oval = val;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
val = val * 16 + (chtype[ch] == NU ? ch - '0' : val = val * 16 + (chtype[ch] == NU ? ch - '0' :
@ -498,7 +543,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
if (ch == '.') { if (ch == '.') {
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = '.'; *sp++ = '.';
if (chtype[ch = Nxtch(inp_stream)] != NU) { if (chtype[ch = Nxtch(inp_stream)] != NU) {
@ -506,13 +551,13 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
*chp = ch; *chp = ch;
*--sp = '\0'; *--sp = '\0';
if (has_overflow) if (has_overflow)
return(read_int_overflow(s,base,val)); return read_int_overflow(s,base,val);
return (MkIntegerTerm(val)); return MkIntegerTerm(val);
} }
do { do {
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
} }
@ -524,7 +569,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -532,7 +577,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
cbuff = '-'; cbuff = '-';
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = '-'; *sp++ = '-';
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -556,35 +601,35 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
*sp0 = '\0'; *sp0 = '\0';
for (sp = s; sp < sp0; sp++) { for (sp = s; sp < sp0; sp++) {
if (*sp == '.') if (*sp == '.')
return (float_send(s)); return float_send(s);
} }
return(MkIntegerTerm(val)); return MkIntegerTerm(val);
} }
do { do {
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
return (TermNil); return TermNil;
} }
*sp++ = ch; *sp++ = ch;
} while (chtype[ch = Nxtch(inp_stream)] == NU); } while (chtype[ch = Nxtch(inp_stream)] == NU);
} }
*sp = '\0'; *sp = '\0';
*chp = ch; *chp = ch;
return (float_send(s)); return float_send(s);
} else if (has_overflow) { } else if (has_overflow) {
*sp = '\0'; *sp = '\0';
/* skip base */ /* skip base */
*chp = ch; *chp = ch;
if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
return(read_int_overflow(s+2,16,val)); return read_int_overflow(s+2,16,val);
if (s[1] == '\'') if (s[1] == '\'')
return(read_int_overflow(s+2,base,val)); return read_int_overflow(s+2,base,val);
if (s[2] == '\'') if (s[2] == '\'')
return(read_int_overflow(s+3,base,val)); return read_int_overflow(s+3,base,val);
return(read_int_overflow(s,base,val)); return read_int_overflow(s,base,val);
} else { } else {
*chp = ch; *chp = ch;
return (MkIntegerTerm(val)); return MkIntegerTerm(val);
} }
} }
@ -596,16 +641,14 @@ Yap_scan_num(int (*Nxtch) (int))
Term out; Term out;
int sign = 1; int sign = 1;
int ch, cherr; int ch, cherr;
UInt tsize; char *ptr;
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
ScannerStack = (char *)TR; ScannerStack = (char *)TR;
tsize = Yap_TrailTop-ScannerStack; ScannerExtraBlocks = NULL;
if (tsize < 4096) { if (!(ptr = AllocScannerMemory(4096))) {
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { Yap_ErrorMessage = "Trail Overflow";
Yap_ErrorMessage = "Trail Overflow"; return TermNil;
return TermNil;
}
} }
ch = Nxtch(-1); ch = Nxtch(-1);
if (ch == '-') { if (ch == '-') {
@ -618,7 +661,8 @@ Yap_scan_num(int (*Nxtch) (int))
return(TermNil); return(TermNil);
} }
cherr = 0; cherr = 0;
out = get_num(&ch, &cherr, -1, Nxtch, Nxtch, tsize); out = get_num(&ch, &cherr, -1, Nxtch, Nxtch, ptr, 4096);
PopScannerMemory(ptr, 4096);
if (sign == -1) { if (sign == -1) {
if (IsIntegerTerm(out)) if (IsIntegerTerm(out))
out = MkIntegerTerm(-IntegerOfTerm(out)); out = MkIntegerTerm(-IntegerOfTerm(out));
@ -645,6 +689,7 @@ Yap_tokenizer(int inp_stream)
Yap_AnonVarTable = NULL; Yap_AnonVarTable = NULL;
Yap_eot_before_eof = FALSE; Yap_eot_before_eof = FALSE;
ScannerStack = (char *)TR; ScannerStack = (char *)TR;
ScannerExtraBlocks = NULL;
l = NULL; l = NULL;
p = NULL; /* Just to make lint happy */ p = NULL; /* Just to make lint happy */
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -717,18 +762,18 @@ Yap_tokenizer(int inp_stream)
case NU: case NU:
{ {
int cherr, cha = ch; int cherr, cha = ch;
UInt tsize = Yap_TrailTop-ScannerStack; char *ptr;
cherr = 0; cherr = 0;
if (tsize < 4096) { if (!(ptr = AllocScannerMemory(4096))) {
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { Yap_ErrorMessage = "Trail Overflow";
Yap_ErrorMessage = "Trail Overflow"; if (p)
if (p) t->TokInfo = eot_tok;
t->TokInfo = eot_tok; /* serious error now */
/* serious error now */ return l;
return l;
}
} }
t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,tsize); t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096);
PopScannerMemory(ptr, 4096);
ch = cha; ch = cha;
if (cherr) { if (cherr) {
TokEntry *e; TokEntry *e;
@ -1016,6 +1061,12 @@ void clean_tokens(TokEntry *tk)
void void
Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable) Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable)
{ {
scanner_extra_alloc *ptr = ScannerExtraBlocks;
while (ptr) {
scanner_extra_alloc *next = ptr->next;
free(ptr);
ptr = next;
}
clean_vtable(vartable); clean_vtable(vartable);
clean_vtable(anonvartable); clean_vtable(anonvartable);
clean_tokens(tokstart); clean_tokens(tokstart);

8
C/stdpreds.c
View File

@ -11,8 +11,12 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2004-12-08 04:45:03 $,$Author: vsc $ * * Last rev: $Date: 2004-12-28 22:20:36 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.78 2004/12/08 04:45:03 vsc
* polish changes to undefp
* get rid of a few warnings
*
* Revision 1.77 2004/12/05 05:07:26 vsc * Revision 1.77 2004/12/05 05:07:26 vsc
* name/2 should accept [] as a valid list (string) * name/2 should accept [] as a valid list (string)
* *
@ -271,7 +275,7 @@ showprofres(UInt type) {
pr->pcs = 0L; pr->pcs = 0L;
pr++; pr++;
if (pr > (clauseentry *)Yap_TrailTop - 1024) { if (pr > (clauseentry *)Yap_TrailTop - 1024) {
Yap_growtrail(64 * 1024L); Yap_growtrail(64 * 1024L, TRUE);
} }
ProfPreds++; ProfPreds++;

4
C/sysbits.c
View File

@ -883,7 +883,7 @@ HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap)
sip->si_code == SEGV_MAPERR && sip->si_code == SEGV_MAPERR &&
(void *)(sip->si_addr) > (void *)(Yap_HeapBase) && (void *)(sip->si_addr) > (void *)(Yap_HeapBase) &&
(void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) { (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) {
Yap_growtrail(64 * 1024L); Yap_growtrail(64 * 1024L, TRUE);
} else } else
#endif #endif
{ {
@ -1034,7 +1034,7 @@ SearchForTrailFault(void)
while ((CELL)TR > (CELL)Yap_TrailTop+trsize) { while ((CELL)TR > (CELL)Yap_TrailTop+trsize) {
trsize += 64*2014L; trsize += 64*2014L;
} }
if (!Yap_growtrail(trsize)) { if (!Yap_growtrail(trsize, TRUE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L); Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L);
} }
/* just in case, make sure the OS keeps the signal handler. */ /* just in case, make sure the OS keeps the signal handler. */

2
C/write.c
View File

@ -463,7 +463,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
{ {
char *s = (char *)TR; char *s = (char *)TR;
while (s+2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10) > (char *)Yap_TrailTop) while (s+2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10) > (char *)Yap_TrailTop)
Yap_growtrail(2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10)); Yap_growtrail(2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10), TRUE);
mpz_get_str(s, 10, Yap_BigIntOfTerm(t)); mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
wrputs(s,wglb->writech); wrputs(s,wglb->writech);
} }

10
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.75 2004-12-08 04:45:04 vsc Exp $ * * version: $Id: Heap.h,v 1.76 2004-12-28 22:20:36 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -45,6 +45,8 @@ typedef struct scratch_block_struct {
} scratch_block; } scratch_block;
typedef struct worker_local_struct { typedef struct worker_local_struct {
char *scanner_stack;
struct scanner_extra_alloc *scanner_extra_blocks;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
lockvar signal_lock; /* protect signal handlers from IPIs */ lockvar signal_lock; /* protect signal handlers from IPIs */
struct pred_entry *wpp; struct pred_entry *wpp;
@ -104,7 +106,6 @@ typedef struct various_codes {
ADDR heap_top; ADDR heap_top;
ADDR heap_lim; ADDR heap_lim;
struct FREEB *free_blocks; struct FREEB *free_blocks;
char *scanner_stack;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
lockvar bgl; /* protect long critical regions */ lockvar bgl; /* protect long critical regions */
lockvar free_blocks_lock; /* protect the list of free blocks */ lockvar free_blocks_lock; /* protect the list of free blocks */
@ -439,7 +440,6 @@ struct various_codes *Yap_heap_regs;
#define HeapMax Yap_heap_regs->heap_max #define HeapMax Yap_heap_regs->heap_max
#define HeapTop Yap_heap_regs->heap_top #define HeapTop Yap_heap_regs->heap_top
#define HeapLim Yap_heap_regs->heap_lim #define HeapLim Yap_heap_regs->heap_lim
#define ScannerStack Yap_heap_regs->scanner_stack
#ifdef YAPOR #ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def #define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def
#define GETWORK (&(Yap_heap_regs->getworkcode )) #define GETWORK (&(Yap_heap_regs->getworkcode ))
@ -671,6 +671,8 @@ struct various_codes *Yap_heap_regs;
#define WakeUpCode Yap_heap_regs->wake_up_code #define WakeUpCode Yap_heap_regs->wake_up_code
#endif #endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define ScannerStack Yap_heap_regs->wl[worker_id].scanner_stack
#define ScannerExtraAlloc Yap_heap_regs->wl[worker_id].scanner_extra_alloc
#define SignalLock Yap_heap_regs->wl[worker_id].signal_lock #define SignalLock Yap_heap_regs->wl[worker_id].signal_lock
#define WPP Yap_heap_regs->wl[worker_id].wpp #define WPP Yap_heap_regs->wl[worker_id].wpp
#define UncaughtThrow Yap_heap_regs->wl[worker_id].uncaught_throw #define UncaughtThrow Yap_heap_regs->wl[worker_id].uncaught_throw
@ -692,6 +694,8 @@ struct various_codes *Yap_heap_regs;
#define Yap_old_TR Yap_heap_regs->wl[worker_id].old_TR #define Yap_old_TR Yap_heap_regs->wl[worker_id].old_TR
#define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code #define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code
#else #else
#define ScannerStack Yap_heap_regs->wl.scanner_stack
#define ScannerExtraBlocks Yap_heap_regs->wl.scanner_extra_blocks
#define ActiveSignals Yap_heap_regs->wl.active_signals #define ActiveSignals Yap_heap_regs->wl.active_signals
#define IPredArity Yap_heap_regs->wl.i_pred_arity #define IPredArity Yap_heap_regs->wl.i_pred_arity
#define ProfEnd Yap_heap_regs->wl.prof_end #define ProfEnd Yap_heap_regs->wl.prof_end

4
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.57 2004-10-26 20:16:15 vsc Exp $ * * version: $Id: Yapproto.h,v 1.58 2004-12-28 22:20:36 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -163,7 +163,7 @@ Int STD_PROTO(Yap_total_stack_shift_time,(void));
void STD_PROTO(Yap_InitGrowPreds, (void)); void STD_PROTO(Yap_InitGrowPreds, (void));
int STD_PROTO(Yap_growheap, (int, UInt, void *)); int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growstack, (long)); int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long)); int STD_PROTO(Yap_growtrail, (long, int));
int STD_PROTO(Yap_growglobal, (CELL **)); int STD_PROTO(Yap_growglobal, (CELL **));
CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***)); CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***));

2
Makefile.in
View File

@ -90,7 +90,7 @@ TEXI2PDF=texi2pdf
#4.1VPATH=@srcdir@:@srcdir@/OPTYap #4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD) CWD=$(PWD)
# #
VERSION=Yap-4.5.5 VERSION=Yap-4.5.6
# #
TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\ TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\

2
distribute
View File

@ -1,7 +1,7 @@
#/bin/bash #/bin/bash
# Guess what: this code works for me! # Guess what: this code works for me!
version="Yap-4.5.5" version="Yap-4.5.6"
PATH="$PATH":~/bin/noarch PATH="$PATH":~/bin/noarch
splat splat
cd C cd C

4
docs/yap.tex
View File

@ -8,9 +8,9 @@
@c @setchapternewpage odd @c @setchapternewpage odd
@c %**end of header @c %**end of header
@set VERSION 4.5.5 @set VERSION 4.5.6
@set EDITION 4.2.4 @set EDITION 4.2.4
@set UPDATED November 2004 @set UPDATED December 2004
@c Index for C-Prolog compatible predicate @c Index for C-Prolog compatible predicate
@defindex cy @defindex cy

2
misc/Yap.spec
View File

@ -3,7 +3,7 @@
Name: Yap Name: Yap
Summary: Prolog Compiler Summary: Prolog Compiler
Version: 4.5.5 Version: 4.5.6
Packager: Vitor Santos Costa <vitor@cos.ufrj.br> Packager: Vitor Santos Costa <vitor@cos.ufrj.br>
Release: 1 Release: 1
Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

1
pl/boot.yap
View File

@ -753,7 +753,6 @@ not(G) :- \+ '$execute'(G).
'$do_undefp'(G,M) :- '$do_undefp'(G,M) :-
\+ '$undefined'(unknown_predicate_handler(_,_,_), user), \+ '$undefined'(unknown_predicate_handler(_,_,_), user),
'$system_catch'(unknown_predicate_handler(G,M,NG), user, _, fail), !, '$system_catch'(unknown_predicate_handler(G,M,NG), user, _, fail), !,
erase(R),
'$exit_undefp', '$exit_undefp',
'$execute'(user:NG). '$execute'(user:NG).
'$do_undefp'(G,M) :- '$do_undefp'(G,M) :-