WIN32 fixes
compiler bug fixes extend interface git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1632 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
b54dd9e2b9
commit
98de08022b
31
C/alloc.c
31
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;
|
||||
}
|
||||
|
||||
@ -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
|
||||
*
|
||||
@ -330,6 +333,10 @@ 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_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;
|
||||
}
|
||||
|
||||
|
||||
13
C/compiler.c
13
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) {
|
||||
/* 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);
|
||||
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 */
|
||||
|
||||
27
C/dlmalloc.c
27
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);
|
||||
|
||||
@ -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
|
||||
|
||||
45
C/grow.c
45
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,19 +644,26 @@ 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 = 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();
|
||||
delay_overflows++;
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
53
C/index.c
53
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 */
|
||||
|
||||
13
C/save.c
13
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();
|
||||
|
||||
@ -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)
|
||||
|
||||
21
H/Heap.h
21
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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -16,6 +16,14 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> NEW: make YAP large address aware on WIN32 (should be able to
|
||||
allocate up to 3GB).</li>
|
||||
<li> FIXED: WIN32 may have a lot of fragmentation so several memory holes may be active at the same time, keep up to 32 open holes.</li>
|
||||
<li> FIXED: WIN32 may move functions without moving emulator: always fix C-functtions.</li>
|
||||
<li> FIXED: use $SYSTEMDRIVE to install YAP in WIN32.</li>
|
||||
<li> FIXED: compilation bug in arg(X,1,A).</li>
|
||||
<li> NEW: extend interface to pass chunks of integers/floats.</li>
|
||||
<li> FIXED: get rid of some more global variables.</li>
|
||||
<li> NEW: thread_yield/0 (request Paulo Moura).</li>
|
||||
<li> FIXED: current_thread was not returning aliases (obs Paulo Moura).</li>
|
||||
<li> FIXED: AuxSp was not properly initialised for new threads (obs Paulo Moura).</li>
|
||||
|
||||
@ -360,7 +360,7 @@ then
|
||||
yap_cv_readline=no
|
||||
if test "$prefix" = "NONE"
|
||||
then
|
||||
prefix="c:/Yap"
|
||||
prefix="$SYSTEMDRIVE/Yap"
|
||||
fi
|
||||
else
|
||||
use_malloc="yes"
|
||||
@ -722,6 +722,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
SHLIB_LD="\$(CC) -shared ../../yap.dll"
|
||||
SHLIB_SUFFIX=".dll"
|
||||
C_PARSER_FLAGS="$C_INTERF_FLAGS"
|
||||
LDFLAGS="-Wl,--large-address-aware $LDFLAGS"
|
||||
EXEC_SUFFIX=".exe"
|
||||
INSTALL_DLLS=""
|
||||
DO_SECOND_LD=""
|
||||
|
||||
@ -366,6 +366,12 @@ extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
|
||||
|
||||
/* matrices stuff */
|
||||
extern X_API int PROTO(YAP_ArgsToIntArray,(YAP_Term, YAP_UInt, const YAP_Int *));
|
||||
extern X_API YAP_Term PROTO(YAP_IntArrayToArgs,(YAP_UInt, const YAP_Int *));
|
||||
extern X_API int PROTO(YAP_ArgsToFloatArray,(YAP_Term, YAP_UInt, const YAP_Float *));
|
||||
extern X_API YAP_Term PROTO(YAP_FloatArrayToArgs,(YAP_UInt, const YAP_Float *));
|
||||
|
||||
/* term comparison */
|
||||
extern X_API int PROTO(YAP_CompareTerms,(YAP_Term, YAP_Term));
|
||||
|
||||
|
||||
@ -43,6 +43,8 @@ typedef struct AtomEntry *YAP_Atom;
|
||||
|
||||
typedef long int YAP_Int;
|
||||
|
||||
typedef unsigned long int YAP_UInt;
|
||||
|
||||
typedef double YAP_Float;
|
||||
|
||||
#ifndef TRUE
|
||||
|
||||
@ -92,4 +92,7 @@ YAP_ThreadAttachEngine
|
||||
YAP_ThreadDetachEngine
|
||||
YAP_ThreadDestroyEngine
|
||||
YAP_CompareTerms
|
||||
|
||||
YAP_ArgsToIntArray
|
||||
YAP_IntArrayToArgs
|
||||
YAP_ArgsToFloatArray
|
||||
YAP_FloatArrayToArgs
|
||||
|
||||
Reference in New Issue
Block a user