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

support interface to foreign objects that have a backtrack handler.

Browse Source
This commit is contained in:
Vitor Santos Costa 2011-07-22 04:09:33 -07:00
parent e4a775925b
commit f6be2ed08d
15 changed files with 171 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/absmi.c
View File

@ -2081,8 +2081,13 @@ Yap_absmi(int inp)
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0,pt1,H) && IsAttVar(pt1))
if (IN_BETWEEN(H0,pt1,H)) {
if (IsAttVar(pt1)) {
goto failloop;
} else if (*pt1 == (CELL)FunctorBigInt) {
Yap_CleanOpaqueVariable(pt1);
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
if (pt0 < TR_FZ)

75
C/bignum.c
View File

@ -25,9 +25,10 @@ static char SccsId[] = "%W% %G%";
#include <string.h>
#endif
#include "YapHeap.h"
#ifdef USE_GMP
#include "YapHeap.h"
#include "eval.h"
#include "alloc.h"
@ -59,27 +60,6 @@ Yap_MkBigIntTerm(MP_INT *big)
return AbsAppl(ret);
}
Term
Yap_AllocExternalDataInStack(size_t bytes)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
CELL *ret = H;
nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
if (nlimbs > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = EXTERNAL_BLOB;
dst->_mp_size = 0;
dst->_mp_alloc = nlimbs;
H = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials;
H++;
return AbsAppl(ret);
}
MP_INT *
Yap_BigIntOfTerm(Term t)
@ -149,9 +129,58 @@ Yap_RatTermToApplTerm(Term t)
return Yap_MkApplTerm(FunctorRDiv,2,ts);
}
#endif
Term
Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
CELL *ret = H;
nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
if (nlimbs > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = tag;
dst->_mp_size = 0;
dst->_mp_alloc = nlimbs;
H = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials;
H++;
if (tag != EXTERNAL_BLOB) {
TrailTerm(TR) = AbsPair(ret);
TR++;
}
return AbsAppl(ret);
}
int Yap_CleanOpaqueVariable(CELL *pt)
{
CELL blob_info, blob_tag;
MP_INT *blobp;
#ifdef DEBUG
/* sanity checking */
if (pt[0] != (CELL)FunctorBigInt) {
Yap_Error(SYSTEM_ERROR, TermNil, "CleanOpaqueVariable bad call");
return FALSE;
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
return FALSE;
}
blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers)
return FALSE;
blobp = (MP_INT *)(pt+2);
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)((void *)(blobp+1));
}
Term
Yap_MkULLIntTerm(YAP_ULONG_LONG n)
{

46
C/c_interface.c
View File

@ -391,6 +391,7 @@ X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term));
X_API Bool STD_PROTO(YAP_IsPairTerm,(Term));
X_API Bool STD_PROTO(YAP_IsApplTerm,(Term));
X_API Bool STD_PROTO(YAP_IsExternalDataInStackTerm,(Term));
X_API Bool STD_PROTO(YAP_IsOpaqueObjectTerm,(Term, int));
X_API Term STD_PROTO(YAP_MkIntTerm,(Int));
X_API Term STD_PROTO(YAP_MkBigNumTerm,(void *));
X_API Term STD_PROTO(YAP_MkRationalTerm,(void *));
@ -539,6 +540,9 @@ X_API int STD_PROTO(YAP_MaxOpPriority,(Atom, Term));
X_API int STD_PROTO(YAP_OpInfo,(Atom, Term, int, int *, int *));
X_API Term STD_PROTO(YAP_AllocExternalDataInStack,(size_t));
X_API void *STD_PROTO(YAP_ExternalDataInStackFromTerm,(Term));
X_API int STD_PROTO(YAP_NewOpaqueType,(void *));
X_API Term STD_PROTO(YAP_NewOpaqueObject,(int, size_t));
X_API void *STD_PROTO(YAP_OpaqueObjectFromTerm,(Term));
static int (*do_putcf)(wchar_t);
@ -2320,7 +2324,7 @@ YAP_RunGoal(Term t)
X_API Term
YAP_AllocExternalDataInStack(size_t bytes)
{
Term t = Yap_AllocExternalDataInStack(bytes);
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes);
if (t == TermNil)
return 0L;
return t;
@ -2329,7 +2333,7 @@ YAP_AllocExternalDataInStack(size_t bytes)
X_API Bool
YAP_IsExternalDataInStackTerm(Term t)
{
return IsExternalBlobTerm(t);
return IsExternalBlobTerm(t, EXTERNAL_BLOB);
}
X_API void *
@ -2338,6 +2342,44 @@ YAP_ExternalDataInStackFromTerm(Term t)
return ExternalBlobFromTerm (t);
}
int YAP_NewOpaqueType(void *f)
{
int i;
if (!GLOBAL_OpaqueHandlers) {
GLOBAL_OpaqueHandlers = malloc(sizeof(opaque_handler_t)*(USER_BLOB_END-USER_BLOB_START));
if (!GLOBAL_OpaqueHandlers) {
/* no room */
return -1;
}
} else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END-USER_BLOB_START) {
/* all types used */
return -1;
}
i = GLOBAL_OpaqueHandlersCount++;
memcpy(GLOBAL_OpaqueHandlers+i,f,sizeof(opaque_handler_t));
return i+USER_BLOB_START;
}
Term YAP_NewOpaqueObject(int tag, size_t bytes)
{
Term t = Yap_AllocExternalDataInStack((CELL)tag, bytes);
if (t == TermNil)
return 0L;
return t;
}
X_API Bool
YAP_IsOpaqueObjectTerm(Term t, int tag)
{
return IsExternalBlobTerm(t, (CELL)tag);
}
X_API void *
YAP_OpaqueObjectFromTerm(Term t)
{
return ExternalBlobFromTerm (t);
}
X_API Term
YAP_RunGoalOnce(Term t)
{

4
C/grow.c
View File

@ -399,7 +399,7 @@ AdjustTrail(int adjusting_heap, int thread_copying USES_REGS)
#if defined(YAPOR_THREADS)
}
#endif
/* moving the trail is simple */
/* moving the trail is simple, yeaahhh! */
while (ptt != tr_base) {
register CELL reg = TrailTerm(ptt-1);
#ifdef FROZEN_STACKS
@ -420,8 +420,6 @@ AdjustTrail(int adjusting_heap, int thread_copying USES_REGS)
} else if (IsPairTerm(reg)) {
TrailTerm(ptt) = AdjustPair(reg PASS_REGS);
#ifdef MULTI_ASSIGNMENT_VARIABLES /* does not work with new structures */
/* check it whether we are protecting a
multi-assignment */
} else if (IsApplTerm(reg)) {
TrailTerm(ptt) = AdjustAppl(reg PASS_REGS);
#endif

25
C/heapgc.c
View File

@ -1658,13 +1658,22 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
#endif
}
} else if (IsPairTerm(trail_cell)) {
/* can safely ignore this */
/* cannot safely ignore this */
CELL *cptr = RepPair(trail_cell);
if (IN_BETWEEN(LOCAL_GlobalBase,cptr,H) &&
GlobalIsAttVar(cptr)) {
if (IN_BETWEEN(LOCAL_GlobalBase,cptr,H)) {
if (GlobalIsAttVar(cptr)) {
TrailTerm(trail_base) = (CELL)cptr;
mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
TrailTerm(trail_base) = trail_cell;
} else if (*cptr == (CELL)FunctorBigInt) {
TrailTerm(trail_base) = AbsAppl(cptr);
mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
TrailTerm(trail_base) = trail_cell;
}
#ifdef DEBUG
else
fprintf(GLOBAL_stderr,"OOPS in GC: weird trail entry at %p:" UInt_FORMAT "\n", &TrailTerm(trail_base), (CELL)cptr);
#endif
}
}
#if MULTI_ASSIGNMENT_VARIABLES
@ -2450,12 +2459,20 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
CELL *pt0 = RepPair(trail_cell);
CELL flags;
if (IN_BETWEEN(LOCAL_GlobalBase, pt0, H) && GlobalIsAttVar(pt0)) {
if (IN_BETWEEN(LOCAL_GlobalBase, pt0, H)) {
if (GlobalIsAttVar(pt0)) {
TrailTerm(dest) = trail_cell;
/* be careful with partial gc */
if (HEAP_PTR(TrailTerm(dest))) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS);
}
} else if (*pt0 == (CELL)FunctorBigInt) {
TrailTerm(dest) = trail_cell;
/* be careful with partial gc */
if (HEAP_PTR(TrailTerm(dest))) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS);
}
}
dest++;
trail_ptr++;
continue;

10
H/TermExt.h
View File

@ -86,7 +86,9 @@ typedef enum
CLAUSE_LIST = 0x40,
BLOB_STRING = 0x80, /* SWI style strings */
BLOB_WIDE_STRING = 0x81, /* SWI style strings */
EXTERNAL_BLOB = 0x100 /* generic data */
EXTERNAL_BLOB = 0x100, /* generic data */
USER_BLOB_START = 0x1000, /* user defined blob */
USER_BLOB_END = 0x1100 /* end of user defined blob */
}
big_blob_type;
@ -438,14 +440,14 @@ IsLargeNumTerm (Term t)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
}
inline EXTERN int IsExternalBlobTerm (Term);
inline EXTERN int IsExternalBlobTerm (Term, CELL);
inline EXTERN int
IsExternalBlobTerm (Term t)
IsExternalBlobTerm (Term t, CELL tag)
{
return (int) (IsApplTerm (t) &&
FunctorOfTerm (t) == FunctorBigInt &&
RepAppl(t)[1] == EXTERNAL_BLOB);
RepAppl(t)[1] == tag);
}
inline EXTERN void *ExternalBlobFromTerm (Term);

6
H/YapHeap.h
View File

@ -33,6 +33,12 @@ typedef int (*SWI_PLGetStreamPositionFunction)(void *);
#include "../include/dswiatoms.h"
typedef int (*Opaque_CallOnFail)(void *);
typedef struct opaque_handler_struct {
Opaque_CallOnFail fail_handler;
} opaque_handler_t;
#ifndef INT_KEYS_DEFAULT_SIZE
#define INT_KEYS_DEFAULT_SIZE 256
#endif

3
H/Yapproto.h
View File

@ -120,7 +120,8 @@ int STD_PROTO(Yap_IsStringTerm, (Term));
int STD_PROTO(Yap_IsWideStringTerm, (Term));
Term STD_PROTO(Yap_RatTermToApplTerm, (Term));
void STD_PROTO(Yap_InitBigNums, (void));
Term STD_PROTO(Yap_AllocExternalDataInStack, (size_t));
Term STD_PROTO(Yap_AllocExternalDataInStack, (CELL, size_t));
int STD_PROTO(Yap_CleanOpaqueVariable, (CELL *));
/* c_interface.c */
Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));

2
H/dglobals.h
View File

@ -102,6 +102,8 @@
#define GLOBAL_Executable Yap_global->Executable_
#endif
#define GLOBAL_OpaqueHandlersCount Yap_global->OpaqueHandlersCount_
#define GLOBAL_OpaqueHandlers Yap_global->OpaqueHandlers_
#if __simplescalar__
#define GLOBAL_pwd Yap_global->pwd_
#endif

2
H/hglobals.h
View File

@ -102,6 +102,8 @@ typedef struct global_data {
char Executable_[YAP_FILENAME_MAX];
#endif
int OpaqueHandlersCount_;
struct opaque_handler_struct* OpaqueHandlers_;
#if __simplescalar__
char pwd_[YAP_FILENAME_MAX];
#endif

2
H/iglobals.h
View File

@ -102,6 +102,8 @@ static void InitGlobal(void) {
#endif
GLOBAL_OpaqueHandlersCount = 0;
GLOBAL_OpaqueHandlers = NULL;
#if __simplescalar__
#endif

2
H/rglobals.h
View File

@ -102,6 +102,8 @@ static void RestoreGlobal(void) {
#endif
#if __simplescalar__
#endif

10
include/YapInterface.h
View File

@ -558,11 +558,13 @@ extern X_API int PROTO(YAP_OpInfo,(YAP_Atom, YAP_Term, int, int *, int *));
/* YAP_Bool YAP_IsExternalDataInStackTerm(YAP_Term) */
extern X_API YAP_Bool PROTO(YAP_IsExternalDataInStackTerm,(YAP_Term));
/* Term YAP_AllocExternalDataInStack(size_t) */
extern X_API YAP_Term PROTO(YAP_AllocExternalDataInStack,(size_t));
extern X_API YAP_opaque_tag_t PROTO(YAP_NewOpaqueType,(struct YAP_opaque_handler_struct *));
/* void *YAP_ExternalDataInStackFromTerm(YAP_Term) */
extern X_API void *PROTO(YAP_ExternalDataInStackFromTerm,(YAP_Term));
extern X_API YAP_Bool PROTO(YAP_IsOpaqueObjectTerm,(YAP_Term, YAP_opaque_tag_t));
extern X_API YAP_Term PROTO(YAP_NewOpaqueObject,(YAP_opaque_tag_t, size_t));
extern X_API void *PROTO(YAP_OpaqueObjectFromTerm,(YAP_Term));
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)

8
include/yap_structs.h
View File

@ -204,6 +204,14 @@ typedef int (*YAP_agc_hook)(void *_Atom);
typedef void (*YAP_halt_hook)(int exit_code, void *closure);
typedef int YAP_opaque_tag_t;
typedef int (*YAP_Opaque_CallOnFail)(void *);
typedef struct YAP_opaque_handler_struct {
YAP_Opaque_CallOnFail fail_handler;
} YAP_opaque_handler_t;
/********* execution mode ***********************/
typedef enum

2
misc/GLOBALS
View File

@ -120,6 +120,8 @@ char* DIRNAME =NULL
char Executable[YAP_FILENAME_MAX] void
#endif
int OpaqueHandlersCount =0
struct opaque_handler_struct* OpaqueHandlers =NULL
#if __simplescalar__
char pwd[YAP_FILENAME_MAX] void