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

continue cleanup

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-11-16 00:27:02 +00:00
parent 9c5d7af938
commit 84bd55df0d
24 changed files with 237 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/alloc.c
View File

@ -387,7 +387,7 @@ InitExStacks(int wid, int Trail, int Stack)
REMOTE_ScratchPad(wid).ptr = NULL;
REMOTE_ScratchPad(wid).sz = REMOTE_ScratchPad(wid).msz = SCRATCH_START_SIZE;
#ifdef DEBUG
#if DEBUG
if (Yap_output_msg) {
UInt ta;
@ -1547,7 +1547,7 @@ Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack)
AuxTop = (ADDR)(AuxSp = (CELL *)LOCAL_GlobalBase);
#endif
#ifdef DEBUG
#if DEBUG
#if SIZEOF_INT_P!=SIZEOF_INT
if (Yap_output_msg) {
fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n",

42
C/c_interface.c
View File

@ -581,32 +581,6 @@ current_arity(void)
}
}
static int
dogc( int extra_args, Term *tp USES_REGS )
{
UInt arity;
yamop *nextpc;
int i;
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
nextpc = P;
} else {
arity = 0;
nextpc = CP;
}
for (i=0; i < extra_args; i++) {
XREGS[arity+i+1] = tp[i];
}
if (!Yap_gc(arity+extra_args, ENV, nextpc)) {
return FALSE;
}
for (i=0; i < extra_args; i++) {
tp[i] = XREGS[arity+i+1];
}
return TRUE;
}
static int
doexpand(UInt sz)
{
@ -1005,7 +979,7 @@ YAP_MkPairTerm(Term t1, Term t2)
Int sl1 = Yap_InitSlot(t1 PASS_REGS);
Int sl2 = Yap_InitSlot(t2 PASS_REGS);
RECOVER_H();
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
return TermNil;
}
BACKUP_H();
@ -1030,7 +1004,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
while (H+sz*2 > ASP-1024) {
Int sl1 = Yap_InitSlot((CELL)ta PASS_REGS);
RECOVER_H();
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
return TermNil;
}
BACKUP_H();
@ -2062,7 +2036,7 @@ YAP_ReadBuffer(char *s, Term *tp)
while ((t = Yap_StringToTerm(s,tp)) == 0L) {
if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) {
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
LOCAL_ErrorMessage = NULL;
RECOVER_H();
@ -2908,7 +2882,7 @@ do_bootfile (char *bootfilename)
YAP_Reset();
}
YAP_EndConsult(bootfile);
#ifdef DEBUG
#if DEBUG
if (Yap_output_msg)
fprintf(stderr,"Boot loaded\n");
#endif
@ -3574,7 +3548,7 @@ YAP_FloatsToList(double *dblp, size_t sz)
/* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp;
}
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return 0L;
}
@ -3646,7 +3620,7 @@ YAP_IntsToList(Int *dblp, size_t sz)
/* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp;
}
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return 0L;
}
@ -3698,7 +3672,7 @@ YAP_OpenList(int n)
BACKUP_H();
while (H+2*n > ASP-1024) {
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
@ -4134,7 +4108,7 @@ YAP_RequiresExtraStack(size_t sz) {
while (H > ASP-sz) {
CACHE_REGS
RECOVER_H();
if (!dogc( 0, NULL PASS_REGS )) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
return -1;
}
BACKUP_H();

28
C/exec.c
View File

@ -1883,6 +1883,34 @@ p_get_exception( USES_REGS1 )
return Yap_unify(t, ARG1);
}
int
Yap_dogc( int extra_args, Term *tp USES_REGS )
{
UInt arity;
yamop *nextpc;
int i;
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
nextpc = P;
} else {
arity = 0;
nextpc = CP;
}
for (i=0; i < extra_args; i++) {
XREGS[arity+i+1] = tp[i];
}
if (!Yap_gc(arity+extra_args, ENV, nextpc)) {
return FALSE;
}
for (i=0; i < extra_args; i++) {
tp[i] = XREGS[arity+i+1];
}
return TRUE;
}
void
Yap_InitExecFs(void)
{

2
C/heapgc.c
View File

@ -2027,7 +2027,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
if (pe == NULL) {
fprintf(GLOBAL_stderr,"%% marked " Int_FORMAT " (%u)\n", LOCAL_total_marked, (unsigned int)opnum);
} else if (pe->ArityOfPE) {
fprintf(GLOBAL_stderr,"%% %s/%d marked " Int_FORMAT " (%u)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, (unsigned int)opnum);
fprintf(GLOBAL_stderr,"%% %s/%lu marked " Int_FORMAT " (%u)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, (unsigned long int)pe->ArityOfPE, LOCAL_total_marked, (unsigned int)opnum);
} else {
fprintf(GLOBAL_stderr,"%% %s marked " Int_FORMAT " (%u)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, (unsigned int)opnum);
}

4
C/init.c
View File

@ -56,12 +56,12 @@ static char SccsId[] = "%W% %G%";
#include <string.h>
#endif
int Yap_output_msg = FALSE;
#if DEBUG
#define LOGFILE "logfile"
int Yap_output_msg = FALSE;
#ifdef MACC
static void InTTYLine(char *);
#endif

9
C/pl-yap.c
View File

@ -1088,11 +1088,18 @@ term_t PL_new_term_ref__LD(ARG1_LD)
return to;
}
int PL_is_atom__LD(term_t ts ARG_LD)
{
REGS_FROM_LD
Term t = Yap_GetFromSlot(ts PASS_REGS);
return !IsVarTerm(t) && IsAtomTerm(t);
}
int PL_is_variable__LD(term_t ts ARG_LD)
{
REGS_FROM_LD
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
return YAP_IsVarTerm(t);
return IsVarTerm(t);
}
X_API int PL_unify__LD(term_t t1, term_t t2 ARG_LD)

9
C/scanner.c
View File

@ -234,7 +234,14 @@ float_send(char *s, int sign)
{
GET_LD
Float f = (Float)atof(s);
#if HAVE_FINITE
#if HAVE_ISFINITE
if (truePrologFlag(PLFLAG_ISO)) { /* iso */
if (!isfinite(f)) {
LOCAL_ErrorMessage = "Float overflow while scanning";
return(MkEvalFl(0.0));
}
}
#elif HAVE_FINITE
if (truePrologFlag(PLFLAG_ISO)) { /* iso */
if (!finite(f)) {
LOCAL_ErrorMessage = "Float overflow while scanning";

9
C/yap-args.c
View File

@ -17,7 +17,7 @@
/* static char SccsId[] = "X 4.3.3"; */
#include "config.h"
#include "YapInterface.h"
#include "Yap.h"
#if HAVE_STDINT_H
#include <stdint.h>
#endif
@ -35,6 +35,9 @@
#include <string.h>
#endif
void YAP_SetOutputMessage(void);
int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
#define DefTrailSpace MinTrailSpace
@ -153,7 +156,7 @@ dump_runtime_variables(void)
* shell
*/
X_API int
int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
char *p;
@ -416,7 +419,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
if (ch)
{
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
YAP_Exit(1);
Yap_exit(1);
}
*ssize = i;
}

1
H/Regs.h
View File

@ -724,3 +724,4 @@ CalculateStackGap(void)
// if (gmin > 1024*1024) return 1024*1024;
return gmin;
}

1
H/Yapproto.h
View File

@ -187,6 +187,7 @@ Int Yap_exec_absmi(int);
void Yap_trust_last(void);
Term Yap_GetException(void);
void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
int Yap_dogc( int extra_args, Term *tp USES_REGS );
/* exo.c */
void Yap_InitExoPreds(void);

2
H/Yatom.h
View File

@ -1787,5 +1787,7 @@ AddPropToAtom(AtomEntry *ae, PropEntry *p)
ae->PropsOfAE = AbsProp(p);
}
}
#endif

93
H/pl-basic.h
View File

@ -4,6 +4,11 @@
#define PL_BASIC_H
/* we are in YAP */
#ifndef __YAP_PROLOG__
#define __YAP_PROLOG__ 1
#endif
#if USE_GMP
#define O_GMP 1
#endif
@ -14,6 +19,8 @@
#define PL_KERNEL 1
#endif
#include <SWI-Prolog.h>
#ifdef __MINGW32__
#ifndef O_XOS
#define O_XOS 1
@ -61,46 +68,8 @@ typedef int pthread_t;
typedef uintptr_t word; /* Anonymous 4 byte object */
#if !defined(_FLI_H_INCLUDED)
typedef int bool;
/* this must be called if we're not including SWI-Prolog first */
/* should be a copy of what we can find in SWI-Prolog.h */
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
typedef struct mod_entry *module_t;
typedef struct DB_STRUCT *record_t;
typedef uintptr_t atom_t;
typedef struct pred_entry *predicate_t;
typedef struct open_query_struct *qid_t;
typedef uintptr_t functor_t;
typedef int (*PL_agc_hook_t)(atom_t);
typedef unsigned long foreign_t; /* return type of foreign functions */
typedef wchar_t pl_wchar_t; /* wide character support */
#include <inttypes.h> /* more portable than stdint.h */
#if !defined(_MSC_VER)
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
typedef int (*PL_dispatch_hook_t)(int fd);
#define O_STRING 1
typedef void *pl_function_t;
#define fid_t PL_fid_t /* avoid AIX name-clash */
#endif
#ifndef COMMON
#define COMMON(X) X
#endif
#define GLOBAL_LD (LOCAL_PL_local_data_p)
@ -116,7 +85,7 @@ typedef void *pl_function_t;
#define IGNORE_LD
#define REGS_FROM_LD
#define LD_FROM_CACHE
#define LD_FROM_REGS
#else
@ -137,6 +106,52 @@ typedef void *pl_function_t;
#endif
static inline Term
OpenList(int n USES_REGS)
{
Term t;
BACKUP_H();
while (H+2*n > ASP-1024) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
}
t = AbsPair(H);
H += 2*n;
RECOVER_H();
return t;
}
static inline Term
ExtendList(Term t0, Term inp)
{
Term t;
CELL *ptr = RepPair(t0);
BACKUP_H();
ptr[0] = inp;
ptr[1] = AbsPair(ptr+2);
t = AbsPair(ptr+2);
RECOVER_H();
return t;
}
static inline int
CloseList(Term t0, Term tail)
{
CELL *ptr = RepPair(t0);
RESET_VARIABLE(ptr-1);
if (!Yap_unify((Term)(ptr-1), tail))
return FALSE;
return TRUE;
}
#endif

5
H/pl-codelist.h
View File

@ -5,7 +5,8 @@
static inline Word
INIT_SEQ_STRING(size_t n)
{
return RepPair(YAP_OpenList(n));
CACHE_REGS
return RepPair(OpenList(n PASS_REGS));
}
static inline Word
@ -38,7 +39,7 @@ CLOSE_SEQ_STRING(Word p, Word p0, term_t tail, term_t term, term_t l) {
}
return FALSE;
} else {
p[0] = YAP_TermNil();
p[0] = TermNil;
return Yap_unify(Yap_GetFromSlot(l PASS_REGS), Yap_GetFromSlot(term PASS_REGS));
}
}

41
H/pl-incl.h
View File

@ -6,37 +6,21 @@
/* define that we are in the pl-* code */
#define _PL_EMULATION_LAYER 1
#include "config.h"
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#ifdef __MINGW32__
#define O_XOS 1
#ifndef __WINDOWS__
#define __WINDOWS__ 1
#endif
#endif
#ifdef __WINDOWS__
#include <windows.h>
#include <windows/uxnt.h>
#define O_HASDRIVES 1
#define O_HASSHARES 1
#define EMULATE_DLOPEN 1
#endif
#include "Yap.h"
#include "YapHeap.h"
/* include all stuff that is exported to yap */
#include "pl-shared.h"
#define PLVERSION YAP_VERSION
#define PLNAME "yap"
#define SWIP "swi_"
/* PL internal magic */
typedef word * Word;
/* try not to pollute the SWI space */
#ifdef P
#undef P
@ -66,6 +50,7 @@ do_endCritical(void) {
}
#define startCritical do_startCritical()
#define endCritical do_endCritical()
#ifdef LOCK
#undef LOCK
#endif
@ -73,10 +58,13 @@ do_endCritical(void) {
#undef UNLOCK
#endif
#include "pl-shared.h"
#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#ifdef HAVE_ERRNO_H
#include <errno.h>
#else
extern int errno;
#endif
typedef int Char; /* char that can pass EOF */
#define usedStack(D) 0
@ -800,6 +788,7 @@ COMMON(int) _PL_get_arg__LD(int index, term_t t, term_t a ARG_LD);
COMMON(int) PL_get_atom__LD(term_t t1, atom_t *a ARG_LD);
COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
COMMON(int) PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD);
COMMON(int) PL_is_atom__LD(term_t t ARG_LD);
COMMON(int) PL_is_variable__LD(term_t t ARG_LD);
COMMON(term_t) PL_new_term_ref__LD(ARG1_LD);
COMMON(int) PL_put_atom__LD(term_t t, atom_t a ARG_LD);

2
H/pl-shared.h
View File

@ -3,6 +3,8 @@
#define PL_SHARED_H
#include "config.h"
#include "pl-basic.h"
#include "SWI-Stream.h"

99
H/pl-yap.h
View File

@ -3,6 +3,8 @@
#ifdef __YAP_PROLOG__
#include "Yatom.h"
/* depends on tag schema, but 4 should always do */
#define LMASK_BITS 4 /* total # mask bits */
@ -25,13 +27,12 @@
#define INTBITSIZE (sizeof(int)*8)
typedef module_t Module;
typedef YAP_Term *Word; /* Anonymous 4 byte object */
typedef YAP_Term (*Func)(term_t); /* foreign functions */
typedef Term (*Func)(term_t); /* foreign functions */
extern const char *Yap_GetCurrentPredName(void);
extern YAP_Int Yap_GetCurrentPredArity(void);
extern Int Yap_GetCurrentPredArity(void);
extern int Yap_read_term(term_t t, IOSTREAM *st, term_t *exc, term_t vs);
extern term_t Yap_fetch_module_for_format(term_t args, YAP_Term *modp);
extern term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern IOENC Yap_DefaultEncoding(void);
extern void Yap_SetDefaultEncoding(IOENC);
extern void Yap_setCurrentSourceLocation(IOSTREAM **s);
@ -39,7 +40,7 @@ extern void *Yap_GetStreamHandle(Atom at);
extern atom_t codeToAtom(int chrcode);
#define valTermRef(t) ((Word)YAP_AddressFromSlot(t))
#define valTermRef(t) ((Word)Yap_AddressFromSlot(t PASS_REGS))
#include "pl-codelist.h"
@ -71,16 +72,20 @@ COMMON(word) pl_writeq(term_t term);
static inline int
get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
YAP_Term t = YAP_GetFromSlot(descr);
CACHE_REGS
Term t = Yap_GetFromSlot(descr PASS_REGS);
if (YAP_IsVarTerm(t)) return 0;
if (YAP_IsAtomTerm(t))
*proc = YAP_Predicate(YAP_AtomOfTerm(t),0,YAP_CurrentModule());
else if (YAP_IsApplTerm(t)) {
YAP_Functor f = YAP_FunctorOfTerm(t);
*proc = YAP_Predicate(YAP_NameOfFunctor(f),YAP_ArityOfFunctor(f),YAP_CurrentModule());
if (IsVarTerm(t)) return FALSE;
if (IsAtomTerm(t))
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule));
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
return FALSE;
}
*proc = RepPredProp(Yap_GetPredPropByFunc(f, CurrentModule));
}
return 1;
return TRUE;
}
COMMON(intptr_t) lengthList(term_t list, int errors);
@ -110,10 +115,10 @@ extern word globalWString(size_t size, wchar_t *s);
#define valHandle(r) valHandle__LD(r PASS_LD)
YAP_Int YAP_PLArityOfSWIFunctor(functor_t f);
YAP_Atom YAP_AtomFromSWIAtom(atom_t at);
atom_t YAP_SWIAtomFromAtom(YAP_Atom at);
PL_blob_t* YAP_find_blob_type(YAP_Atom at);
Int YAP_PLArityOfSWIFunctor(functor_t f);
Atom YAP_AtomFromSWIAtom(atom_t at);
atom_t YAP_SWIAtomFromAtom(Atom at);
struct PL_blob_t* YAP_find_blob_type(Atom at);
void PL_license(const char *license, const char *module);
@ -121,43 +126,40 @@ void PL_license(const char *license, const char *module);
#define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
#define stringAtom(w) YAP_AtomName(YAP_AtomFromSWIAtom(w))
#define isInteger(A) (YAP_IsIntTerm((A)) || YAP_IsBigNumTerm((A)))
#define isString(A) Yap_IsStringTerm(A)
#define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil())
#define isReal(A) YAP_IsFloatTerm((A))
#define isFloat(A) YAP_IsFloatTerm((A))
#define isVar(A) YAP_IsVarTerm((A))
#define valReal(w) YAP_FloatOfTerm((w))
#define valFloat(w) YAP_FloatOfTerm((w))
#ifdef AtomLength /* there is another AtomLength in the system */
#undef AtomLength
#endif
#define AtomLength(w) YAP_AtomNameLength(w)
#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) ))
#define isString(A) (!IsVarTerm(A) && Yap_IsStringTerm(A) )
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) )
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
#define isNil(A) ((A) == TermNil)
#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) YAP_AtomFromSWIAtom(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(YAP_AtomOfTerm(term))
#define atomName(atom) ((char *)YAP_AtomName(atom))
#define nameOfAtom(atom) ((char *)YAP_AtomName(atom))
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static size_t
atomLength(Atom atom)
inline static char *
atomName(Atom atom)
{
if (YAP_IsWideAtom(atom))
return wcslen(atom->WStrOfAE)*sizeof(wchar_t);
return(strlen(atom->StrOfAE));
if (IsWideAtom(atom))
return (char *)(atom->WStrOfAE);
return atom->StrOfAE;
}
#define nameOfAtom(atom) nameOfAtom(atom)
#define atomBlobType(at) YAP_find_blob_type(at)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); }
#define canBind(t) FALSE // VSC: to implement
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
#define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
#define predicateHasClauses(pe) ((pe)->cs.p_code.NOfClauses != 0)
#define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
#define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) YAP_InitSlot(*(A))
#define wordToTermRef(A) Yap_InitSlot(*(A) PASS_REGS)
#define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A)
@ -176,14 +178,16 @@ inline static int
charCode(Term w)
{ if ( IsAtomTerm(w) )
{
YAP_Atom a = atomValue(w);
Atom a = atomValue(w);
if ( YAP_AtomNameLength(a) == 1) {
if (YAP_IsWideAtom(a)) {
return YAP_WideAtomName(a)[0];
}
return YAP_AtomName(a)[0];
if (IsWideAtom(a)) {
if (wcslen(a->WStrOfAE) == 1)
return a->WStrOfAE[0];
return -1;
}
if (strlen(a->StrOfAE) == 1)
return a->StrOfAE[0];
return -1;
}
return -1;
}
@ -191,6 +195,7 @@ charCode(Term w)
#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD)
#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD)
#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD)
#define PL_is_atom(t) PL_is_atom__LD(t PASS_LD)
#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD)
#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1)
#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD)

1
config.h.in
View File

@ -206,6 +206,7 @@
#undef HAVE_GETTIMEOFDAY
#undef HAVE_GETWD
#undef HAVE_ISATTY
#undef HAVE_ISFINITE
#undef HAVE_ISINF
#undef HAVE_ISNAN
#undef HAVE_KILL

2
configure.in
View File

@ -1547,7 +1547,7 @@ AC_CHECK_FUNCS(getexecname)
AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpagesize getpid)
AC_CHECK_FUNCS(getpwnam getrlimit getrusage gettimeofday getwd)
AC_CHECK_FUNCS(isatty isnan isinf kill labs link lgamma)
AC_CHECK_FUNCS(isatty isnan isfinite isinf kill labs link lgamma)
AC_CHECK_FUNCS(localeconv localtime lstat mallinfo)
AC_CHECK_FUNCS(mbscoll)
AC_CHECK_FUNCS(mbscasecoll)

10
include/SWI-Prolog.h
View File

@ -134,8 +134,6 @@ typedef unsigned long uintptr_t;
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifndef PL_BASIC_H
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
@ -154,15 +152,16 @@ typedef wchar_t pl_wchar_t; /* wide character support */
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
typedef int (*PL_dispatch_hook_t)(int fd);
typedef void *pl_function_t;
#define O_STRING 1
typedef void *pl_function_t;
#define COMMON(X) X
#define fid_t PL_fid_t /* avoid AIX name-clash */
#endif
typedef struct _PL_extension
{ const char *predicate_name; /* Name of the predicate */
@ -619,6 +618,9 @@ extern X_API size_t PL_utf8_strlen(const char *s, size_t len);
extern X_API int PL_unify_list_codes(term_t l, const char *chars);
PL_EXPORT(void) PL_add_to_protocol(const char *buf, size_t count);
#define PL_SIGSYNC 0x00010000 /* call handler synchronously */

25
library/dialect/swi/fli/swi.c
View File

@ -41,8 +41,6 @@
#include <yapio.h>
#include "pl-basic.h"
#ifdef USE_GMP
#include <gmp.h>
#endif
@ -206,6 +204,28 @@ X_API int PL_get_arg(int index, term_t ts, term_t a)
Yap_PutInSlot(a,YAP_ArgOfTerm(index, t) PASS_REGS);
return 1;
}
X_API int _PL_get_arg(int index, term_t ts, term_t a)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !YAP_IsApplTerm(t) ) {
if (YAP_IsPairTerm(t)) {
if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1;
} else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1;
}
}
return 0;
}
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
@ -2867,6 +2887,7 @@ str_prefix(const char *p0, char *s)
static int
atom_generator(const char *prefix, char **hit, int state)
{
CACHE_REGS
struct scan_atoms *index;
Atom catom;
Int i;

4
os/pl-files.c
View File

@ -903,7 +903,7 @@ PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0)
static
PRED_IMPL("delete_file", 1, delete_file, 0)
PRED_IMPL("$swi_delete_file", 1, delete_file, 0)
{ PRED_LD
char *n;
atom_t aname;
@ -1198,7 +1198,7 @@ BeginPredDefs(files)
PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 0)
PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0)
PRED_DEF("delete_file", 1, delete_file, 0)
PRED_DEF("$swi_delete_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0)
PRED_DEF("same_file", 2, same_file, 0)

3
os/pl-os.c
View File

@ -209,9 +209,6 @@ static char errmsg[64];
#ifndef __WINDOWS__ /* defined in pl-nt.c */
#define HAVE_CLOCK_GETTIME
#define HAVE_TIMES
#ifdef HAVE_TIMES
#include <sys/times.h>

13
os/pl-privitf.c
View File

@ -133,24 +133,27 @@ PL_unify_char(term_t chr, int c, int how)
int
allocList(size_t maxcells, list_ctx *ctx)
{
ctx->gstore = ctx->start = YAP_OpenList(maxcells);
CACHE_REGS
ctx->gstore = ctx->start = OpenList(maxcells PASS_REGS);
return (ctx->gstore != 0L);
}
int
unifyList(term_t term, list_ctx *ctx)
{
if (!YAP_CloseList(ctx->gstore, YAP_TermNil()))
CACHE_REGS
if (!CloseList(ctx->gstore, TermNil))
return FALSE;
return YAP_Unify(YAP_GetFromSlot(term), ctx->start);
return Yap_unify(Yap_GetFromSlot(term PASS_REGS), ctx->start);
}
int
unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
{
if (!YAP_CloseList(ctx->gstore, YAP_GetFromSlot(tail)))
CACHE_REGS
if (!CloseList(ctx->gstore, Yap_GetFromSlot(tail PASS_REGS)))
return FALSE;
return YAP_Unify(YAP_GetFromSlot(head), ctx->start);
return Yap_unify(Yap_GetFromSlot(head PASS_REGS), ctx->start);
}
#else

6
os/pl-privitf.h
View File

@ -60,14 +60,14 @@ avoid using term-references to address the list.
typedef struct list_ctx
{
YAP_Term gstore;
YAP_Term start;
Term gstore;
Term start;
} list_ctx;
static inline void
addSmallIntList(list_ctx *ctx, int value)
{
ctx->gstore = YAP_ExtendList(ctx->gstore,YAP_MkIntTerm(value));
ctx->gstore = ExtendList(ctx->gstore,MkIntTerm(value));
}
#else