diff --git a/C/alloc.c b/C/alloc.c index 68fe0142a..75b149c15 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -12,7 +12,7 @@ * Last rev: * * mods: * * comments: allocating space * -* version:$Id: alloc.c,v 1.83 2006-04-28 13:23:22 vsc Exp $ * +* version:$Id: alloc.c,v 1.84 2006-05-16 18:37:30 vsc Exp $ * *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; @@ -676,6 +676,10 @@ ExtendWorkSpace(Int s, int fixed_allocation) Yap_PrologMode = ExtendStackMode; + +#if DEBUG_WIN32_ALLOC + fprintf(stderr,"trying: %p--%x %d\n",b, s, fixed_allocation); +#endif if (fixed_allocation) { b = VirtualAlloc(b, s, MEM_RESERVE, PAGE_NOACCESS); } else { @@ -686,7 +690,16 @@ ExtendWorkSpace(Int s, int fixed_allocation) } if (!b) { Yap_PrologMode = OldPrologMode; - /* fprintf(stderr,"NOT OK1: %p--%p\n",b,brk);*/ +#if DEBUG_WIN32_ALLOC + { + char msg[256]; + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256, + NULL); + fprintf(stderr,"NOT OK1: %p--%p %s\n",b, brk, msg); + } +#endif return FALSE; } b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE); @@ -696,11 +709,15 @@ ExtendWorkSpace(Int s, int fixed_allocation) "VirtualAlloc could not commit %ld bytes", (long int)s); Yap_PrologMode = OldPrologMode; - /* fprintf(stderr,"NOT OK2: %p--%p\n",b,brk);*/ +#if DEBUG_WIN32_ALLOC + fprintf(stderr,"NOT OK2: %p--%p\n",b,brk); +#endif return FALSE; } brk = (LPVOID) ((Int) b + s); - /* fprintf(stderr,"OK: %p--%p\n",b,brk);*/ +#if DEBUG_WIN32_ALLOC + fprintf(stderr,"OK: %p--%p\n",b,brk); +#endif Yap_PrologMode = OldPrologMode; return TRUE; } @@ -1412,10 +1429,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s) /* progress 1 MB */ WorkSpaceTop += 512*1024; if (ExtendWorkSpace(s, MAP_FIXED)) { -#if USE_DL_MALLOC - Yap_hole_start = (ADDR)WorkSpaceTop0; - Yap_hole_end = (ADDR)WorkSpaceTop-s; -#endif + Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); Yap_ErrorMessage = NULL; return WorkSpaceTop-WorkSpaceTop0; } @@ -1430,6 +1444,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s) WorkSpaceTop = WorkSpaceTop0; #endif if (ExtendWorkSpace(s, 0)) { + Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); Yap_ErrorMessage = NULL; return WorkSpaceTop-WorkSpaceTop0; } diff --git a/C/c_interface.c b/C/c_interface.c index ad2e14efa..c1b464c1e 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -10,8 +10,11 @@ * File: c_interface.c * * comments: c_interface primitives definition * * * -* Last rev: $Date: 2006-03-09 15:52:04 $,$Author: tiagosoares $ * +* Last rev: $Date: 2006-05-16 18:37:30 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.84 2006/03/09 15:52:04 tiagosoares +* CUT_C and MYDDAS support for 64 bits architectures +* * Revision 1.83 2006/02/08 17:29:54 tiagosoares * MYDDAS: Myddas Top Level for MySQL and Datalog * @@ -323,13 +326,17 @@ X_API void *STD_PROTO(YAP_ExtraSpaceCut,(void)); #endif X_API Term STD_PROTO(YAP_CurrentModule,(void)); X_API Term STD_PROTO(YAP_CreateModule,(Atom)); -X_API int STD_PROTO(YAP_ThreadSelf,(void)); -X_API int STD_PROTO(YAP_GetThreadRefCount,(int)); -X_API void STD_PROTO(YAP_SetThreadRefCount,(int,int)); +X_API int STD_PROTO(YAP_ThreadSelf,(void)); +X_API int STD_PROTO(YAP_GetThreadRefCount,(int)); +X_API void STD_PROTO(YAP_SetThreadRefCount,(int,int)); X_API CELL STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *)); -X_API int STD_PROTO(YAP_ThreadAttachEngine,(int)); -X_API int STD_PROTO(YAP_ThreadDetachEngine,(int)); -X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int)); +X_API int STD_PROTO(YAP_ThreadAttachEngine,(int)); +X_API int STD_PROTO(YAP_ThreadDetachEngine,(int)); +X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int)); +X_API int STD_PROTO(YAP_ArgsToIntArray,(Term, UInt, const Int *)); +X_API Term STD_PROTO(YAP_IntArrayToArgs,(UInt, const Int *)); +X_API int STD_PROTO(YAP_ArgsToFloatArray,(Term, UInt, const Float *)); +X_API Term STD_PROTO(YAP_FloatArrayToArgs,(UInt, const Float *)); static int (*do_getf)(void); @@ -1627,3 +1634,86 @@ YAP_ThreadDestroyEngine(int wid) #endif } +/* Copy a number of terms to an array of integers */ +X_API int +YAP_ArgsToIntArray(Term t, UInt size, const Int *ar) +{ + Int *dest = (Int *)ar; + CELL *ptr; + + if (IsVarTerm(t) || + !IsApplTerm(t)) return FALSE; + if (ArityOfFunctor(FunctorOfTerm(t)) != size) + return FALSE; + ptr = RepAppl(t)+1; + while (size) { + Term t = *ptr++; + if (IsVarTerm(t) || !IsIntegerTerm(t)) + return FALSE; + *dest++ = IntegerOfTerm(t); + } + return TRUE; +} + +X_API Term +YAP_IntArrayToArgs(UInt size, const Int *ar) +{ + Term t; + BACKUP_H(); + CELL *ptr = H+1; + Int *source = (Int *)ar; + + if (H+(size+1) >= ASP) { + return TermNil; + } + t = AbsAppl(H); + *H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size); + H+=size; + while (size) { + *ptr++ = MkIntegerTerm(*source++); + } + RECOVER_H(); + return t; +} + +X_API int +YAP_ArgsToFloatArray(Term t, UInt size, const Float *ar) +{ + CELL *ptr; + Float *dest = (Float *)ar; + + if (IsVarTerm(t) || + !IsApplTerm(t)) return FALSE; + if (ArityOfFunctor(FunctorOfTerm(t)) != size) + return FALSE; + ptr = RepAppl(t)+1; + while (size) { + Term t = *ptr++; + if (IsVarTerm(t) || !IsFloatTerm(t)) + return FALSE; + *dest++ = FloatOfTerm(t); + } + return TRUE; +} + +X_API Term +YAP_FloatArrayToArgs(UInt size, const Float *ar) +{ + Term t; + BACKUP_H(); + CELL *ptr = H+1; + Float *source = (Float *)ar; + + if (H+(size+1) >= ASP) { + return TermNil; + } + t = AbsAppl(H); + *H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size); + H+=size; + while (size) { + *ptr++ = MkFloatTerm(*source++); + } + RECOVER_H(); + return t; +} + diff --git a/C/compiler.c b/C/compiler.c index 2e41c7b18..89bee2819 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -11,8 +11,11 @@ * File: compiler.c * * comments: Clause compiler * * * -* Last rev: $Date: 2006-04-13 02:04:24 $,$Author: vsc $ * +* Last rev: $Date: 2006-05-16 18:37:30 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.74 2006/04/13 02:04:24 vsc +* fix debugging typo +* * Revision 1.73 2006/04/12 20:08:51 vsc * make it sure that making vars safe does not propagate across branches of disjunctions. * @@ -882,15 +885,21 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs) } } else { if (Op == _arg) { - Term tn = MkVarTerm(); - Int v1 = --cglobs->tmpreg; - Int v2 = --cglobs->tmpreg; + /* we know the second argument is bound */ + if (IsPrimitiveTerm(t2) || IsNumTerm(t2)) { + Yap_emit(fail_op, Zero, Zero, &cglobs->cint); + return; + } else { + Term tn = MkVarTerm(); + Int v1 = --cglobs->tmpreg; + Int v2 = --cglobs->tmpreg; - c_arg(t2, v2, 0, 0, cglobs); - Yap_emit(fetch_args_vv_op, Zero, Zero, &cglobs->cint); - /* these should be the arguments */ - c_var(t1, v1, 0, 0, cglobs); - c_var(tn, v2, 0, 0, cglobs); + c_eq(t2, tn, cglobs); + Yap_emit(fetch_args_vv_op, Zero, Zero, &cglobs->cint); + /* these should be the arguments */ + c_var(t1, v1, 0, 0, cglobs); + c_var(tn, v2, 0, 0, cglobs); + } /* it has to be either an integer or a floating point */ } else if (IsIntegerTerm(t2)) { /* first temp */ diff --git a/C/dlmalloc.c b/C/dlmalloc.c index 1c41c0986..7cf67c09a 100755 --- a/C/dlmalloc.c +++ b/C/dlmalloc.c @@ -176,16 +176,34 @@ ChunkPtrAdjust (struct malloc_chunk *ptr) /* vsc: emulation of sbrk with YAP contiguous memory management */ +void +Yap_add_memory_hole(ADDR start, ADDR end) +{ + if (Yap_NOfMemoryHoles == MAX_DLMALLOC_HOLES) { + Yap_Error(OPERATING_SYSTEM_ERROR, 0L, "Unexpected Too Much Memory Fragmentation: please contact YAP maintainers"); + return; + } + Yap_MemoryHoles[Yap_NOfMemoryHoles].start = start; + Yap_MemoryHoles[Yap_NOfMemoryHoles].end = end; + Yap_NOfMemoryHoles++; +} + static void * yapsbrk(long size) { ADDR newHeapTop = HeapTop, oldHeapTop = HeapTop; LOCK(HeapUsedLock); newHeapTop = HeapTop+size; - if (Yap_hole_start && newHeapTop > Yap_hole_start) { - HeapTop = oldHeapTop = Yap_hole_end; + if (Yap_NOfMemoryHoles && newHeapTop > Yap_MemoryHoles[0].start) { + UInt i; + + HeapTop = oldHeapTop = Yap_MemoryHoles[0].end; newHeapTop = oldHeapTop+size; - Yap_hole_start = Yap_hole_end = NULL; + Yap_NOfMemoryHoles--; + for (i=0; i < Yap_NOfMemoryHoles; i++) { + Yap_MemoryHoles[i].start = Yap_MemoryHoles[i+1].start; + Yap_MemoryHoles[i].end = Yap_MemoryHoles[i+1].end; + } } if (newHeapTop > HeapLim - MinHeapGap) { if (HeapTop + size < HeapLim) { @@ -1150,6 +1168,7 @@ static Void_t* sYSMALLOc(nb, av) INTERNAL_SIZE_T nb; mstate av; /* check that one of the above allocation paths succeeded */ if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) { + remainder_size = size - nb; remainder = chunk_at_offset(p, nb); av->top = remainder; @@ -1168,7 +1187,6 @@ static Void_t* sYSMALLOc(nb, av) INTERNAL_SIZE_T nb; mstate av; - /* sYSTRIm is an inverse of sorts to sYSMALLOc. It gives memory back to the system (via negative arguments to sbrk) if there is unused @@ -2901,6 +2919,7 @@ void Yap_initdlmalloc(void) { HeapTop = (ADDR)ALIGN_SIZE(HeapTop,16); + Yap_NOfMemoryHoles = 0; Yap_av = (struct malloc_state *)HeapTop; memset((void *)Yap_av, 0, sizeof(struct malloc_state)); HeapTop += sizeof(struct malloc_state); diff --git a/C/errors.c b/C/errors.c index 7b76027cc..dcbb84c7a 100644 --- a/C/errors.c +++ b/C/errors.c @@ -281,8 +281,13 @@ dump_stack(void) #if !USE_SYSTEM_MALLOC fprintf (stderr,"%ldKB of Code Space (%p--%p)\n",(long int)((CELL)HeapTop-(CELL)Yap_HeapBase)/1024,Yap_HeapBase,HeapTop); #if USE_DL_MALLOC - if (Yap_hole_start) { - fprintf (stderr," Last hole: %p--%p\n", Yap_hole_start, Yap_hole_end); + if (Yap_NOfMemoryHoles) { + UInt i; + + for (i=0; i < Yap_NOfMemoryHoles; i++) + fprintf(stderr," Current hole: %p--%p\n", + Yap_MemoryHoles[i].start, + Yap_MemoryHoles[i].end); } #endif #endif diff --git a/C/grow.c b/C/grow.c index 72ae89a93..697746830 100644 --- a/C/grow.c +++ b/C/grow.c @@ -263,9 +263,20 @@ MoveGlobalOnly(void) * absmi.asm */ #if HAVE_MEMMOVE - cpcellsd(H0, (CELL *)((ADDR)OldH0+DelayDiff), OldH - OldH0); + cpcellsd(H0, OldH0, OldH - OldH0); #else - cpcellsd(H, (CELL *)((ADDR)OldH+DelayDiff), OldH - OldH0); + cpcellsd(H, OldH, OldH - OldH0); +#endif +} + +static void +MoveDelays(void) +{ + UInt sz = (ADDR)OldH0-(ADDR)OldGlobalBase; +#if HAVE_MEMMOVE + cpcellsd((CELL *)Yap_GlobalBase, OldGlobalBase, sz); +#else + cpcellsd(H0, OldH0, sz); #endif } @@ -633,18 +644,25 @@ static_growglobal(long size, CELL **ptr) int gc_verbose; char *omax = (ADDR)DelayTop(); ADDR old_GlobalBase = Yap_GlobalBase; - Int ReallocDiff; + UInt minimal_request = 0L; + long size0; /* adjust to a multiple of 256) */ Yap_PrologMode |= GrowStackMode; if (size < (omax-Yap_GlobalBase)/8) size = (omax-Yap_GlobalBase)/8; - size = AdjustPageSize(size); + size0 = size = AdjustPageSize(size); Yap_ErrorMessage = NULL; if (!Yap_ExtendWorkSpace(size)) { - Yap_ErrorMessage = "Global Stack crashed against Local Stack"; - Yap_PrologMode &= ~GrowStackMode; - return FALSE; + + Yap_ErrorMessage = NULL; + size += AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap); minimal_request = size; + size = Yap_ExtendWorkSpaceThroughHole(size); + if (size < 0) { + Yap_ErrorMessage = "Global Stack crashed against Local Stack"; + Yap_PrologMode &= ~GrowStackMode; + return FALSE; + } } start_growth_time = Yap_cputime(); gc_verbose = Yap_is_gc_verbose(); @@ -655,13 +673,20 @@ static_growglobal(long size, CELL **ptr) } ASP -= 256; YAPEnterCriticalSection(); - ReallocDiff = Yap_GlobalBase-old_GlobalBase; - TrDiff = LDiff = GDiff = size + ReallocDiff; - DelayDiff = ReallocDiff; + if (minimal_request) { + DelayDiff = size-size0; + TrDiff = LDiff = GDiff = size; + } else { + TrDiff = LDiff = GDiff = size; + DelayDiff = 0; + } XDiff = HDiff = 0; Yap_GlobalBase = old_GlobalBase; SetHeapRegs(); MoveLocalAndTrail(); + if (minimal_request) { + MoveDelays(); + } MoveGlobalOnly(); AdjustStacksAndTrail(); AdjustRegs(MaxTemps); @@ -669,6 +694,9 @@ static_growglobal(long size, CELL **ptr) *ptr = PtoLocAdjust(*ptr); YAPLeaveCriticalSection(); ASP += 256; + if (minimal_request) { + Yap_AllocHole(minimal_request, size); + } growth_time = Yap_cputime()-start_growth_time; total_delay_overflow_time += growth_time; if (gc_verbose) { @@ -885,7 +913,6 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip) } #if YAPOR Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running"); - fprintf(stderr,"ERROR 1\n"); return FALSE; #endif if (SizeOfOverflow > sz) @@ -894,7 +921,6 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip) size = size/2; sz = size << shift_factor; if (sz < in_size) { -fprintf(stderr,"ERROR 2\n"); return FALSE; } } @@ -925,7 +951,6 @@ fprintf(stderr,"ERROR 2\n"); return TRUE; } /* failed */ -fprintf(stderr,"ERROR 3\n"); return FALSE; } diff --git a/C/index.c b/C/index.c index c14238720..b9dd77ece 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2006-05-02 16:44:11 $,$Author: vsc $ * +* Last rev: $Date: 2006-05-16 18:37:30 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.167 2006/05/02 16:44:11 vsc +* avoid uninitialised memory at overflow. +* * Revision 1.166 2006/05/02 16:39:06 vsc * bug in indexing code * fix warning messages for write.c @@ -381,8 +384,6 @@ UInt STATIC_PROTO(do_compound_index, (ClauseDef *,ClauseDef *,Term *t,struct int UInt STATIC_PROTO(do_dbref_index, (ClauseDef *,ClauseDef *,Term,struct intermediates *,UInt,UInt,int,int,CELL *)); UInt STATIC_PROTO(do_blob_index, (ClauseDef *,ClauseDef *,Term,struct intermediates *,UInt,UInt,int,int,CELL *)); -static UInt labelno; - static UInt cleanup_sw_on_clauses(CELL larg, UInt sz, OPCODE ecls) { @@ -3223,10 +3224,10 @@ groups_in(ClauseDef *min, ClauseDef *max, GroupDef *grp) } static UInt -new_label(void) +new_label(struct intermediates *cint) { - UInt lbl = labelno; - labelno += 2; + UInt lbl = cint->i_labelno; + cint->i_labelno += 2; return lbl; } @@ -3507,7 +3508,7 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates UInt labl; UInt labl_dyn0 = 0, labl_dynf = 0; - labl = new_label(); + labl = new_label(cint); Yap_emit(label_op, labl, Zero, cint); /* add expand_node if var_group == TRUE (jump on var) || @@ -3516,11 +3517,11 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates if (first && cint->CurrentPred->PredFlags & LogUpdatePredFlag) { UInt ncls; - labl_dyn0 = new_label(); + labl_dyn0 = new_label(cint); if (clleft) labl_dynf = labl_dyn0; else - labl_dynf = new_label(); + labl_dynf = new_label(cint); if (clleft == 0) /* trust*/ ncls = (cf-c0)+1; else @@ -3637,7 +3638,7 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i /* with tabling we don't clean trust at the very end of computation. */ if (clleft == 0 && !first) { - UInt lbl = new_label(); + UInt lbl = new_label(cint); Yap_emit(label_op, lbl, Zero, cint); /* vsc: should check if this condition is sufficient */ @@ -3775,7 +3776,7 @@ do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term, return nxtlbl; } n = count_consts(grp); - lbl = new_label(); + lbl = new_label(cint); Yap_emit(label_op, lbl, Zero, cint); cs = emit_cswitch(n, (UInt)FAILCODE, cint); for (i = 0; i < n; i++) { @@ -3848,7 +3849,7 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs /* no clauses, just skip */ return nxtlbl; } - lbl = new_label(); + lbl = new_label(cint); Yap_emit(label_op, lbl, Zero, cint); /* generate a switch */ fs = emit_fswitch(n, (UInt)FAILCODE, cint); @@ -3935,7 +3936,7 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, struct intermedi if (first) { if (clleft) { if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) { - UInt labl = new_label(); + UInt labl = new_label(cint); Yap_emit_3ops(enter_lu_op, labl, labl, 0, cint); Yap_emit(label_op, labl, Zero, cint); @@ -4063,7 +4064,7 @@ do_optims(GroupDef *group, int ngroups, UInt fail_l, ClauseDef *min, struct inte CELL *sp; UInt labl; - labl = new_label(); + labl = new_label(cint); sp = Yap_emit_extra_size(if_not_op, Zero, 4*CellSize, cint); sp[0] = (CELL)(group[0].FirstClause->Tag); sp[1] = (CELL)(group[1].FirstClause->Code); @@ -4134,7 +4135,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, } ngroups = groups_in(min, max, group); if (IsVarTerm(t)) { - lablx = new_label(); + lablx = new_label(cint); Yap_emit(label_op, lablx, Zero, cint); while (IsVarTerm(t)) { if (ngroups > 1 || !group->VarClauses) { @@ -4159,9 +4160,9 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, } ngroups = groups_in(min, max, group); } - labl0 = labl = new_label(); + labl0 = labl = new_label(cint); } else { - lablx = labl0 = labl = new_label(); + lablx = labl0 = labl = new_label(cint); } cint->expand_block = eblk; top = (CELL *)(group+ngroups); @@ -4214,7 +4215,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, (ap->PredFlags & LogUpdatePredFlag && group[0].VarClauses)) { /* make sure we know where to suspend */ Yap_emit(label_op, labl0, Zero, cint); - labl = new_label(); + labl = new_label(cint); Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint); } } @@ -4224,7 +4225,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, /* a group may end up not having clauses*/ if (i < ngroups-1) { - nextlbl = new_label(); + nextlbl = new_label(cint); } else { nextlbl = fail_l; } @@ -4306,7 +4307,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi if (ngroups == 1 && group->VarClauses == 0) { /* ok, we are doing a sub-argument */ /* process groups */ - *newlabp = new_label(); + *newlabp = new_label(cint); top = (CELL *)(group+1); newlabp = do_nonvar_group(group, (sreg == NULL ? 0L : Deref(sreg[i])), i+1, (isvt ? NULL : sreg), arity, *newlabp, cint, argno, argno == 1, (last_arg && i+1 == arity), fail_l, clleft, top); if (newlabp == NULL) { @@ -4350,7 +4351,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin if (ngroups > 1 || group->VarClauses) { return do_index(min, max, cint, argno+1, fail_l, first, clleft, top); } else { - int labl = new_label(); + int labl = new_label(cint); Yap_emit(label_op, labl, Zero, cint); Yap_emit(index_dbref_op, Zero, Zero, cint); @@ -4382,7 +4383,7 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint if (ngroups > 1 || group->VarClauses) { return do_index(min, max, cint, argno+1, fail_l, first, clleft, top); } else { - int labl = new_label(); + int labl = new_label(cint); Yap_emit(label_op, labl, Zero, cint); Yap_emit(index_blob_op, Zero, Zero, cint); @@ -4439,7 +4440,7 @@ compile_index(struct intermediates *cint) CELL *top = (CELL *) TR; /* only global variable I use directly */ - labelno = 1; + cint->i_labelno = 1; Yap_Error_Size = 0; /* reserve double the space for compiler */ @@ -4453,7 +4454,7 @@ compile_index(struct intermediates *cint) cint->freep = (char *)(cls+NClauses); if (ap->PredFlags & LogUpdatePredFlag) { /* throw away a label */ - new_label(); + new_label(cint); init_log_upd_clauses(cls,ap); } else { /* prepare basic data structures */ @@ -5005,7 +5006,7 @@ expand_index(struct intermediates *cint) { first = ap->cs.p_code.FirstClause; NClauses = ap->cs.p_code.NOfClauses; sp = stack = (istack_entry *)top; - labelno = 1; + cint->i_labelno = 1; stack[0].pos = 0; /* try to refine the interval using the indexing code */ @@ -8711,7 +8712,7 @@ find_caller(PredEntry *ap, yamop *code, struct intermediates *cint) { UInt arity = 0; sp = stack = (istack_entry *)top; - labelno = 1; + cint->i_labelno = 1; stack[0].pos = 0; /* try to refine the interval using the indexing code */ diff --git a/C/save.c b/C/save.c index a0dedbecf..8e973ccaf 100644 --- a/C/save.c +++ b/C/save.c @@ -1467,6 +1467,7 @@ CloseRestore(void) Yap_PrologMode = UserMode; } +#if !defined(_WIN32) static int check_opcodes(OPCODE old_ops[]) { @@ -1479,11 +1480,13 @@ check_opcodes(OPCODE old_ops[]) break; } } - return(have_shifted); + return have_shifted; #else - return(FALSE); + /* be conservative */ + return TRUE; #endif } +#endif static void RestoreHeap(OPCODE old_ops[]) @@ -1492,7 +1495,13 @@ RestoreHeap(OPCODE old_ops[]) Term mod = CurrentModule; CurrentModule = PROLOG_MODULE; +#if defined(_WIN32) + /* It seems that under WIN32 opcodes may not have moved but the + remaining code may have bmoved */ + opcodes_moved = TRUE; +#else opcodes_moved = check_opcodes(old_ops); +#endif /* opcodes_moved has side-effects and should be tried first */ if (heap_moved) { RestoreFreeSpace(); diff --git a/C/tracer.c b/C/tracer.c index 319b8093e..acd131f7d 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -161,8 +161,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; - if (vsc_count < 81000) - return; #ifdef COMMENTED if (worker_id != 04 || worker_id != 03) return; // if (vsc_count == 218280) diff --git a/H/Heap.h b/H/Heap.h index 53fc28c6f..766805e6f 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.97 2006-04-28 15:48:32 vsc Exp $ * +* version: $Id: Heap.h,v 1.98 2006-05-16 18:37:30 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -31,6 +31,16 @@ #define INT_KEYS_DEFAULT_SIZE 256 #endif +#if USE_DL_MALLOC + +#define MAX_DLMALLOC_HOLES 32 + +typedef struct memory_hole { + ADDR start; + ADDR end; +} memory_hole_type; +#endif + #define GC_MAVARS_HASH_SIZE 512 @@ -181,7 +191,10 @@ typedef int (*Agc_hook)(Atom); typedef struct various_codes { special_functors funcs; struct malloc_state *av_; - ADDR hole_start, hole_end; +#if USE_DL_MALLOC + struct memory_hole memory_holes[MAX_DLMALLOC_HOLES]; + UInt nof_memory_holes; +#endif Int heap_used; Int heap_max; ADDR heap_top; @@ -527,8 +540,8 @@ struct various_codes *Yap_heap_regs; #endif #define Yap_av Yap_heap_regs->av_ -#define Yap_hole_start Yap_heap_regs->hole_start -#define Yap_hole_end Yap_heap_regs->hole_end +#define Yap_MemoryHoles Yap_heap_regs->memory_holes +#define Yap_NOfMemoryHoles Yap_heap_regs->nof_memory_holes #define HeapUsed Yap_heap_regs->heap_used #define HeapMax Yap_heap_regs->heap_max #define HeapTop Yap_heap_regs->heap_top diff --git a/H/alloc.h b/H/alloc.h index 13899c7ef..d43ccaa48 100644 --- a/H/alloc.h +++ b/H/alloc.h @@ -131,6 +131,13 @@ MALLOC_T calloc(size_t,size_t); #endif +#if USE_DL_MALLOC +void Yap_add_memory_hole(ADDR, ADDR); +#else +#define Yap_add_memory_hole(Start, End) +#endif + #define SCRATCH_START_SIZE (64*1024L) #define SCRATCH_INC_SIZE (64*1024L) + diff --git a/H/compile.h b/H/compile.h index ebb6a0970..ca4042ff8 100644 --- a/H/compile.h +++ b/H/compile.h @@ -244,6 +244,7 @@ typedef struct intermediates { jmp_buf CompilerBotch; yamop *code_addr; yamop *expand_block; + UInt i_labelno; /* for expanding code */ union { struct static_index *si; diff --git a/changes-5.1.html b/changes-5.1.html index 56c804c6a..229e23466 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,14 @@

Yap-5.1.2: