From ef6bbb12738b219a6593c14b1f7e2eaf81e23fa1 Mon Sep 17 00:00:00 2001 From: vsc Date: Tue, 28 Dec 2004 22:20:37 +0000 Subject: [PATCH] some extra bug fixes for trail overflows: some cannot be recovered that easily, some can. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1219 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 11 ++-- C/amasm.c | 8 ++- C/cdmgr.c | 8 ++- C/dbase.c | 4 +- C/grow.c | 13 +++-- C/heapgc.c | 4 +- C/index.c | 16 +++--- C/init.c | 4 +- C/save.c | 2 +- C/scanner.c | 143 ++++++++++++++++++++++++++++++++++---------------- C/stdpreds.c | 8 ++- C/sysbits.c | 4 +- C/write.c | 2 +- H/Heap.h | 10 ++-- H/Yapproto.h | 4 +- Makefile.in | 2 +- distribute | 2 +- docs/yap.tex | 4 +- misc/Yap.spec | 2 +- pl/boot.yap | 1 - 20 files changed, 167 insertions(+), 85 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index c2dd7ada5..0c8d101e8 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,13 @@ * * * File: absmi.c * * 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 $ +* 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 * replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate. * @@ -469,7 +474,7 @@ Yap_absmi(int inp) ASP = YREG+E_CB; } 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); setregs(); FAIL(); @@ -12638,7 +12643,7 @@ Yap_absmi(int inp) } if (ActiveSignals & YAP_TROVF_SIGNAL) { 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); setregs_and_ycache(); FAIL(); diff --git a/C/amasm.c b/C/amasm.c index 24929a225..955676572 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,12 @@ * File: amasm.c * * 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 $ +* 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 * fix memory overflow * @@ -2970,7 +2974,7 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip) case OUT_OF_TRAIL_ERROR: /* don't just return NULL */ ARG1 = *tp; - if (!Yap_growtrail(64 * 1024L)) { + if (!Yap_growtrail(64 * 1024L, FALSE)) { return NULL; } Yap_Error_TYPE = YAP_NO_ERROR; diff --git a/C/cdmgr.c b/C/cdmgr.c index e1cb2cebe..0a7ee124a 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,12 @@ * File: cdmgr.c * * 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 $ +* 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 * fix overflows * @@ -1993,7 +1997,7 @@ p_compile(void) return (FALSE); 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 */ t = Deref(ARG1); /* just in case there was an heap overflow */ if (!Yap_ErrorMessage) diff --git a/C/dbase.c b/C/dbase.c index 437c2812f..5a833fec8 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -276,7 +276,7 @@ recover_from_record_error(int nargs) } goto recover_record; 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"); return FALSE; } @@ -826,9 +826,9 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, d0 = ArityOfFunctor(f); pt0 = ap2+1; pt0_end = ap2 + d0; + CheckDBOverflow(d0+1); /* prepare for our new compound term */ /* first the functor */ - CheckDBOverflow(d0); *CodeMax++ = (CELL)f; /* we'll be working here */ StoPoint = CodeMax; diff --git a/C/grow.c b/C/grow.c index b91924d1f..4443a7780 100644 --- a/C/grow.c +++ b/C/grow.c @@ -1216,7 +1216,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep) return(TRUE); } -static int do_growtrail(long size) +static int do_growtrail(long size, int contiguous) { UInt start_growth_time = Yap_cputime(), growth_time; int gc_verbose = Yap_is_gc_verbose(); @@ -1243,6 +1243,11 @@ static int do_growtrail(long size) #else if (!Yap_ExtendWorkSpace(size)) { Yap_ErrorMessage = NULL; + if (contiguous) { + /* I can't expand in this case */ + trail_overflows--; + return FALSE; + } execute_growstack(size, TRUE); } YAPEnterCriticalSection(); @@ -1267,9 +1272,9 @@ static int do_growtrail(long size) /* Used by do_goal() when we're short of stack space */ int -Yap_growtrail(long size) +Yap_growtrail(long size, int contiguous) { - return do_growtrail(size); + return do_growtrail(size, contiguous); } CELL ** @@ -1293,7 +1298,7 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp) return (CELL **)((char *)newb+(sz1+dsz)); #else 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); cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit)); return dest; diff --git a/C/heapgc.c b/C/heapgc.c index 6056a9448..986a2163e 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -102,7 +102,7 @@ gc_growtrail(int committed) #if USE_SYSTEM_MALLOC TR = Yap_old_TR; #endif - if (!Yap_growtrail(64 * 1024L)) { + if (!Yap_growtrail(64 * 1024L, TRUE)) { /* could not find more trail */ 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; if ((ADDR)nsTR > Yap_TrailTop-1024) - Yap_growtrail(64 * 1024L); + Yap_growtrail(64 * 1024L, TRUE); TrailTerm(nsTR) = (CELL)NULL; TrailTerm(nsTR+1) = *hp; TrailTerm(nsTR+2) = trail_cell; diff --git a/C/index.c b/C/index.c index 2cae0eaee..c45014ee2 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,12 @@ * File: index.c * * 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 $ +* 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 * 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 */ longjmp(cint->CompilerBotch,4); #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", 2*max*CellSize); return; @@ -4047,7 +4051,7 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots) } else if (setjres == 4) { restore_machine_regs(); 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); return FAILCODE; } @@ -5001,7 +5005,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) { } } else if (cb == 4) { restore_machine_regs(); - if (!Yap_growtrail(Yap_Error_Size)) { + if (!Yap_growtrail(Yap_Error_Size, FALSE)) { save_machine_regs(); if (ap->PredFlags & LogUpdatePredFlag) { 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(); } else if (cb == 4) { restore_machine_regs(); - Yap_growtrail(Yap_Error_Size); + Yap_growtrail(Yap_Error_Size, FALSE); save_machine_regs(); } if (cb) { @@ -7351,7 +7355,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) { save_machine_regs(); } else if (cb == 4) { restore_machine_regs(); - Yap_growtrail(Yap_Error_Size); + Yap_growtrail(Yap_Error_Size, FALSE); save_machine_regs(); } Yap_Error_Size = 0; diff --git a/C/init.c b/C/init.c index 21a9aff73..7075bb430 100644 --- a/C/init.c +++ b/C/init.c @@ -588,7 +588,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, pe->ModuleOfPred = CurrentModule; if (def != NULL) { 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; 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 = NEXTOP(p_code,sla); p_code->opc = Yap_opcode(_procceed); + p_code = NEXTOP(p_code,e); + p_code->opc = Yap_opcode(_Ystop); } else { pe->OpcodeOfPred = Yap_opcode(_undef_p); pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred)); diff --git a/C/save.c b/C/save.c index fb76d83b1..7c6554ea2 100644 --- a/C/save.c +++ b/C/save.c @@ -966,7 +966,7 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries) if (H + (NOfE*2) > ASP) { basep = (CELL *)TR; 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, "not enough space to restore hash tables for indexing"); Yap_exit(1); diff --git a/C/scanner.c b/C/scanner.c index 484f76064..3c4b239b9 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -57,7 +57,7 @@ STATIC_PROTO(int my_getch, (int (*) (int))); 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 */ static char chtype0[NUMBER_OF_CHARS+1] = @@ -122,6 +122,12 @@ EF, #define 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 * AllocScannerMemory(unsigned int size) { @@ -132,16 +138,55 @@ AllocScannerMemory(unsigned int size) AuxSpScan = ScannerStack; size = AdjustSize(size); - ScannerStack = AuxSpScan+size; - if (Yap_TrailTop <= ScannerStack) { - if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { + if (ScannerExtraBlocks) { + struct scanner_extra_alloc *ptr; + + if (!(ptr = (struct scanner_extra_alloc *)malloc(size+sizeof(ScannerExtraBlock)))) { 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; #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 * 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 */ 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 val = 0, base = ch - '0'; 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; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } base = 10 * base + ch - '0'; 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 (base > 36) { Yap_ErrorMessage = "Admissible bases are 0..36"; - return (TermNil); + return TermNil; } might_be_float = FALSE; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; 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 */ if (scan_extra) *chp = Nxtch(inp_stream); - return (MkIntTerm(ascii)); + return MkIntTerm(ascii); } else if (base >= 10 && base <= 36) { int upper_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; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; 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; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; 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; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; 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 (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = '.'; 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; *--sp = '\0'; if (has_overflow) - return(read_int_overflow(s,base,val)); - return (MkIntegerTerm(val)); + return read_int_overflow(s,base,val); + return MkIntegerTerm(val); } do { if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; } @@ -524,7 +569,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; ch = Nxtch(inp_stream); @@ -532,7 +577,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted cbuff = '-'; if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = '-'; ch = Nxtch(inp_stream); @@ -556,35 +601,35 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted *sp0 = '\0'; for (sp = s; sp < sp0; sp++) { if (*sp == '.') - return (float_send(s)); + return float_send(s); } - return(MkIntegerTerm(val)); + return MkIntegerTerm(val); } do { if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; - return (TermNil); + return TermNil; } *sp++ = ch; } while (chtype[ch = Nxtch(inp_stream)] == NU); } *sp = '\0'; *chp = ch; - return (float_send(s)); + return float_send(s); } else if (has_overflow) { *sp = '\0'; /* skip base */ *chp = ch; 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] == '\'') - return(read_int_overflow(s+2,base,val)); + return read_int_overflow(s+2,base,val); if (s[2] == '\'') - return(read_int_overflow(s+3,base,val)); - return(read_int_overflow(s,base,val)); + return read_int_overflow(s+3,base,val); + return read_int_overflow(s,base,val); } else { *chp = ch; - return (MkIntegerTerm(val)); + return MkIntegerTerm(val); } } @@ -596,16 +641,14 @@ Yap_scan_num(int (*Nxtch) (int)) Term out; int sign = 1; int ch, cherr; - UInt tsize; + char *ptr; Yap_ErrorMessage = NULL; ScannerStack = (char *)TR; - tsize = Yap_TrailTop-ScannerStack; - if (tsize < 4096) { - if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { - Yap_ErrorMessage = "Trail Overflow"; - return TermNil; - } + ScannerExtraBlocks = NULL; + if (!(ptr = AllocScannerMemory(4096))) { + Yap_ErrorMessage = "Trail Overflow"; + return TermNil; } ch = Nxtch(-1); if (ch == '-') { @@ -618,7 +661,8 @@ Yap_scan_num(int (*Nxtch) (int)) return(TermNil); } 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 (IsIntegerTerm(out)) out = MkIntegerTerm(-IntegerOfTerm(out)); @@ -645,6 +689,7 @@ Yap_tokenizer(int inp_stream) Yap_AnonVarTable = NULL; Yap_eot_before_eof = FALSE; ScannerStack = (char *)TR; + ScannerExtraBlocks = NULL; l = NULL; p = NULL; /* Just to make lint happy */ ch = Nxtch(inp_stream); @@ -717,18 +762,18 @@ Yap_tokenizer(int inp_stream) case NU: { int cherr, cha = ch; - UInt tsize = Yap_TrailTop-ScannerStack; + char *ptr; + cherr = 0; - if (tsize < 4096) { - if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { - Yap_ErrorMessage = "Trail Overflow"; - if (p) - t->TokInfo = eot_tok; - /* serious error now */ - return l; - } + if (!(ptr = AllocScannerMemory(4096))) { + Yap_ErrorMessage = "Trail Overflow"; + if (p) + t->TokInfo = eot_tok; + /* serious error now */ + 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; if (cherr) { TokEntry *e; @@ -1016,6 +1061,12 @@ void clean_tokens(TokEntry *tk) void 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(anonvartable); clean_tokens(tokstart); diff --git a/C/stdpreds.c b/C/stdpreds.c index 30bba24af..3b8bfb44a 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,12 @@ * File: stdpreds.c * * 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 $ +* 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 * name/2 should accept [] as a valid list (string) * @@ -271,7 +275,7 @@ showprofres(UInt type) { pr->pcs = 0L; pr++; if (pr > (clauseentry *)Yap_TrailTop - 1024) { - Yap_growtrail(64 * 1024L); + Yap_growtrail(64 * 1024L, TRUE); } ProfPreds++; diff --git a/C/sysbits.c b/C/sysbits.c index b960e0fd6..d8343dc16 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -883,7 +883,7 @@ HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap) sip->si_code == SEGV_MAPERR && (void *)(sip->si_addr) > (void *)(Yap_HeapBase) && (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) { - Yap_growtrail(64 * 1024L); + Yap_growtrail(64 * 1024L, TRUE); } else #endif { @@ -1034,7 +1034,7 @@ SearchForTrailFault(void) while ((CELL)TR > (CELL)Yap_TrailTop+trsize) { 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); } /* just in case, make sure the OS keeps the signal handler. */ diff --git a/C/write.c b/C/write.c index c561427a5..a53a00d96 100644 --- a/C/write.c +++ b/C/write.c @@ -463,7 +463,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb) { char *s = (char *)TR; 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)); wrputs(s,wglb->writech); } diff --git a/H/Heap.h b/H/Heap.h index 2b5993e0c..be4b5e124 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * 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 */ @@ -45,6 +45,8 @@ typedef struct scratch_block_struct { } scratch_block; typedef struct worker_local_struct { + char *scanner_stack; + struct scanner_extra_alloc *scanner_extra_blocks; #if defined(YAPOR) || defined(THREADS) lockvar signal_lock; /* protect signal handlers from IPIs */ struct pred_entry *wpp; @@ -104,7 +106,6 @@ typedef struct various_codes { ADDR heap_top; ADDR heap_lim; struct FREEB *free_blocks; - char *scanner_stack; #if defined(YAPOR) || defined(THREADS) lockvar bgl; /* protect long critical regions */ 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 HeapTop Yap_heap_regs->heap_top #define HeapLim Yap_heap_regs->heap_lim -#define ScannerStack Yap_heap_regs->scanner_stack #ifdef YAPOR #define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def #define GETWORK (&(Yap_heap_regs->getworkcode )) @@ -671,6 +671,8 @@ struct various_codes *Yap_heap_regs; #define WakeUpCode Yap_heap_regs->wake_up_code #endif #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 WPP Yap_heap_regs->wl[worker_id].wpp #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 TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code #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 IPredArity Yap_heap_regs->wl.i_pred_arity #define ProfEnd Yap_heap_regs->wl.prof_end diff --git a/H/Yapproto.h b/H/Yapproto.h index 337938074..4da36fe85 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * 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 */ @@ -163,7 +163,7 @@ Int STD_PROTO(Yap_total_stack_shift_time,(void)); void STD_PROTO(Yap_InitGrowPreds, (void)); int STD_PROTO(Yap_growheap, (int, UInt, void *)); 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 **)); CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***)); diff --git a/Makefile.in b/Makefile.in index 8c9c5d7ff..e8abf0d4d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -90,7 +90,7 @@ TEXI2PDF=texi2pdf #4.1VPATH=@srcdir@:@srcdir@/OPTYap CWD=$(PWD) # -VERSION=Yap-4.5.5 +VERSION=Yap-4.5.6 # TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\ diff --git a/distribute b/distribute index fe45f1b20..1a1b8a5c2 100755 --- a/distribute +++ b/distribute @@ -1,7 +1,7 @@ #/bin/bash # Guess what: this code works for me! -version="Yap-4.5.5" +version="Yap-4.5.6" PATH="$PATH":~/bin/noarch splat cd C diff --git a/docs/yap.tex b/docs/yap.tex index 386a1e9e1..a8ebf2af1 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -8,9 +8,9 @@ @c @setchapternewpage odd @c %**end of header -@set VERSION 4.5.5 +@set VERSION 4.5.6 @set EDITION 4.2.4 -@set UPDATED November 2004 +@set UPDATED December 2004 @c Index for C-Prolog compatible predicate @defindex cy diff --git a/misc/Yap.spec b/misc/Yap.spec index e02194393..bb6e8107f 100644 --- a/misc/Yap.spec +++ b/misc/Yap.spec @@ -3,7 +3,7 @@ Name: Yap Summary: Prolog Compiler -Version: 4.5.5 +Version: 4.5.6 Packager: Vitor Santos Costa Release: 1 Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz diff --git a/pl/boot.yap b/pl/boot.yap index c517a92a7..d55ce5648 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -753,7 +753,6 @@ not(G) :- \+ '$execute'(G). '$do_undefp'(G,M) :- \+ '$undefined'(unknown_predicate_handler(_,_,_), user), '$system_catch'(unknown_predicate_handler(G,M,NG), user, _, fail), !, - erase(R), '$exit_undefp', '$execute'(user:NG). '$do_undefp'(G,M) :-