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

fix indexing in 64 bits (it would split ints from atoms :( ).

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2072 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-01-30 10:35:43 +00:00
parent cca4dfef2e
commit cfa2a8f75f
6 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2008-01-24 10:20:42 $,$Author: vsc $ * * Last rev: $Date: 2008-01-30 10:35:43 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.195 2008/01/24 10:20:42 vsc
* clause should not try to discover who is fail.
*
* Revision 1.194 2008/01/24 00:11:59 vsc * Revision 1.194 2008/01/24 00:11:59 vsc
* garbage collector was not asking for space. * garbage collector was not asking for space.
* avoid 0 sized calls to mmap. * avoid 0 sized calls to mmap.
@ -598,7 +601,7 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz)
static inline int static inline int
smaller(Term t1, Term t2) smaller(Term t1, Term t2)
{ {
CELL tg1 = TagOf(t1), tg2 = TagOf(t2); CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
if (tg1 == tg2) { if (tg1 == tg2) {
return t1 < t2; return t1 < t2;
} else } else
@ -608,7 +611,7 @@ smaller(Term t1, Term t2)
static inline int static inline int
smaller_or_eq(Term t1, Term t2) smaller_or_eq(Term t1, Term t2)
{ {
CELL tg1 = TagOf(t1), tg2 = TagOf(t2); CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
if (tg1 == tg2) { if (tg1 == tg2) {
return t1 <= t2; return t1 <= t2;
} else } else
@ -3621,13 +3624,13 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint, CELL func_
} }
static AtomSwiEntry * static AtomSwiEntry *
emit_cswitch(int n, yamop *fail_l, struct intermediates *cint) emit_cswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
{ {
compiler_vm_op op; compiler_vm_op op;
AtomSwiEntry *target; AtomSwiEntry *target;
if (n > MIN_HASH_ENTRIES) { if (n > MIN_HASH_ENTRIES) {
int cases = MIN_HASH_ENTRIES, i; COUNT cases = MIN_HASH_ENTRIES, i;
n += 1+n/4; n += 1+n/4;
while (cases < n) cases *= 2; while (cases < n) cases *= 2;
n = cases; n = cases;
@ -3688,7 +3691,7 @@ fetch_centry(AtomSwiEntry *cebase, Term wt, int i, int n)
} }
static FuncSwiEntry * static FuncSwiEntry *
emit_fswitch(int n, yamop *fail_l, struct intermediates *cint) emit_fswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
{ {
compiler_vm_op op; compiler_vm_op op;
FuncSwiEntry *target; FuncSwiEntry *target;
@ -4017,9 +4020,9 @@ do_var_entries(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, in
static UInt static UInt
do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term, CELL *sreg, UInt arity, int last_arg, UInt argno, int first, UInt nxtlbl, int clleft, CELL *top) do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term, CELL *sreg, UInt arity, int last_arg, UInt argno, int first, UInt nxtlbl, int clleft, CELL *top)
{ {
UInt n; COUNT n;
ClauseDef *min = grp->FirstClause; ClauseDef *min = grp->FirstClause;
UInt i; COUNT i;
UInt lbl; UInt lbl;
/* generate a switch */ /* generate a switch */
AtomSwiEntry *cs; AtomSwiEntry *cs;
@ -4072,9 +4075,9 @@ do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term,
static void static void
do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first, UInt nxtlbl, int clleft, CELL *top) do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first, UInt nxtlbl, int clleft, CELL *top)
{ {
UInt n; COUNT n;
ClauseDef *min = grp->FirstClause; ClauseDef *min = grp->FirstClause;
UInt i; COUNT i;
/* generate a switch */ /* generate a switch */
AtomSwiEntry *cs; AtomSwiEntry *cs;
PredEntry *ap = cint->CurrentPred; PredEntry *ap = cint->CurrentPred;
@ -4106,9 +4109,9 @@ do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
static UInt static UInt
do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first, int last_arg, UInt nxtlbl, int clleft, CELL *top) do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first, int last_arg, UInt nxtlbl, int clleft, CELL *top)
{ {
UInt n = count_funcs(grp); COUNT n = count_funcs(grp);
ClauseDef *min = grp->FirstClause; ClauseDef *min = grp->FirstClause;
UInt i; COUNT i;
FuncSwiEntry *fs; FuncSwiEntry *fs;
UInt lbl; UInt lbl;
@ -4135,6 +4138,7 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
ifs->u.Label = suspend_indexing(min, max, ap, cint); ifs->u.Label = suspend_indexing(min, max, ap, cint);
} else } else
*/ */
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) if (f == FunctorDBRef)
ifs->u.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top); ifs->u.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top);

3
H/Tags_24bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Tag Scheme for machines with 24 bits adresses (m68000) * * comments: Tag Scheme for machines with 24 bits adresses (m68000) *
* version: $Id: Tags_24bits.h,v 1.1 2005-05-27 22:27:06 rslopes Exp $ * * version: $Id: Tags_24bits.h,v 1.2 2008-01-30 10:35:43 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* Version for 24 bit addresses (68000) /* Version for 24 bit addresses (68000)
@ -54,6 +54,7 @@
#define MAX_ABS_INT /* 0xfe00000LL */ ((((UInt)(1<<7))-1) << SHIFT_HIGH_TAG) #define MAX_ABS_INT /* 0xfe00000LL */ ((((UInt)(1<<7))-1) << SHIFT_HIGH_TAG)
#define TagOf(X) (Unsigned(X) & TagBits) #define TagOf(X) (Unsigned(X) & TagBits)
#define LowTagOf(X) (Unsigned(X) & TagBits)
#define NonTagPart(X) (Signed(X) & MaskAdr) #define NonTagPart(X) (Signed(X) & MaskAdr)
#define TAGGEDA(TAG,V) (TAG | Unsigned(V)) #define TAGGEDA(TAG,V) (TAG | Unsigned(V))
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V))) #define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)))

3
H/Tags_32LowTag.h
View File

@ -11,7 +11,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32LowTag.h,v 1.3 2005-05-31 08:21:43 ricroc Exp $ * * version: $Id: Tags_32LowTag.h,v 1.4 2008-01-30 10:35:43 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_LOW_BITS_32 1 #define TAG_LOW_BITS_32 1
@ -66,6 +66,7 @@
#define NumberMask /* 0x0000000bL */ MKTAG(0x2,3) #define NumberMask /* 0x0000000bL */ MKTAG(0x2,3)
#define TagOf(V) (Unsigned(V) & LowTagBits) #define TagOf(V) (Unsigned(V) & LowTagBits)
#define LowTagOf(V) (Unsigned(V) & LowTagBits)
#define NonTagPart(V) ((Unsigned(V)>>1) & ~LowTagBits) #define NonTagPart(V) ((Unsigned(V)>>1) & ~LowTagBits)
#define TAGGED(TAG,V) (((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)|(TAG)) #define TAGGED(TAG,V) (((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)|(TAG))
#define NONTAGGED(TAG,V) ((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1) #define NONTAGGED(TAG,V) ((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)

3
H/Tags_32Ops.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32Ops.h,v 1.2 2005-12-23 00:20:14 vsc Exp $ * * version: $Id: Tags_32Ops.h,v 1.3 2008-01-30 10:35:43 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* /*
@ -91,6 +91,7 @@ are now 1 in compound terms and structures.
#endif #endif
#define TagOf(t) (Unsigned(t)&TagBits) #define TagOf(t) (Unsigned(t)&TagBits)
#define LowTagOf(t) (Unsigned(t)&TagBits)
#define NonTagPart(X) (Signed(X) & MaskPrim) #define NonTagPart(X) (Signed(X) & MaskPrim)
#define TAGGEDA(TAG,V) (TAG | Unsigned(V)) #define TAGGEDA(TAG,V) (TAG | Unsigned(V))
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2)) #define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2))

3
H/Tags_64bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_64bits.h,v 1.1 2005-05-27 22:27:06 rslopes Exp $ * * version: $Id: Tags_64bits.h,v 1.2 2008-01-30 10:35:43 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_64BITS 1 #define TAG_64BITS 1
@ -65,6 +65,7 @@ property list
#define NumberMask /* 0x20000007L */ MKTAG(0x2,7) #define NumberMask /* 0x20000007L */ MKTAG(0x2,7)
#define TagOf(t) (Unsigned(t)&TagBits) #define TagOf(t) (Unsigned(t)&TagBits)
#define LowTagOf(t) (Unsigned(t)&LowTagBits)
#define NonTagPart(X) (Signed(X) & MaskPrim) #define NonTagPart(X) (Signed(X) & MaskPrim)
#define TAGGEDA(TAG,V) (TAG | Unsigned(V)) #define TAGGEDA(TAG,V) (TAG | Unsigned(V))
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */ #define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */

2
changes-5.1.html
View File

@ -17,6 +17,8 @@
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> FIXED: with 64 bits indexing would separate ints from atoms (obs from A N Saravanaraj).</li>
<li> FIXED: duplicated clause when starting from trace (obs from A N Saravanaraj).</li>
<li> FIXED: always remember wchar_t is unsigned in WIN32.</li> <li> FIXED: always remember wchar_t is unsigned in WIN32.</li>
<li> FIXED: more BOM trouble (obs from P Moura).</li> <li> FIXED: more BOM trouble (obs from P Moura).</li>
<li> FIXED: testing for BOM forced incorrect execution of gets (obs <li> FIXED: testing for BOM forced incorrect execution of gets (obs