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

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

Browse Source
This commit is contained in:
Tiago Gomes 2013-01-25 13:50:09 +00:00
commit 31bff4dc84
112 changed files with 5508 additions and 3004 deletions

92
C/absmi.c

@ -963,7 +963,7 @@ Yap_absmi(int inp)
/*****************************************************************
* EXO try - retry instructions *
*****************************************************************/
/* try_exo Pred,Label */
/* enter_exo Pred,Label */
BOp(enter_exo, e);
{
yamop *pt;
@ -1011,6 +1011,37 @@ Yap_absmi(int inp)
GONext();
ENDOp();
/* try_udi Pred,Label */
Op(try_udi, p);
/* check if enough space between trail and codespace */
check_trail(TR);
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
* register, but sometimes (X86) not. In this case, have a
* new register to point at YREG =*/
CACHE_Y(YREG);
{
S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */
}
S_YREG--;
/* store arguments for procedure */
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
/* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0);
/* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut.
*/
set_cut(S_YREG, B);
/* now, install the new YREG =*/
B = B_YREG;
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
SET_BB(B_YREG);
ENDCACHE_Y();
GONext();
ENDOp();
/* check if enough space between trail and codespace */
/* try_exo Pred,Label */
Op(try_all_exo, lp);
@ -1097,6 +1128,61 @@ Yap_absmi(int inp)
GONext();
ENDOp();
/* retry_exo Pred */
Op(retry_udi, p);
BEGD(d0);
CACHE_Y(B);
{
// struct udi_index_t *jp = (struct udi_index_t *)((CELL *)(B+1))[it->arity];
/* operation has a side-effect: S = (CELL*)NextClause */
saveregs();
d0 = 0L; // Yap_UDI_NextAlt(jp);
setregs();
#ifdef SHADOW_S
SREG = S;
#endif
/* d0 says if we're last */
}
if (d0) {
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_YREG);
} else {
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
}
PREG = (yamop *)SREG;
ENDCACHE_Y();
ENDD(D0);
GONext();
ENDOp();
/* retry_exo Pred */
Op(retry_all_exo, lp);
BEGD(d0);
@ -7446,7 +7532,7 @@ Yap_absmi(int inp)
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_ExecuteFirst(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
EX = 0L;
EX = NULL;
restore_machine_regs();
setregs();
LOCAL_PrologMode = UserMode;
@ -7489,7 +7575,7 @@ Yap_absmi(int inp)
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_ExecuteNext(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
EX = 0L;
EX = NULL;
restore_machine_regs();
setregs();
LOCAL_PrologMode = UserMode;

3
C/arith1.c

@ -523,8 +523,7 @@ eval1(Int fi, Term t) {
#endif
#if HAVE_ISINF
if (isinf(dbl)) {
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\
(%f)",dbl);
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer (%f)",dbl);
}
#endif
if (dbl < 0.0)

46
C/c_interface.c

@ -1663,6 +1663,10 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
{
CACHE_REGS
Int ret;
// Term omod = CurrentModule;
//if (pe->PredFlags & CArgsPredFlag) {
// CurrentModule = pe->ModuleOfPred;
//}
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context ctx;
@ -1683,6 +1687,7 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
ret = (exec_code)( PASS_REGS1 );
}
PP = NULL;
//CurrentModule = omod;
if (!ret) {
Term t;
@ -2429,6 +2434,8 @@ YAP_RunGoal(Term t)
Yap_StartSlots( PASS_REGS1 );
} else {
ENV = B->cp_env;
ENV = (CELL *)ENV[E_E];
CP = old_CP;
B = B->cp_b;
LOCAL_AllowRestart = FALSE;
}
@ -2503,11 +2510,13 @@ YAP_RunGoalOnce(Term t)
Term out;
yamop *old_CP = CP;
Int oldPrologMode = LOCAL_PrologMode;
Int oldSlot = CurSlot;
BACKUP_MACHINE_REGS();
LOCAL_PrologMode = UserMode;
out = Yap_RunTopGoal(t);
LOCAL_PrologMode = oldPrologMode;
CurSlot = oldSlot;
if (!(oldPrologMode & UserCCallMode)) {
/* called from top-level */
LOCAL_AllowRestart = FALSE;
@ -2538,10 +2547,9 @@ YAP_RunGoalOnce(Term t)
B = cut_pt;
}
ASP = B->cp_env;
Yap_PopSlots( PASS_REGS1 );
ENV = (CELL *)ASP[E_E];
B = (choiceptr)ASP[E_CB];
#ifdef DEPTH_LIMIT
#ifdef DEPTH_LIMITxs
DEPTH = ASP[E_DEPTH];
#endif
P = (yamop *)ASP[E_CP];
@ -2567,7 +2575,6 @@ YAP_RestartGoal(void)
if (out == FALSE) {
/* cleanup */
Yap_trust_last();
Yap_CloseSlots( PASS_REGS1 );
LOCAL_AllowRestart = FALSE;
}
} else {
@ -3043,42 +3050,11 @@ YAP_Init(YAP_init_args *yap_init)
yap_init->SchedulerLoop,
yap_init->DelayedReleaseLoad
);
#if THREADS
/* make sure we use the correct value of regcache */
regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
#endif
#if USE_SYSTEM_MALLOC
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
if (Stack < MinStackSpace)
Stack = MinStackSpace;
if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
yap_init->ErrorNo = RESOURCE_ERROR_MEMORY;
yap_init->ErrorCause = "could not allocate stack space for main thread";
return YAP_BOOT_ERROR;
}
#if THREADS
/* don't forget this is a thread */
LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase;
LOCAL_ThreadHandle.ssize = Trail+Stack;
#endif
#endif
GLOBAL_AllowGlobalExpansion = TRUE;
GLOBAL_AllowLocalExpansion = TRUE;
GLOBAL_AllowTrailExpansion = TRUE;
Yap_InitExStacks (0, Trail, Stack);
if (yap_init->QuietMode) {
yap_flags[QUIET_MODE_FLAG] = TRUE;
}
{ BACKUP_MACHINE_REGS();
Yap_InitYaamRegs( 0 );
#if HAVE_MPE
Yap_InitMPE ();
#endif
if (yap_init->YapPrologRCFile != NULL) {
{ if (yap_init->YapPrologRCFile != NULL) {
/*
This must be done before restore, otherwise
restore will print out messages ....

36
C/cdmgr.c

@ -5416,27 +5416,55 @@ Yap_dump_code_area_for_profiler(void) {
#endif /* LOW_PROF */
static UInt
index_ssz(StaticIndex *x)
tree_index_ssz(StaticIndex *x)
{
UInt sz = x->ClSize;
x = x->ChildIndex;
while (x != NULL) {
sz += index_ssz(x);
sz += tree_index_ssz(x);
x = x->SiblingIndex;
}
return sz;
}
static UInt
index_ssz(StaticIndex *x, PredEntry *pe)
{
UInt sz = 0;
yamop *ep = ExpandClausesFirst;
if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
struct index_t *i = ((struct index_t **)(pe->cs.p_code.FirstClause))[0];
sz = 0;
while (i) {
sz = i->size+sz;
}
return sz;
}
}
/* expand clause blocks */
while (ep) {
if (ep->u.sssllp.p == pe)
sz += (UInt)NEXTOP((yamop *)NULL,sssllp)+ep->u.sssllp.s1*sizeof(yamop *);
ep = ep->u.sssllp.snext;
}
/* main indexing tree */
sz += tree_index_ssz(x);
return sz;
}
static Int
static_statistics(PredEntry *pe)
{
CACHE_REGS
UInt sz = 0, cls = 0, isz = 0;
UInt sz = sizeof(PredEntry), cls = 0, isz = 0;
StaticClause *cl = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause);
if (pe->cs.p_code.NOfClauses > 1 &&
pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause) {
isz = index_ssz(ClauseCodeToStaticIndex(pe->cs.p_code.TrueCodeOfPred));
isz = index_ssz(ClauseCodeToStaticIndex(pe->cs.p_code.TrueCodeOfPred), pe);
}
if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);

18
C/compiler.c

@ -2109,14 +2109,14 @@ c_head(Term t, compiler_struct *cglobs)
if (IsAtomTerm(t)) {
Yap_emit(name_op, (CELL) AtomOfTerm(t), Zero, &cglobs->cint);
#ifdef BEAM
if (EAM) {
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
if (EAM) {
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
#endif
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
return;
}
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
f = FunctorOfTerm(t);
Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f), &cglobs->cint);
#ifdef BEAM
@ -2124,8 +2124,10 @@ c_head(Term t, compiler_struct *cglobs)
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
#endif
if (Yap_ExecutionMode == MIXED_MODE_USER)
if (Yap_ExecutionMode == MIXED_MODE_USER)
Yap_emit(native_op, 0, 0, &cglobs->cint);
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
c_args(t, 0, cglobs);
}
@ -3537,6 +3539,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
}
if (LOCAL_ErrorMessage)
return (0);
/* make sure we give enough space for the fact */
if (cglobs.space_op)
cglobs.space_op->rnd1 = cglobs.space_used;
#ifdef DEBUG
if (GLOBAL_Option['g' - 96])
Yap_ShowCode(&cglobs.cint);

14
C/dbase.c

@ -3749,7 +3749,7 @@ index_sz(LogUpdIndex *x)
static Int
lu_statistics(PredEntry *pe USES_REGS)
{
UInt sz = 0, cls = 0, isz = 0;
UInt sz = sizeof(PredEntry), cls = 0, isz = 0;
/* count number of clauses and size */
LogUpdClause *x;
@ -3765,10 +3765,16 @@ lu_statistics(PredEntry *pe USES_REGS)
x = x->ClNext;
}
}
isz = 0;
if (pe->PredFlags & IndexedPredFlag) {
isz = index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
} else {
isz = 0;
/* expand clause blocks */
yamop *ep = ExpandClausesFirst;
while (ep) {
if (ep->u.sssllp.p == pe)
isz += (UInt)NEXTOP((yamop *)NULL,sssllp)+ep->u.sssllp.s1*sizeof(yamop *);
ep = ep->u.sssllp.snext;
}
isz += index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
}
return
Yap_unify(ARG2,MkIntegerTerm(cls)) &&

22
C/depth_bound.c

@ -18,6 +18,11 @@
static char SccsId[] = "%W% %G%";
#endif /* SCCS */
#include <math.h>
#ifndef INFINITY
#define INFINITY (1.0/0.0)
#endif
#include "Yap.h"
#ifdef DEPTH_LIMIT
@ -29,7 +34,10 @@ STD_PROTO(static Int p_set_depth_limit, ( USES_REGS1 ));
static Int p_get_depth_limit( USES_REGS1 )
{
return(Yap_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
Int d = IntOfTerm(DEPTH);
if (d % 2 == 1)
return(Yap_unify(ARG1, MkFloatTerm(INFINITY)));
return(Yap_unify_constant(ARG1, MkIntTerm(d/2)));
}
static Int p_set_depth_limit( USES_REGS1 )
@ -40,8 +48,12 @@ static Int p_set_depth_limit( USES_REGS1 )
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
d = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
}
d = MkIntTerm(IntegerOfTerm(d)*2);
@ -59,6 +71,10 @@ static Int p_set_depth_limit_for_next_call( USES_REGS1 )
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
return TRUE;
}
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}

11
C/errors.c

@ -1441,6 +1441,17 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case SAVED_STATE_ERROR:
{
int i;
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomSystemError);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case SYSTEM_ERROR:
{
int i;

117
C/exec.c

@ -33,6 +33,7 @@ STATIC_PROTO(Int EnterCreepMode, (Term, Term CACHE_TYPE));
STATIC_PROTO(Int p_save_cp, ( USES_REGS1 ));
STATIC_PROTO(Int p_execute, ( USES_REGS1 ));
STATIC_PROTO(Int p_execute0, ( USES_REGS1 ));
static int execute_pred(PredEntry *ppe, CELL *pt USES_REGS);
static Term
cp_as_integer(choiceptr cp USES_REGS)
@ -666,7 +667,7 @@ p_do_goal_expansion( USES_REGS1 )
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
ARG3 = ARG2;
goto complete;
@ -675,7 +676,7 @@ p_do_goal_expansion( USES_REGS1 )
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
ARG3 = ARG2;
goto complete;
@ -686,7 +687,7 @@ p_do_goal_expansion( USES_REGS1 )
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
goto complete;
}
@ -696,7 +697,7 @@ p_do_goal_expansion( USES_REGS1 )
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
ARG3 = ARG2;
out = TRUE;
}
@ -728,7 +729,7 @@ p_do_term_expansion( USES_REGS1 )
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
goto complete;
}
@ -736,7 +737,7 @@ p_do_term_expansion( USES_REGS1 )
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
goto complete;
}
@ -745,7 +746,7 @@ p_do_term_expansion( USES_REGS1 )
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
execute_pred(pe, NULL PASS_REGS) ) {
out = TRUE;
}
complete:
@ -1142,7 +1143,7 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
/* and now create a pseudo choicepoint for much the same reasons */
/* CP = YESCODE; */
/* keep a place where you can inform you had an exception */
{
if (pt) {
int i;
for (i = 0; i < arity; i++) {
XREGS[i+1] = *pt++;
@ -1167,7 +1168,7 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
}
static Int
do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
{
choiceptr saved_b = B;
Int out;
@ -1193,59 +1194,28 @@ Yap_exec_absmi(int top)
}
Int
Yap_execute_goal(Term t, int nargs, Term mod)
static int
execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
{
CACHE_REGS
Int out;
yamop *CodeAdr;
yamop *saved_p, *saved_cp;
Prop pe;
PredEntry *ppe;
CELL *pt;
/* preserve the current restart environment */
/* visualc*/
/* just keep the difference because of possible garbage collections */
Int saved_slot = CurSlot;
yamop *CodeAdr;
Int out;
saved_p = P;
saved_cp = CP;
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pt = NULL;
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t)+1;
pe = PredPropByFunc(f, mod);
} else {
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
ppe = RepPredProp(pe);
if (pe == NIL) {
return CallMetaCall(t, mod PASS_REGS);
}
PELOCK(81,RepPredProp(pe));
if (IsAtomTerm(t)) {
PELOCK(81,ppe);
if (ppe->ArityOfPE == 0) {
CodeAdr = ppe->CodeOfPred;
UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, 0, pt, FALSE PASS_REGS);
out = do_goal(CodeAdr, 0, pt, FALSE PASS_REGS);
} else {
Functor f = FunctorOfTerm(t);
CodeAdr = ppe->CodeOfPred;
UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE PASS_REGS);
out = do_goal(CodeAdr, ppe->ArityOfPE, pt, FALSE PASS_REGS);
}
CurSlot = saved_slot;
if (out == 1) {
choiceptr cut_B;
@ -1284,15 +1254,13 @@ Yap_execute_goal(Term t, int nargs, Term mod)
DEPTH= ENV[E_DEPTH];
#endif
ENV = (CELL *)(ENV[E_E]);
Yap_StartSlots( PASS_REGS1 );
/* we have failed, and usually we would backtrack to this B,
trouble is, we may also have a delayed cut to do */
if (B != NULL)
HB = B->cp_h;
YENV = ENV;
return(TRUE);
return TRUE;
} else if (out == 0) {
ASP = B->cp_env;
P = saved_p;
CP = saved_cp;
H = B->cp_h;
@ -1314,6 +1282,47 @@ Yap_execute_goal(Term t, int nargs, Term mod)
}
}
Int
Yap_execute_goal(Term t, int nargs, Term mod)
{
CACHE_REGS
Prop pe;
PredEntry *ppe;
CELL *pt;
/* preserve the current restart environment */
/* visualc*/
/* just keep the difference because of possible garbage collections */
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pt = NULL;
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t)+1;
pe = PredPropByFunc(f, mod);
} else {
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
ppe = RepPredProp(pe);
if (pe == NIL) {
return CallMetaCall(t, mod PASS_REGS);
}
return execute_pred(ppe, pt PASS_REGS);
}
void
Yap_trust_last(void)
{
@ -1399,7 +1408,7 @@ Yap_RunTopGoal(Term t)
"unable to boot because of too little Trail space");
}
#endif
goal_out = do_goal(t, CodeAdr, arity, pt, TRUE PASS_REGS);
goal_out = do_goal(CodeAdr, arity, pt, TRUE PASS_REGS);
return goal_out;
}

4
C/exo.c

@ -143,6 +143,7 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0, UInt bnd
if (bnds[k]) {
if (*target != cl[k]) {
/* found a new forking point */
// printf("j=%ld hash0=%ld cl[j]=%lx\n", j, hash0, cl[j]);
INSERT(cl, it, arity, k, hash0, bnds);
return;
}
@ -229,6 +230,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
static struct index_t *
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
{
CACHE_REGS
UInt ncls = ap->cs.p_code.NOfClauses, j;
CELL *base = NULL;
struct index_t *i;
@ -264,6 +266,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
}
bzero(base, 3*sizeof(CELL)*ncls);
}
i->size = sizeof(CELL)*(ncls+i->hsize)+sz+sizeof(struct index_t);
i->key = (CELL **)base;
i->links = (CELL *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0;
@ -308,6 +311,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
ptr = NEXTOP(ptr, p);
ptr->opc = Yap_opcode(_Ystop);
ptr->u.l.l = i->code;
Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX);
return i;
}

2
C/heapgc.c

@ -4173,7 +4173,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
}
/*
* debug for(save_total=1; save_total<=N; ++save_total)
* plwrite(XREGS[save_total],NULL,30,0,0);
* plwrite(XREGS[save_total],NULL,30,0,0,0);
*/
return TRUE;
}

33
C/init.c

@ -884,6 +884,13 @@ InitStdPreds(void)
{
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
Yap_InitYaamRegs( 0 );
#if HAVE_MPE
Yap_InitMPE ();
#endif
initIO();
}
static void
@ -1005,9 +1012,12 @@ InitLogDBErasedMarker(void)
static void
InitSWIAtoms(void)
{
extern atom_t ATOM_;
int i=0, j=0;
#include "iswiatoms.h"
Yap_InitSWIHash();
ATOM_ = PL_new_atom("");
}
static void
@ -1331,6 +1341,29 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
InitDebug();
InitVersion();
Yap_InitSysPath();
#if THREADS
/* make sure we use the correct value of regcache */
regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
#endif
#if USE_SYSTEM_MALLOC
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
if (Stack < MinStackSpace)
Stack = MinStackSpace;
if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
Yap_Error(RESOURCE_ERROR_MEMORY, 0, "could not allocate stack space for main thread");
Yap_exit(1);
}
#if THREADS
/* don't forget this is a thread */
LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase;
LOCAL_ThreadHandle.ssize = Trail+Stack;
#endif
#endif
GLOBAL_AllowGlobalExpansion = TRUE;
GLOBAL_AllowLocalExpansion = TRUE;
GLOBAL_AllowTrailExpansion = TRUE;
Yap_InitExStacks (0, Trail, Stack);
InitStdPreds();
/* make sure tmp area is available */
{

6
C/iopreds.c Normal file → Executable file

@ -219,10 +219,10 @@ Yap_GetCharForSIGINT(void)
{
int ch;
/* ask for a new line */
fprintf(stderr, "Action (h for help): ");
ch = getc(stdin);
Sfprintf(Serror, "\nAction (h for help): ");
ch = Sgetchar();
/* first process up to end of line */
while ((fgetc(stdin)) != '\n');
while ((Sfgetc(Sinput)) != '\n');
newline = TRUE;
return ch;
}

6
C/load_dll.c

@ -27,10 +27,10 @@
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
return NULL;
return "yap";
}
void *

94
C/pl-yap.c

@ -177,6 +177,23 @@ Yap_SetDefaultEncoding(IOENC new_encoding)
LD->encoding = new_encoding;
}
int
PL_qualify(term_t raw, term_t qualified)
{ GET_LD
Module m = NULL;
term_t mname;
if ( !(mname = PL_new_term_ref()) ||
!PL_strip_module(raw, &m, qualified) )
return FALSE;
/* modules are terms in YAP */
Yap_PutInSlot(mname, (Term)m PASS_REGS);
return PL_cons_functor(qualified, FUNCTOR_colon2, mname, qualified);
}
int
valueExpression(term_t t, Number r ARG_LD)
{
@ -284,6 +301,8 @@ int
_PL_unify_atomic(term_t t, PL_atomic_t a)
{
GET_LD
if (IsApplTerm(a) || IsAtomTerm(a))
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), a);
return PL_unify_atom(t, a);
}
@ -482,8 +501,6 @@ PL_set_prolog_flag(const char *name, int type, ...)
int rval = TRUE;
int flags = (type & FF_MASK);
initPrologFlagTable();
va_start(args, type);
switch(type & ~FF_MASK)
{ case PL_BOOL:
@ -496,7 +513,7 @@ PL_set_prolog_flag(const char *name, int type, ...)
{ const char *v = va_arg(args, const char *);
#ifndef __YAP_PROLOG__
if ( !GD->initialised )
initAtoms();
initAtoms();
#endif
setPrologFlag(name, FT_ATOM|flags, v);
break;
@ -509,13 +526,12 @@ PL_set_prolog_flag(const char *name, int type, ...)
default:
rval = FALSE;
}
va_end(args);
return rval;
}
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
@ -761,6 +777,12 @@ PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags)
fail;
}
void *
PL_malloc_uncollectable(size_t sz)
{
return malloc(sz);
}
int
PL_get_list_chars(term_t l, char **s, unsigned flags)
{ return PL_get_list_nchars(l, NULL, s, flags);
@ -1213,6 +1235,68 @@ nameOfWideAtom(atom_t atom)
return RepAtom(a)->WStrOfAE;
}
access_level_t
setAccessLevel(access_level_t accept)
{ GET_LD
bool old;
old = LD->prolog_flag.access_level;
LD->prolog_flag.access_level = accept;
return old;
}
static bool
vsysError(const char *fm, va_list args)
{ GET_LD
static int active = 0;
switch ( active++ )
{ case 1:
PL_halt(3);
case 2:
abort();
}
#ifdef O_PLMT
Sfprintf(Serror, "[PROLOG SYSTEM ERROR: Thread %d\n\t",
PL_thread_self());
#else
Sfprintf(Serror, "[PROLOG SYSTEM ERROR:\n\t");
#endif
Svfprintf(Serror, fm, args);
#if defined(O_DEBUGGER)
Sfprintf(Serror, "\n\nPROLOG STACK:\n");
PL_backtrace(10, 0);
Sfprintf(Serror, "]\n");
#endif /*O_DEBUGGER*/
#ifdef HAVE_GETPID
Sfprintf(Serror, "\n[pid=%d] Action? ", getpid());
#else
Sfprintf(Serror, "\nAction? ");
#endif
Sflush(Soutput);
ResetTty();
PL_halt(3);
return FALSE; /* not reached */
}
bool
sysError(const char *fm, ...)
{ va_list args;
va_start(args, fm);
vsysError(fm, args);
va_end(args);
PL_fail;
}
#if THREADS

18
C/qlyr.c

@ -47,6 +47,20 @@ typedef enum {
BAD_READ = 11
} qlfr_err_t;
static char *
qlyr_error[] = { "out of temporary space",
"out of temporary space",
"out of code space",
"unknown atom in saved space",
"unknown functor in saved space",
"unknown predicate in saved space",
"unknown YAAM opcode in saved space",
"unknown data-base reference in saved space",
"corrupted atom in saved space",
"formatting mismatch in saved space",
"foreign predicate has different definition in saved space",
"bad read" };
static char *
Yap_AlwaysAllocCodeSpace(UInt size)
{
@ -62,7 +76,7 @@ Yap_AlwaysAllocCodeSpace(UInt size)
static void
QLYR_ERROR(qlfr_err_t my_err)
{
fprintf(stderr,"Error %d\n", my_err);
Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
exit(1);
}
@ -1056,8 +1070,10 @@ Yap_Restore(char *s, char *lib_dir)
IOSTREAM *stream = Yap_OpenRestore(s, lib_dir);
if (!stream)
return -1;
GLOBAL_RestoreFile = s;
read_module(stream);
Sclose( stream );
GLOBAL_RestoreFile = NULL;
return DO_ONLY_CODE;
}

4
C/save.c

@ -685,8 +685,8 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
if (strcmp(pp, msg) != 0) {
LOCAL_ErrorMessage = LOCAL_ErrorSay;
strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE);
strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE);
strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE);
strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE-1);
strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE-1);
LOCAL_Error_TYPE = CONSISTENCY_ERROR;
return FAIL_RESTORE;
}

12
C/stdpreds.c

@ -3886,12 +3886,12 @@ p_statistics_atom_info( USES_REGS1 )
while (catom != NIL) {
Atom ncatom;
count++;
spaceused += sizeof(AtomEntry)+strlen(RepAtom(catom)->StrOfAE);
spaceused += sizeof(AtomEntry)+strlen(RepAtom(catom)->StrOfAE)+1;
ncatom = RepAtom(catom)->NextOfAE;
if (ncatom != NIL) {
READ_LOCK(RepAtom(ncatom)->ARWLock);
}
READ_UNLOCK(RepAtom(ncatom)->ARWLock);
READ_UNLOCK(RepAtom(catom)->ARWLock);
catom = ncatom;
}
}
@ -3907,12 +3907,12 @@ p_statistics_atom_info( USES_REGS1 )
while (catom != NIL) {
Atom ncatom;
count++;
spaceused += sizeof(AtomEntry)+wcslen((wchar_t *)( RepAtom(catom)->StrOfAE));
spaceused += sizeof(AtomEntry)+sizeof(wchar_t)*(wcslen((wchar_t *)( RepAtom(catom)->StrOfAE)+1));
ncatom = RepAtom(catom)->NextOfAE;
if (ncatom != NIL) {
READ_LOCK(RepAtom(ncatom)->ARWLock);
}
READ_UNLOCK(RepAtom(ncatom)->ARWLock);
READ_UNLOCK(RepAtom(catom)->ARWLock);
catom = ncatom;
}
}
@ -4361,10 +4361,6 @@ Yap_InitBackCPreds(void)
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
Yap_InitBackMYDDAS_SharedPreds();
#endif
{
extern void initIO(void);
initIO();
}
}
typedef void (*Proc)(void);

348
C/utilpreds.c

@ -2657,6 +2657,353 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */
return Yap_unify(ARG3,out);
}
static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
CELL *InitialH = H;
*H++ = MkAtomTerm(AtomDollar);
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, vars_within_term_unk);
vars_within_term_nvar:
{
if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
continue;
}
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
}
continue;
}
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (H+1024 > ASP) {
goto global_overflow;
}
H[0] = (CELL)ptd0;
H ++;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
if (H != InitialH+1) {
InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (H-InitialH)-1);
return AbsAppl(InitialH);
} else {
return MkAtomTerm(AtomDollar);
}
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
aux_overflow:
LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
global_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
CELL *InitialH = H;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, vars_within_term_unk);
vars_within_term_nvar:
{
if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
continue;
}
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
}
continue;
}
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
return TermNil;
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
aux_overflow:
LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
}
static Int
p_free_variables_in_term( USES_REGS1 ) /* variables within term t */
{
Term out;
Term t, t0;
Term found_module = 0L;
do {
tr_fr_ptr TR0 = TR;
t = t0 = Deref(ARG1);
while (!IsVarTerm(t) && IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorHat) {
out = bind_vars_in_complex_term(RepAppl(t),
RepAppl(t)+1, TR0 PASS_REGS);
if (out == 0L) {
goto trail_overflow;
}
} else if (f == FunctorModule) {
found_module = ArgOfTerm(1, t);
} else {
break;
}
t = ArgOfTerm(2,t);
}
if (IsVarTerm(t)) {
out = free_vars_in_complex_term(VarOfTerm(t)-1,
VarOfTerm(t), TR0 PASS_REGS);
} else if (IsPrimitiveTerm(t))
out = TermNil;
else if (IsPairTerm(t)) {
out = free_vars_in_complex_term(RepPair(t)-1,
RepPair(t)+1, TR0 PASS_REGS);
}
else {
Functor f = FunctorOfTerm(t);
out = free_vars_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(f), TR0 PASS_REGS);
}
if (out == 0L) {
trail_overflow:
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
if (found_module && t!=t0) {
Term ts[2];
ts[0] = found_module;
ts[1] = t;
t = Yap_MkApplTerm(FunctorModule, 2, ts);
}
return
Yap_unify(ARG2, t) &&
Yap_unify(ARG3,out);
}
static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
{
@ -5196,6 +5543,7 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0);
Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
Yap_InitCPred("term_variables", 2, p_term_variables, 0);
Yap_InitCPred("term_variables", 3, p_term_variables3, 0);

11
H/Yap.h

@ -88,7 +88,7 @@
#undef USE_THREADED_CODE
#endif /* USE_THREADED_CODE */
#define inline __inline
#define YAP_VERSION "YAP-6.3.2"
#define YAP_VERSION "YAP-6.3.4"
#define BIN_DIR "c:\\Yap\\bin"
#define LIB_DIR "c:\\Yap\\lib\\Yap"
#define SHARE_DIR "c:\\Yap\\share\\Yap"
@ -121,6 +121,14 @@
#define DUMMY_FILLER_FOR_ABS_TYPE int dummy;
#endif /* HAVE_GCC */
#ifdef HAVE___BUILTIN_EXPECT
#define likely(x) __builtin_expect((x), 1)
#define unlikely(x) __builtin_expect((x), 0)
#else
#define likely(x) (x)
#define unlikely(x) (x)
#endif
#ifdef THREADS
#if USE_PTHREAD_LOCKING
#ifndef _XOPEN_SOURCE
@ -403,6 +411,7 @@ typedef enum
RESOURCE_ERROR_MEMORY,
RESOURCE_ERROR_STACK,
RETRY_COUNTER_UNDERFLOW,
SAVED_STATE_ERROR,
SYNTAX_ERROR,
SYSTEM_ERROR,
TYPE_ERROR_ARRAY,

2
H/YapOpcodes.h

@ -9,8 +9,10 @@
OPCODE(trust_me ,Otapl),
OPCODE(enter_exo ,e),
OPCODE(try_exo ,lp),
OPCODE(try_udi ,p),
OPCODE(try_all_exo ,lp),
OPCODE(retry_exo ,lp),
OPCODE(retry_udi ,p),
OPCODE(retry_all_exo ,lp),
OPCODE(enter_profiling ,p),
OPCODE(retry_profiled ,p),

1
H/clause.h

@ -173,6 +173,7 @@ typedef struct index_t {
CELL **key;
CELL *cls;
CELL *links;
size_t size;
yamop *code;
} Index_t;

1
H/dglobals.h

@ -98,4 +98,5 @@
#endif
#define GLOBAL_RestoreFile Yap_global->RestoreFile_

3
H/dlocals.h

@ -433,3 +433,6 @@
#define LOCAL_ibnds LOCAL->ibnds_
#define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_
#define LOCAL_search_atoms LOCAL->search_atoms_
#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_

1
H/hglobals.h

@ -98,4 +98,5 @@ typedef struct global_data {
#endif
char* RestoreFile_;
} w_shared;

2
H/hlocals.h

@ -243,4 +243,6 @@ typedef struct worker_local {
Functor FunctorVar_;
UInt ibnds_[256];
struct scan_atoms* search_atoms_;
} w_local;

3
H/iatoms.h

@ -74,6 +74,7 @@
AtomDefault = Yap_LookupAtom("default");
AtomDevNull = Yap_LookupAtom("/dev/null");
AtomDiff = Yap_LookupAtom("\\=");
AtomDollar = Yap_FullLookupAtom("$");
AtomDoLogUpdClause = Yap_FullLookupAtom("$do_log_upd_clause");
AtomDoLogUpdClause0 = Yap_FullLookupAtom("$do_log_upd_clause0");
AtomDoLogUpdClauseErase = Yap_FullLookupAtom("$do_log_upd_clause_erase");
@ -127,6 +128,7 @@
AtomGlobalSp = Yap_LookupAtom("global_sp");
AtomGlobalTrie = Yap_LookupAtom("global_trie");
AtomGoalExpansion = Yap_LookupAtom("goal_expansion");
AtomHat = Yap_LookupAtom("^");
AtomHERE = Yap_LookupAtom("\n <====HERE====> \n");
AtomHandleThrow = Yap_FullLookupAtom("$handle_throw");
AtomHeap = Yap_LookupAtom("heap");
@ -390,6 +392,7 @@
FunctorGoalExpansion2 = Yap_MkFunctor(AtomGoalExpansion,2);
FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
FunctorHat = Yap_MkFunctor(AtomHat,2);
FunctorId = Yap_MkFunctor(AtomId,1);
FunctorIs = Yap_MkFunctor(AtomIs,2);
FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1);

1
H/iglobals.h

@ -98,4 +98,5 @@ static void InitGlobal(void) {
#endif
}

2
H/ilocals.h

@ -243,4 +243,6 @@ static void InitWorker(int wid) {
REMOTE_FunctorVar(wid) = FunctorVar;
}

61
H/iswiatoms.h

@ -8,7 +8,9 @@
SWI_Atoms[i++] = Yap_LookupAtom("$aborted");
SWI_Atoms[i++] = Yap_LookupAtom("abs");
SWI_Atoms[i++] = Yap_LookupAtom("access");
SWI_Atoms[i++] = Yap_LookupAtom("access_level");
SWI_Atoms[i++] = Yap_LookupAtom("acos");
SWI_Atoms[i++] = Yap_LookupAtom("acosh");
SWI_Atoms[i++] = Yap_LookupAtom("acyclic_term");
SWI_Atoms[i++] = Yap_LookupAtom("add_import");
SWI_Atoms[i++] = Yap_LookupAtom("address");
@ -32,6 +34,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("as");
SWI_Atoms[i++] = Yap_LookupAtom("ascii");
SWI_Atoms[i++] = Yap_LookupAtom("asin");
SWI_Atoms[i++] = Yap_LookupAtom("asinh");
SWI_Atoms[i++] = Yap_LookupAtom("assert");
SWI_Atoms[i++] = Yap_LookupAtom("asserta");
SWI_Atoms[i++] = Yap_LookupAtom("at");
@ -43,6 +46,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("@<");
SWI_Atoms[i++] = Yap_LookupAtom("@=<");
SWI_Atoms[i++] = Yap_LookupAtom("atan");
SWI_Atoms[i++] = Yap_LookupAtom("atanh");
SWI_Atoms[i++] = Yap_LookupAtom("atan2");
SWI_Atoms[i++] = Yap_LookupAtom("atom");
SWI_Atoms[i++] = Yap_LookupAtom("atom_garbage_collection");
@ -56,8 +60,10 @@
SWI_Atoms[i++] = Yap_LookupAtom("\\");
SWI_Atoms[i++] = Yap_LookupAtom("backtrace");
SWI_Atoms[i++] = Yap_LookupAtom("|");
SWI_Atoms[i++] = Yap_LookupAtom("base");
SWI_Atoms[i++] = Yap_LookupAtom("begin");
SWI_Atoms[i++] = Yap_LookupAtom("binary");
SWI_Atoms[i++] = Yap_LookupAtom("binary_stream");
SWI_Atoms[i++] = Yap_LookupAtom("bind");
SWI_Atoms[i++] = Yap_LookupAtom("\\/");
SWI_Atoms[i++] = Yap_LookupAtom("blobs");
@ -67,6 +73,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("boolean");
SWI_Atoms[i++] = Yap_LookupAtom("brace_term_position");
SWI_Atoms[i++] = Yap_LookupAtom("break");
SWI_Atoms[i++] = Yap_LookupAtom("break_level");
SWI_Atoms[i++] = Yap_LookupAtom("btree");
SWI_Atoms[i++] = Yap_LookupAtom("buffer");
SWI_Atoms[i++] = Yap_LookupAtom("buffer_size");
@ -80,6 +87,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("canceled");
SWI_Atoms[i++] = Yap_LookupAtom("case_sensitive_file_names");
SWI_Atoms[i++] = Yap_LookupAtom("catch");
SWI_Atoms[i++] = Yap_LookupAtom("category");
SWI_Atoms[i++] = Yap_LookupAtom("ceil");
SWI_Atoms[i++] = Yap_LookupAtom("ceiling");
SWI_Atoms[i++] = Yap_LookupAtom("char_type");
@ -90,7 +98,9 @@
SWI_Atoms[i++] = Yap_LookupAtom("chdir");
SWI_Atoms[i++] = Yap_LookupAtom("chmod");
SWI_Atoms[i++] = Yap_LookupAtom("choice");
SWI_Atoms[i++] = Yap_LookupAtom("class");
SWI_Atoms[i++] = Yap_LookupAtom("clause");
SWI_Atoms[i++] = Yap_LookupAtom("clauses");
SWI_Atoms[i++] = Yap_LookupAtom("clause_reference");
SWI_Atoms[i++] = Yap_LookupAtom("close");
SWI_Atoms[i++] = Yap_LookupAtom("close_on_abort");
@ -109,9 +119,11 @@
SWI_Atoms[i++] = Yap_LookupAtom("context");
SWI_Atoms[i++] = Yap_LookupAtom("context_module");
SWI_Atoms[i++] = Yap_LookupAtom("continue");
SWI_Atoms[i++] = Yap_LookupAtom("copysign");
SWI_Atoms[i++] = Yap_LookupAtom("core");
SWI_Atoms[i++] = Yap_LookupAtom("core_left");
SWI_Atoms[i++] = Yap_LookupAtom("cos");
SWI_Atoms[i++] = Yap_LookupAtom("cosh");
SWI_Atoms[i++] = Yap_LookupAtom("cputime");
SWI_Atoms[i++] = Yap_LookupAtom("create");
SWI_Atoms[i++] = Yap_LookupAtom("csym");
@ -127,6 +139,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("cut_parent");
SWI_Atoms[i++] = Yap_LookupAtom("cut");
SWI_Atoms[i++] = Yap_LookupAtom("cyclic_term");
SWI_Atoms[i++] = Yap_LookupAtom("cycles");
SWI_Atoms[i++] = Yap_LookupAtom("$and");
SWI_Atoms[i++] = Yap_LookupAtom("date");
SWI_Atoms[i++] = Yap_LookupAtom("db_reference");
@ -137,8 +150,10 @@
SWI_Atoms[i++] = Yap_LookupAtom("$cut");
SWI_Atoms[i++] = Yap_LookupAtom("dde_error");
SWI_Atoms[i++] = Yap_LookupAtom("dde_handle");
SWI_Atoms[i++] = Yap_LookupAtom("deadline");
SWI_Atoms[i++] = Yap_LookupAtom("debug");
SWI_Atoms[i++] = Yap_LookupAtom("debug_on_error");
SWI_Atoms[i++] = Yap_LookupAtom("debug_topic");
SWI_Atoms[i++] = Yap_LookupAtom("debugger_print_options");
SWI_Atoms[i++] = Yap_LookupAtom("debugger_show_context");
SWI_Atoms[i++] = Yap_LookupAtom("debugging");
@ -170,11 +185,13 @@
SWI_Atoms[i++] = Yap_LookupAtom("double_quotes");
SWI_Atoms[i++] = Yap_LookupAtom("**");
SWI_Atoms[i++] = Yap_LookupAtom("$profile_node");
SWI_Atoms[i++] = Yap_LookupAtom("$query_loop");
SWI_Atoms[i++] = Yap_LookupAtom("$recover_and_rethrow");
SWI_Atoms[i++] = Yap_LookupAtom("$stream");
SWI_Atoms[i++] = Yap_LookupAtom("$thread_init");
SWI_Atoms[i++] = Yap_LookupAtom("$throw");
SWI_Atoms[i++] = Yap_LookupAtom("$time");
SWI_Atoms[i++] = Yap_LookupAtom("$toplevel");
SWI_Atoms[i++] = Yap_LookupAtom("$VAR$");
SWI_Atoms[i++] = Yap_LookupAtom("$wakeup");
SWI_Atoms[i++] = Yap_LookupAtom("dynamic");
@ -268,9 +285,8 @@
SWI_Atoms[i++] = Yap_LookupAtom("hash");
SWI_Atoms[i++] = Yap_LookupAtom("hashed");
SWI_Atoms[i++] = Yap_LookupAtom("^");
SWI_Atoms[i++] = Yap_LookupAtom("heap");
SWI_Atoms[i++] = Yap_LookupAtom("heaplimit");
SWI_Atoms[i++] = Yap_LookupAtom("heapused");
SWI_Atoms[i++] = Yap_LookupAtom("heap_gc");
SWI_Atoms[i++] = Yap_LookupAtom("help");
SWI_Atoms[i++] = Yap_LookupAtom("hidden");
SWI_Atoms[i++] = Yap_LookupAtom("hide_childs");
@ -278,6 +294,8 @@
SWI_Atoms[i++] = Yap_LookupAtom("->");
SWI_Atoms[i++] = Yap_LookupAtom("ignore");
SWI_Atoms[i++] = Yap_LookupAtom("ignore_ops");
SWI_Atoms[i++] = Yap_LookupAtom("import_into");
SWI_Atoms[i++] = Yap_LookupAtom("import_type");
SWI_Atoms[i++] = Yap_LookupAtom("imported");
SWI_Atoms[i++] = Yap_LookupAtom("imported_procedure");
SWI_Atoms[i++] = Yap_LookupAtom("index");
@ -312,9 +330,11 @@
SWI_Atoms[i++] = Yap_LookupAtom(">=");
SWI_Atoms[i++] = Yap_LookupAtom("level");
SWI_Atoms[i++] = Yap_LookupAtom("li");
SWI_Atoms[i++] = Yap_LookupAtom("library");
SWI_Atoms[i++] = Yap_LookupAtom("limit");
SWI_Atoms[i++] = Yap_LookupAtom("line");
SWI_Atoms[i++] = Yap_LookupAtom("line_count");
SWI_Atoms[i++] = Yap_LookupAtom("line_position");
SWI_Atoms[i++] = Yap_LookupAtom("list");
SWI_Atoms[i++] = Yap_LookupAtom("list_position");
SWI_Atoms[i++] = Yap_LookupAtom("listing");
@ -329,6 +349,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("log");
SWI_Atoms[i++] = Yap_LookupAtom("log10");
SWI_Atoms[i++] = Yap_LookupAtom("long");
SWI_Atoms[i++] = Yap_LookupAtom("loose");
SWI_Atoms[i++] = Yap_LookupAtom("low");
SWI_Atoms[i++] = Yap_LookupAtom("lower");
SWI_Atoms[i++] = Yap_LookupAtom("lsb");
@ -342,6 +363,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("max_depth");
SWI_Atoms[i++] = Yap_LookupAtom("max_files");
SWI_Atoms[i++] = Yap_LookupAtom("max_frame_size");
SWI_Atoms[i++] = Yap_LookupAtom("max_length");
SWI_Atoms[i++] = Yap_LookupAtom("max_path_length");
SWI_Atoms[i++] = Yap_LookupAtom("max_size");
SWI_Atoms[i++] = Yap_LookupAtom("max_variable_length");
@ -361,6 +383,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("mode");
SWI_Atoms[i++] = Yap_LookupAtom("modify");
SWI_Atoms[i++] = Yap_LookupAtom("module");
SWI_Atoms[i++] = Yap_LookupAtom("module_class");
SWI_Atoms[i++] = Yap_LookupAtom("module_property");
SWI_Atoms[i++] = Yap_LookupAtom("module_transparent");
SWI_Atoms[i++] = Yap_LookupAtom("modules");
@ -391,6 +414,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("not_unique");
SWI_Atoms[i++] = Yap_LookupAtom("number");
SWI_Atoms[i++] = Yap_LookupAtom("number_of_clauses");
SWI_Atoms[i++] = Yap_LookupAtom("number_of_rules");
SWI_Atoms[i++] = Yap_LookupAtom("numbervar_option");
SWI_Atoms[i++] = Yap_LookupAtom("numbervars");
SWI_Atoms[i++] = Yap_LookupAtom("occurs_check");
@ -405,6 +429,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("or");
SWI_Atoms[i++] = Yap_LookupAtom("order");
SWI_Atoms[i++] = Yap_LookupAtom("output");
SWI_Atoms[i++] = Yap_LookupAtom("owner");
SWI_Atoms[i++] = Yap_LookupAtom("pair");
SWI_Atoms[i++] = Yap_LookupAtom("paren");
SWI_Atoms[i++] = Yap_LookupAtom("parent");
@ -423,6 +448,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("+");
SWI_Atoms[i++] = Yap_LookupAtom("popcount");
SWI_Atoms[i++] = Yap_LookupAtom("portray");
SWI_Atoms[i++] = Yap_LookupAtom("portray_goal");
SWI_Atoms[i++] = Yap_LookupAtom("position");
SWI_Atoms[i++] = Yap_LookupAtom("posix");
SWI_Atoms[i++] = Yap_LookupAtom("powm");
@ -433,6 +459,8 @@
SWI_Atoms[i++] = Yap_LookupAtom("priority");
SWI_Atoms[i++] = Yap_LookupAtom("private_procedure");
SWI_Atoms[i++] = Yap_LookupAtom("procedure");
SWI_Atoms[i++] = Yap_LookupAtom("process_comment");
SWI_Atoms[i++] = Yap_LookupAtom("process_cputime");
SWI_Atoms[i++] = Yap_LookupAtom("profile_mode");
SWI_Atoms[i++] = Yap_LookupAtom("profile_no_cpu_time");
SWI_Atoms[i++] = Yap_LookupAtom("profile_node");
@ -457,6 +485,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("quoted");
SWI_Atoms[i++] = Yap_LookupAtom("radix");
SWI_Atoms[i++] = Yap_LookupAtom("random");
SWI_Atoms[i++] = Yap_LookupAtom("random_float");
SWI_Atoms[i++] = Yap_LookupAtom("random_option");
SWI_Atoms[i++] = Yap_LookupAtom("rational");
SWI_Atoms[i++] = Yap_LookupAtom("rationalize");
@ -472,6 +501,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("record_position");
SWI_Atoms[i++] = Yap_LookupAtom("redefine");
SWI_Atoms[i++] = Yap_LookupAtom("redo");
SWI_Atoms[i++] = Yap_LookupAtom("redo_in_skip");
SWI_Atoms[i++] = Yap_LookupAtom("references");
SWI_Atoms[i++] = Yap_LookupAtom("rem");
SWI_Atoms[i++] = Yap_LookupAtom("rename");
@ -489,6 +519,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("runtime");
SWI_Atoms[i++] = Yap_LookupAtom("save_class");
SWI_Atoms[i++] = Yap_LookupAtom("save_option");
SWI_Atoms[i++] = Yap_LookupAtom("see");
SWI_Atoms[i++] = Yap_LookupAtom("seed");
SWI_Atoms[i++] = Yap_LookupAtom("seek_method");
SWI_Atoms[i++] = Yap_LookupAtom("select");
@ -501,15 +532,18 @@
SWI_Atoms[i++] = Yap_LookupAtom("shared_object");
SWI_Atoms[i++] = Yap_LookupAtom("shared_object_handle");
SWI_Atoms[i++] = Yap_LookupAtom("shell");
SWI_Atoms[i++] = Yap_LookupAtom("shift_time");
SWI_Atoms[i++] = Yap_LookupAtom("sign");
SWI_Atoms[i++] = Yap_LookupAtom("signal");
SWI_Atoms[i++] = Yap_LookupAtom("signal_handler");
SWI_Atoms[i++] = Yap_LookupAtom("silent");
SWI_Atoms[i++] = Yap_LookupAtom("sin");
SWI_Atoms[i++] = Yap_LookupAtom("singletons");
SWI_Atoms[i++] = Yap_LookupAtom("sinh");
SWI_Atoms[i++] = Yap_LookupAtom("size");
SWI_Atoms[i++] = Yap_LookupAtom("size_t");
SWI_Atoms[i++] = Yap_LookupAtom("skip");
SWI_Atoms[i++] = Yap_LookupAtom("skipped");
SWI_Atoms[i++] = Yap_LookupAtom("<");
SWI_Atoms[i++] = Yap_LookupAtom("=<");
SWI_Atoms[i++] = Yap_LookupAtom("*->");
@ -528,6 +562,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("*");
SWI_Atoms[i++] = Yap_LookupAtom("start");
SWI_Atoms[i++] = Yap_LookupAtom("stat");
SWI_Atoms[i++] = Yap_LookupAtom("state");
SWI_Atoms[i++] = Yap_LookupAtom("static_procedure");
SWI_Atoms[i++] = Yap_LookupAtom("statistics");
SWI_Atoms[i++] = Yap_LookupAtom("status");
@ -538,9 +573,11 @@
SWI_Atoms[i++] = Yap_LookupAtom("stream_pair");
SWI_Atoms[i++] = Yap_LookupAtom("$stream_position");
SWI_Atoms[i++] = Yap_LookupAtom("stream_property");
SWI_Atoms[i++] = Yap_LookupAtom("stream_type_check");
SWI_Atoms[i++] = Yap_LookupAtom("==");
SWI_Atoms[i++] = Yap_LookupAtom("string");
SWI_Atoms[i++] = Yap_LookupAtom("string_position");
SWI_Atoms[i++] = Yap_LookupAtom("strong");
SWI_Atoms[i++] = Yap_LookupAtom("subterm_positions");
SWI_Atoms[i++] = Yap_LookupAtom("suffix");
SWI_Atoms[i++] = Yap_LookupAtom("syntax_error");
@ -551,15 +588,19 @@
SWI_Atoms[i++] = Yap_LookupAtom("system_thread_id");
SWI_Atoms[i++] = Yap_LookupAtom("system_time");
SWI_Atoms[i++] = Yap_LookupAtom("tan");
SWI_Atoms[i++] = Yap_LookupAtom("tanh");
SWI_Atoms[i++] = Yap_LookupAtom("temporary_files");
SWI_Atoms[i++] = Yap_LookupAtom("term");
SWI_Atoms[i++] = Yap_LookupAtom("term_expansion");
SWI_Atoms[i++] = Yap_LookupAtom("term_position");
SWI_Atoms[i++] = Yap_LookupAtom("terminal");
SWI_Atoms[i++] = Yap_LookupAtom("terminal_capability");
SWI_Atoms[i++] = Yap_LookupAtom("test");
SWI_Atoms[i++] = Yap_LookupAtom("text");
SWI_Atoms[i++] = Yap_LookupAtom("text_stream");
SWI_Atoms[i++] = Yap_LookupAtom("thread");
SWI_Atoms[i++] = Yap_LookupAtom("thread_cputime");
SWI_Atoms[i++] = Yap_LookupAtom("thread_get_message_option");
SWI_Atoms[i++] = Yap_LookupAtom("thread_initialization");
SWI_Atoms[i++] = Yap_LookupAtom("thread_local");
SWI_Atoms[i++] = Yap_LookupAtom("thread_local_procedure");
@ -637,6 +678,7 @@
SWI_Atoms[i++] = Yap_LookupAtom("wakeup");
SWI_Atoms[i++] = Yap_LookupAtom("walltime");
SWI_Atoms[i++] = Yap_LookupAtom("warning");
SWI_Atoms[i++] = Yap_LookupAtom("weak");
SWI_Atoms[i++] = Yap_LookupAtom("wchar_t");
SWI_Atoms[i++] = Yap_LookupAtom("when_condition");
SWI_Atoms[i++] = Yap_LookupAtom("white");
@ -656,15 +698,18 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_abs),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_access),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_acos),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_acosh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_alias),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_and),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ar_equals),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ar_not_equal),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asin),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asinh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_assert),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asserta),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atanh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan2),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atom),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_att),3);
@ -686,6 +731,7 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ceiling),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_chars),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_chars),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_class),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_clause),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_close_on_abort),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_close_on_exec),1);
@ -694,7 +740,9 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_colon),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_comma),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_context),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_copysign),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cos),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cosh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cputime),0);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_curl),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cut_call),1);
@ -762,7 +810,9 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ground),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_hat),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ifthen),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_import_into),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_input),0);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_input),3);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_integer),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_interrupt),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_io_error),2);
@ -792,6 +842,7 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_nonvar),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_implemented),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_provable),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_strict_equal),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_occurs_check),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_or),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_output),0);
@ -806,14 +857,17 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_powm),3);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_print),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_print_message),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_priority),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_procedure),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_prove),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_prove),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_punct),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_random),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_random_float),0);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rational),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rationalize),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rdiv),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_redo),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rem),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_reposition),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_representation_error),1);
@ -831,6 +885,7 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_signal),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_sin),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_singletons),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_sinh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_size),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_smaller),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_smaller_equal),2);
@ -848,6 +903,7 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_syntax_error),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_syntax_error),3);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_tan),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_tanh),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_term_expansion),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_term_position),5);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_timeout),1);
@ -868,3 +924,4 @@
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_warning),3);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xor),2);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xpceref),1);
SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xpceref),2);

44
H/pl-global.h

@ -81,6 +81,15 @@ typedef struct {
int optimise; /* -O: optimised compilation */
} cmdline;
struct
{ char * CWDdir;
size_t CWDlen;
char * executable; /* Running executable */
#ifdef __WINDOWS__
char * module; /* argv[0] module passed */
#endif
} paths;
struct
{ ExtensionCell _ext_head; /* head of registered extensions */
ExtensionCell _ext_tail; /* tail of this chain */
@ -163,6 +172,7 @@ typedef struct PL_local_data {
{ IOSTREAM *streams[6]; /* handles for standard streams */
struct input_context *input_stack; /* maintain input stream info */
struct output_context *output_stack; /* maintain output stream info */
st_check stream_type_check; /* Check bin/text streams? */
} IO;
struct
@ -192,6 +202,7 @@ typedef struct PL_local_data {
pl_features_t mask; /* Masked access to booleans */
int write_attributes; /* how to write attvars? */
occurs_check_t occurs_check; /* Unify and occurs check */
access_level_t access_level; /* Current access level */
} prolog_flag;
void * glob_info; /* pl-glob.c */
@ -236,6 +247,10 @@ typedef struct PL_local_data {
int _current_buffer_id;
} fli;
struct
{ fid_t numbervars_frame; /* Numbervars choice-point */
} var_names;
#ifdef O_GMP
struct
{
@ -253,35 +268,6 @@ extern PL_local_data_t lds;
#define exception_term (LD->exception.term)
// THIS HAS TO BE ABSTRACTED
#define GLOBAL_LD (LOCAL_PL_local_data_p)
#if !defined(O_PLMT) && !defined(YAPOR)
#define LOCAL_LD (GLOBAL_LD)
#define LD (GLOBAL_LD)
#define ARG1_LD void
#define ARG_LD
#define GET_LD
#define PRED_LD
#define PASS_LD
#define PASS_LD1
#else
#define LOCAL_LD (__PL_ld)
#define LD LOCAL_LD
#define GET_LD CACHE_REGS PL_local_data_t *__PL_ld = GLOBAL_LD;
#define ARG1_LD PL_local_data_t *__PL_ld
#define ARG_LD , ARG1_LD
#define PASS_LD1 LD
#define PASS_LD , LD
#define PRED_LD GET_LD
#endif
#define Suser_input (LD->IO.streams[0])
#define Suser_output (LD->IO.streams[1])
#define Suser_error (LD->IO.streams[2])

160
H/pl-incl.h

@ -36,9 +36,16 @@
#define O_PLMT 1
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#include "Yap.h"
#include "YapHeap.h"
#define PLVERSION YAP_VERSION
#define PLNAME "yap"
/* try not to pollute the SWI space */
#ifdef P
#undef P
@ -225,6 +232,37 @@ users foreign language code.
*******************************/
#define WM_SIGNALLED (WM_USER+4201) /* how to select a good number!? */
#endif
// THIS HAS TO BE ABSTRACTED
#define GLOBAL_LD (LOCAL_PL_local_data_p)
#if !defined(O_PLMT) && !defined(YAPOR)
#define LOCAL_LD (GLOBAL_LD)
#define LD (GLOBAL_LD)
#define ARG1_LD void
#define ARG_LD
#define GET_LD
#define PRED_LD
#define PASS_LD
#define PASS_LD1
#define IGNORE_LD
#else
#define LOCAL_LD (__PL_ld)
#define LD LOCAL_LD
#define GET_LD CACHE_REGS struct PL_local_data *__PL_ld = GLOBAL_LD;
#define ARG1_LD struct PL_local_data *__PL_ld
#define ARG_LD , ARG1_LD
#define PASS_LD1 LD
#define PASS_LD , LD
#define PRED_LD GET_LD
#define IGNORE_LD (void)__PL_ld;
#endif
/********************************
@ -339,6 +377,7 @@ typedef struct
{ functor_t functor; /* Functor to use ($VAR/1) */
av_action on_attvar; /* How to handle attvars */
int singletons; /* Write singletons as $VAR('_') */
int numbered_check; /* Check for already numbered */
} nv_options;
@ -437,9 +476,6 @@ typedef struct
#define FT_FROM_VALUE 0x0f /* Determine type from value */
#define FT_MASK 0x0f /* mask to get type */
#define FF_READONLY 0x10 /* feature is read-only */
#define FF_KEEP 0x20 /* keep value it already set */
#define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */
#define PLFLAG_GC 0x000002 /* do GC */
#define PLFLAG_TRACE_GC 0x000004 /* verbose gc */
@ -481,6 +517,36 @@ typedef struct exception_frame /* PL_throw exception environments */
jmp_buf exception_jmp_env; /* longjmp environment */
} exception_frame;
/*******************************
* STREAM I/O *
*******************************/
#define REDIR_MAGIC 0x23a9bef3
typedef struct redir_context
{ int magic; /* REDIR_MAGIC */
IOSTREAM *stream; /* temporary output */
int is_stream; /* redirect to stream */
int redirected; /* output is redirected */
term_t term; /* redirect target */
int out_format; /* output type */
int out_arity; /* 2 for difference-list versions */
size_t size; /* size of I/O buffer */
char *data; /* data written */
char buffer[1024]; /* fast temporary buffer */
} redir_context;
#include "pl-file.h"
typedef enum
{ ACCESS_LEVEL_USER = 0, /* Default user view */
ACCESS_LEVEL_SYSTEM /* Allow low-level access */
} access_level_t;
#define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM)
#define PL_malloc_atomic malloc
/* vsc: global variables */
#include "pl-global.h"
@ -514,6 +580,21 @@ it mean anything?
#define fail return FALSE
#define TRY(goal) if ((goal) == FALSE) fail
/* Flags on module. Most of these flags are copied to the read context
in pl-read.c.
*/
#define M_SYSTEM (0x0001) /* system module */
#define M_CHARESCAPE (0x0002) /* module */
#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */
#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */
#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */
#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
#define UNKNOWN_FAIL (0x0020) /* module */
#define UNKNOWN_WARNING (0x0040) /* module */
#define UNKNOWN_ERROR (0x0080) /* module */
#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
extern int fileerrors;
@ -558,25 +639,6 @@ typedef struct wakeup_state
} wakeup_state;
/*******************************
* STREAM I/O *
*******************************/
#define REDIR_MAGIC 0x23a9bef3
typedef struct redir_context
{ int magic; /* REDIR_MAGIC */
IOSTREAM *stream; /* temporary output */
int is_stream; /* redirect to stream */
int redirected; /* output is redirected */
term_t term; /* redirect target */
int out_format; /* output type */
int out_arity; /* 2 for difference-list versions */
size_t size; /* size of I/O buffer */
char *data; /* data written */
char buffer[1024]; /* fast temporary buffer */
} redir_context;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Defining built-in predicates using the new interface
@ -651,6 +713,7 @@ typedef double real;
#endif
#define PL_unify_time(A,B) PL_unify_int64(A,B)
extern int PL_unify_char(term_t chr, int c, int how);
extern int PL_get_char(term_t chr, int *c, int eof);
extern void PL_cleanup_fork(void);
@ -660,6 +723,7 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
extern IOSTREAM ** /* provide access to Suser_input, */
@ -740,7 +804,19 @@ PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
COMMON(atom_t) fileNameStream(IOSTREAM *s);
COMMON(int) streamStatus(IOSTREAM *s);
COMMON(int) getOutputStream(term_t t, IOSTREAM **s);
#define getOutputStream(t, k, s) getOutputStream__LD(t, k, s PASS_LD)
#define getTextOutputStream(t, s) getTextOutputStream__LD(t, s PASS_LD)
#define getBinaryOutputStream(t, s) getBinaryOutputStream__LD(t, s PASS_LD)
#define getInputStream(t, k, s) getInputStream__LD(t, k, s PASS_LD)
#define getTextInputStream(t, s) getTextInputStream__LD(t, s PASS_LD)
#define getBinaryInputStream(t, s) getBinaryInputStream__LD(t, s PASS_LD)
COMMON(int) getTextOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getTextInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(void) pushOutputContext(void);
COMMON(void) popOutputContext(void);
COMMON(int) getSingleChar(IOSTREAM *s, int signals);
@ -754,6 +830,7 @@ COMMON(int) unicode_separator(pl_wchar_t c);
COMMON(word) pl_raw_read(term_t term);
COMMON(word) pl_raw_read2(term_t stream, term_t term);
COMMON(access_level_t) setAccessLevel(access_level_t new_level);
/**** stuff from pl-error.c ****/
extern void outOfCore(void);
@ -795,7 +872,7 @@ extern size_t getenv3(const char *name, char *buf, size_t len);
extern int Setenv(char *name, char *value);
extern int Unsetenv(char *name);
extern int System(char *cmd);
extern bool expandVars(const char *pattern, char *expanded, int maxlen);
extern char *expandVars(const char *pattern, char *expanded, int maxlen);
/**** SWI stuff (emulated in pl-yap.c) ****/
extern int writeAtomToStream(IOSTREAM *so, atom_t at);
@ -819,6 +896,10 @@ COMMON(char) digitName(int n, int sm);
/**** stuff from pl-utf8.c ****/
size_t utf8_strlen(const char *s, size_t len);
/**** stuff from pl-version.c ****/
COMMON(void) setGITVersion(void);
/**** stuff from pl-write.c ****/
COMMON(char *) varName(term_t var, char *buf);
COMMON(int) writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags);
@ -856,10 +937,12 @@ COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags,
COMMON(bool) systemMode(bool accept);
COMMON(void) initPrologFlagTable(void);
COMMON(void) cleanupPrologFlags(void);
COMMON(void) initPrologFlags(void);
COMMON(int) raiseStackOverflow(int overflow);
COMMON(int) PL_qualify(term_t raw, term_t qualified);
static inline word
setBoolean(int *flag, term_t old, term_t new)
{ if ( !PL_unify_bool_ex(old, *flag) ||
@ -869,7 +952,21 @@ setBoolean(int *flag, term_t old, term_t new)
succeed;
}
COMMON(int) getInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
#define BEGIN_NUMBERVARS(save) \
{ fid_t _savedf; \
if ( save ) \
{ _savedf = LD->var_names.numbervars_frame; \
LD->var_names.numbervars_frame = PL_open_foreign_frame(); \
}
#define END_NUMBERVARS(save) \
if ( save ) \
{ PL_discard_foreign_frame(LD->var_names.numbervars_frame); \
LD->var_names.numbervars_frame = _savedf; \
} \
}
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);
@ -884,6 +981,8 @@ COMMON(word) pl_get_prolog_flag(term_t key, term_t value);
COMMON(word) pl_prolog_flag5(term_t key, term_t value, word scope, word access, word type, control_t h);
COMMON(foreign_t) pl_prolog_flag(term_t name, term_t value, control_t h);
COMMON(struct tm *) PL_localtime_r(const time_t *t, struct tm *r);
/* inlines that need ARG_LD */
static inline intptr_t
skip_list(Word l, Word *tailp ARG_LD) {
@ -901,7 +1000,14 @@ static inline void *allocHeap__LD(size_t n ARG_LD)
return YAP_AllocSpaceFromYap(n);
}
static inline void freeHeap__LD(void *mem, size_t n ARG_LD)
static inline void *allocHeapOrHalt(size_t n)
{
void *ptr = YAP_AllocSpaceFromYap(n);
if (!ptr) Yap_exit(1);
return ptr;
}
static inline void freeHeap(void *mem, size_t n)
{
YAP_FreeSpaceFromYap(mem);
}

9
H/pl-yap.h

@ -95,13 +95,14 @@ COMMON(bool) ChDir(const char *path);
COMMON(int) DeleteTemporaryFile(atom_t name);
COMMON(int) IsAbsolutePath(const char *spec);
COMMON(bool) sysError(const char *fm, ...);
/* TBD */
extern word globalString(size_t size, char *s);
extern word globalWString(size_t size, wchar_t *s);
#define allocHeap(n) allocHeap__LD(n PASS_LD)
#define freeHeap(p, n) freeHeap__LD(p, n PASS_LD)
#define valHandle(r) valHandle__LD(r PASS_LD)
@ -150,6 +151,7 @@ atomLength(Atom atom)
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
#define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
#define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
#define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) YAP_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A)
@ -179,8 +181,6 @@ charCode(Term w)
return -1;
}
#define getInputStream(t, s) getInputStream__LD(t, s PASS_LD)
#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)
@ -227,5 +227,8 @@ unblockSignal(int sig)
}
#endif
#define suspendTrace(x)
atom_t ATOM_;
#endif /* PL_YAP_H */

3
H/ratoms.h

@ -74,6 +74,7 @@
AtomDefault = AtomAdjust(AtomDefault);
AtomDevNull = AtomAdjust(AtomDevNull);
AtomDiff = AtomAdjust(AtomDiff);
AtomDollar = AtomAdjust(AtomDollar);
AtomDoLogUpdClause = AtomAdjust(AtomDoLogUpdClause);
AtomDoLogUpdClause0 = AtomAdjust(AtomDoLogUpdClause0);
AtomDoLogUpdClauseErase = AtomAdjust(AtomDoLogUpdClauseErase);
@ -127,6 +128,7 @@
AtomGlobalSp = AtomAdjust(AtomGlobalSp);
AtomGlobalTrie = AtomAdjust(AtomGlobalTrie);
AtomGoalExpansion = AtomAdjust(AtomGoalExpansion);
AtomHat = AtomAdjust(AtomHat);
AtomHERE = AtomAdjust(AtomHERE);
AtomHandleThrow = AtomAdjust(AtomHandleThrow);
AtomHeap = AtomAdjust(AtomHeap);
@ -390,6 +392,7 @@
FunctorGoalExpansion2 = FuncAdjust(FunctorGoalExpansion2);
FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
FunctorHat = FuncAdjust(FunctorHat);
FunctorId = FuncAdjust(FunctorId);
FunctorIs = FuncAdjust(FunctorIs);
FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin);

2
H/rclause.h

@ -447,6 +447,8 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _lock_lu:
case _procceed:
case _retry_profiled:
case _retry_udi:
case _try_udi:
pc->u.p.p = PtoPredAdjust(pc->u.p.p);
pc = NEXTOP(pc,p);
break;

1
H/rglobals.h

@ -98,4 +98,5 @@ static void RestoreGlobal(void) {
#endif
}

1
H/rheap.h

@ -1042,6 +1042,7 @@ RestoreYapRecords__( USES_REGS1 )
ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
RestoreDBTerm(ptr->dbrecord, FALSE PASS_REGS);
ptr = ptr->next_rec;
}
}

2
H/rlocals.h

@ -243,4 +243,6 @@ static void RestoreWorker(int wid USES_REGS) {
}

2
H/saveclause.h

@ -464,6 +464,8 @@
case _lock_lu:
case _procceed:
case _retry_profiled:
case _retry_udi:
case _try_udi:
CHECK(save_PtoPred(stream, pc->u.p.p));
pc = NEXTOP(pc,p);
break;

6
H/tatoms.h

@ -146,6 +146,8 @@
#define AtomDevNull Yap_heap_regs->AtomDevNull_
Atom AtomDiff_;
#define AtomDiff Yap_heap_regs->AtomDiff_
Atom AtomDollar_;
#define AtomDollar Yap_heap_regs->AtomDollar_
Atom AtomDoLogUpdClause_;
#define AtomDoLogUpdClause Yap_heap_regs->AtomDoLogUpdClause_
Atom AtomDoLogUpdClause0_;
@ -252,6 +254,8 @@
#define AtomGlobalTrie Yap_heap_regs->AtomGlobalTrie_
Atom AtomGoalExpansion_;
#define AtomGoalExpansion Yap_heap_regs->AtomGoalExpansion_
Atom AtomHat_;
#define AtomHat Yap_heap_regs->AtomHat_
Atom AtomHERE_;
#define AtomHERE Yap_heap_regs->AtomHERE_
Atom AtomHandleThrow_;
@ -778,6 +782,8 @@
#define FunctorGoalExpansion Yap_heap_regs->FunctorGoalExpansion_
Functor FunctorHandleThrow_;
#define FunctorHandleThrow Yap_heap_regs->FunctorHandleThrow_
Functor FunctorHat_;
#define FunctorHat Yap_heap_regs->FunctorHat_
Functor FunctorId_;
#define FunctorId Yap_heap_regs->FunctorId_
Functor FunctorIs_;

2
H/walkclause.h

@ -350,6 +350,8 @@
case _deallocate:
case _enter_profiling:
case _retry_profiled:
case _retry_udi:
case _try_udi:
pc = NEXTOP(pc,p);
break;
/* instructions type plxxs */

296
LGPL/debug.pl

@ -1,11 +1,10 @@
/* $Id: debug.pl,v 1.1 2008-02-12 17:03:53 vsc Exp $
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
@ -30,19 +29,29 @@
*/
:- module(prolog_debug,
[ debug/3, % +Topic, +Format, +Args
[ debug/3, % +Topic, +Format, :Args
debug/1, % +Topic
nodebug/1, % +Topic
debugging/1, % ?Topic
debugging/2, % ?Topic, ?Bool
list_debug_topics/0,
debug_message_context/1, % (+|-)What
assertion/1 % :Goal
]).
:- meta_predicate(assertion(:)).
:- use_module(library(error)).
:- use_module(library(lists)).
:- set_prolog_flag(generate_debug_info, false).
:- meta_predicate
assertion(0),
debug(+,+,:).
:- multifile prolog:assertion_failed/2.
:- dynamic prolog:assertion_failed/2.
/*:- use_module(library(prolog_stack)).*/ % We use the autoloader if needed
:- if(current_prolog_flag(dialect, yap)).
:- use_module(library(hacks), [stack_dump/1]).
@ -53,10 +62,15 @@ backtrace(N) :-
:- endif.
:- dynamic
debugging/2.
%:- set_prolog_flag(generate_debug_info, false).
/** <module> Print debug messages
:- dynamic
debugging/3, % Topic, Enabled, To
debug_context/1.
debug_context(thread).
/** <module> Print debug messages and test assertions
This library is a replacement for format/3 for printing debug messages.
Messages are assigned a _topic_. By dynamically enabling or disabling
@ -64,7 +78,7 @@ topics the user can select desired messages. Debug statements are
removed when the code is compiled for optimization.
See manual for details. With XPCE, you can use the call below to start a
graphical monitorring tool.
graphical monitoring tool.
==
?- prolog_ide(debug_monitor).
@ -80,11 +94,26 @@ program explicit, trapping the debugger if the condition does not hold.
%% debugging(-Topic) is nondet.
%% debugging(?Topic, ?Bool) is nondet.
%
% Check whether we are debugging Topic or enumerate the topics we
% are debugging.
% Examine debug topics. The form debugging(+Topic) may be used to
% perform more complex debugging tasks. A typical usage skeleton
% is:
%
% ==
% ( debugging(mytopic)
% -> <perform debugging actions>
% ; true
% ),
% ...
% ==
%
% The other two calls are intended to examine existing and enabled
% debugging tokens and are typically not used in user programs.
debugging(Topic) :-
debugging(Topic, true).
debugging(Topic, true, _To).
debugging(Topic, Bool) :-
debugging(Topic, Bool, _To).
%% debug(+Topic) is det.
%% nodebug(+Topic) is det.
@ -92,27 +121,51 @@ debugging(Topic) :-
% Add/remove a topic from being printed. nodebug(_) removes all
% topics. Gives a warning if the topic is not defined unless it is
% used from a directive. The latter allows placing debug topics at
% the start a a (load-)file without warnings.
% the start of a (load-)file without warnings.
%
% For debug/1, Topic can be a term Topic > Out, where Out is
% either a stream or stream-alias or a filename (atom). This
% redirects debug information on this topic to the given output.
debug(Topic) :-
debug(Topic, true).
nodebug(Topic) :-
debug(Topic, false).
debug(Topic, Val) :-
( ( retract(debugging(Topic, _))
*-> assert(debugging(Topic, Val)),
debug(Spec, Val) :-
debug_target(Spec, Topic, Out),
( ( retract(debugging(Topic, Enabled0, To0))
*-> update_debug(Enabled0, To0, Val, Out, Enabled, To),
assert(debugging(Topic, Enabled, To)),
fail
; ( prolog_load_context(file, _)
-> true
; print_message(warning, debug_no_topic(Topic))
),
assert(debugging(Topic, Val))
update_debug(false, [], Val, Out, Enabled, To),
assert(debugging(Topic, Enabled, To))
)
-> true
; true
).
debug_target(Spec, Topic, To) :-
nonvar(Spec),
Spec = (Topic > To), !.
debug_target(Topic, Topic, -).
update_debug(_, To0, true, -, true, To) :- !,
ensure_output(To0, To).
update_debug(true, To0, true, Out, true, Output) :- !,
append(To0, [Out], Output).
update_debug(false, _, true, Out, true, [Out]) :- !.
update_debug(_, _, false, -, false, []) :- !.
update_debug(true, [Out], false, Out, false, []) :- !.
update_debug(true, To0, false, Out, true, Output) :- !,
delete(To0, Out, Output).
ensure_output([], [user_error]) :- !.
ensure_output(List, List).
%% debug_topic(+Topic) is det.
%
@ -120,44 +173,108 @@ debug(Topic, Val) :-
% topics available for debugging.
debug_topic(Topic) :-
( debugging(Registered, _),
( debugging(Registered, _, _),
Registered =@= Topic
-> true
; assert(debugging(Topic, false))
; assert(debugging(Topic, false, []))
).
%% list_debug_topics is det.
%
%
% List currently known debug topics and their setting.
list_debug_topics :-
format(user_error, '~*t~40|~n', "-"),
format(user_error, '~w~t~30| ~w~n', ['Debug Topic', 'Activated']),
format(user_error, '~*t~40|~n', "-"),
( debugging(Topic, Value),
format(user_error, '~w~t~30| ~w~n', [Topic, Value]),
format(user_error, '~*t~45|~n', "-"),
format(user_error, '~w~t ~w~35| ~w~n',
['Debug Topic', 'Activated', 'To']),
format(user_error, '~*t~45|~n', "-"),
( debugging(Topic, Value, To),
format(user_error, '~w~t ~w~35| ~w~n', [Topic, Value, To]),
fail
; true
).
%% debug(+Topic, +Format, +Args) is det.
%% debug_message_context(+What) is det.
%
% As format/3 to user_error, but only does something if Topic
% is activated through debug/1.
% Specify additional context for debug messages. What is one of
% +Context or -Context, and Context is one of =thread=, =time= or
% time(Format), where Format is a format specification for
% format_time/3 (default is =|%T.%3f|=). Initially, debug/3 shows
% only thread information.
debug_message_context(+Topic) :- !,
valid_topic(Topic, Del, Add),
retractall(debug_context(Del)),
assert(debug_context(Add)).
debug_message_context(-Topic) :- !,
valid_topic(Topic, Del, _),
retractall(debug_context(Del)).
debug_message_context(Term) :-
type_error(debug_message_context, Term).
valid_topic(thread, thread, thread) :- !.
valid_topic(time, time(_), time('%T.%3f')) :- !.
valid_topic(time(Format), time(_), time(Format)) :- !.
valid_topic(X, _, _) :-
domain_error(debug_message_context, X).
%% debug(+Topic, +Format, :Args) is det.
%
% Format a message if debug topic is enabled. Similar to format/3
% to =user_error=, but only prints if Topic is activated through
% debug/1. Args is a meta-argument to deal with goal for the
% @-command. Output is first handed to the hook
% prolog:debug_print_hook/3. If this fails, Format+Args is
% translated to text using the message-translation (see
% print_message/2) for the term debug(Format, Args) and then
% printed to every matching destination (controlled by debug/1)
% using print_message_lines/3.
%
% The message is preceded by '% ' and terminated with a newline.
%
% @see format/3.
debug(Topic, Format, Args) :-
debugging(Topic, true), !,
print_debug(Topic, Format, Args).
debugging(Topic, true, To), !,
print_debug(Topic, To, Format, Args).
debug(_, _, _).
%% prolog:debug_print_hook(+Topic, +Format, +Args) is semidet.
%
% Hook called by debug/3. This hook is used by the graphical
% frontend that can be activated using prolog_ide/1:
%
% ==
% ?- prolog_ide(debug_monitor).
% ==
:- multifile
prolog:debug_print_hook/3.
print_debug(Topic, Format, Args) :-
print_debug(Topic, _To, Format, Args) :-
prolog:debug_print_hook(Topic, Format, Args), !.
print_debug(_, Format, Args) :-
print_message(informational, debug(Format, Args)).
print_debug(_, [], _, _) :- !.
print_debug(Topic, To, Format, Args) :-
phrase('$messages':translate_message(debug(Format, Args)), Lines),
( member(T, To),
debug_output(T, Stream),
print_message_lines(Stream, kind(debug(Topic)), Lines),
fail
; true
).
debug_output(user, user_error) :- !.
debug_output(Stream, Stream) :-
is_stream(Stream), !.
debug_output(File, Stream) :-
open(File, append, Stream,
[ close_on_abort(false),
alias(File),
buffer(line)
]).
/*******************************
@ -165,27 +282,46 @@ print_debug(_, Format, Args) :-
*******************************/
%% assertion(:Goal) is det.
%
% Acts similar to C assert() macro. It has no effect of Goal
% succeeds. If Goal fails it prints a message, a stack-trace
% and finally traps the debugger.
%
% Acts similar to C assert() macro. It has no effect if Goal
% succeeds. If Goal fails or throws an exception, the following
% steps are taken:
%
% * call prolog:assertion_failed/2. If prolog:assertion_failed/2
% fails, then:
%
% - If this is an interactive toplevel thread, print a
% message, the stack-trace, and finally trap the debugger.
% - Otherwise, throw error(assertion_error(Reason, G),_) where
% Reason is one of =fail= or the exception raised.
assertion(G) :-
\+ \+ G, !. % avoid binding variables
\+ \+ catch(G,
Error,
assertion_failed(Error, G)),
!.
assertion(G) :-
print_message(error, assumption_failed(G)),
assertion_failed(fail, G),
assertion_failed. % prevent last call optimization.
assertion_failed(Reason, G) :-
prolog:assertion_failed(Reason, G), !.
assertion_failed(Reason, G) :-
print_message(error, assertion_failed(Reason, G)),
backtrace(10),
trace,
assertion_failed.
( current_prolog_flag(break_level, _) % interactive thread
-> trace
; throw(error(assertion_error(Reason, G), _))
).
assertion_failed.
%% assume(:Goal) is det.
%
%
% Acts similar to C assert() macro. It has no effect of Goal
% succeeds. If Goal fails it prints a message, a stack-trace
% and finally traps the debugger.
%
%
% @deprecated Use assertion/1 in new code.
/*******************************
@ -193,34 +329,28 @@ assertion_failed.
*******************************/
:- multifile
user:goal_expansion/2.
system:goal_expansion/2.
user:goal_expansion(debug(Topic,_,_), true) :-
system:goal_expansion(debug(Topic,_,_), true) :-
( current_prolog_flag(optimise, true)
-> true
; debug_topic(Topic),
fail
).
user:goal_expansion(debugging(Topic), fail) :-
system:goal_expansion(debugging(Topic), fail) :-
( current_prolog_flag(optimise, true)
-> true
; debug_topic(Topic),
fail
).
user:goal_expansion(assertion(G), Goal) :-
( current_prolog_flag(optimise, true)
-> Goal = true
; expand_goal(G, G2),
Goal = assertion(G2)
).
user:goal_expansion(assume(G), Goal) :-
system:goal_expansion(assertion(_), Goal) :-
current_prolog_flag(optimise, true),
Goal = true.
system:goal_expansion(assume(_), Goal) :-
print_message(informational,
compatibility(renamed(assume/1, assertion/1))),
( current_prolog_flag(optimise, true)
-> Goal = true
; expand_goal(G, G2),
Goal = assertion(G2)
).
current_prolog_flag(optimise, true),
Goal = true.
/*******************************
@ -230,13 +360,41 @@ user:goal_expansion(assume(G), Goal) :-
:- multifile
prolog:message/3.
prolog:message(assumption_failed(G)) -->
[ 'Assertion failed: ~p'-[G] ].
prolog:message(assertion_failed(_, G)) -->
[ 'Assertion failed: ~q'-[G] ].
prolog:message(debug(Fmt, Args)) -->
{ thread_self(Me) },
( { Me == main }
-> [ Fmt-Args ]
; [ '[Thread ~w] '-[Me], Fmt-Args ]
).
show_thread_context,
show_time_context,
[ Fmt-Args ].
prolog:message(debug_no_topic(Topic)) -->
[ '~q: no matching debug topic (yet)'-[Topic] ].
show_thread_context -->
{ debug_context(thread),
thread_self(Me) ,
Me \== main
},
[ '[Thread ~w] '-[Me] ].
show_thread_context -->
[].
show_time_context -->
{ debug_context(time(Format)),
get_time(Now),
format_time(string(S), Format, Now)
},
[ '[~w] '-[S] ].
show_time_context -->
[].
/*******************************
* HOOKS *
*******************************/
%% prolog:assertion_failed(+Reason, +Goal) is semidet.
%
% This hook is called if the Goal of assertion/1 fails. Reason is
% unified with either =fail= if Goal simply failed or an exception
% call otherwise. If this hook fails, the default behaviour is
% activated. If the hooks throws an exception it will be
% propagated into the caller of assertion/1.

78
LGPL/record.pl

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
@ -32,6 +32,7 @@
:- module((record),
[ (record)/1, % +Record
current_record/2, % ?Name, ?Term
current_record_predicate/2, % ?Record, :PI
op(1150, fx, record)
]).
:- use_module(library(error)).
@ -59,7 +60,8 @@ _directive_. Here is a simple example declaration and some calls.
*/
:- multifile
error:has_type/2.
error:has_type/2,
prolog:generated_predicate/1.
error:has_type(record(M:Name), X) :-
current_record(Name, M, _, X, IsX), !,
@ -77,6 +79,7 @@ error:has_type(record(M:Name), X) :-
% info the following predicates:
%
% * <constructor>_<name>(Record, Value)
% * <constructor>_data(?Name, ?Record, ?Value)
% * default_<constructor>(-Record)
% * is_<constructor>(@Term)
% * make_<constructor>(+Fields, -Record)
@ -120,12 +123,14 @@ compile_record(RecordDef) -->
defaults(Args, Defs, TypedArgs),
types(TypedArgs, Names, Types),
atom_concat(default_, Constructor, DefName),
atom_concat(Constructor, '_data', DataName),
DefRecord =.. [Constructor|Defs],
DefClause =.. [DefName,DefRecord],
length(Names, Arity)
},
[ DefClause ],
access_predicates(Names, 1, Arity, Constructor),
data_predicate(Names, 1, Arity, Constructor, DataName),
set_predicates(Names, 1, Arity, Types, Constructor),
set_field_predicates(Names, 1, Arity, Types, Constructor),
make_predicate(Constructor),
@ -133,7 +138,8 @@ compile_record(RecordDef) -->
current_clause(RecordDef).
:- meta_predicate
current_record(:).
current_record(?, :),
current_record_predicate(?, :).
:- multifile
current_record/5. % Name, Module, Term, X, IsX
@ -156,6 +162,56 @@ current_clause(RecordDef) -->
].
%% current_record_predicate(?Record, ?PI) is nondet.
%
% True if PI is the predicate indicator for an access predicate to
% Record. This predicate is intended to support cross-referencer
% tools.
current_record_predicate(Record, M:PI) :-
( ground(PI)
-> Det = true
; true
),
current_record(Record, M:RecordDef),
( general_record_pred(Record, M:PI)
; RecordDef =.. [_|Args],
defaults(Args, _Defs, TypedArgs),
types(TypedArgs, Names, _Types),
member(Field, Names),
field_record_pred(Record, Field, M:PI)
),
( Det == true
-> !
; true
).
general_record_pred(Record, _:Name/1) :-
atom_concat(is_, Record, Name).
general_record_pred(Record, _:Name/1) :-
atom_concat(default_, Record, Name).
general_record_pred(Record, _:Name/A) :-
member(A, [2,3]),
atom_concat(make_, Record, Name).
general_record_pred(Record, _:Name/3) :-
atom_concat(Record, '_data', Name).
general_record_pred(Record, _:Name/A) :-
member(A, [3,4]),
atomic_list_concat([set_, Record, '_fields'], Name).
general_record_pred(Record, _:Name/3) :-
atomic_list_concat([set_, Record, '_field'], Name).
field_record_pred(Record, Field, _:Name/2) :-
atomic_list_concat([Record, '_', Field], Name).
field_record_pred(Record, Field, _:Name/A) :-
member(A, [2,3]),
atomic_list_concat([set_, Field, '_of_', Record], Name).
field_record_pred(Record, Field, _:Name/2) :-
atomic_list_concat([nb_set_, Field, '_of_', Record], Name).
prolog:generated_predicate(P) :-
current_record_predicate(_, P).
%% make_predicate(+Constructor)// is det.
%
% Creates the make_<constructor>(+Fields, -Record) predicate. This
@ -286,6 +342,22 @@ access_predicates([Name|NT], I, Arity, Constructor) -->
access_predicates(NT, I2, Arity, Constructor).
%% data_predicate(+Names, +Idx0, +Arity, +Constructor, +DataName)// is det.
%
% Create the <constructor>_data(Name, Record, Value) predicate.
data_predicate([], _, _, _, _) -->
[].
data_predicate([Name|NT], I, Arity, Constructor, DataName) -->
{ functor(Record, Constructor, Arity),
arg(I, Record, Value),
Clause =.. [DataName, Name, Record, Value],
I2 is I + 1
},
[Clause],
data_predicate(NT, I2, Arity, Constructor, DataName).
%% set_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det.
%
% Create the clauses

13
Makefile.in

@ -101,7 +101,7 @@ SONAMEFLAG=@SONAMEFLAG@
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
VERSION=6.3.2
VERSION=6.3.4
MYDDAS_VERSION=MYDDAS-0.9.1
#
@ -135,14 +135,13 @@ IOLIB_HEADERS=$(srcdir)/os/pl-buffer.h \
$(srcdir)/os/dtoa.c \
$(srcdir)/H/pl-incl.h \
$(srcdir)/H/pl-global.h \
$(srcdir)/os/pl-mswchar.h \
$(srcdir)/os/pl-option.h \
$(srcdir)/os/pl-os.h \
$(srcdir)/os/pl-privitf.h \
$(srcdir)/os/pl-table.h \
$(srcdir)/os/pl-text.h \
$(srcdir)/os/pl-utf8.h \
$(srcdir)/H/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/os/windows/dirent.h $(srcdir)/os/windows/utf8.h $(srcdir)/os/windows/utf8.c $(srcdir)/os/windows/uxnt.h $(srcdir)/os/windows/mswchar.h $(srcdir)/os/windows/popen.c
$(srcdir)/H/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/os/windows/dirent.h $(srcdir)/os/windows/utf8.h $(srcdir)/os/windows/utf8.c $(srcdir)/os/windows/uxnt.h $(srcdir)/os/windows/popen.c
HEADERS = \
$(srcdir)/H/Atoms.h \
@ -224,6 +223,7 @@ IOLIB_SOURCES=$(srcdir)/os/pl-buffer.c $(srcdir)/os/pl-ctype.c \
$(srcdir)/os/pl-table.c \
$(srcdir)/os/pl-tai.c \
$(srcdir)/os/pl-text.c \
$(srcdir)/os/pl-version.c \
$(srcdir)/os/pl-write.c \
$(srcdir)/C/pl-yap.c @ENABLE_WINCONSOLE@$(srcdir)/os/windows/uxnt.c
@ -350,7 +350,7 @@ IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o \
pl-rl.o \
pl-stream.o pl-string.o pl-table.o \
pl-tai.o pl-text.o pl-utf8.o \
pl-write.o \
pl-version.o pl-write.o \
pl-yap.o @ENABLE_WINCONSOLE@ uxnt.o
ENGINE_OBJECTS = \
@ -649,6 +649,9 @@ pl-text.o: $(srcdir)/os/pl-text.c config.h
pl-utf8.o: $(srcdir)/os/pl-utf8.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-utf8.c -o $@
pl-version.o: $(srcdir)/os/pl-version.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-version.c -o $@
pl-write.o: $(srcdir)/os/pl-write.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-write.c -o $@
@ -698,6 +701,7 @@ all: startup.yss
@INSTALL_DLLS@ (cd library/system; $(MAKE))
@INSTALL_DLLS@ (cd library/tries; $(MAKE))
@ENABLE_CLIB@ @INSTALL_DLLS@ (cd packages/clib; $(MAKE))
@ENABLE_CHR@ @INSTALL_DLLS@ (cd packages/chr; $(MAKE))
@ENABLE_HTTP@ @INSTALL_DLLS@ (cd packages/http; $(MAKE))
@ENABLE_PLDOC@ @INSTALL_DLLS@ (cd packages/pldoc; $(MAKE))
@ENABLE_PLUNIT@ @INSTALL_DLLS@ (cd packages/plunit; $(MAKE))
@ -921,6 +925,7 @@ clean: clean_docs
@ENABLE_REAL@ (cd packages/real; $(MAKE) clean)
@ENABLE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean)
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE) clean)
@ENABLE_CHR@ @INSTALL_DLLS@ (cd packages/chr; $(MAKE) clean)
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) clean)
@ENABLE_PRISM@ (cd packages/prism/src/c; $(MAKE) clean)
@ENABLE_PRISM@ (cd packages/prism/src/prolog; $(MAKE) clean)

5
config.h.in

@ -52,6 +52,7 @@
#undef HAVE_ARPA_INET_H
#undef HAVE_CTYPE_H
#undef HAVE_CRYPT_H
#undef HAVE_CRTDBG_H
#undef HAVE_CUDD_H
#undef HAVE_CUDDINT_H
#undef HAVE_CUDD_CUDD_H
@ -87,6 +88,7 @@
#undef HAVE_READLINE_HISTORY_H
#undef HAVE_REGEX_H
#undef HAVE_RINTERFACE_H
#undef HAVE_SHLOBJ_H
#undef HAVE_SIGINFO_H
#undef HAVE_SIGNAL_H
#undef HAVE_STDARG_H
@ -117,6 +119,8 @@
#undef HAVE_WCTYPE_H
#undef HAVE_WINSOCK_H
#undef HAVE_WINSOCK2_H
#undef HAVE_WINSOCK2_H
#undef HAVE_LIBLOADERAPI_H
#if __MINGW32__
#define __WINDOWS__ 1
@ -184,6 +188,7 @@
#undef HAVE_FINITE
#undef HAVE_FPCLASS
#undef HAVE_FTIME
#undef HAVE_FTRUNCATE
#undef HAVE_GETCWD
#undef HAVE_GETENV
#undef HAVE_GETEXECNAME

17
configure vendored

@ -8038,7 +8038,6 @@ fi
fi
INSTALL_DLLS="#"
EXTRA_OBJS=""
SHLIB_LD="#"
@ -8387,6 +8386,7 @@ fi
fi
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
DYNYAPLIB=libYap."$SO"
YAPLIB_LD=$SHLIB_LD
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
@ -9026,7 +9026,7 @@ $as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h
fi
for ac_header in arpa/inet.h alloca.h crypt.h
for ac_header in arpa/inet.h alloca.h crtdbg.h crypt.h
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
@ -9091,7 +9091,7 @@ fi
done
for ac_header in netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h
for ac_header in netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h shlobj.h
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
@ -9221,12 +9221,13 @@ fi
done
for ac_header in mach-o/dyld.h
for ac_header in mach-o/dyld.h LibLoaderAPI.h
do :
ac_fn_c_check_header_mongrel "$LINENO" "mach-o/dyld.h" "ac_cv_header_mach_o_dyld_h" "$ac_includes_default"
if test "x$ac_cv_header_mach_o_dyld_h" = xyes; then :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_MACH_O_DYLD_H 1
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
fi
@ -10238,7 +10239,7 @@ _ACEOF
fi
done
for ac_func in fesettrapenable fgetpos finite fpclass ftime getcwd getenv
for ac_func in fesettrapenable fgetpos finite fpclass ftime ftruncate getcwd getenv
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"

10
configure.in

@ -1167,7 +1167,6 @@ else
AC_SYS_RESTARTABLE_SYSCALLS
fi
dnl defaults
INSTALL_DLLS="#"
EXTRA_OBJS=""
@ -1400,6 +1399,7 @@ dnl Linux has both elf and a.out, in this case we found elf
fi
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
DYNYAPLIB=libYap."$SO"
YAPLIB_LD=$SHLIB_LD
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
@ -1694,12 +1694,12 @@ AC_SUBST(PRE_INSTALL_ENV)
dnl Checks for header files.
AC_HEADER_STDC
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(arpa/inet.h alloca.h crypt.h)
AC_CHECK_HEADERS(arpa/inet.h alloca.h crtdbg.h crypt.h)
AC_CHECK_HEADERS(ctype.h direct.h dirent.h dlfcn.h)
AC_CHECK_HEADERS(errno.h execinfo.h fcntl.h fenv.h)
AC_CHECK_HEADERS(float.h fpu_control.h ieeefp.h io.h limits.h)
AC_CHECK_HEADERS(locale.h malloc.h math.h memory.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h shlobj.h)
AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h stdint.h string.h stropts.h)
AC_CHECK_HEADERS(sys/conf.h sys/dir.h sys/file.h)
AC_CHECK_HEADERS(sys/mman.h sys/ndir.h sys/param.h)
@ -1709,7 +1709,7 @@ AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h)
AC_CHECK_HEADERS(sys/ucontext.h sys/un.h sys/wait.h)
AC_CHECK_HEADERS(time.h unistd.h utime.h wctype.h winsock.h winsock2.h)
AC_CHECK_HEADERS(zlib.h zutil.h)
AC_CHECK_HEADERS(mach-o/dyld.h)
AC_CHECK_HEADERS(mach-o/dyld.h LibLoaderAPI.h)
if test "$yap_cv_gmp" != "no"
then
AC_CHECK_HEADERS(gmp.h)
@ -2068,7 +2068,7 @@ AC_CHECK_FUNCS(_NSGetEnviron _chsize_s access acosh)
AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime)
AC_CHECK_FUNCS(ctime dlopen dup2)
AC_CHECK_FUNCS(erf feclearexcept)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime getcwd getenv)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime ftruncate getcwd getenv)
AC_CHECK_FUNCS(getexecname)
AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpagesize)

18
docs/yap.tex

@ -8,7 +8,7 @@
@c @setchapternewpage odd
@c %**end of header
@set VERSION 6.3.2
@set VERSION 6.3.3
@set EDITION 4.2.9
@set UPDATED Oct 2010
@ -1686,6 +1686,13 @@ supported encodings.
is @code{compact} clauses are compiled and no source code is stored;
if it is @code{source} clauses are compiled and source code is stored;
if it is @code{assert_all} clauses are asserted into the data-base.
@item comnsult(+@var{Mode})
This extension controls the type of file to load. If @var{Mode}
is @code{consult}, clauses are added to the data-base,
is @code{reconsult}, clauses are recompiled,
is @code{db}, these are facts that need to be added to the data-base,
is @code{exo}, these are facts with atoms and integers that need a very compact representation.
@end table
@item ensure_loaded(@var{+F}) [ISO]
@ -1708,7 +1715,14 @@ if they have not been loaded before, does nothing otherwise.
@syindex load_db/1
@cnindex load_db/1
@noindent
Load a database of facts with equal structure. Useful when wanting to
Load a database of facts with equal structure.
@item exo_files(@var{+Files})
@findex exo_files/1
@syindex exo_files/1
@cnindex exo_files/1
@noindent
Load compactly a database of facts with equal structure. Useful when wanting to
read in a very compact way database tables.
@item make

25
include/SWI-Prolog.h

@ -127,7 +127,10 @@ typedef unsigned long uintptr_t;
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
typedef void *module_t;
typedef void *record_t;
typedef uintptr_t atom_t;
@ -220,6 +223,15 @@ typedef void *PL_engine_t;
#define PL_CYCLIC_TERM (42) /* a cyclic list/term */
#define PL_NOT_A_LIST (43) /* Object is not a list */
/* Or'ed flags for PL_set_prolog_flag() */
/* MUST fit in a short int! */
#define FF_READONLY 0x1000 /* Read-only prolog flag */
#define FF_KEEP 0x2000 /* keep prolog flag if already se
t */
#define FF_NOCREATE 0x4000 /* Fail if flag is non-existent */
#define FF_MASK 0xf000
#define CVT_ATOM 0x0001
#define CVT_STRING 0x0002
#define CVT_LIST 0x0004
@ -332,9 +344,6 @@ UNICODE file functions.
#ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */
#define FF_NOCREATE 0x4000 /* Fail if flag is non-existent */
#define FF_MASK 0xf000
/*******************************
* STREAM SUPPORT *
*******************************/
@ -373,6 +382,10 @@ PL_EXPORT(IOSTREAM *)*_PL_streams(void); /* base of streams */
PL_WRT_ATTVAR_WRITE | \
PL_WRT_ATTVAR_PORTRAY)
#define PL_WRT_BLOB_PORTRAY 0x400 /* Use portray to emit non-text blobs */
#define PL_WRT_NO_CYCLES 0x800 /* Never emit @(Template,Subst) */
#define PL_WRT_LIST 0x1000 /* Write [...], even with ignoreops */
#define PL_WRT_NEWLINE 0x2000 /* Add a newline */
#define PL_WRT_VARNAMES 0x4000 /* Internal: variable_names(List) */
PL_EXPORT(int) PL_write_term(IOSTREAM *s,
term_t term,
@ -525,6 +538,7 @@ extern X_API int PL_is_string(term_t);
extern X_API int PL_is_variable(term_t);
extern X_API int PL_term_type(term_t);
extern X_API int PL_is_inf(term_t);
extern X_API int PL_is_acyclic(term_t t);
/* end PL_is_* functions =============================*/
extern X_API void PL_halt(int);
extern X_API int PL_initialise(int, char **);
@ -579,6 +593,7 @@ extern X_API int PL_erase_external(char *);
extern X_API int PL_action(int,...);
extern X_API void PL_on_halt(void (*)(int, void *), void *);
extern X_API void *PL_malloc(size_t);
extern X_API void *PL_malloc_uncollectable(size_t s);
extern X_API void *PL_realloc(void*,size_t);
extern X_API void PL_free(void *);
extern X_API int PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
@ -618,7 +633,7 @@ extern char *PL_prompt_string(int fd);
PL_EXPORT(int) PL_get_file_name(term_t n, char **name, int flags);
PL_EXPORT(int) PL_get_file_nameW(term_t n, wchar_t **name, int flags);
PL_EXPORT(void) PL_changed_cwd(void); /* foreign code changed CWD */
PL_EXPORT(const char *) PL_cwd(void);
PL_EXPORT(char *) PL_cwd(char *buf, size_t buflen);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
NOTE: the functions in this section are not documented, as as yet not
@ -784,8 +799,6 @@ PL_EXPORT(int) PL_unify_mpq(term_t t, mpq_t mpz);
#endif
extern X_API const char *PL_cwd(void);
void swi_install(void);
X_API int PL_warning(const char *msg, ...);

1775
include/dswiatoms.h

File diff suppressed because it is too large Load Diff

8
include/yap_structs.h

@ -120,8 +120,14 @@ typedef enum {
#define YAP_WRITE_QUOTED 1
#define YAP_WRITE_IGNORE_OPS 2
#define YAP_WRITE_HANDLE_VARS 2
#define YAP_WRITE_HANDLE_VARS 4
#define YAP_WRITE_USE_PORTRAY 8
#define YAP_WRITE_HANDLE_CYCLES 0x20
#define YAP_WRITE_BACKQUOTE_STRING 0x80
#define YAP_WRITE_ATTVAR_NONE 0x100
#define YAP_WRITE_ATTVAR_DOTS 0x200
#define YAP_WRITE_ATTVAR_PORTRAY 0x400
#define YAP_WRITE_BLOB_PORTRAY 0x800
#define YAP_CONSULT_MODE 0
#define YAP_RECONSULT_MODE 1

4
library/dialect/swi/fli/blobs.c

@ -20,6 +20,10 @@
#include <string.h>
/* for freeBSD9.1 */
#define _WITH_DPRINTF
#include <stdio.h>
#include <SWI-Prolog.h>
#include "swi.h"

136
library/dialect/swi/fli/swi.c

@ -1738,6 +1738,12 @@ X_API int PL_is_ground(term_t t)
return Yap_IsGroundTerm(Yap_GetFromSlot(t PASS_REGS));
}
X_API int PL_is_acyclic(term_t t)
{
CACHE_REGS
return Yap_IsAcyclicTerm(Yap_GetFromSlot(t PASS_REGS));
}
X_API int PL_is_callable(term_t t)
{
CACHE_REGS
@ -2196,6 +2202,7 @@ PL_open_foreign_frame(void)
new->open = FALSE;
new->cp = CP;
new->p = P;
new->flags = 0;
new->b = (CELL)(LCL0-(CELL*)B);
new->slots = CurSlot;
LOCAL_execution = new;
@ -2226,6 +2233,8 @@ PL_close_foreign_frame(fid_t f)
CurSlot = env->slots;
B = (choiceptr)(LCL0-env->b);
ASP = (CELL *)(LCL0-CurSlot);
EX = NULL;
LOCAL_BallTerm = EX;
LOCAL_execution = env->old;
free(env);
}
@ -2274,6 +2283,8 @@ PL_discard_foreign_frame(fid_t f)
LOCAL_execution = env->old;
ASP = LCL0-CurSlot;
B = B->cp_b;
EX = NULL;
LOCAL_BallTerm = EX;
free(env);
}
@ -2285,9 +2296,22 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
Term t[2], m;
/* ignore flags and module for now */
PL_open_foreign_frame();
if (!LOCAL_execution) {
open_query *new = (open_query *)malloc(sizeof(open_query));
if (!new) return 0;
new->old = LOCAL_execution;
new->g = TermNil;
new->open = FALSE;
new->cp = CP;
new->p = P;
new->b = (CELL)(LCL0-(CELL*)B);
new->slots = CurSlot;
new->flags = 0;
LOCAL_execution = new;
}
LOCAL_execution->open=1;
LOCAL_execution->state=0;
LOCAL_execution->flags = flags;
PredicateInfo((PredEntry *)p, &yname, &arity, &m);
t[0] = SWIModuleToModule(ctx);
if (arity == 0) {
@ -2346,9 +2370,15 @@ X_API void PL_cut_query(qid_t qi)
X_API void PL_close_query(qid_t qi)
{
CACHE_REGS
EX = NULL;
if (EX && !(qi->flags & (PL_Q_CATCH_EXCEPTION|PL_Q_PASS_EXCEPTION))) {
EX = NULL;
}
/* need to implement backtracking here */
if (qi->open != 1 || qi->state == 0)
if (qi->open != 1 || qi->state == 0) {
return;
}
YAP_PruneGoal();
YAP_RestartGoal();
qi->open = 0;
@ -2784,6 +2814,11 @@ PL_query(int query)
}
}
X_API void
PL_cleanup_fork(void)
{
}
X_API void (*PL_signal(int sig, void (*func)(int)))(int)
{
@ -2796,11 +2831,106 @@ X_API void PL_on_halt(void (*f)(int, void *), void *closure)
Yap_HaltRegisterHook((HaltHookFunc)f,closure);
}
X_API char *PL_atom_generator(const char *prefix, int state)
#define is_signalled() unlikely(LD && LD->signal.pending != 0)
#ifdef O_PLMT
#include <pthread.h>
static pthread_key_t atomgen_key;
#endif
typedef struct scan_atoms {
Int pos;
Atom atom;
} scan_atoms_t;
static inline int
str_prefix(const char *p0, char *s)
{
char *p = (char *)p0;
while (*p && *p == *s) { p++; s++; }
return p[0] == '\0';
}
static int
atom_generator(const char *prefix, char **hit, int state)
{
struct scan_atoms *index;
Atom catom;
Int i;
#ifdef O_PLMT
if ( !atomgen_key ) {
pthread_key_create(&atomgen_key, NULL);
state = FALSE;
}
#endif
if ( !state )
{ index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms));
i = 0;
catom = NIL;
} else
{
#ifdef O_PLMT
index = (struct scan_atoms *)pthread_getspecific(atomgen_key);
#else
index = LOCAL_search_atoms;
#endif
catom = index->atom;
i = index->pos;
}
while (catom != NIL || i < AtomHashTableSize) {
// if ( is_signalled() ) /* Notably allow windows version */
// PL_handle_signals(); /* to break out on ^C */
AtomEntry *ap;
if (catom == NIL) {
/* move away from current hash table line */
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
i++;
} else {
ap = RepAtom(catom);
READ_LOCK(ap->ARWLock);
if ( str_prefix(prefix, ap->StrOfAE) ) {
index->pos = i;
index->atom = ap->NextOfAE;
#ifdef O_PLMT
pthread_setspecific(atomgen_key,index);
#else
LOCAL_search_atoms = index;
#endif
*hit = ap->StrOfAE;
READ_UNLOCK(ap->ARWLock);
return TRUE;
}
catom = ap->NextOfAE;
READ_UNLOCK(ap->ARWLock);
}
}
#ifdef O_PLMT
pthread_setspecific(atomgen_key,NULL);
#else
LOCAL_search_atoms = NULL;
#endif
free(index);
return FALSE;
}
char *
PL_atom_generator(const char *prefix, int state)
{
char * hit = NULL;
if (atom_generator(prefix, &hit, state)) {
return hit;
}
return NULL;
}
X_API pl_wchar_t *PL_atom_generator_w(const pl_wchar_t *pref, pl_wchar_t *buffer, size_t buflen, int state)
{
return NULL;

1
library/dialect/swi/fli/swi.h

@ -49,6 +49,7 @@ typedef struct open_query_struct {
yamop *p, *cp;
Int slots, b;
jmp_buf env;
int flags;
struct open_query_struct *old;
} open_query;

3
misc/ATOMS

@ -79,6 +79,7 @@ A Dec10 N "dec10"
A Default N "default"
A DevNull N "/dev/null"
A Diff N "\\="
A Dollar F "$"
A DoLogUpdClause F "$do_log_upd_clause"
A DoLogUpdClause0 F "$do_log_upd_clause0"
A DoLogUpdClauseErase F "$do_log_upd_clause_erase"
@ -132,6 +133,7 @@ A GetworkSeq F "$getwork_seq"
A GlobalSp N "global_sp"
A GlobalTrie N "global_trie"
A GoalExpansion N "goal_expansion"
A Hat N "^"
A HERE N "\n <====HERE====> \n"
A HandleThrow F "$handle_throw"
A Heap N "heap"
@ -395,6 +397,7 @@ F GeneratePredInfo GeneratePredInfo 4
F GoalExpansion2 GoalExpansion 2
F GoalExpansion GoalExpansion 3
F HandleThrow HandleThrow 3
F Hat Hat 2
F Id Id 1
F Is Is 2
F LastExecuteWithin LastExecuteWithin 1

2
misc/GLOBALS

@ -118,6 +118,8 @@ char pwd[YAP_FILENAME_MAX] void
//udi.c
//struct udi_control_block RtreeCmd void
char* RestoreFile void
END_GLOBAL_DATA

3
misc/LOCALS

@ -274,4 +274,7 @@ Functor FunctorVar =FunctorVar
// exo indexing
UInt ibnds[256] void
// atom completion
struct scan_atoms* search_atoms void
END_WORKER_LOCAL

77
misc/SWIATOMS

@ -14,7 +14,9 @@ A abort "abort"
A aborted "$aborted"
A abs "abs"
A access "access"
A access_level "access_level"
A acos "acos"
A acosh "acosh"
A acyclic_term "acyclic_term"
A add_import "add_import"
A address "address"
@ -38,6 +40,7 @@ A argumentlimit "argumentlimit"
A as "as"
A ascii "ascii"
A asin "asin"
A asinh "asinh"
A assert "assert"
A asserta "asserta"
A at "at"
@ -49,6 +52,7 @@ A at_not_equals "\\=@="
A at_smaller "@<"
A at_smaller_eq "@=<"
A atan "atan"
A atanh "atanh"
A atan2 "atan2"
A atom "atom"
A atom_garbage_collection "atom_garbage_collection"
@ -62,8 +66,10 @@ A backquoted_string "backquoted_string"
A backslash "\\"
A backtrace "backtrace"
A bar "|"
A base "base"
A begin "begin"
A binary "binary"
A binary_stream "binary_stream"
A bind "bind"
A bitor "\\/"
A blobs "blobs"
@ -73,6 +79,7 @@ A bool "bool"
A boolean "boolean"
A brace_term_position "brace_term_position"
A break "break"
A break_level "break_level"
A btree "btree"
A buffer "buffer"
A buffer_size "buffer_size"
@ -86,6 +93,7 @@ A callpred "$callpred"
A canceled "canceled"
A case_sensitive_file_names "case_sensitive_file_names"
A catch "catch"
A category "category"
A ceil "ceil"
A ceiling "ceiling"
A char_type "char_type"
@ -96,11 +104,13 @@ A chars "chars"
A chdir "chdir"
A chmod "chmod"
A choice "choice"
A class "class"
A clause "clause"
A clauses "clauses"
A clause_reference "clause_reference"
A close "close"
A close_on_abort "close_on_abort"
A close_on_exec "close_on_exec"
A close_on_exec "close_on_exec"
A close_option "close_option"
A cm "cm"
A cntrl "cntrl"
@ -115,9 +125,11 @@ A compound "compound"
A context "context"
A context_module "context_module"
A continue "continue"
A copysign "copysign"
A core "core"
A core_left "core_left"
A cos "cos"
A cosh "cosh"
A cputime "cputime"
A create "create"
A csym "csym"
@ -133,6 +145,7 @@ A cut_exit "cut_exit"
A cut_parent "cut_parent"
A cutted "cut"
A cyclic_term "cyclic_term"
A cycles "cycles"
A dand "$and"
A date "date"
A db_reference "db_reference"
@ -143,8 +156,10 @@ A dcatch "$catch"
A dcut "$cut"
A dde_error "dde_error"
A dde_handle "dde_handle"
A deadline "deadline"
A debug "debug"
A debug_on_error "debug_on_error"
A debug_topic "debug_topic"
A debugger_print_options "debugger_print_options"
A debugger_show_context "debugger_show_context"
A debugging "debugging"
@ -176,11 +191,13 @@ A dots "dots"
A double_quotes "double_quotes"
A doublestar "**"
A dprof_node "$profile_node"
A dquery_loop "$query_loop"
A drecover_and_rethrow "$recover_and_rethrow"
A dstream "$stream"
A dthread_init "$thread_init"
A dthrow "$throw"
A dtime "$time"
A dtoplevel "$toplevel"
A dvard "$VAR$"
A dwakeup "$wakeup"
A dynamic "dynamic"
@ -274,9 +291,8 @@ A has_alternatives "has_alternatives"
A hash "hash"
A hashed "hashed"
A hat "^"
A heap "heap"
A heaplimit "heaplimit"
A heapused "heapused"
A heap_gc "heap_gc"
A help "help"
A hidden "hidden"
A hide_childs "hide_childs"
@ -284,6 +300,8 @@ A history_depth "history_depth"
A ifthen "->"
A ignore "ignore"
A ignore_ops "ignore_ops"
A import_into "import_into"
A import_type "import_type"
A imported "imported"
A imported_procedure "imported_procedure"
A index "index"
@ -292,7 +310,7 @@ A inf "inf"
A inferences "inferences"
A infinite "infinite"
A informational "informational"
A init_file "init_file"
A init_file "init_file"
A initialization "initialization"
A input "input"
A inserted_char "inserted_char"
@ -318,9 +336,11 @@ A larger ">"
A larger_equal ">="
A level "level"
A li "li"
A library "library"
A limit "limit"
A line "line"
A line_count "line_count"
A line_position "line_position"
A list "list"
A list_position "list_position"
A listing "listing"
@ -335,6 +355,7 @@ A locked "locked"
A log "log"
A log10 "log10"
A long "long"
A loose "loose"
A low "low"
A lower "lower"
A lsb "lsb"
@ -348,6 +369,7 @@ A max_dde_handles "max_dde_handles"
A max_depth "max_depth"
A max_files "max_files"
A max_frame_size "max_frame_size"
A max_length "max_length"
A max_path_length "max_path_length"
A max_size "max_size"
A max_variable_length "max_variable_length"
@ -367,6 +389,7 @@ A mod "mod"
A mode "mode"
A modify "modify"
A module "module"
A module_class "module_class"
A module_property "module_property"
A module_transparent "module_transparent"
A modules "modules"
@ -393,15 +416,16 @@ A not_implemented "not_implemented"
A not_less_than_one "not_less_than_one"
A not_less_than_zero "not_less_than_zero"
A not_provable "\\+"
A not_strickt_equals "\\=="
A not_strict_equal "\\=="
A not_unique "not_unique"
A number "number"
A number_of_clauses "number_of_clauses"
A number_of_rules "number_of_rules"
A numbervar_option "numbervar_option"
A numbervars "numbervars"
A occurs_check "occurs_check"
A octet "octet"
A off "off"
A off "off"
A on "on"
A open "open"
A operator "operator"
@ -411,6 +435,7 @@ A optimise "optimise"
A or "or"
A order "order"
A output "output"
A owner "owner"
A pair "pair"
A paren "paren"
A parent "parent"
@ -429,6 +454,7 @@ A plain "plain"
A plus "+"
A popcount "popcount"
A portray "portray"
A portray_goal "portray_goal"
A position "position"
A posix "posix"
A powm "powm"
@ -439,6 +465,8 @@ A print_message "print_message"
A priority "priority"
A private_procedure "private_procedure"
A procedure "procedure"
A process_comment "process_comment"
A process_cputime "process_cputime"
A profile_mode "profile_mode"
A profile_no_cpu_time "profile_no_cpu_time"
A profile_node "profile_node"
@ -463,6 +491,7 @@ A quote "quote"
A quoted "quoted"
A radix "radix"
A random "random"
A random_float "random_float"
A random_option "random_option"
A rational "rational"
A rationalize "rationalize"
@ -478,6 +507,7 @@ A record "record"
A record_position "record_position"
A redefine "redefine"
A redo "redo"
A redo_in_skip "redo_in_skip"
A references "references"
A rem "rem"
A rename "rename"
@ -495,6 +525,7 @@ A running "running"
A runtime "runtime"
A save_class "save_class"
A save_option "save_option"
A see "see"
A seed "seed"
A seek_method "seek_method"
A select "select"
@ -507,15 +538,18 @@ A shared "shared"
A shared_object "shared_object"
A shared_object_handle "shared_object_handle"
A shell "shell"
A shift_time "shift_time"
A sign "sign"
A signal "signal"
A signal_handler "signal_handler"
A silent "silent"
A sin "sin"
A singletons "singletons"
A sinh "sinh"
A size "size"
A size_t "size_t"
A skip "skip"
A skipped "skipped"
A smaller "<"
A smaller_equal "=<"
A softcut "*->"
@ -534,6 +568,7 @@ A standard "standard"
A star "*"
A start "start"
A stat "stat"
A state "state"
A static_procedure "static_procedure"
A statistics "statistics"
A status "status"
@ -544,9 +579,11 @@ A stream_or_alias "stream_or_alias"
A stream_pair "stream_pair"
A stream_position "$stream_position"
A stream_property "stream_property"
A stream_type_check "stream_type_check"
A strict_equal "=="
A string "string"
A string_position "string_position"
A strong "strong"
A subterm_positions "subterm_positions"
A suffix "suffix"
A syntax_error "syntax_error"
@ -554,18 +591,22 @@ A syntax_errors "syntax_errors"
A system "system"
A system_error "system_error"
A system_init_file "system_init_file"
A system_thread_id "system_thread_id"
A system_thread_id "system_thread_id"
A system_time "system_time"
A tan "tan"
A tanh "tanh"
A temporary_files "temporary_files"
A term "term"
A term_expansion "term_expansion"
A term_position "term_position"
A terminal "terminal"
A terminal_capability "terminal_capability"
A test "test"
A text "text"
A text_stream "text_stream"
A thread "thread"
A thread_cputime "thread_cputime"
A thread_get_message_option "thread_get_message_option"
A thread_initialization "thread_initialization"
A thread_local "thread_local"
A thread_local_procedure "thread_local_procedure"
@ -583,7 +624,7 @@ A timezone "timezone"
A to_lower "to_lower"
A to_upper "to_upper"
A top "top"
A top_level "top_level"
A top_level "top_level"
A toplevel "toplevel"
A trace "trace"
A trace_any "trace_any"
@ -643,6 +684,7 @@ A wait "wait"
A wakeup "wakeup"
A walltime "walltime"
A warning "warning"
A weak "weak"
A wchar_t "wchar_t"
A when_condition "when_condition"
A white "white"
@ -663,15 +705,18 @@ A zero_divisor "zero_divisor"
F abs 1
F access 1
F acos 1
F acosh 1
F alias 1
F and 2
F ar_equals 2
F ar_not_equal 2
F asin 1
F asinh 1
F assert 1
F asserta 1
F atan 1
F atan 2
F atanh 1
F atan2 2
F atom 1
F att 3
@ -693,15 +738,18 @@ F ceil 1
F ceiling 1
F chars 1
F chars 2
F class 1
F clause 1
F close_on_abort 1
F close_on_exec 1
F close_on_exec 1
F codes 1
F codes 2
F colon 2
F comma 2
F context 2
F copysign 2
F cos 1
F cosh 1
F cputime 0
F curl 1
F cut_call 1
@ -717,7 +765,7 @@ F debugging 1
F detached 1
F dexit 2
F dforeign_registered 2
F dgarbage_collect 1
F dgarbage_collect 1
F div 2
F gdiv 2
F divide 2
@ -769,7 +817,9 @@ F goal_expansion 2
F ground 1
F hat 2
F ifthen 2
F import_into 1
F input 0
F input 3
F integer 1
F interrupt 1
F io_error 2
@ -799,6 +849,7 @@ F nlink 1
F nonvar 1
F not_implemented 2
F not_provable 1
F not_strict_equal 2
F occurs_check 2
F or 1
F output 0
@ -813,14 +864,17 @@ F position 1
F powm 3
F print 1
F print_message 2
F priority 1
F procedure 2
F prove 1
F prove 2
F punct 2
F random 1
F random_float 0
F rational 1
F rationalize 1
F rdiv 2
F redo 1
F rem 2
F reposition 1
F representation_error 1
@ -838,6 +892,7 @@ F signal 1
F signal 2
F sin 1
F singletons 1
F sinh 1
F size 1
F smaller 2
F smaller_equal 2
@ -855,6 +910,7 @@ F string_position 2
F syntax_error 1
F syntax_error 3
F tan 1
F tanh 1
F term_expansion 2
F term_position 5
F timeout 1
@ -875,3 +931,4 @@ F wakeup 3
F warning 3
F xor 2
F xpceref 1
F xpceref 2

2
misc/Yap.spec

@ -3,7 +3,7 @@
Name: yap
Summary: Prolog Compiler
Version: 6.3.2
Version: 6.3.4
Packager: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Release: 1
Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

2
misc/Yap64.spec

@ -3,7 +3,7 @@
Name: yap
Summary: Prolog Compiler
Version: 6.3.2
Version: 6.3.4
Packager: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Release: 1
Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

2
misc/yap.nsi

@ -268,4 +268,4 @@ Function .onInstFailed
installer, please contact yap-users@sf.net"
FunctionEnd
outfile "yap-6.3.2-installer.exe"
outfile "yap-6.3.4-installer.exe"

2
misc/yap64.nsi

@ -265,4 +265,4 @@ Function .onInstFailed
installer, please contact yap-users@sf.net"
FunctionEnd
outfile "yap64-6.3.2-installer.exe"
outfile "yap64-6.3.4-installer.exe"

783
os/SWI-Stream.h

@ -1,388 +1,395 @@
#ifndef _PL_STREAM_H
#define _PL_STREAM_H
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
/* This appears to make the wide-character support compile and work
on HPUX 11.23. There really should be a cleaner way ...
*/
#if defined(__hpux)
#include <sys/_mbstate_t.h>
#endif
#if defined(_MSC_VER) && !defined(__WINDOWS__)
#define __WINDOWS__ 1
#endif
#include <stdarg.h>
#include <wchar.h>
#include <stddef.h>
#ifdef __WINDOWS__
#ifndef INT64_T_DEFINED
#define INT64_T_DEFINED 1
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
#if (_MSC_VER < 1300) && !defined(__MINGW32__)
typedef long intptr_t;
typedef unsigned long uintptr_t;
typedef intptr_t ssize_t; /* signed version of size_t */
#endif
#endif
#else
#include <unistd.h>
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifdef __cplusplus
extern "C" {
#endif
/*******************************
* CONSTANTS *
*******************************/
#ifndef EOF
#define EOF (-1)
#endif
#ifndef NULL
#define NULL ((void *)0)
#endif
#if defined(__WINDOWS__) && !defined(EWOULDBLOCK)
#define EWOULDBLOCK 1000 /* Needed for socket handling */
#endif
#define EPLEXCEPTION 1001 /* errno: pending Prolog exception */
#define SIO_BUFSIZE (4096) /* buffering buffer-size */
#define SIO_LINESIZE (1024) /* Sgets() default buffer size */
#define SIO_MAGIC (7212676) /* magic number */
#define SIO_CMAGIC (42) /* we are close (and thus illegal!) */
typedef ssize_t (*Sread_function)(void *handle, char *buf, size_t bufsize);
typedef ssize_t (*Swrite_function)(void *handle, char*buf, size_t bufsize);
typedef long (*Sseek_function)(void *handle, long pos, int whence);
typedef int64_t (*Sseek64_function)(void *handle, int64_t pos, int whence);
typedef int (*Sclose_function)(void *handle);
typedef int (*Scontrol_function)(void *handle, int action, void *arg);
#include "pl-thread.h"
typedef struct io_functions
{ Sread_function read; /* fill the buffer */
Swrite_function write; /* empty the buffer */
Sseek_function seek; /* seek to position */
Sclose_function close; /* close stream */
Scontrol_function control; /* Info/control */
Sseek64_function seek64; /* seek to position (intptr_t files) */
} IOFUNCTIONS;
typedef struct io_position
{ int64_t byteno; /* byte-position in file */
int64_t charno; /* character position in file */
int lineno; /* lineno in file */
int linepos; /* position in line */
intptr_t reserved[2]; /* future extensions */
} IOPOS;
/* NOTE: check with encoding_names */
/* in pl-file.c */
typedef enum
{ ENC_UNKNOWN = 0, /* invalid/unknown */
ENC_OCTET, /* raw 8 bit input */
ENC_ASCII, /* US-ASCII (0..127) */
ENC_ISO_LATIN_1, /* ISO Latin-1 (0..256) */
ENC_ANSI, /* default (multibyte) codepage */
ENC_UTF8,
ENC_UNICODE_BE, /* big endian unicode file */
ENC_UNICODE_LE, /* little endian unicode file */
ENC_WCHAR /* pl_wchar_t */
} IOENC;
#define SIO_NL_POSIX 0 /* newline as \n */
#define SIO_NL_DOS 1 /* newline as \r\n */
#define SIO_NL_DETECT 3 /* detect processing mode */
typedef struct io_stream
{ char *bufp; /* `here' */
char *limitp; /* read/write limit */
char *buffer; /* the buffer */
char *unbuffer; /* Sungetc buffer */
int lastc; /* last character written */
int magic; /* magic number SIO_MAGIC */
int bufsize; /* size of the buffer */
int flags; /* Status flags */
IOPOS posbuf; /* location in file */
IOPOS * position; /* pointer to above */
void *handle; /* function's handle */
IOFUNCTIONS *functions; /* open/close/read/write/seek */
int locks; /* lock/unlock count */
IOLOCK * mutex; /* stream mutex */
/* SWI-Prolog 4.0.7 */
void (*close_hook)(void* closure);
void * closure;
/* SWI-Prolog 5.1.3 */
int timeout; /* timeout (milliseconds) */
/* SWI-Prolog 5.4.4 */
char * message; /* error/warning message */
IOENC encoding; /* character encoding used */
struct io_stream * tee; /* copy data to this stream */
mbstate_t * mbstate; /* ENC_ANSI decoding */
struct io_stream * upstream; /* stream providing our input */
struct io_stream * downstream; /* stream providing our output */
unsigned newline : 2; /* Newline mode */
unsigned erased : 1; /* Stream was erased */
unsigned references : 4; /* Reference-count */
int io_errno; /* Save errno value */
void * exception; /* pending exception (record_t) */
intptr_t reserved[2]; /* reserved for extension */
} IOSTREAM;
#define SmakeFlag(n) (1<<(n-1))
#define SIO_FBUF SmakeFlag(1) /* full buffering */
#define SIO_LBUF SmakeFlag(2) /* line buffering */
#define SIO_NBUF SmakeFlag(3) /* no buffering */
#define SIO_FEOF SmakeFlag(4) /* end-of-file */
#define SIO_FERR SmakeFlag(5) /* error ocurred */
#define SIO_USERBUF SmakeFlag(6) /* buffer is from user */
#define SIO_INPUT SmakeFlag(7) /* input stream */
#define SIO_OUTPUT SmakeFlag(8) /* output stream */
#define SIO_NOLINENO SmakeFlag(9) /* line no. info is void */
#define SIO_NOLINEPOS SmakeFlag(10) /* line pos is void */
#define SIO_STATIC SmakeFlag(11) /* Stream in static memory */
#define SIO_RECORDPOS SmakeFlag(12) /* Maintain position */
#define SIO_FILE SmakeFlag(13) /* Stream refers to an OS file */
#define SIO_PIPE SmakeFlag(14) /* Stream refers to an OS pipe */
#define SIO_NOFEOF SmakeFlag(15) /* don't set SIO_FEOF flag */
#define SIO_TEXT SmakeFlag(16) /* text-mode operation */
#define SIO_FEOF2 SmakeFlag(17) /* attempt to read past eof */
#define SIO_FEOF2ERR SmakeFlag(18) /* Sfpasteof() */
#define SIO_NOCLOSE SmakeFlag(19) /* Do not close on abort */
#define SIO_APPEND SmakeFlag(20) /* opened in append-mode */
#define SIO_UPDATE SmakeFlag(21) /* opened in update-mode */
#define SIO_ISATTY SmakeFlag(22) /* Stream is a tty */
#define SIO_CLOSING SmakeFlag(23) /* We are closing the stream */
#define SIO_TIMEOUT SmakeFlag(24) /* We had a timeout */
#define SIO_NOMUTEX SmakeFlag(25) /* Do not allow multi-thread access */
#define SIO_ADVLOCK SmakeFlag(26) /* File locked with advisory lock */
#define SIO_WARN SmakeFlag(27) /* Pending warning */
#define SIO_CLEARERR SmakeFlag(28) /* Clear error after reporting */
#define SIO_REPXML SmakeFlag(29) /* Bad char --> XML entity */
#define SIO_REPPL SmakeFlag(30) /* Bad char --> Prolog \hex\ */
#define SIO_BOM SmakeFlag(31) /* BOM was detected/written */
#define SIO_SEEK_SET 0 /* From beginning of file. */
#define SIO_SEEK_CUR 1 /* From current position. */
#define SIO_SEEK_END 2 /* From end of file. */
PL_EXPORT(IOSTREAM *) S__getiob(void); /* get DLL's __iob[] address */
PL_EXPORT_DATA(IOFUNCTIONS) Sfilefunctions; /* OS file functions */
PL_EXPORT_DATA(int) Slinesize; /* Sgets() linesize */
#if (defined(__CYGWIN__) || defined(__MINGW32__)) && !defined(PL_KERNEL)
#define S__iob S__getiob()
#else
PL_EXPORT_DATA(IOSTREAM) S__iob[3]; /* Libs standard streams */
#endif
#define Sinput (&S__iob[0]) /* Stream Sinput */
#define Soutput (&S__iob[1]) /* Stream Soutput */
#define Serror (&S__iob[2]) /* Stream Serror */
#define Sgetchar() Sgetc(Sinput)
#define Sputchar(c) Sputc((c), Soutput)
#define S__checkpasteeof(s,c) \
if ( (c)==-1 && (s)->flags & (SIO_FEOF|SIO_FERR) ) \
((s)->flags |= SIO_FEOF2)
#define S__updatefilepos_getc(s, c) \
((s)->position ? S__fupdatefilepos_getc((s), (c)) \
: S__fcheckpasteeof((s), (c)))
#define Snpgetc(s) ((s)->bufp < (s)->limitp ? (int)(*(s)->bufp++)&0xff \
: S__fillbuf(s))
#define Sgetc(s) S__updatefilepos_getc((s), Snpgetc(s))
PL_EXPORT(int) Speekcode(IOSTREAM *s);
/* Control-operations */
#define SIO_GETSIZE (1) /* get size of underlying object */
#define SIO_GETFILENO (2) /* get underlying file (if any) */
#define SIO_SETENCODING (3) /* modify encoding of stream */
#define SIO_FLUSHOUTPUT (4) /* flush output */
#define SIO_LASTERROR (5) /* string holding last error */
#ifdef __WINDOWS__
#define SIO_GETWINSOCK (6) /* get underlying SOCKET object */
#endif
/* Sread_pending() */
#define SIO_RP_BLOCK 0x1 /* wait for new input */
#if IOSTREAM_REPLACES_STDIO
#undef FILE
#undef stdin
#undef stdout
#undef stderr
#undef putc
#undef getc
#undef putchar
#undef getchar
#undef feof
#undef ferror
#undef fileno
#undef clearerr
#define FILE IOSTREAM
#define stdin Sinput
#define stdout Soutput
#define stderr Serror
#define putc Sputc
#define getc Sgetc
#define fputc Sputc
#define fgetc Sgetc
#define getw Sgetw
#define putw Sputw
#define fread Sfread
#define fwrite Sfwrite
#define ungetc Sungetc
#define putchar Sputchar
#define getchar Sgetchar
#define feof Sfeof
#define ferror Sferror
#define clearerr Sclearerr
#define fflush Sflush
#define fseek Sseek
#define ftell Stell
#define fclose Sclose
#define fgets Sfgets
#define gets Sgets
#define fputs Sfputs
#define puts Sputs
#define fprintf Sfprintf
#define printf Sprintf
#define vprintf Svprintf
#define vfprintf Svfprintf
#define sprintf Ssprintf
#define vsprintf Svsprintf
#define fopen Sopen_file
#define fdopen Sfdopen
#define fileno Sfileno
#define popen Sopen_pipe
#endif /*IOSTREAM_REPLACES_STDIO*/
/*******************************
* PROTOTYPES *
*******************************/
PL_EXPORT(void) SinitStreams(void);
PL_EXPORT(void) Scleanup(void);
PL_EXPORT(void) Sreset(void);
PL_EXPORT(int) S__fupdatefilepos_getc(IOSTREAM *s, int c);
PL_EXPORT(int) S__fcheckpasteeof(IOSTREAM *s, int c);
PL_EXPORT(int) S__fillbuf(IOSTREAM *s);
PL_EXPORT(int) Sunit_size(IOSTREAM *s);
/* byte I/O */
PL_EXPORT(int) Sputc(int c, IOSTREAM *s);
PL_EXPORT(int) Sfgetc(IOSTREAM *s);
PL_EXPORT(int) Sungetc(int c, IOSTREAM *s);
/* multibyte I/O */
PL_EXPORT(int) Scanrepresent(int c, IOSTREAM *s);
PL_EXPORT(int) Sputcode(int c, IOSTREAM *s);
PL_EXPORT(int) Sgetcode(IOSTREAM *s);
PL_EXPORT(int) Sungetcode(int c, IOSTREAM *s);
/* word I/O */
PL_EXPORT(int) Sputw(int w, IOSTREAM *s);
PL_EXPORT(int) Sgetw(IOSTREAM *s);
PL_EXPORT(size_t) Sfread(void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(size_t) Sfwrite(const void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(int) Sfeof(IOSTREAM *s);
PL_EXPORT(int) Sfpasteof(IOSTREAM *s);
PL_EXPORT(int) Sferror(IOSTREAM *s);
PL_EXPORT(void) Sclearerr(IOSTREAM *s);
PL_EXPORT(void) Sseterr(IOSTREAM *s, int which, const char *message);
#ifdef _FLI_H_INCLUDED
PL_EXPORT(void) Sset_exception(IOSTREAM *s, term_t ex);
#else
PL_EXPORT(void) Sset_exception(IOSTREAM *s, intptr_t ex);
#endif
PL_EXPORT(int) Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
PL_EXPORT(int) Sflush(IOSTREAM *s);
PL_EXPORT(long) Ssize(IOSTREAM *s);
PL_EXPORT(int) Sseek(IOSTREAM *s, long pos, int whence);
PL_EXPORT(long) Stell(IOSTREAM *s);
PL_EXPORT(int) Sclose(IOSTREAM *s);
PL_EXPORT(char *) Sfgets(char *buf, int n, IOSTREAM *s);
PL_EXPORT(char *) Sgets(char *buf);
PL_EXPORT(ssize_t) Sread_pending(IOSTREAM *s,
char *buf, size_t limit, int flags);
PL_EXPORT(int) Sfputs(const char *q, IOSTREAM *s);
PL_EXPORT(int) Sputs(const char *q);
PL_EXPORT(int) Sfprintf(IOSTREAM *s, const char *fm, ...);
PL_EXPORT(int) Sprintf(const char *fm, ...);
PL_EXPORT(int) Svprintf(const char *fm, va_list args);
PL_EXPORT(int) Svfprintf(IOSTREAM *s, const char *fm, va_list args);
PL_EXPORT(int) Ssprintf(char *buf, const char *fm, ...);
PL_EXPORT(int) Svsprintf(char *buf, const char *fm, va_list args);
PL_EXPORT(int) Svdprintf(const char *fm, va_list args);
PL_EXPORT(int) Sdprintf(const char *fm, ...);
PL_EXPORT(int) Slock(IOSTREAM *s);
PL_EXPORT(int) StryLock(IOSTREAM *s);
PL_EXPORT(int) Sunlock(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Snew(void *handle, int flags, IOFUNCTIONS *functions);
PL_EXPORT(IOSTREAM *) Sopen_file(const char *path, const char *how);
PL_EXPORT(IOSTREAM *) Sfdopen(int fd, const char *type);
PL_EXPORT(int) Sfileno(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Sopen_pipe(const char *command, const char *type);
PL_EXPORT(IOSTREAM *) Sopenmem(char **buffer, size_t *sizep, const char *mode);
PL_EXPORT(IOSTREAM *) Sopen_string(IOSTREAM *s, char *buf, size_t sz, const char *m);
PL_EXPORT(int) Sclosehook(void (*hook)(IOSTREAM *s));
PL_EXPORT(void) Sfree(void *ptr);
PL_EXPORT(int) Sset_filter(IOSTREAM *parent, IOSTREAM *filter);
PL_EXPORT(void) Ssetbuffer(IOSTREAM *s, char *buf, size_t size);
PL_EXPORT(int64_t) Stell64(IOSTREAM *s);
PL_EXPORT(int) Sseek64(IOSTREAM *s, int64_t pos, int whence);
PL_EXPORT(int) ScheckBOM(IOSTREAM *s);
PL_EXPORT(int) SwriteBOM(IOSTREAM *s);
PL_EXPORT(ssize_t) Sread_user(void *handle, char *buf, size_t size);
#ifdef __cplusplus
}
#endif
#endif /*_PL_STREAM_H*/
#ifndef _PL_STREAM_H
#define _PL_STREAM_H
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
/* This appears to make the wide-character support compile and work
on HPUX 11.23. There really should be a cleaner way ...
*/
#if defined(__hpux)
#include <sys/_mbstate_t.h>
#endif
#if defined(_MSC_VER) && !defined(__WINDOWS__)
#define __WINDOWS__ 1
#endif
#include <stdarg.h>
#include <wchar.h>
#include <stddef.h>
#ifdef __WINDOWS__
#ifndef INT64_T_DEFINED
#define INT64_T_DEFINED 1
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
#if (_MSC_VER < 1300) && !defined(__MINGW32__)
typedef long intptr_t;
typedef unsigned long uintptr_t;
typedef intptr_t ssize_t; /* signed version of size_t */
#endif
#endif
#else
#include <unistd.h>
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifdef __cplusplus
extern "C" {
#endif
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
/*******************************
* CONSTANTS *
*******************************/
#ifndef EOF
#define EOF (-1)
#endif
#ifndef NULL
#define NULL ((void *)0)
#endif
#if defined(__WINDOWS__) && !defined(EWOULDBLOCK)
#define EWOULDBLOCK 1000 /* Needed for socket handling */
#endif
#define EPLEXCEPTION 1001 /* errno: pending Prolog exception */
#define SIO_BUFSIZE (4096) /* buffering buffer-size */
#define SIO_LINESIZE (1024) /* Sgets() default buffer size */
#define SIO_MAGIC (7212676) /* magic number */
#define SIO_CMAGIC (42) /* we are close (and thus illegal!) */
typedef ssize_t (*Sread_function)(void *handle, char *buf, size_t bufsize);
typedef ssize_t (*Swrite_function)(void *handle, char*buf, size_t bufsize);
typedef long (*Sseek_function)(void *handle, long pos, int whence);
typedef int64_t (*Sseek64_function)(void *handle, int64_t pos, int whence);
typedef int (*Sclose_function)(void *handle);
typedef int (*Scontrol_function)(void *handle, int action, void *arg);
#include "pl-thread.h"
typedef struct io_functions
{ Sread_function read; /* fill the buffer */
Swrite_function write; /* empty the buffer */
Sseek_function seek; /* seek to position */
Sclose_function close; /* close stream */
Scontrol_function control; /* Info/control */
Sseek64_function seek64; /* seek to position (intptr_t files) */
} IOFUNCTIONS;
typedef struct io_position
{ int64_t byteno; /* byte-position in file */
int64_t charno; /* character position in file */
int lineno; /* lineno in file */
int linepos; /* position in line */
intptr_t reserved[2]; /* future extensions */
} IOPOS;
/* NOTE: check with encoding_names */
/* in pl-file.c */
typedef enum
{ ENC_UNKNOWN = 0, /* invalid/unknown */
ENC_OCTET, /* raw 8 bit input */
ENC_ASCII, /* US-ASCII (0..127) */
ENC_ISO_LATIN_1, /* ISO Latin-1 (0..256) */
ENC_ANSI, /* default (multibyte) codepage */
ENC_UTF8,
ENC_UNICODE_BE, /* big endian unicode file */
ENC_UNICODE_LE, /* little endian unicode file */
ENC_WCHAR /* pl_wchar_t */
} IOENC;
#define SIO_NL_POSIX 0 /* newline as \n */
#define SIO_NL_DOS 1 /* newline as \r\n */
#define SIO_NL_DETECT 3 /* detect processing mode */
typedef struct io_stream
{ char *bufp; /* `here' */
char *limitp; /* read/write limit */
char *buffer; /* the buffer */
char *unbuffer; /* Sungetc buffer */
int lastc; /* last character written */
int magic; /* magic number SIO_MAGIC */
int bufsize; /* size of the buffer */
int flags; /* Status flags */
IOPOS posbuf; /* location in file */
IOPOS * position; /* pointer to above */
void *handle; /* function's handle */
IOFUNCTIONS *functions; /* open/close/read/write/seek */
int locks; /* lock/unlock count */
IOLOCK * mutex; /* stream mutex */
/* SWI-Prolog 4.0.7 */
void (*close_hook)(void* closure);
void * closure;
/* SWI-Prolog 5.1.3 */
int timeout; /* timeout (milliseconds) */
/* SWI-Prolog 5.4.4 */
char * message; /* error/warning message */
IOENC encoding; /* character encoding used */
struct io_stream * tee; /* copy data to this stream */
mbstate_t * mbstate; /* ENC_ANSI decoding */
struct io_stream * upstream; /* stream providing our input */
struct io_stream * downstream; /* stream providing our output */
unsigned newline : 2; /* Newline mode */
unsigned erased : 1; /* Stream was erased */
unsigned references : 4; /* Reference-count */
int io_errno; /* Save errno value */
void * exception; /* pending exception (record_t) */
void * context; /* getStreamContext() */
intptr_t reserved[2]; /* reserved for extension */
} IOSTREAM;
#define SmakeFlag(n) (1<<(n-1))
#define SIO_FBUF SmakeFlag(1) /* full buffering */
#define SIO_LBUF SmakeFlag(2) /* line buffering */
#define SIO_NBUF SmakeFlag(3) /* no buffering */
#define SIO_FEOF SmakeFlag(4) /* end-of-file */
#define SIO_FERR SmakeFlag(5) /* error ocurred */
#define SIO_USERBUF SmakeFlag(6) /* buffer is from user */
#define SIO_INPUT SmakeFlag(7) /* input stream */
#define SIO_OUTPUT SmakeFlag(8) /* output stream */
#define SIO_NOLINENO SmakeFlag(9) /* line no. info is void */
#define SIO_NOLINEPOS SmakeFlag(10) /* line pos is void */
#define SIO_STATIC SmakeFlag(11) /* Stream in static memory */
#define SIO_RECORDPOS SmakeFlag(12) /* Maintain position */
#define SIO_FILE SmakeFlag(13) /* Stream refers to an OS file */
#define SIO_PIPE SmakeFlag(14) /* Stream refers to an OS pipe */
#define SIO_NOFEOF SmakeFlag(15) /* don't set SIO_FEOF flag */
#define SIO_TEXT SmakeFlag(16) /* text-mode operation */
#define SIO_FEOF2 SmakeFlag(17) /* attempt to read past eof */
#define SIO_FEOF2ERR SmakeFlag(18) /* Sfpasteof() */
#define SIO_NOCLOSE SmakeFlag(19) /* Do not close on abort */
#define SIO_APPEND SmakeFlag(20) /* opened in append-mode */
#define SIO_UPDATE SmakeFlag(21) /* opened in update-mode */
#define SIO_ISATTY SmakeFlag(22) /* Stream is a tty */
#define SIO_CLOSING SmakeFlag(23) /* We are closing the stream */
#define SIO_TIMEOUT SmakeFlag(24) /* We had a timeout */
#define SIO_NOMUTEX SmakeFlag(25) /* Do not allow multi-thread access */
#define SIO_ADVLOCK SmakeFlag(26) /* File locked with advisory lock */
#define SIO_WARN SmakeFlag(27) /* Pending warning */
#define SIO_CLEARERR SmakeFlag(28) /* Clear error after reporting */
#define SIO_REPXML SmakeFlag(29) /* Bad char --> XML entity */
#define SIO_REPPL SmakeFlag(30) /* Bad char --> Prolog \hex\ */
#define SIO_BOM SmakeFlag(31) /* BOM was detected/written */
#define SIO_SEEK_SET 0 /* From beginning of file. */
#define SIO_SEEK_CUR 1 /* From current position. */
#define SIO_SEEK_END 2 /* From end of file. */
PL_EXPORT(IOSTREAM *) S__getiob(void); /* get DLL's __iob[] address */
PL_EXPORT_DATA(IOFUNCTIONS) Sfilefunctions; /* OS file functions */
PL_EXPORT_DATA(int) Slinesize; /* Sgets() linesize */
#if (defined(__CYGWIN__) || defined(__MINGW32__)) && !defined(PL_KERNEL)
#define S__iob S__getiob()
#else
PL_EXPORT_DATA(IOSTREAM) S__iob[3]; /* Libs standard streams */
#endif
#define Sinput (&S__iob[0]) /* Stream Sinput */
#define Soutput (&S__iob[1]) /* Stream Soutput */
#define Serror (&S__iob[2]) /* Stream Serror */
#define Sgetchar() Sgetc(Sinput)
#define Sputchar(c) Sputc((c), Soutput)
#define S__checkpasteeof(s,c) \
if ( (c)==-1 && (s)->flags & (SIO_FEOF|SIO_FERR) ) \
((s)->flags |= SIO_FEOF2)
#define S__updatefilepos_getc(s, c) \
((s)->position ? S__fupdatefilepos_getc((s), (c)) \
: S__fcheckpasteeof((s), (c)))
#define Snpgetc(s) ((s)->bufp < (s)->limitp ? (int)(*(s)->bufp++)&0xff \
: S__fillbuf(s))
#define Sgetc(s) S__updatefilepos_getc((s), Snpgetc(s))
PL_EXPORT(int) Speekcode(IOSTREAM *s);
/* Control-operations */
#define SIO_GETSIZE (1) /* get size of underlying object */
#define SIO_GETFILENO (2) /* get underlying file (if any) */
#define SIO_SETENCODING (3) /* modify encoding of stream */
#define SIO_FLUSHOUTPUT (4) /* flush output */
#define SIO_LASTERROR (5) /* string holding last error */
#ifdef __WINDOWS__
#define SIO_GETWINSOCK (6) /* get underlying SOCKET object */
#endif
/* Sread_pending() */
#define SIO_RP_BLOCK 0x1 /* wait for new input */
#if IOSTREAM_REPLACES_STDIO
#undef FILE
#undef stdin
#undef stdout
#undef stderr
#undef putc
#undef getc
#undef putchar
#undef getchar
#undef feof
#undef ferror
#undef fileno
#undef clearerr
#define FILE IOSTREAM
#define stdin Sinput
#define stdout Soutput
#define stderr Serror
#define putc Sputc
#define getc Sgetc
#define fputc Sputc
#define fgetc Sgetc
#define getw Sgetw
#define putw Sputw
#define fread Sfread
#define fwrite Sfwrite
#define ungetc Sungetc
#define putchar Sputchar
#define getchar Sgetchar
#define feof Sfeof
#define ferror Sferror
#define clearerr Sclearerr
#define fflush Sflush
#define fseek Sseek
#define ftell Stell
#define fclose Sclose
#define fgets Sfgets
#define gets Sgets
#define fputs Sfputs
#define puts Sputs
#define fprintf Sfprintf
#define printf Sprintf
#define vprintf Svprintf
#define vfprintf Svfprintf
#define sprintf Ssprintf
#define vsprintf Svsprintf
#define fopen Sopen_file
#define fdopen Sfdopen
#define fileno Sfileno
#define popen Sopen_pipe
#endif /*IOSTREAM_REPLACES_STDIO*/
/*******************************
* PROTOTYPES *
*******************************/
PL_EXPORT(void) SinitStreams(void);
PL_EXPORT(void) Scleanup(void);
PL_EXPORT(void) Sreset(void);
PL_EXPORT(int) S__fupdatefilepos_getc(IOSTREAM *s, int c);
PL_EXPORT(int) S__fcheckpasteeof(IOSTREAM *s, int c);
PL_EXPORT(int) S__fillbuf(IOSTREAM *s);
PL_EXPORT(int) Sunit_size(IOSTREAM *s);
/* byte I/O */
PL_EXPORT(int) Sputc(int c, IOSTREAM *s);
PL_EXPORT(int) Sfgetc(IOSTREAM *s);
PL_EXPORT(int) Sungetc(int c, IOSTREAM *s);
/* multibyte I/O */
PL_EXPORT(int) Scanrepresent(int c, IOSTREAM *s);
PL_EXPORT(int) Sputcode(int c, IOSTREAM *s);
PL_EXPORT(int) Sgetcode(IOSTREAM *s);
PL_EXPORT(int) Sungetcode(int c, IOSTREAM *s);
/* word I/O */
PL_EXPORT(int) Sputw(int w, IOSTREAM *s);
PL_EXPORT(int) Sgetw(IOSTREAM *s);
PL_EXPORT(size_t) Sfread(void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(size_t) Sfwrite(const void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(int) Sfeof(IOSTREAM *s);
PL_EXPORT(int) Sfpasteof(IOSTREAM *s);
PL_EXPORT(int) Sferror(IOSTREAM *s);
PL_EXPORT(void) Sclearerr(IOSTREAM *s);
PL_EXPORT(void) Sseterr(IOSTREAM *s, int which, const char *message);
PL_EXPORT(void) Sset_exception(IOSTREAM *s, term_t ex);
PL_EXPORT(int) Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
PL_EXPORT(int) Sflush(IOSTREAM *s);
PL_EXPORT(int64_t) Ssize(IOSTREAM *s);
PL_EXPORT(int) Sseek(IOSTREAM *s, long pos, int whence);
PL_EXPORT(long) Stell(IOSTREAM *s);
PL_EXPORT(int) Sclose(IOSTREAM *s);
PL_EXPORT(char *) Sfgets(char *buf, int n, IOSTREAM *s);
PL_EXPORT(char *) Sgets(char *buf);
PL_EXPORT(ssize_t) Sread_pending(IOSTREAM *s,
char *buf, size_t limit, int flags);
PL_EXPORT(int) Sfputs(const char *q, IOSTREAM *s);
PL_EXPORT(int) Sputs(const char *q);
PL_EXPORT(int) Sfprintf(IOSTREAM *s, const char *fm, ...);
PL_EXPORT(int) Sprintf(const char *fm, ...);
PL_EXPORT(int) Svprintf(const char *fm, va_list args);
PL_EXPORT(int) Svfprintf(IOSTREAM *s, const char *fm, va_list args);
PL_EXPORT(int) Ssprintf(char *buf, const char *fm, ...);
PL_EXPORT(int) Svsprintf(char *buf, const char *fm, va_list args);
PL_EXPORT(int) Svdprintf(const char *fm, va_list args);
PL_EXPORT(int) Sdprintf(const char *fm, ...);
PL_EXPORT(int) Slock(IOSTREAM *s);
PL_EXPORT(int) StryLock(IOSTREAM *s);
PL_EXPORT(int) Sunlock(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Snew(void *handle, int flags, IOFUNCTIONS *functions);
PL_EXPORT(IOSTREAM *) Sopen_file(const char *path, const char *how);
PL_EXPORT(IOSTREAM *) Sfdopen(int fd, const char *type);
PL_EXPORT(int) Sfileno(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Sopen_pipe(const char *command, const char *type);
PL_EXPORT(IOSTREAM *) Sopenmem(char **buffer, size_t *sizep, const char *mode);
PL_EXPORT(IOSTREAM *) Sopen_string(IOSTREAM *s, char *buf, size_t sz, const char *m);
PL_EXPORT(int) Sclosehook(void (*hook)(IOSTREAM *s));
PL_EXPORT(void) Sfree(void *ptr);
PL_EXPORT(int) Sset_filter(IOSTREAM *parent, IOSTREAM *filter);
PL_EXPORT(void) Ssetbuffer(IOSTREAM *s, char *buf, size_t size);
PL_EXPORT(int64_t) Stell64(IOSTREAM *s);
PL_EXPORT(int) Sseek64(IOSTREAM *s, int64_t pos, int whence);
#ifdef __WINDOWS__
#if defined(_WINSOCKAPI_) || defined(NEEDS_SWINSOCK)
PL_EXPORT(SOCKET) Swinsock(IOSTREAM *s);
#endif
#endif
PL_EXPORT(int) ScheckBOM(IOSTREAM *s);
PL_EXPORT(int) SwriteBOM(IOSTREAM *s);
PL_EXPORT(ssize_t) Sread_user(void *handle, char *buf, size_t size);
#ifdef __cplusplus
}
#endif
#endif /*_PL_STREAM_H*/

18
os/pl-buffer.c

@ -28,6 +28,7 @@ int
growBuffer(Buffer b, size_t minfree)
{ size_t osz = b->max - b->base, sz = osz;
size_t top = b->top - b->base;
char *new;
if ( b->max - b->top >= (int)minfree )
return TRUE;
@ -37,20 +38,17 @@ growBuffer(Buffer b, size_t minfree)
while( top + minfree > sz )
sz *= 2;
if ( b->base != b->static_buffer )
{ b->base = realloc(b->base, sz);
if ( !b->base )
return FALSE;
} else /* from static buffer */
{ char *new;
if ( !(new = malloc(sz)) )
if ( b->base == b->static_buffer )
{ if ( !(new = malloc(sz)) )
return FALSE;
memcpy(new, b->static_buffer, osz);
b->base = new;
} else
{ if ( !(new = realloc(b->base, sz)) )
return FALSE;
}
b->base = new;
b->top = b->base + top;
b->max = b->base + sz;
@ -62,7 +60,7 @@ growBuffer(Buffer b, size_t minfree)
* BUFFER RING *
*******************************/
#define discardable_buffer (LD->fli._discardable_buffer)
#define discardable_buffer (LD->fli._discardable_buffer)
#define buffer_ring (LD->fli._buffer_ring)
#define current_buffer_id (LD->fli._current_buffer_id)

24
os/pl-buffer.h

@ -49,7 +49,7 @@ int growBuffer(Buffer b, size_t minfree);
{ if ( !growBuffer((Buffer)b, sizeof(type)) ) \
outOfCore(); \
} \
*((type *)(b)->top) = obj; \
*((type *)(b)->top) = obj; \
(b)->top += sizeof(type); \
} while(0)
@ -68,6 +68,24 @@ int growBuffer(Buffer b, size_t minfree);
(b)->top = (char *)_d; \
} while(0)
#define allocFromBuffer(b, bytes) \
f__allocFromBuffer((Buffer)(b), (bytes))
static inline void*
f__allocFromBuffer(Buffer b, size_t bytes)
{ if ( b->top + bytes <= b->max ||
growBuffer(b, bytes) )
{ void *top = b->top;
b->top += bytes;
return top;
}
return NULL;
}
#define baseBuffer(b, type) ((type *) (b)->base)
#define topBuffer(b, type) ((type *) (b)->top)
#define inBuffer(b, addr) ((char *) (addr) >= (b)->base && \
@ -83,6 +101,8 @@ int growBuffer(Buffer b, size_t minfree);
sizeof((b)->static_buffer))
#define emptyBuffer(b) ((b)->top = (b)->base)
#define isEmptyBuffer(b) ((b)->top == (b)->base)
#define popBuffer(b,type) \
((b)->top -= sizeof(type), *(type*)(b)->top)
#define discardBuffer(b) \
do \
@ -99,6 +119,6 @@ int growBuffer(Buffer b, size_t minfree);
COMMON(Buffer) findBuffer(int flags);
COMMON(int) unfindBuffer(int flags);
COMMON(char *) buffer_string(const char *s, int flags);
COMMON(char *) buffer_string(const char *s, int flags);
#endif /*BUFFER_H_INCLUDED*/

116
os/pl-cstack.c

@ -89,15 +89,49 @@ get_trace_store(void)
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
next_btrace_id() produces the id for the next backtrace and sets
bt->current to the subsequent id. Although bt is thread-local, it may be
called from a signal handler or (Windows) exception. We cannot use
locking because the mutex functions are not async signal safe. So, we
use atomic instructions if possible. Otherwise, we ensure consistency of
the datastructures, but we may overwrite an older stack trace.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
void
save_backtrace(const char *why)
{ btrace *bt = get_trace_store();
if ( bt )
{ btrace_stack *s = &bt->dumps[bt->current];
{ btrace_stack *s;
unw_cursor_t cursor; unw_context_t uc;
int depth;
int current = next_btrace_id(bt);
s = &bt->dumps[current];
unw_getcontext(&uc);
unw_init_local(&cursor, &uc);
for(depth=0; unw_step(&cursor) > 0 && depth < MAX_DEPTH; depth++)
@ -107,9 +141,6 @@ save_backtrace(const char *why)
}
s->name = why;
s->depth = depth;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
}
}
@ -228,6 +259,33 @@ get_trace_store(void)
}
/* Copy of same function above. Relies on a different btrace structure.
Ideally, this should be shared :-(
*/
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
void
save_backtrace(const char *why)
{ btrace *bt = get_trace_store();
@ -235,15 +293,14 @@ save_backtrace(const char *why)
if ( bt )
{ void *array[100];
size_t frames;
int current = next_btrace_id(bt);
frames = backtrace(array, sizeof(array)/sizeof(void *));
bt->sizes[bt->current] = frames;
if ( bt->symbols[bt->current] )
free(bt->symbols[bt->current]);
bt->symbols[bt->current] = backtrace_symbols(array, frames);
bt->why[bt->current] = why;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
bt->sizes[current] = frames;
if ( bt->symbols[current] )
free(bt->symbols[current]);
bt->symbols[current] = backtrace_symbols(array, frames);
bt->why[current] = why;
}
}
@ -358,6 +415,9 @@ initBackTrace(void)
*/
#define MAX_MODULE_NAME_LENGTH 64
#define LOCK() PL_LOCK(L_CSTACK)
#define UNLOCK() PL_UNLOCK(L_CSTACK)
typedef struct
{ char name[MAX_FUNCTION_NAME_LENGTH]; /* function called */
DWORD64 offset; /* offset in function */
@ -397,6 +457,32 @@ get_trace_store(void)
return LD->btrace_store;
}
/* Copy of same function above. Relies on a different btrace structure.
Ideally, this should be shared :-(
*/
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
{ STACKFRAME64 frame;
CONTEXT context;
@ -406,7 +492,6 @@ int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
char symbolScratch[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LEN];
SYMBOL_INFO* symbol = (SYMBOL_INFO*)&symbolScratch;
IMAGEHLP_MODULE64 moduleInfo;
EXCEPTION_POINTERS *pExp = NULL;
DWORD64 offset;
DWORD imageType;
int skip = 0;
@ -529,11 +614,12 @@ void
win_save_backtrace(const char *why, PEXCEPTION_POINTERS pExceptionInfo)
{ btrace *bt = get_trace_store();
if ( bt )
{ btrace_stack *s = &bt->dumps[bt->current];
{ int current = next_btrace_id(bt);
btrace_stack *s = &bt->dumps[current];
LOCK();
s->depth = backtrace(s, pExceptionInfo);
UNLOCK();
s->name = why;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
}
}

4
os/pl-ctype.c

@ -471,7 +471,7 @@ init_tout(PL_chars_t *t, size_t len)
{ t->text.t = t->buf;
t->storage = PL_CHARS_LOCAL;
} else
{ t->text.t = PL_malloc(len+1);
{ t->text.t = PL_malloc(len);
t->storage = PL_CHARS_MALLOC;
}
succeed;
@ -480,7 +480,7 @@ init_tout(PL_chars_t *t, size_t len)
{ t->text.w = (pl_wchar_t*)t->buf;
t->storage = PL_CHARS_LOCAL;
} else
{ t->text.w = PL_malloc((len+1)*sizeof(pl_wchar_t));
{ t->text.w = PL_malloc(len*sizeof(pl_wchar_t));
t->storage = PL_CHARS_MALLOC;
}
succeed;

695
os/pl-file.c

File diff suppressed because it is too large Load Diff

81
os/pl-file.h Normal file

@ -0,0 +1,81 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2011, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef PL_FILE_H_INCLUDED
#define PL_FILE_H_INCLUDED
typedef enum
{ ST_FALSE = -1, /* Do not check stream types */
ST_LOOSE = 0, /* Default: accept latin-1 for binary */
ST_TRUE = 1 /* Strict checking */
} st_check;
/* pl-file.c */
COMMON(void) initIO(void);
COMMON(void) dieIO(void);
COMMON(void) closeFiles(int all);
COMMON(int) openFileDescriptors(unsigned char *buf, int size);
COMMON(void) protocol(const char *s, size_t n);
COMMON(int) getTextInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getTextOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) reportStreamError(IOSTREAM *s);
COMMON(int) streamStatus(IOSTREAM *s);
COMMON(atom_t) fileNameStream(IOSTREAM *s);
COMMON(int) getSingleChar(IOSTREAM *s, int signals);
COMMON(int) readLine(IOSTREAM *in, IOSTREAM *out, char *buffer);
COMMON(int) LockStream(void);
COMMON(int) UnlockStream(void);
COMMON(IOSTREAM *) PL_current_input(void);
COMMON(IOSTREAM *) PL_current_output(void);
COMMON(int) pl_see(term_t f);
COMMON(int) pl_seen(void);
COMMON(int) seeString(const char *s);
COMMON(int) seeingString(void);
COMMON(int) seenString(void);
COMMON(int) tellString(char **s, size_t *size, IOENC enc);
COMMON(int) toldString(void);
COMMON(void) prompt1(atom_t prompt);
COMMON(atom_t) PrologPrompt(void);
COMMON(int) streamNo(term_t spec, int mode);
COMMON(void) release_stream_handle(term_t spec);
COMMON(int) unifyTime(term_t t, time_t time);
#ifdef __WINDOWS__
COMMON(word) pl_make_fat_filemap(term_t dir);
#endif
COMMON(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
COMMON(void) pushOutputContext(void);
COMMON(void) popOutputContext(void);
COMMON(IOENC) atom_to_encoding(atom_t a);
COMMON(atom_t) encoding_to_atom(IOENC enc);
COMMON(int) setupOutputRedirect(term_t to,
redir_context *ctx,
int redir);
COMMON(int) closeOutputRedirect(redir_context *ctx);
COMMON(void) discardOutputRedirect(redir_context *ctx);
COMMON(int) push_input_context(atom_t type);
COMMON(int) pop_input_context(void);
#endif /*PL_FILE_H_INCLUDED*/

126
os/pl-files.c

@ -3,9 +3,10 @@
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2008, University of Amsterdam
Copyright (C): 1985-2011, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +20,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -44,26 +45,89 @@
General file operations and binding to Prolog
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef __WINDOWS__
static void
set_posix_error(int win_error)
{ int error = 0;
switch(win_error)
{ case ERROR_ACCESS_DENIED: error = EACCES; break;
case ERROR_FILE_NOT_FOUND: error = ENOENT; break;
case ERROR_SHARING_VIOLATION: error = EAGAIN; break;
case ERROR_ALREADY_EXISTS: error = EEXIST; break;
}
errno = error;
}
#endif /*__WINDOWS__*/
/*******************************
* OS STUFF *
*******************************/
/** time_t LastModifiedFile(const char *file)
/** int LastModifiedFile(const char *file, double *t)
Return the last modification time of file as a POSIX timestamp. Returns
(time_t)-1 on failure.
Contains a 64-bit value representing the number of 100-nanosecond
intervals since January 1, 1601 (UTC).
*/
int
LastModifiedFile(const char *name, double *tp)
{
#ifdef __WINDOWS__
HANDLE hFile;
wchar_t wfile[MAXPATHLEN];
time_t
LastModifiedFile(const char *file)
{ char tmp[MAXPATHLEN];
#define nano * 0.000000001
#define ntick 100.0
#define SEC_TO_UNIX_EPOCH 11644473600.0
if ( !_xos_os_filenameW(name, wfile, MAXPATHLEN) )
return FALSE;
if ( (hFile=CreateFileW(wfile,
0,
FILE_SHARE_DELETE|FILE_SHARE_READ|FILE_SHARE_WRITE,
NULL,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
NULL)) != INVALID_HANDLE_VALUE )
{ FILETIME wt;
int rc;
rc = GetFileTime(hFile, NULL, NULL, &wt);
CloseHandle(hFile);
if ( rc )
{ double t;
t = (double)wt.dwHighDateTime * (4294967296.0 * ntick nano);
t += (double)wt.dwLowDateTime * (ntick nano);
t -= SEC_TO_UNIX_EPOCH;
*tp = t;
return TRUE;
}
}
set_posix_error(GetLastError());
return FALSE;
#else
char tmp[MAXPATHLEN];
statstruct buf;
if ( statfunc(OsPath(file, tmp), &buf) < 0 )
return (time_t)-1;
if ( statfunc(OsPath(name, tmp), &buf) < 0 )
return FALSE;
return buf.st_mtime;
*tp = (double)buf.st_mtime;
return TRUE;
#endif
}
@ -349,13 +413,7 @@ MarkExecutable(const char *name)
int
unifyTime(term_t t, time_t time)
{
#if __YAP_PROLOG__
/* maintain compatibility with old Prolog systems, and avoid losing precision unnecessarily */
return PL_unify_int64(t, (int64_t)time);
#else
return PL_unify_float(t, (double)time);
#endif
{ return PL_unify_time(t, time);
}
@ -433,9 +491,12 @@ get_file_name(term_t n, char **namep, char *tmp, int flags)
return PL_error(NULL, 0, "file name contains a 0-code",
ERR_DOMAIN, ATOM_file_name, n);
}
if ( len+1 >= MAXPATHLEN )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(name = ExpandOneFile(name, tmp)) )
{ if ( !(name = expandVars(name, tmp, MAXPATHLEN)) )
return FALSE;
}
@ -529,13 +590,13 @@ PRED_IMPL("time_file", 2, time_file, 0)
{ char *fn;
if ( PL_get_file_name(A1, &fn, 0) )
{ time_t time;
{ double time;
if ( (time = LastModifiedFile(fn)) == (time_t)-1 )
return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION,
ATOM_time, ATOM_file, A1);
if ( LastModifiedFile(fn, &time) )
return PL_unify_float(A2, time);
return unifyTime(A2, time);
return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION,
ATOM_time, ATOM_file, A1);
}
return FALSE;
@ -544,7 +605,8 @@ PRED_IMPL("time_file", 2, time_file, 0)
static
PRED_IMPL("size_file", 2, size_file, 0)
{ char *n;
{ PRED_LD
char *n;
if ( PL_get_file_name(A1, &n, 0) )
{ int64_t size;
@ -680,7 +742,7 @@ static
PRED_IMPL("file_base_name", 2, file_base_name, 0)
{ char *n;
if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) )
if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
return FALSE;
return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n));
@ -692,7 +754,7 @@ PRED_IMPL("file_directory_name", 2, file_directory_name, 0)
{ char *n;
char tmp[MAXPATHLEN];
if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) )
if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
return FALSE;
return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n, tmp));
@ -868,12 +930,13 @@ PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0)
static
PRED_IMPL("working_directory", 2, working_directory, 0)
{ PRED_LD
char buf[MAXPATHLEN];
const char *wd;
term_t old = A1;
term_t new = A2;
if ( !(wd = PL_cwd()) )
if ( !(wd = PL_cwd(buf, sizeof(buf))) )
return FALSE;
if ( PL_unify_chars(old, PL_ATOM|REP_FN, -1, wd) )
@ -966,8 +1029,8 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0)
PL_fail;
}
if ( PL_get_chars_ex(base, &b, CVT_ALL|BUF_RING|REP_FN) &&
PL_get_chars_ex(ext, &e, CVT_ALL|REP_FN) )
if ( PL_get_chars(base, &b, CVT_ALL|BUF_RING|REP_FN|CVT_EXCEPTION) &&
PL_get_chars(ext, &e, CVT_ALL|REP_FN|CVT_EXCEPTION) )
{ char *s;
if ( e[0] == '.' ) /* +Base, +Extension, -full */
@ -989,20 +1052,19 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0)
static
PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0)
{
{ PRED_LD
term_t pl = A1;
term_t os = A2;
#ifdef O_XOS
PRED_LD
wchar_t *wn;
if ( !PL_is_variable(pl) )
{ char *n;
wchar_t buf[MAXPATHLEN];
if ( PL_get_chars_ex(pl, &n, CVT_ALL|REP_UTF8) )
if ( PL_get_chars(pl, &n, CVT_ALL|REP_UTF8|CVT_EXCEPTION) )
{ if ( !_xos_os_filenameW(n, buf, MAXPATHLEN) )
return name_too_long();

12
os/pl-files.h

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef PL_FILES_H_INCLUDED
@ -31,11 +31,11 @@
#define ACCESS_WRITE 4
COMMON(void) initFiles(void);
COMMON(time_t) LastModifiedFile(const char *f);
COMMON(int) RemoveFile(const char *path);
COMMON(int) LastModifiedFile(const char *f, double *t);
COMMON(int) RemoveFile(const char *path);
COMMON(int) AccessFile(const char *path, int mode);
COMMON(char *) DeRefLink(const char *link, char *buf);
COMMON(int) ExistsFile(const char *path);
COMMON(int) ExistsDirectory(const char *path);
COMMON(char *) DeRefLink(const char *link, char *buf);
COMMON(int) ExistsFile(const char *path);
COMMON(int) ExistsDirectory(const char *path);
#endif /*PL_FILES_H_INCLUDED*/

103
os/pl-fmt.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -53,9 +53,9 @@ typedef struct
struct rubber rub[MAXRUBBER];
} format_state;
#define BUFSIZE 1024
#define DEFAULT (-1)
#define SHIFT { argc--; argv++; }
#define BUFSIZE 1024
#define DEFAULT (-1)
#define SHIFT { argc--; argv++; }
#define NEED_ARG { if ( argc <= 0 ) \
{ FMT_ERROR("not enough arguments"); \
} \
@ -189,7 +189,8 @@ outtext(format_state *state, PL_chars_t *txt)
#define format_predicates (GD->format.predicates)
static int update_column(int, Char);
static bool do_format(IOSTREAM *fd, PL_chars_t *fmt, int ac, term_t av);
static bool do_format(IOSTREAM *fd, PL_chars_t *fmt,
int ac, term_t av, Module m);
static void distribute_rubber(struct rubber *, int, int);
static int emit_rubber(format_state *state);
@ -272,7 +273,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
static word
format_impl(IOSTREAM *out, term_t format, term_t Args)
format_impl(IOSTREAM *out, term_t format, term_t Args, Module m)
{ GET_LD
term_t argv;
int argc = 0;
@ -307,7 +308,7 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
break;
}
rval = do_format(out, &fmt, argc, argv);
rval = do_format(out, &fmt, argc, argv, m);
PL_free_text(&fmt);
if ( !endCritical )
return FALSE;
@ -318,31 +319,20 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
word
pl_format3(term_t out, term_t format, term_t args)
{ redir_context ctx;
{ GET_LD
redir_context ctx;
word rc;
#if __YAP_PROLOG__
/*
YAP allows the last argument to format to be of the form
module:[]
*/
YAP_Term mod;
#endif
Module m = NULL;
term_t list = PL_new_term_ref();
if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) ) {
#if __YAP_PROLOG__
/* module processing */
{
args = Yap_fetch_module_for_format(args, &mod);
}
#endif
{ if ( (rc = format_impl(ctx.stream, format, args)) )
rc = closeOutputRedirect(&ctx);
else
if ( !PL_strip_module(args, &m, list) )
return FALSE;
if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) )
{ if ( (rc = format_impl(ctx.stream, format, list, m)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
}
#if __YAP_PROLOG__
YAP_SetCurrentModule(mod);
#endif
}
return rc;
@ -374,7 +364,7 @@ get_chr_from_text(const PL_chars_t *t, int index)
********************************/
static bool
do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv, Module m)
{ GET_LD
format_state state; /* complete state */
int tab_stop = 0; /* padded tab stop */
@ -443,7 +433,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
char buf[BUFSIZE];
char *str = buf;
size_t bufsize = BUFSIZE;
unsigned int i;
int i;
PL_predicate_info(proc, NULL, &arity, NULL);
av = PL_new_term_refs(arity);
@ -481,7 +471,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( !PL_get_text(argv, &txt, CVT_ATOMIC) )
FMT_ARG("a", argv);
SHIFT;
outtext(&state, &txt);
rc = outtext(&state, &txt);
if ( !rc )
goto out;
here++;
break;
}
@ -494,7 +486,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
SHIFT;
while(times-- > 0)
{ outchr(&state, chr);
{ rc = outchr(&state, chr);
if ( !rc )
goto out;
}
} else
FMT_ARG("c", argv);
@ -508,7 +502,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
case 'G': /* shortest of 'f' and 'E' */
{ number n;
union {
tmp_buffer b;
tmp_buffer b;
buffer b1;
} u;
@ -525,8 +519,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
initBuffer(&u.b);
formatFloat(c, arg, &n, &u.b1);
clearNumber(&n);
outstring0(&state, baseBuffer(&u.b, char));
rc = outstring0(&state, baseBuffer(&u.b, char));
discardBuffer(&u.b);
if ( !rc )
goto out;
here++;
break;
}
@ -564,8 +560,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
formatNumber(FALSE, 0, arg, c == 'r', &i, (Buffer)&b);
}
clearNumber(&i);
outstring0(&state, baseBuffer(&b, char));
rc = outstring0(&state, baseBuffer(&b, char));
discardBuffer(&b);
if ( !rc )
goto out;
here++;
break;
}
@ -576,8 +574,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( !PL_get_text(argv, &txt, CVT_LIST|CVT_STRING) &&
!PL_get_text(argv, &txt, CVT_ATOM) ) /* SICStus compat */
FMT_ARG("s", argv);
outtext(&state, &txt);
rc = outtext(&state, &txt);
SHIFT;
if ( !rc )
goto out;
here++;
break;
}
@ -610,8 +610,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
str = buf;
tellString(&str, &bufsize, ENC_UTF8);
(*f)(argv);
rc = (*f)(argv);
toldString();
if ( !rc )
goto out;
oututf8(&state, str, bufsize);
if ( str != buf )
free(str);
@ -632,8 +634,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
str = buf;
tellString(&str, &bufsize, ENC_UTF8);
(*f)(argv);
rc = (*f)(argv);
toldString();
if ( !rc )
goto out;
oututf8(&state, str, bufsize);
if ( str != buf )
free(str);
@ -704,7 +708,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
{ FMT_ERROR("not enough arguments");
}
tellString(&str, &bufsize, ENC_UTF8);
rval = callProlog(NULL, argv, PL_Q_CATCH_EXCEPTION, &ex);
rval = callProlog(m, argv, PL_Q_CATCH_EXCEPTION, &ex);
toldString();
oututf8(&state, str, bufsize);
if ( str != buf )
@ -724,7 +728,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
break;
}
case '~': /* ~ */
{ outchr(&state, '~');
{ rc = outchr(&state, '~');
if ( !rc )
goto out;
here++;
break;
}
@ -735,7 +741,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( c == 'N' && state.column == 0 )
arg--;
while( arg-- > 0 )
outchr(&state, '\n');
{ rc = outchr(&state, '\n');
if ( !rc )
goto out;
}
here++;
break;
}
@ -790,7 +799,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
break; /* the '~' switch */
}
default:
{ outchr(&state, c);
{ rc = outchr(&state, c);
if ( !rc )
goto out;
here++;
break;
}
@ -1032,7 +1043,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
while(written >= size)
{ size = written+1;
growBuffer(out, size); /* reserve for -.e<null> */
if ( !growBuffer(out, size) ) /* reserve for -.e<null> */
outOfCore();
written = gmp_snprintf(baseBuffer(out, char), size, tmp, mpf);
}
mpf_clear(mpf);
@ -1053,7 +1065,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
while(written >= size)
{ size = written+1;
growBuffer(out, size);
if ( !growBuffer(out, size) )
outOfCore();
written = snprintf(baseBuffer(out, char), size, tmp, f->value.f);
}
out->top = out->base + written;

65
os/pl-glob.c

@ -3,9 +3,10 @@
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2011, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +20,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -29,9 +30,9 @@
#include <unistd.h>
#endif
#ifdef __WATCOMC__
#include <direct.h>
#else /*__WATCOMC__*/
#ifdef O_XOS
# include "windows/dirent.h"
#else
#if HAVE_DIRENT_H
# include <dirent.h>
#else
@ -46,7 +47,7 @@
# include <ndir.h>
# endif
#endif
#endif /*__WATCOMC__*/
#endif /*O_XOS*/
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
@ -326,8 +327,8 @@ PRED_IMPL("wildcard_match", 2, wildcard_match, 0)
{ char *p, *s;
compiled_pattern buf;
if ( !PL_get_chars_ex(A1, &p, CVT_ALL) ||
!PL_get_chars_ex(A2, &s, CVT_ALL) )
if ( !PL_get_chars(A1, &p, CVT_ALL|CVT_EXCEPTION) ||
!PL_get_chars(A2, &s, CVT_ALL|CVT_EXCEPTION) )
fail;
if ( compilePattern(p, &buf) )
@ -423,6 +424,7 @@ expand(const char *pattern, GlobInfo info)
compiled_pattern cbuf;
char prefix[MAXPATHLEN]; /* before first pattern */
char patbuf[MAXPATHLEN]; /* pattern buffer */
size_t prefix_len;
int end, dot;
initBuffer(&info->files);
@ -441,20 +443,25 @@ expand(const char *pattern, GlobInfo info)
switch( (c=*s++) )
{ case EOS:
if ( s > pat ) /* something left and expanded */
{ un_escape(prefix, pat, s);
{ size_t prefix_len;
un_escape(prefix, pat, s);
prefix_len = strlen(prefix);
end = info->end;
for( ; info->start < end; info->start++ )
{ char path[MAXPATHLEN];
size_t plen;
const char *entry = expand_entry(info, info->start);
size_t plen = strlen(entry);
strcpy(path, expand_entry(info, info->start));
plen = strlen(path);
if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
path[plen++] = '/';
strcpy(&path[plen], prefix);
if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
add_path(path, info);
if ( plen+prefix_len+2 <= MAXPATHLEN )
{ strcpy(path, entry);
if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
path[plen++] = '/';
strcpy(&path[plen], prefix);
if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
add_path(path, info);
}
}
}
succeed;
@ -489,8 +496,9 @@ expand(const char *pattern, GlobInfo info)
*/
un_escape(prefix, pat, head);
un_escape(patbuf, head, tail);
prefix_len = strlen(prefix);
if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */
if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */
fail;
dot = (patbuf[0] == '.'); /* do dots as well */
@ -502,6 +510,10 @@ expand(const char *pattern, GlobInfo info)
char path[MAXPATHLEN];
char tmp[MAXPATHLEN];
const char *current = expand_entry(info, info->start);
size_t clen = strlen(current);
if ( clen+prefix_len+1 > sizeof(path) )
continue;
strcpy(path, current);
strcat(path, prefix);
@ -521,12 +533,11 @@ expand(const char *pattern, GlobInfo info)
matchPattern(e->d_name, &cbuf) )
{ char newp[MAXPATHLEN];
strcpy(newp, path);
strcpy(&newp[plen], e->d_name);
/* if ( !tail[0] || ExistsDirectory(newp) )
Saves memory, but involves one more file-access
*/
if ( plen+strlen(e->d_name)+1 < sizeof(newp) )
{ strcpy(newp, path);
strcpy(&newp[plen], e->d_name);
add_path(newp, info);
}
}
}
closedir(d);
@ -579,11 +590,11 @@ PRED_IMPL("expand_file_name", 2, expand_file_name, 0)
term_t head = PL_new_term_ref();
int i;
if ( !PL_get_chars_ex(A1, &s, CVT_ALL|REP_FN) )
if ( !PL_get_chars(A1, &s, CVT_ALL|REP_FN|CVT_EXCEPTION) )
fail;
if ( strlen(s) > sizeof(spec)-1 )
return PL_error(NULL, 0, "File name too intptr_t",
ERR_DOMAIN, ATOM_pattern, A1);
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
if ( !expandVars(s, spec, sizeof(spec)) )
fail;

39
os/pl-mswchar.h

@ -1,39 +0,0 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2005, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <wchar.h>
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
See pl-mswchar.cpp for the motivation for this nonsense. Used in
pl-fli.c and pl-text.c.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if defined(__WINDOWS__) && !defined(__MINGW32__)
#define wcrtomb(s, wc, ps) ms_wcrtomb(s, wc, ps)
#define mbrtowc(pwc, s, n, ps) ms_mbrtowc(pwc, s, n, ps)
extern size_t ms_wcrtomb(char *s, wchar_t wc, mbstate_t *ps);
extern size_t ms_mbrtowc(wchar_t *pwc, const char *s, size_t n, mbstate_t *ps);
#endif

288
os/pl-nt.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifdef __MINGW32__
@ -27,8 +27,8 @@
#endif
#ifdef __WINDOWS__
#define _WIN32_WINNT 0x0400
#if (_MSC_VER >= 1300) || defined(__MINGW32__)
#define WINVER 0x0501
#if (_MSC_VER >= 1300) || __MINGW32__
#include <winsock2.h> /* Needed on VC8 */
#include <windows.h>
#else
@ -36,16 +36,40 @@
#include <winsock2.h>
#endif
#ifdef __MINGW32__
#ifndef _WIN32_IE
#define _WIN32_IE 0x0400
#endif
/* FIXME: these are copied from SWI-Prolog.h. */
#define PL_MSG_EXCEPTION_RAISED -1
#define PL_MSG_IGNORED 0
#define PL_MSG_HANDLED 1
#endif
#include "pl-incl.h"
#ifdef __YAP_PROLOG__
#include "pl-utf8.h"
//#include <crtdbg.h>
#else
#include "os/pl-utf8.h"
#endif
#include <process.h>
#ifdef __YAP_PROLOG__
#include "pl-ctype.h"
#else
#include "os/pl-ctype.h"
#endif
#include <stdio.h>
#include <stdarg.h>
#ifdef __YAP_PROLOG__
#include "SWI-Stream.h"
#else
#include "os/SWI-Stream.h"
#endif
#include <process.h>
#include <winbase.h>
#ifdef HAVE_CRTDBG_H
#include <crtdbg.h>
#endif
/*******************************
@ -135,8 +159,8 @@ PlMessage(const char *fm, ...)
* WinAPI ERROR CODES *
*******************************/
char *
WinError()
const char *
WinError(void)
{ int id = GetLastError();
char *msg;
static WORD lang;
@ -232,23 +256,21 @@ Pause(double t)
* SET FILE SIZE *
*******************************/
#ifndef HAVE_FTRUNCATE
int
ftruncate(int fileno, int64_t length)
{ int e;
{ errno_t e;
#if HAVE__CHSIZE_S
/* not always available in mingw */
if ( (e=_chsize_s(fileno, length)) == 0 )
return 0;
#else
if ( (e=_chsize(fileno, (long)length)) == 0 )
return 0;
#endif
errno = e;
return -1;
}
#endif
/*******************************
* QUERY CPU TIME *
@ -273,13 +295,14 @@ CpuTime(cputime_kind which)
case CPU_SYSTEM:
p = &kerneltime;
break;
default:
assert(0);
return 0.0;
}
t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano);
t += (double)p->dwLowDateTime * (ntick nano);
} else /* '95, Windows 3.1/win32s */
{ extern intptr_t clock_wait_ticks;
t = (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
{ t = 0.0;
}
return t;
@ -287,7 +310,7 @@ CpuTime(cputime_kind which)
static int
CpuCount()
CpuCount(void)
{ SYSTEM_INFO si;
GetSystemInfo(&si);
@ -297,7 +320,7 @@ CpuCount()
void
setOSPrologFlags()
setOSPrologFlags(void)
{ PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount());
}
@ -310,7 +333,7 @@ findExecutable(const char *module, char *exe)
if ( module )
{ if ( !(hmod = GetModuleHandle(module)) )
{ hmod = GetModuleHandle("libpl.dll");
{ hmod = GetModuleHandle("libswipl.dll");
DEBUG(0,
Sdprintf("Warning: could not find module from \"%s\"\n"
"Warning: Trying %s to find home\n",
@ -340,7 +363,7 @@ findExecutable(const char *module, char *exe)
typedef struct
{ const char *name;
int id;
UINT id;
} showtype;
static int
@ -348,12 +371,12 @@ get_showCmd(term_t show, UINT *cmd)
{ char *s;
showtype *st;
static showtype types[] =
{ { "hide", SW_HIDE },
{ "maximize", SW_MAXIMIZE },
{ "minimize", SW_MINIMIZE },
{ "restore", SW_RESTORE },
{ "show", SW_SHOW },
{ "showdefault", SW_SHOWDEFAULT },
{ { "hide", SW_HIDE },
{ "maximize", SW_MAXIMIZE },
{ "minimize", SW_MINIMIZE },
{ "restore", SW_RESTORE },
{ "show", SW_SHOW },
{ "showdefault", SW_SHOWDEFAULT },
{ "showmaximized", SW_SHOWMAXIMIZED },
{ "showminimized", SW_SHOWMINIMIZED },
{ "showminnoactive", SW_SHOWMINNOACTIVE },
@ -361,8 +384,8 @@ get_showCmd(term_t show, UINT *cmd)
{ "shownoactive", SW_SHOWNOACTIVATE },
{ "shownormal", SW_SHOWNORMAL },
/* compatibility */
{ "normal", SW_SHOWNORMAL },
{ "iconic", SW_MINIMIZE },
{ "normal", SW_SHOWNORMAL },
{ "iconic", SW_MINIMIZE },
{ NULL, 0 },
};
@ -422,8 +445,9 @@ win_exec(size_t len, const wchar_t *cmd, UINT show)
} else
{ term_t tmp = PL_new_term_ref();
PL_unify_wchars(tmp, PL_ATOM, len, cmd);
return PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp);
return ( PL_unify_wchars(tmp, PL_ATOM, len, cmd) &&
PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp)
);
}
}
@ -524,7 +548,7 @@ static const shell_error se_errors[] =
{ SE_ERR_DDETIMEOUT, "DDE request timed out" },
{ SE_ERR_DLLNOTFOUND, "DLL not found" },
{ SE_ERR_FNF, "File not found (FNF)" },
{ SE_ERR_NOASSOC, "No association" },
{ SE_ERR_NOASSOC, "No association" },
{ SE_ERR_OOM, "Not enough memory" },
{ SE_ERR_PNF, "Path not found (PNF)" },
{ SE_ERR_SHARE, "Sharing violation" },
@ -550,7 +574,7 @@ win_shell(term_t op, term_t file, term_t how)
{ const shell_error *se;
for(se = se_errors; se->message; se++)
{ if ( se->eno == (int)instance )
{ if ( se->eno == (int)(intptr_t)instance )
return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
}
PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
@ -621,22 +645,113 @@ need. They are used by pl-load.c, which defines the actual Prolog
interface.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static char *dlmsg;
#ifdef HAVE_LIBLOADERAPI_H
#include <LibLoaderAPI.h>
#else
#ifndef LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR
#define LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR 0x00000100
#endif
#ifndef LOAD_LIBRARY_SEARCH_DEFAULT_DIRS
#define LOAD_LIBRARY_SEARCH_DEFAULT_DIRS 0x00001000
#endif
typedef void * DLL_DIRECTORY_COOKIE;
#endif
static const char *dlmsg;
static DLL_DIRECTORY_COOKIE WINAPI (*f_AddDllDirectoryW)(wchar_t* dir);
static BOOL WINAPI (*f_RemoveDllDirectory)(DLL_DIRECTORY_COOKIE);
static DWORD
load_library_search_flags(void)
{ static int done = FALSE;
static DWORD flags = 0;
if ( !done )
{ HMODULE kernel = GetModuleHandle(TEXT("kernel32.dll"));
if ( (f_AddDllDirectoryW = (void*)GetProcAddress(kernel, "AddDllDirectory")) &&
(f_RemoveDllDirectory = (void*)GetProcAddress(kernel, "RemoveDllDirectory")) )
{ flags = ( LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR|
LOAD_LIBRARY_SEARCH_DEFAULT_DIRS );
}
done = TRUE;
}
return flags;
}
static
PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0)
{ PRED_LD
char *dirs;
if ( PL_get_file_name(A1, &dirs, REP_UTF8) )
{ size_t len = utf8_strlen(dirs, strlen(dirs));
wchar_t *dirw = alloca((len+10)*sizeof(wchar_t));
DLL_DIRECTORY_COOKIE cookie;
if ( _xos_os_filenameW(dirs, dirw, len+10) == NULL )
return PL_representation_error("file_name");
if ( load_library_search_flags() )
{ if ( (cookie = (*f_AddDllDirectoryW)(dirw)) )
return PL_unify_int64(A2, (int64_t)cookie);
return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "AddDllDirectory()");
} else
return FALSE;
} else
return FALSE;
}
static
PRED_IMPL("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
{ int64_t icookie;
if ( PL_get_int64_ex(A1, &icookie) )
{ if ( f_RemoveDllDirectory )
{ if ( (*f_RemoveDllDirectory)((DLL_DIRECTORY_COOKIE)icookie) )
return TRUE;
return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "RemoveDllDirectory()");
} else
return FALSE;
} else
return FALSE;
}
static int
is_windows_abs_path(const wchar_t *path)
{ if ( path[1] == ':' && path[0] < 0x80 && iswalpha(path[0]) )
return TRUE; /* drive */
if ( path[0] == '\\' && path[1] == '\\' )
return TRUE; /* UNC */
return FALSE;
}
void *
dlopen(const char *file, int flags) /* file is in UTF-8 */
dlopen(const char *file, int flags) /* file is in UTF-8, POSIX path */
{ HINSTANCE h;
DWORD llflags = 0;
size_t len = utf8_strlen(file, strlen(file));
wchar_t *wfile = alloca((len+1)*sizeof(wchar_t));
wchar_t *wfile = alloca((len+10)*sizeof(wchar_t));
if ( !wfile )
{ dlmsg = "No memory";
return NULL;
}
utf8towcs(wfile, file);
if ( _xos_os_filenameW(file, wfile, len+10) == NULL )
{ dlmsg = "Name too long";
return NULL;
}
if ( (h = LoadLibraryW(wfile)) )
if ( is_windows_abs_path(wfile) )
llflags |= load_library_search_flags();
if ( (h = LoadLibraryExW(wfile, NULL, llflags)) )
{ dlmsg = "No Error";
return (void *)h;
}
@ -647,7 +762,7 @@ dlopen(const char *file, int flags) /* file is in UTF-8 */
const char *
dlerror()
dlerror(void)
{ return dlmsg;
}
@ -676,11 +791,59 @@ dlclose(void *handle)
#endif /*EMULATE_DLOPEN*/
/*******************************
* SNPRINTF MADNESS *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
MS-Windows _snprintf() may look like C99 snprintf(), but is is not quite
the same: on overflow, the buffer is *not* 0-terminated and the return
is negative (unspecified how negative). The code below works around
this, returning count on overflow. This is still not the same as the C99
version that returns the number of characters that would have been
written, but it seems to be enough for our purposes.
See http://www.di-mgt.com.au/cprog.html#snprintf
The above came from the provided link, but it is even worse (copied from
VS2005 docs):
- If len < count, then len characters are stored in buffer, a
null-terminator is appended, and len is returned.
- If len = count, then len characters are stored in buffer, no
null-terminator is appended, and len is returned.
- If len > count, then count characters are stored in buffer, no
null-terminator is appended, and a negative value is returned.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int
ms_snprintf(char *buffer, size_t count, const char *fmt, ...)
{ va_list ap;
int ret;
va_start(ap, fmt);
ret = _vsnprintf(buffer, count-1, fmt, ap);
va_end(ap);
if ( ret < 0 || ret == count )
{ ret = (int)count;
buffer[count-1] = '\0';
}
return ret;
}
/*******************************
* FOLDERS *
*******************************/
#include <Shlobj.h>
#ifdef HAVE_SHLOBJ_H
#include <shlobj.h>
#endif
typedef struct folderid
{ int csidl;
@ -727,7 +890,7 @@ static int
unify_csidl_path(term_t t, int csidl)
{ wchar_t buf[MAX_PATH];
if ( SHGetFolderPathW(0, csidl, NULL, FALSE, buf) )
if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
{ wchar_t *p;
for(p=buf; *p; p++)
@ -935,7 +1098,7 @@ setStacksFromKey(HKEY key)
void
getDefaultsFromRegistry()
getDefaultsFromRegistry(void)
{ HKEY key;
if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) )
@ -948,44 +1111,6 @@ getDefaultsFromRegistry()
}
}
static
PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
{ GET_LD
OPENFILENAMEW ofn;
wchar_t szFileName[MAX_PATH];
void *x;
HWND hwnd;
wchar_t *yap_cwd;
if(!PL_get_pointer(A1, &x))
return FALSE;
if(!PL_get_wchars(A2, NULL, &yap_cwd, CVT_ATOM|CVT_EXCEPTION))
return FALSE;
hwnd = (HWND)x;
ZeroMemory(&ofn, sizeof(ofn));
ofn.lStructSize = sizeof(ofn); // SEE NOTE BELOW
ofn.hwndOwner = hwnd;
ofn.lpstrFilter = L"Prolog Files (*.pl;*.yap)\0*.pl;*.yap\0All Files (*.*)\0*.*\0";
ofn.lpstrFile = szFileName;
ofn.lpstrInitialDir = yap_cwd;
ofn.nMaxFile = MAX_PATH;
ofn.Flags = OFN_EXPLORER | OFN_FILEMUSTEXIST
//| OFN_HIDEREADONLY
//|OFN_ALLOWMULTISELECT
;
ofn.lpstrDefExt = "pl";
if(GetOpenFileNameW(&ofn))
{
// Do something usefull with the filename stored in szFileName
return PL_unify_wchars(A3, PL_ATOM,
MAX_PATH-1, szFileName);
}
return TRUE;
}
/*******************************
* PUBLISH PREDICATES *
*******************************/
@ -993,9 +1118,12 @@ PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
BeginPredDefs(win)
PRED_DEF("win_shell", 2, win_shell2, 0)
PRED_DEF("win_shell", 3, win_shell3, 0)
PRED_DEF("win_open_file_name", 3, win_open_file_name, 0)
PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
#ifdef EMULATE_DLOPEN
PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0)
PRED_DEF("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
#endif
EndPredDefs
#endif /*__WINDOWS__*/

440
os/pl-os.c

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2007, University of Amsterdam
Copyright (C): 1985-2013, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/* Modified (M) 1993 Dave Sherratt */
@ -30,6 +29,17 @@
#include <os2.h> /* this has to appear before pl-incl.h */
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS
is supposed to give the POSIX standard one.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if defined(__sun__) || defined(__sun)
#define _POSIX_PTHREAD_SEMANTICS 1
#endif
#define __MINGW_USE_VC2005_COMPAT /* Get Windows time_t as 64-bit */
#include "pl-incl.h"
#include "pl-ctype.h"
#include "pl-utf8.h"
@ -96,27 +106,11 @@ static double initial_time;
static void initExpand(void);
static void cleanupExpand(void);
static void initEnviron(void);
static char * Which(const char *program, char *fullname);
#ifndef DEFAULT_PATH
#define DEFAULT_PATH "/bin:/usr/bin"
#endif
/*******************************
* GLOBALS *
*******************************/
#ifdef HAVE_CLOCK
long clock_wait_ticks;
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module is a contraction of functions that used to be all over the
place. together with pl-os.h (included by pl-incl.h) this file
should define a basic layer around the OS, on which the rest of
SWI-Prolog is based.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/********************************
* INITIALISATION *
*********************************/
@ -145,20 +139,6 @@ initOs(void)
setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING);
#endif
#ifdef HAVE_CLOCK
clock_wait_ticks = 0L;
#endif
#if OS2
{ DATETIME i;
DosGetDateTime((PDATETIME)&i);
initial_time = (i.hours * 3600.0)
+ (i.minutes * 60.0)
+ i.seconds
+ (i.hundredths / 100.0);
}
#endif /* OS2 */
DEBUG(1, Sdprintf("OS:done\n"));
succeed;
@ -239,11 +219,26 @@ static char errmsg[64];
#endif /*_SC_CLK_TCK*/
#endif /*HAVE_TIMES*/
#ifdef HAVE_CLOCK_GETTIME
#define timespec_to_double(ts) \
((double)(ts).tv_sec + (double)(ts).tv_nsec/(double)1000000000.0)
#endif
double
CpuTime(cputime_kind which)
{
#ifdef HAVE_TIMES
#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_PROCESS_CPUTIME_ID)
#define CPU_TIME_DONE
struct timespec ts;
(void)which;
if ( clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts) == 0 )
return timespec_to_double(ts);
return 0.0;
#endif
#if !defined(CPU_TIME_DONE) && defined(HAVE_TIMES)
#define CPU_TIME_DONE
struct tms t;
double used;
static int MTOK_got_hz = FALSE;
@ -268,39 +263,17 @@ CpuTime(cputime_kind which)
used = 0.0; /* happens when running under GDB */
return used;
#else
#endif
#if OS2 && EMX
DATETIME i;
DosGetDateTime((PDATETIME)&i);
return (((i.hours * 3600)
+ (i.minutes * 60)
+ i.seconds
+ (i.hundredths / 100.0)) - initial_time);
#else
#ifdef HAVE_CLOCK
return (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
#else
#if !defined(CPU_TIME_DONE)
(void)which;
return 0.0;
#endif
#endif
#endif
}
#endif /*__WINDOWS__*/
void
PL_clock_wait_ticks(long waited)
{
#ifdef HAVE_CLOCK
clock_wait_ticks += waited;
#endif
}
double
WallTime(void)
@ -310,7 +283,7 @@ WallTime(void)
struct timespec tp;
clock_gettime(CLOCK_REALTIME, &tp);
stime = (double)tp.tv_sec + (double)tp.tv_nsec/1000000000.0;
stime = timespec_to_double(tp);
#else
#ifdef HAVE_GETTIMEOFDAY
struct timeval tp;
@ -389,7 +362,7 @@ CpuCount()
#include <sys/sysctl.h>
int
CpuCount()
CpuCount(void)
{ int count ;
size_t size=sizeof(count) ;
@ -415,7 +388,7 @@ setOSPrologFlags(void)
{ int cpu_count = CpuCount();
if ( cpu_count > 0 )
PL_set_prolog_flag("cpu_count", PL_INTEGER|FF_READONLY, cpu_count);
PL_set_prolog_flag("cpu_count", PL_INTEGER, cpu_count);
}
#endif
@ -436,8 +409,7 @@ UsedMemory(void)
}
#endif
return (GD->statistics.heap +
usedStack(global) +
return (usedStack(global) +
usedStack(local) +
usedStack(trail));
}
@ -448,8 +420,7 @@ FreeMemory(void)
{
#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
uintptr_t used = UsedMemory();
struct rlimit limit;
struct rlimit limit;
if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
return limit.rlim_cur - used;
@ -470,7 +441,7 @@ FreeMemory(void)
some systems (__WINDOWS__) the seed of rand() is thread-local, while on
others it is global. We appear to have the choice between
# srand()/rand()
# srand()/rand()
Differ in MT handling, often bad distribution
# srandom()/random()
@ -522,16 +493,14 @@ _PL_Random(void)
}
#ifdef HAVE_RANDOM
#if SIZEOF_VOIDP == 4
{ uint64_t l = random();
l ^= (uint64_t)random()<<32;
l ^= (uint64_t)random()<<15;
l ^= (uint64_t)random()<<30;
l ^= (uint64_t)random()<<45;
return l;
}
#else
return random();
#endif
#else
{ uint64_t l = rand(); /* 0<n<2^15-1 */
@ -845,19 +814,16 @@ struct canonical_dir
forwards char *canoniseDir(char *);
#endif /*O_CANONISE_DIRS*/
#define CWDdir (LD->os._CWDdir) /* current directory */
#define CWDlen (LD->os._CWDlen) /* strlen(CWDdir) */
static void
initExpand(void)
{ GET_LD
{
#ifdef O_CANONISE_DIRS
char *dir;
char *cpaths;
#endif
CWDdir = NULL;
CWDlen = 0;
GD->paths.CWDdir = NULL;
GD->paths.CWDlen = 0;
#ifdef O_CANONISE_DIRS
{ char envbuf[MAXPATHLEN];
@ -898,7 +864,15 @@ cleanupExpand(void)
canonical_dirlist = NULL;
for( ; dn; dn = next )
{ next = dn->next;
free(dn);
if ( dn->canonical && dn->canonical != dn->name )
remove_string(dn->canonical);
remove_string(dn->name);
PL_free(dn);
}
if ( GD->paths.CWDdir )
{ remove_string(GD->paths.CWDdir);
GD->paths.CWDdir = NULL;
GD->paths.CWDlen = 0;
}
}
@ -925,7 +899,7 @@ registerParentDirs(const char *path)
}
if ( statfunc(OsPath(dirname, tmp), &buf) == 0 )
{ CanonicalDir dn = malloc(sizeof(*dn));
{ CanonicalDir dn = PL_malloc(sizeof(*dn));
dn->name = store_string(dirname);
dn->inode = buf.st_ino;
@ -980,7 +954,7 @@ verify_entry(CanonicalDir d)
remove_string(d->name);
if ( d->canonical != d->name )
remove_string(d->canonical);
free(d);
PL_free(d);
}
return FALSE;
@ -1008,12 +982,12 @@ canoniseDir(char *path)
}
/* we need to use malloc() here */
/* because allocHeap() only ensures */
/* because allocHeapOrHalt() only ensures */
/* alignment for `word', and inode_t */
/* is sometimes bigger! */
if ( statfunc(OsPath(path, tmp), &buf) == 0 )
{ CanonicalDir dn = malloc(sizeof(*dn));
{ CanonicalDir dn = PL_malloc(sizeof(*dn));
char dirname[MAXPATHLEN];
char *e = path + strlen(path);
@ -1082,8 +1056,7 @@ cleanupExpand(void)
char *
canoniseFileName(char *path)
{ char *out = path, *in = path, *start = path;
char *osave[100];
int osavep = 0;
tmp_buffer saveb;
#ifdef O_HASDRIVES /* C: */
if ( in[1] == ':' && isLetter(in[0]) )
@ -1092,8 +1065,8 @@ canoniseFileName(char *path)
out = start = in;
}
#ifdef __MINGW32__ /* /c/ in MINGW is the same as c: */
if ( in[0] == '/' && isLetter(in[1]) &&
in[2] == '/' )
else if ( in[0] == '/' && isLetter(in[1]) &&
in[2] == '/' )
{
out[0] = in[1];
out[1] = ':';
@ -1101,13 +1074,13 @@ canoniseFileName(char *path)
out = start = in;
}
#endif
#endif
#ifdef O_HASSHARES /* //host/ */
if ( in[0] == '/' && in[1] == '/' && isAlpha(in[2]) )
{ char *s;
for(s = in+3; *s && (isAlpha(*s) || *s == '.'); s++)
for(s = in+3; *s && (isAlpha(*s) || *s == '-' || *s == '.'); s++)
;
if ( *s == '/' )
{ in = out = s+1;
@ -1122,7 +1095,8 @@ canoniseFileName(char *path)
in += 2;
if ( in[0] == '/' )
*out++ = '/';
osave[osavep++] = out;
initBuffer(&saveb);
addBuffer(&saveb, out, char*);
while(*in)
{ if (*in == '/')
@ -1138,15 +1112,15 @@ canoniseFileName(char *path)
}
if ( in[2] == EOS ) /* delete trailing /. */
{ *out = EOS;
return path;
goto out;
}
if ( in[2] == '.' && (in[3] == '/' || in[3] == EOS) )
{ if ( osavep > 0 ) /* delete /foo/../ */
{ out = osave[--osavep];
{ if ( !isEmptyBuffer(&saveb) ) /* delete /foo/../ */
{ out = popBuffer(&saveb, char*);
in += 3;
if ( in[0] == EOS && out > start+1 )
{ out[-1] = EOS; /* delete trailing / */
return path;
goto out;
}
goto again;
} else if ( start[0] == '/' && out == start+1 )
@ -1160,12 +1134,15 @@ canoniseFileName(char *path)
in++;
if ( out > path && out[-1] != '/' )
*out++ = '/';
osave[osavep++] = out;
addBuffer(&saveb, out, char*);
} else
*out++ = *in++;
}
*out++ = *in++;
out:
discardBuffer(&saveb);
return path;
}
@ -1201,15 +1178,18 @@ canonisePath(char *path)
#ifdef O_CANONISE_DIRS
{ char *e;
char dirname[MAXPATHLEN];
size_t plen = strlen(path);
e = path + strlen(path) - 1;
for( ; *e != '/' && e > path; e-- )
;
strncpy(dirname, path, e-path);
dirname[e-path] = EOS;
canoniseDir(dirname);
strcat(dirname, e);
strcpy(path, dirname);
if ( plen > 0 )
{ e = path + plen - 1;
for( ; *e != '/' && e > path; e-- )
;
strncpy(dirname, path, e-path);
dirname[e-path] = EOS;
canoniseDir(dirname);
strcat(dirname, e);
strcpy(path, dirname);
}
}
#endif
@ -1238,11 +1218,12 @@ takeWord(const char **string, char *wrd, int maxlen)
}
bool
char *
expandVars(const char *pattern, char *expanded, int maxlen)
{ GET_LD
int size = 0;
char wordbuf[MAXPATHLEN];
char *rc = expanded;
if ( *pattern == '~' )
{ char *user;
@ -1305,7 +1286,9 @@ expandVars(const char *pattern, char *expanded, int maxlen)
#endif
size += (l = (int) strlen(value));
if ( size+1 >= maxlen )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
return NULL;
}
strcpy(expanded, value);
expanded += l;
UNLOCK();
@ -1345,8 +1328,9 @@ expandVars(const char *pattern, char *expanded, int maxlen)
size += (l = (int)strlen(value));
if ( size+1 >= maxlen )
{ UNLOCK();
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
return NULL;
}
strcpy(expanded, value);
UNLOCK();
@ -1359,8 +1343,10 @@ expandVars(const char *pattern, char *expanded, int maxlen)
def:
size++;
if ( size+1 >= maxlen )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
return NULL;
}
*expanded++ = c;
continue;
@ -1369,61 +1355,14 @@ expandVars(const char *pattern, char *expanded, int maxlen)
}
if ( ++size >= maxlen )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
return NULL;
}
*expanded = EOS;
succeed;
}
static int
ExpandFile(const char *pattern, char **vector)
{ char expanded[MAXPATHLEN];
int matches = 0;
if ( !expandVars(pattern, expanded, sizeof(expanded)) )
return -1;
vector[matches++] = store_string(expanded);
return matches;
}
char *
ExpandOneFile(const char *spec, char *file)
{ GET_LD
char *vector[256];
int size;
switch( (size=ExpandFile(spec, vector)) )
{ case -1:
return NULL;
case 0:
{ term_t tmp = PL_new_term_ref();
PL_put_atom_chars(tmp, spec);
PL_error(NULL, 0, "no match", ERR_EXISTENCE, ATOM_file, tmp);
return NULL;
}
case 1:
strcpy(file, vector[0]);
remove_string(vector[0]);
return file;
default:
{ term_t tmp = PL_new_term_ref();
int n;
for(n=0; n<size; n++)
remove_string(vector[n]);
PL_put_atom_chars(tmp, spec);
PL_error(NULL, 0, "ambiguous", ERR_EXISTENCE, ATOM_file, tmp);
return NULL;
}
}
return rc;
}
@ -1507,7 +1446,7 @@ AbsoluteFile(const char *spec, char *path)
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) )
{ if ( !(file = expandVars(buf, tmp, sizeof(tmp))) )
return (char *) NULL;
}
@ -1530,17 +1469,17 @@ AbsoluteFile(const char *spec, char *path)
}
#endif /*O_HASDRIVES*/
if ( !PL_cwd() )
if ( !PL_cwd(path, MAXPATHLEN) )
return NULL;
if ( (CWDlen + strlen(file) + 1) >= MAXPATHLEN )
if ( (GD->paths.CWDlen + strlen(file) + 1) >= MAXPATHLEN )
{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
return (char *) NULL;
}
strcpy(path, CWDdir);
strcpy(path, GD->paths.CWDdir);
if ( file[0] != EOS )
strcpy(&path[CWDlen], file);
strcpy(&path[GD->paths.CWDlen], file);
if ( strchr(file, '.') || strchr(file, '/') )
return canonisePath(path);
else
@ -1550,20 +1489,20 @@ AbsoluteFile(const char *spec, char *path)
void
PL_changed_cwd(void)
{ GET_LD
if ( CWDdir )
remove_string(CWDdir);
CWDdir = NULL;
CWDlen = 0;
{ LOCK();
if ( GD->paths.CWDdir )
remove_string(GD->paths.CWDdir);
GD->paths.CWDdir = NULL;
GD->paths.CWDlen = 0;
UNLOCK();
}
const char *
PL_cwd(void)
static char *
cwd_unlocked(char *cwd, size_t cwdlen)
{ GET_LD
if ( CWDlen == 0 )
if ( GD->paths.CWDlen == 0 )
{ char buf[MAXPATHLEN];
char *rval;
@ -1593,16 +1532,34 @@ to be implemented directly. What about other Unixes?
}
canonisePath(buf);
CWDlen = strlen(buf);
buf[CWDlen++] = '/';
buf[CWDlen] = EOS;
GD->paths.CWDlen = strlen(buf);
buf[GD->paths.CWDlen++] = '/';
buf[GD->paths.CWDlen] = EOS;
if ( CWDdir )
remove_string(CWDdir);
CWDdir = store_string(buf);
if ( GD->paths.CWDdir )
remove_string(GD->paths.CWDdir);
GD->paths.CWDdir = store_string(buf);
}
return (const char *)CWDdir;
if ( GD->paths.CWDlen < cwdlen )
{ memcpy(cwd, GD->paths.CWDdir, GD->paths.CWDlen+1);
return cwd;
} else
{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
return NULL;
}
}
char *
PL_cwd(char *cwd, size_t cwdlen)
{ char *rc;
LOCK();
rc = cwd_unlocked(cwd, cwdlen);
UNLOCK();
return rc;
}
@ -1652,14 +1609,13 @@ DirName(const char *f, char *dir)
bool
ChDir(const char *path)
{ GET_LD
char ospath[MAXPATHLEN];
{ char ospath[MAXPATHLEN];
char tmp[MAXPATHLEN];
OsPath(path, ospath);
if ( path[0] == EOS || streq(path, ".") ||
(CWDdir && streq(path, CWDdir)) )
(GD->paths.CWDdir && streq(path, GD->paths.CWDdir)) )
succeed;
AbsoluteFile(path, tmp);
@ -1672,10 +1628,12 @@ ChDir(const char *path)
{ tmp[len++] = '/';
tmp[len] = EOS;
}
CWDlen = len;
if ( CWDdir )
remove_string(CWDdir);
CWDdir = store_string(tmp);
LOCK(); /* Lock with PL_changed_cwd() */
GD->paths.CWDlen = len; /* and PL_cwd() */
if ( GD->paths.CWDdir )
remove_string(GD->paths.CWDdir);
GD->paths.CWDdir = store_string(tmp);
UNLOCK();
succeed;
}
@ -1689,7 +1647,7 @@ ChDir(const char *path)
*********************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
struct tm *LocalTime(time_t time, struct tm *r)
struct tm *PL_localtime_r(time_t time, struct tm *r)
Convert time in Unix internal form (seconds since Jan 1 1970) into a
structure providing easier access to the time.
@ -1713,17 +1671,52 @@ ChDir(const char *path)
time_t Time()
Return time in seconds after Jan 1 1970 (Unix' time notion).
Note: MinGW has localtime_r(), but it is not locked and thus not
thread-safe. MinGW does not have localtime_s(), but we test for it in
configure.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
struct tm *
LocalTime(long *t, struct tm *r)
PL_localtime_r(const time_t *t, struct tm *r)
{
#if defined(_REENTRANT) && defined(HAVE_LOCALTIME_R)
#ifdef HAVE_LOCALTIME_R
return localtime_r(t, r);
#else
*r = *localtime((const time_t *) t);
#ifdef HAVE_LOCALTIME_S
return localtime_s(r, t) == EINVAL ? NULL : t;
#else
struct tm *rc;
LOCK();
if ( (rc = localtime(t)) )
*r = *rc;
else
r = NULL;
UNLOCK();
return r;
#endif
#endif
}
char *
PL_asctime_r(const struct tm *tm, char *buf)
{
#ifdef HAVE_ASCTIME_R
return asctime_r(tm, buf);
#else
char *rc;
LOCK();
if ( (rc = asctime(tm)) )
strcpy(buf, rc);
else
buf = NULL;
UNLOCK();
return buf;
#endif
}
@ -1857,7 +1850,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
succeed;
buf->state = allocHeap(sizeof(tty_state));
buf->state = allocHeapOrHalt(sizeof(tty_state));
#ifdef HAVE_TCSETATTR
if ( tcgetattr(fd, &TTY_STATE(buf)) ) /* save the old one */
@ -1915,9 +1908,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool
PopTty(IOSTREAM *s, ttybuf *buf, int do_free)
{ GET_LD
ttymode = buf->mode;
{ ttymode = buf->mode;
if ( buf->state )
{ int fd = Sfileno(s);
@ -1963,7 +1954,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
succeed;
buf->state = allocHeap(sizeof(tty_state));
buf->state = allocHeapOrHalt(sizeof(tty_state));
if ( ioctl(fd, TIOCGETP, &TTY_STATE(buf)) ) /* save the old one */
fail;
@ -2178,7 +2169,7 @@ growEnviron(char **e, int amount)
for(e1=e, filled=0; *e1; e1++, filled++)
;
size = ROUND(filled+10+amount, 32);
env = (char **)malloc(size * sizeof(char *));
env = (char **)PL_malloc(size * sizeof(char *));
for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
;
*e2 = (char *) NULL;
@ -2192,7 +2183,7 @@ growEnviron(char **e, int amount)
{ char **env, **e1, **e2;
size += 32;
env = (char **)realloc(e, size * sizeof(char *));
env = (char **)PL_realloc(e, size * sizeof(char *));
for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
;
*e2 = (char *) NULL;
@ -2224,9 +2215,9 @@ matchName(const char *e, const char *name)
static void
setEntry(char **e, char *name, char *value)
{ int l = (int)strlen(name);
{ size_t l = strlen(name);
*e = (char *) malloc(l + strlen(value) + 2);
*e = PL_malloc_atomic(l + strlen(value) + 2);
strcpy(*e, name);
e[0][l++] = '=';
strcpy(&e[0][l], value);
@ -2292,7 +2283,7 @@ Unsetenv(char *name)
an alternative.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if defined(__unix__)
#ifdef __unix__
#define SPECIFIC_SYSTEM 1
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -2465,30 +2456,15 @@ char *command;
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
[candidate]
exec(+Cmd, [+In, +Out, +Error], -Pid)
The streams may be one of standard stream, std, null stream, null, or
pipe(S), where S is a pipe stream
Detach if none is std!
TBD: Sort out status. The above is SICStus 3. YAP uses `Status' for last
argument (strange). SICStus 4 appears to drop this altogether.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
char *Symbols(char *buf)
char *findExecutable(char *buf)
Return the path name of the executable of SWI-Prolog.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef __WINDOWS__ /* Win32 version in pl-nt.c */
static char * Which(const char *program, char *fullname);
char *
findExecutable(const char *av0, char *buffer)
@ -2500,7 +2476,7 @@ findExecutable(const char *av0, char *buffer)
return NULL;
file = Which(buf, tmp);
#if __unix__ /* argv[0] can be an #! script! */
#if __unix__ /* argv[0] can be an #! script! */
if ( file )
{ int n, fd;
char buf[MAXPATHLEN];
@ -2532,14 +2508,8 @@ findExecutable(const char *av0, char *buffer)
return strcpy(buffer, file ? file : buf);
}
#endif /*__WINDOWS__*/
#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
#define PATHSEP ';'
#else
/* not Windows, must be a Linux-like thingy */
#ifdef __unix__
static char *
okToExec(const char *s)
{ statstruct stbuff;
@ -2552,6 +2522,11 @@ okToExec(const char *s)
return (char *) NULL;
}
#define PATHSEP ':'
#endif /* __unix__ */
#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
#define PATHSEP ';'
#endif
#ifdef EXEC_EXTENSIONS
@ -2636,6 +2611,7 @@ Which(const char *program, char *fullname)
return NULL;
}
#endif /*__WINDOWS__*/
/** int Pause(double time)

8
os/pl-privitf.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -173,7 +173,7 @@ unifyList(term_t term, list_ctx *ctx)
a = valTermRef(term);
deRef(a);
if ( !unify_ptrs(a, ctx->lp PASS_LD) )
if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}
@ -191,13 +191,13 @@ unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
a = valTermRef(head);
deRef(a);
if ( !unify_ptrs(a, ctx->lp PASS_LD) )
if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}
a = valTermRef(tail);
deRef(a);
if ( !unify_ptrs(a, ctx->gstore PASS_LD) )
if ( !unify_ptrs(a, ctx->gstore, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}

215
os/pl-prologflag.c

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.wielemaker@uva.nl
E-mail: J.wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2008, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/*#define O_DEBUG 1*/
@ -76,10 +75,10 @@ too much.
static void setArgvPrologFlag(void);
#endif
static void setTZPrologFlag(void);
#ifndef __YAP_PROLOG__
static void setVersionPrologFlag(void);
#endif
static atom_t lookupAtomFlag(atom_t key);
static void initPrologFlagTable(void);
typedef struct _prolog_flag
{ short flags; /* Type | Flags */
@ -138,7 +137,7 @@ setPrologFlag(const char *name, int flags, ...)
if ( flags & FF_KEEP )
return;
} else
{ f = allocHeap(sizeof(*f));
{ f = allocHeapOrHalt(sizeof(*f));
f->index = -1;
f->flags = flags;
addHTable(GD->prolog_flag.table, (void *)an, f);
@ -155,7 +154,8 @@ setPrologFlag(const char *name, int flags, ...)
val = (f->value.a == ATOM_true);
} else if ( !s ) /* 1st definition */
{ f->index = indexOfBoolMask(mask);
DEBUG(2, Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
DEBUG(MSG_PROLOG_FLAG,
Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
}
f->value.a = (val ? ATOM_true : ATOM_false);
@ -211,12 +211,20 @@ setPrologFlag(const char *name, int flags, ...)
}
static void
freePrologFlag(prolog_flag *f)
{ if ( (f->flags & FT_MASK) == FT_TERM )
PL_erase(f->value.t);
freeHeap(f, sizeof(*f));
}
#ifdef O_PLMT
static void
copySymbolPrologFlagTable(Symbol s)
{ GET_LD
prolog_flag *f = s->value;
prolog_flag *copy = allocHeap(sizeof(*copy));
{ prolog_flag *f = s->value;
prolog_flag *copy = allocHeapOrHalt(sizeof(*copy));
*copy = *f;
if ( (f->flags & FT_MASK) == FT_TERM )
@ -227,13 +235,7 @@ copySymbolPrologFlagTable(Symbol s)
static void
freeSymbolPrologFlagTable(Symbol s)
{ GET_LD
prolog_flag *f = s->value;
if ( (f->flags & FT_MASK) == FT_TERM )
PL_erase(f->value.t);
freeHeap(f, sizeof(*f));
{ freePrologFlag(s->value);
}
#endif
@ -267,25 +269,34 @@ setDoubleQuotes(atom_t a, unsigned int *flagp)
static int
setUnknown(atom_t a, unsigned int *flagp)
{ unsigned int flags;
setUnknown(term_t value, atom_t a, Module m)
{ unsigned int flags = m->flags & ~(UNKNOWN_MASK);
if ( a == ATOM_error )
flags = UNKNOWN_ERROR;
flags |= UNKNOWN_ERROR;
else if ( a == ATOM_warning )
flags = UNKNOWN_WARNING;
flags |= UNKNOWN_WARNING;
else if ( a == ATOM_fail )
flags = UNKNOWN_FAIL;
flags |= UNKNOWN_FAIL;
else
{ GET_LD
term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value);
if ( !(flags&UNKNOWN_ERROR) && (m == MODULE_user || m == MODULE_system) )
{ GET_LD
if ( m == MODULE_system && !SYSTEM_MODE )
{ term_t key = PL_new_term_ref();
PL_put_atom(key, ATOM_unknown);
return PL_error(NULL, 0, NULL, ERR_PERMISSION,
ATOM_modify, ATOM_flag, key);
}
if ( !SYSTEM_MODE )
printMessage(ATOM_warning, PL_CHARS, "unknown_in_module_user");
}
*flagp &= ~(UNKNOWN_MASK);
*flagp |= flags;
m->flags = flags;
succeed;
}
@ -308,6 +319,21 @@ setWriteAttributes(atom_t a)
}
static int
setAccessLevelFromAtom(atom_t a)
{ GET_LD
if ( getAccessLevelMask(a, &LD->prolog_flag.access_level) )
{ succeed;
} else
{ term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_access_level, value);
}
}
static int
getOccursCheckMask(atom_t a, occurs_check_t *val)
{ if ( a == ATOM_false )
@ -357,6 +383,30 @@ setEncoding(atom_t a)
}
static int
setStreamTypeCheck(atom_t a)
{ GET_LD
st_check check;
if ( a == ATOM_false )
check = ST_FALSE;
else if ( a == ATOM_loose )
check = ST_LOOSE;
else if ( a == ATOM_true )
check = ST_TRUE;
else
{ term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_type_check, value);
}
LD->IO.stream_type_check = check;
return TRUE;
}
static word
set_prolog_flag_unlocked(term_t key, term_t value, int flags)
{ GET_LD
@ -385,7 +435,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
#ifdef O_PLMT
if ( GD->statistics.threads_created > 1 )
{ prolog_flag *f2 = allocHeap(sizeof(*f2));
{ prolog_flag *f2 = allocHeapOrHalt(sizeof(*f2));
*f2 = *f;
if ( (f2->flags & FT_MASK) == FT_TERM )
@ -399,7 +449,8 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
}
addHTable(LD->prolog_flag.table, (void *)k, f2);
DEBUG(1, Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
DEBUG(MSG_PROLOG_FLAG,
Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
f = f2;
}
#endif
@ -411,7 +462,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
anyway:
PL_register_atom(k);
f = allocHeap(sizeof(*f));
f = allocHeapOrHalt(sizeof(*f));
f->index = -1;
switch( (flags & FT_MASK) )
@ -437,8 +488,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
goto wrong_type;
}
if ( !(f->value.t = PL_record(value)) )
goto wrong_type;
f->value.t = PL_record(value);
{ freeHeap(f, sizeof(*f));
return FALSE;
}
}
break;
}
@ -483,7 +535,10 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
if ( (flags & FF_READONLY) )
f->flags |= FF_READONLY;
addHTable(GD->prolog_flag.table, (void *)k, f);
if ( !addHTable(GD->prolog_flag.table, (void *)k, f) )
{ freePrologFlag(f);
Sdprintf("OOPS; failed to set Prolog flag!?\n");
}
succeed;
} else
@ -516,9 +571,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
#ifndef __YAP_PROLOG__
if ( k == ATOM_character_escapes )
{ if ( val )
set(m, CHARESCAPE);
set(m, M_CHARESCAPE);
else
clear(m, CHARESCAPE);
clear(m, M_CHARESCAPE);
} else if ( k == ATOM_debug )
{ if ( val )
{ debugmode(DBG_ALL, NULL);
@ -551,15 +606,19 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
if ( k == ATOM_double_quotes )
{ rval = setDoubleQuotes(a, &m->flags);
} else if ( k == ATOM_unknown )
{ rval = setUnknown(a, &m->flags);
{ rval = setUnknown(value, a, m);
} else if ( k == ATOM_write_attributes )
{ rval = setWriteAttributes(a);
} else if ( k == ATOM_occurs_check )
{ rval = setOccursCheck(a);
} else
} else if ( k == ATOM_access_level )
{ rval = setAccessLevelFromAtom(a);
} else
#endif
if ( k == ATOM_encoding )
{ rval = setEncoding(a);
} else if ( k == ATOM_stream_type_check )
{ rval = setStreamTypeCheck(a);
}
if ( !rval )
fail;
@ -705,7 +764,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
#ifndef __YAP_PROLOG__
if ( key == ATOM_character_escapes )
{ atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false);
{ atom_t v = (true(m, M_CHARESCAPE) ? ATOM_true : ATOM_false);
return PL_unify_atom(val, v);
} else if ( key == ATOM_double_quotes )
@ -736,6 +795,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
break;
default:
assert(0);
return FALSE;
}
return PL_unify_atom(val, v);
@ -747,6 +807,14 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
{ return PL_unify_bool_ex(val, debugstatus.debugging);
} else if ( key == ATOM_debugger_show_context )
{ return PL_unify_bool_ex(val, debugstatus.showContext);
} else if ( key == ATOM_break_level )
{ int bl = currentBreakLevel();
if ( bl >= 0 )
return PL_unify_integer(val, bl);
return FALSE;
} else if ( key == ATOM_access_level )
{ return PL_unify_atom(val, accessLevel());
}
#endif /* YAP_PROLOG */
@ -861,7 +929,7 @@ pl_prolog_flag5(term_t key, term_t value,
fail;
} else if ( PL_is_variable(key) )
{ e = allocHeap(sizeof(*e));
{ e = allocHeapOrHalt(sizeof(*e));
e->module = module;
@ -965,7 +1033,7 @@ pl_prolog_flag(term_t name, term_t value, control_t h)
#define SO_PATH "LD_LIBRARY_PATH"
#endif
void
static void
initPrologFlagTable(void)
{ if ( !GD->prolog_flag.table )
{
@ -973,7 +1041,7 @@ initPrologFlagTable(void)
initPrologThreads(); /* may be called before PL_initialise() */
#endif
GD->prolog_flag.table = newHTable(32);
GD->prolog_flag.table = newHTable(64);
}
}
@ -983,7 +1051,7 @@ initPrologFlags(void)
{ GET_LD
#ifndef __YAP_PROLOG__
setPrologFlag("iso", FT_BOOL, FALSE, PLFLAG_ISO);
setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH);
setPrologFlag("arch", FT_ATOM|FF_READONLY, PLARCH);
#if __WINDOWS__
setPrologFlag("windows", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
@ -996,12 +1064,17 @@ initPrologFlags(void)
#if defined(HAVE_GETPID) || defined(EMULATE_GETPID)
setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid());
#endif
setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
setPrologFlag("generate_debug_info", FT_BOOL,
truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL);
setPrologFlag("c_libs", FT_ATOM|FF_READONLY, C_LIBS);
setPrologFlag("c_cc", FT_ATOM|FF_READONLY, C_CC);
setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS);
setPrologFlag("warn_override_implicit_import", FT_BOOL, TRUE,
PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT);
setPrologFlag("c_cc", FT_ATOM, C_CC);
setPrologFlag("c_libs", FT_ATOM, C_LIBS);
setPrologFlag("c_libplso", FT_ATOM, C_LIBPLSO);
setPrologFlag("c_ldflags", FT_ATOM, C_LDFLAGS);
setPrologFlag("c_cflags", FT_ATOM, C_CFLAGS);
#if defined(O_LARGEFILES) || SIZEOF_LONG == 8
setPrologFlag("large_files", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
@ -1041,6 +1114,7 @@ initPrologFlags(void)
setPrologFlag("debug_on_error", FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
setPrologFlag("report_error", FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
#endif
setPrologFlag("break_level", FT_INTEGER|FF_READONLY, 0, 0);
setPrologFlag("user_flags", FT_ATOM, "silent");
setPrologFlag("editor", FT_ATOM, "default");
setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
@ -1065,28 +1139,39 @@ initPrologFlags(void)
setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
setPrologFlag("answer_format", FT_ATOM, "~p");
setPrologFlag("colon_sets_calling_context", FT_BOOL, TRUE, 0);
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING);
setPrologFlag("write_attributes", FT_ATOM, "ignore");
setPrologFlag("stream_type_check", FT_ATOM, "loose");
setPrologFlag("occurs_check", FT_ATOM, "false");
setPrologFlag("access_level", FT_ATOM, "user");
setPrologFlag("double_quotes", FT_ATOM, "codes");
setPrologFlag("unknown", FT_ATOM, "error");
setPrologFlag("debug", FT_BOOL, FALSE, 0);
setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal");
setPrologFlag("verbose_load", FT_BOOL, TRUE, 0);
setPrologFlag("verbose_load", FT_ATOM, "normal");
setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0);
setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0);
setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
ALLOW_VARNAME_FUNCTOR);
setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0);
setPrologFlag("toplevel_prompt", FT_ATOM, "~m~d~l~! ?- ");
setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
#ifdef __unix__
setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
setPrologFlag("tty_control", FT_BOOL,
truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
setPrologFlag("signals", FT_BOOL|FF_READONLY,
truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0);
#if defined(__WINDOWS__) && defined(_DEBUG)
setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug");
@ -1117,14 +1202,14 @@ initPrologFlags(void)
setTZPrologFlag();
#ifndef __YAP_PROLOG__
setOSPrologFlags();
setVersionPrologFlag();
#endif /* YAP_PROLOG */
setVersionPrologFlag();
}
#ifndef __YAP_PROLOG__
static void
setArgvPrologFlag()
setArgvPrologFlag(void)
{ GET_LD
fid_t fid = PL_open_foreign_frame();
term_t e = PL_new_term_ref();
@ -1148,14 +1233,12 @@ setArgvPrologFlag()
#endif
static void
setTZPrologFlag()
setTZPrologFlag(void)
{ tzset();
setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone);
}
#ifndef __YAP_PROLOG__
static void
setVersionPrologFlag(void)
{ GET_LD
@ -1166,7 +1249,7 @@ setVersionPrologFlag(void)
int patch = (PLVERSION%100);
if ( !PL_unify_term(t,
PL_FUNCTOR_CHARS, "swi", 4,
PL_FUNCTOR_CHARS, PLNAME, 4,
PL_INT, major,
PL_INT, minor,
PL_INT, patch,
@ -1178,7 +1261,21 @@ setVersionPrologFlag(void)
setGITVersion();
}
#endif /* YAP_PROLOG */
void
cleanupPrologFlags(void)
{ if ( GD->prolog_flag.table )
{ Table t = GD->prolog_flag.table;
GD->prolog_flag.table = NULL;
#ifdef O_PLMT
t->free_symbol = freeSymbolPrologFlagTable;
#endif
destroyHTable(t);
}
}
/*******************************
* PUBLISH PREDICATES *
*******************************/

2
os/pl-read.c

@ -943,7 +943,7 @@ pl_raw_read2(term_t from, term_t term)
int chr;
PL_chars_t txt;
if ( !getInputStream(from, &in) )
if ( !getTextInputStream(from, &in) )
fail;
init_read_data(&rd, in PASS_LD);

75
os/pl-rl.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -40,12 +40,14 @@ SWI-Prolog.h and SWI-Stream.h
#include "SWI-Stream.h"
#include "SWI-Prolog.h"
#if defined(__WINDOWS__) && !defined(__YAP_PROLOG__)
#ifdef __WINDOWS__
#ifndef __YAP_PROLOG__
#ifdef WIN64
#include "config/win64.h"
#else
#include "config/win32.h"
#endif
#endif
#else
#include <config.h>
#endif
@ -102,7 +104,6 @@ extern void add_history(char *); /* should be in readline.h */
extern int rl_begin_undo_group(void); /* delete when conflict arrises! */
extern int rl_end_undo_group(void);
extern Function *rl_event_hook;
#ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION
#define rl_filename_completion_function filename_completion_function
extern char *filename_completion_function(const char *, int);
@ -368,7 +369,6 @@ input_on_fd(int fd)
return select(fd+1, &rfds, NULL, NULL, &tv) != 0;
}
static int
event_hook(void)
{ if ( Sinput->position )
@ -487,9 +487,8 @@ Sread_readline(void *handle, char *buf, size_t size)
rl_prep_terminal(FALSE);
rl_readline_state = state;
rl_done = 0;
} else {
} else
line = pl_readline(prompt);
}
in_readline--;
if ( my_prompt )
@ -515,31 +514,26 @@ Sread_readline(void *handle, char *buf, size_t size)
}
}
#ifdef HAVE_CLOCK
PL_clock_wait_ticks(clock() - oldclock);
#endif
return rval;
}
static int
prolog_complete(int ignore, int key)
{
if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' )
{ rl_begin_undo_group();
rl_complete(ignore, key);
if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' )
{
{ if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' )
{ rl_begin_undo_group();
rl_complete(ignore, key);
if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' )
{
#ifdef HAVE_RL_INSERT_CLOSE /* actually version >= 1.2 */
rl_delete_text(rl_point-1, rl_point);
rl_point -= 1;
rl_delete_text(rl_point-1, rl_point);
rl_point -= 1;
#else
rl_delete(-1, key);
rl_delete(-1, key);
#endif
}
rl_end_undo_group();
} else
}
rl_end_undo_group();
} else
rl_complete(ignore, key);
return 0;
@ -551,7 +545,12 @@ atom_generator(const char *prefix, int state)
{ char *s = PL_atom_generator(prefix, state);
if ( s )
return strcpy(PL_malloc(1 + strlen(s)), s);
{ char *copy = malloc(1 + strlen(s));
if ( copy ) /* else pretend no completion */
strcpy(copy, s);
s = copy;
}
return s;
}
@ -574,20 +573,26 @@ prolog_completion(const char *text, int start, int end)
#undef read /* UXNT redefinition */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
For some obscure reasons, notably libreadline 6 can show very bad
interactive behaviour. There is a timeout set to 100000 (0.1 sec). It
isn't particularly clear what this timeout is doing. I _think_ it should
be synchronized PL_dispatch_hook(), and set to 0 if this hook is
non-null.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
install_t
PL_install_readline(void)
{ GET_LD
bool old;
access_level_t alevel;
#ifndef __WINDOWS__
if ( !truePrologFlag(PLFLAG_TTY_CONTROL) || !isatty(0) )
return;
#endif
old = systemMode(TRUE);
#if HAVE_DECL_RL_CATCH_SIGNALS
alevel = setAccessLevel(ACCESS_LEVEL_SYSTEM);
rl_catch_signals = 0;
#endif
rl_readline_name = "Prolog";
rl_attempted_completion_function = prolog_completion;
#ifdef __WINDOWS__
@ -599,6 +604,9 @@ PL_install_readline(void)
#if HAVE_RL_INSERT_CLOSE
rl_add_defun("insert-close", rl_insert_close, ')');
#endif
#if HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT /* see (*) */
rl_set_keyboard_input_timeout(20000);
#endif
GD->os.rl_functions = *Sinput->functions; /* structure copy */
GD->os.rl_functions.read = Sread_readline; /* read through readline */
@ -607,14 +615,17 @@ PL_install_readline(void)
Soutput->functions = &GD->os.rl_functions;
Serror->functions = &GD->os.rl_functions;
PL_register_foreign("rl_read_init_file", 1, pl_rl_read_init_file, 0);
PL_register_foreign("rl_add_history", 1, pl_rl_add_history, PL_FA_NOTRACE);
PL_register_foreign("rl_write_history", 1, pl_rl_write_history, 0);
PL_register_foreign("rl_read_history", 1, pl_rl_read_history, 0);
#define PRED(name, arity, func, attr) \
PL_register_foreign_in_module("system", name, arity, func, attr)
PRED("rl_read_init_file", 1, pl_rl_read_init_file, 0);
PRED("rl_add_history", 1, pl_rl_add_history, PL_FA_NOTRACE);
PRED("rl_write_history", 1, pl_rl_write_history, 0);
PRED("rl_read_history", 1, pl_rl_read_history, 0);
PL_set_prolog_flag("readline", PL_BOOL, TRUE);
PL_set_prolog_flag("tty_control", PL_BOOL, TRUE);
PL_license("gpl", "GNU Readline library");
systemMode(old);
setAccessLevel(alevel);
}
#else /*HAVE_LIBREADLINE*/

528
os/pl-stream.c Normal file → Executable file

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2009, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,21 +18,24 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#if defined(__WINDOWS__)||defined(__WIN32)
#include <windows/uxnt.h>
#ifndef _YAP_NOT_INSTALLED_
#ifdef WIN64
#define MD "config/win64.h"
#if defined(__WINDOWS__)|| defined(__WIN32)
#include "windows/uxnt.h"
#ifdef _YAP_NOT_INSTALLED_
#include <config.h>
#else
#define MD "config/win32.h"
#ifdef WIN64
#include "config/win64.h"
#else
#include "config/win32.h"
#endif
#endif
#include <winsock2.h>
#include "windows/mswchar.h"
#define CRLF_MAPPING 1
#else
#include <config.h>
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -48,12 +50,6 @@ recursive locks. If a stream handle might be known to another thread
locking is required.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef MD
#include MD
#else
#include <config.h>
#endif
#if _FILE_OFFSET_BITS == 64 || defined(_LARGE_FILES)
#define O_LARGEFILES 1 /* use for conditional code in Prolog */
#else
@ -62,8 +58,9 @@ locking is required.
#define PL_KERNEL 1
#include <wchar.h>
typedef wchar_t pl_wchar_t;
#define NEEDS_SWINSOCK
#include "SWI-Stream.h"
#include "SWI-Prolog.h"
#include "pl-utf8.h"
#include <sys/types.h>
#ifdef HAVE_SYS_TIME_H
@ -104,7 +101,7 @@ typedef wchar_t pl_wchar_t;
#endif
#define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
#define UNDO_SIZE ROUND(MB_LEN_MAX, sizeof(wchar_t))
#define UNDO_SIZE ROUND(PL_MB_LEN_MAX, sizeof(wchar_t))
#ifndef FALSE
#define FALSE 0
@ -127,7 +124,7 @@ static int S__seterror(IOSTREAM *s);
#ifdef O_PLMT
#define SLOCK(s) if ( s->mutex ) recursiveMutexLock(s->mutex)
#define SUNLOCK(s) if ( s->mutex ) recursiveMutexUnlock(s->mutex)
static inline int
inline int
STRYLOCK(IOSTREAM *s)
{ if ( s->mutex &&
recursiveMutexTryLock(s->mutex) == EBUSY )
@ -141,13 +138,9 @@ STRYLOCK(IOSTREAM *s)
#define STRYLOCK(s) (TRUE)
#endif
typedef void *record_t;
typedef void *Module;
typedef intptr_t term_t;
typedef intptr_t atom_t;
#include "pl-error.h"
extern int fatalError(const char *fm, ...);
extern int fatalError(const char *fm, ...);
extern int PL_handle_signals(void);
extern IOENC initEncoding(void);
extern int reportStreamError(IOSTREAM *s);
@ -368,6 +361,69 @@ Sunlock(IOSTREAM *s)
}
/*******************************
* TIMEOUT *
*******************************/
#ifdef HAVE_SELECT
#ifndef __WINDOWS__
typedef int SOCKET;
#define INVALID_SOCKET -1
#define Swinsock(s) Sfileno(s)
#define NFDS(n) (n+1)
#else
#define NFDS(n) (0) /* 1st arg of select is ignored */
#endif
static int
S__wait(IOSTREAM *s)
{ SOCKET fd = Swinsock(s);
fd_set wait;
struct timeval time;
int rc;
if ( fd == INVALID_SOCKET )
{ errno = EPERM; /* no permission to select */
s->flags |= SIO_FERR;
return -1;
}
time.tv_sec = s->timeout / 1000;
time.tv_usec = (s->timeout % 1000) * 1000;
FD_ZERO(&wait);
FD_SET(fd, &wait);
for(;;)
{ if ( (s->flags & SIO_INPUT) )
rc = select(NFDS(fd), &wait, NULL, NULL, &time);
else
rc = select(NFDS(fd), NULL, &wait, NULL, &time);
if ( rc < 0 && errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ errno = EPLEXCEPTION;
return -1;
}
continue;
}
break;
}
if ( rc == 0 )
{ s->flags |= (SIO_TIMEOUT|SIO_FERR);
return -1;
}
return 0; /* ok, data available */
}
#endif /*HAVE_SELECT*/
/*******************************
* FLUSH/FILL *
*******************************/
@ -385,7 +441,18 @@ S__flushbuf(IOSTREAM *s)
while ( from < to )
{ size_t size = (size_t)(to - from);
ssize_t n = (*s->functions->write)(s->handle, from, size);
ssize_t n;
#ifdef HAVE_SELECT
s->flags &= ~SIO_TIMEOUT;
if ( s->timeout >= 0 )
{ if ( (rc=S__wait(s)) < 0 )
goto partial;
}
#endif
n = (*s->functions->write)(s->handle, from, size);
if ( n > 0 ) /* wrote some */
{ from += n;
@ -398,6 +465,9 @@ S__flushbuf(IOSTREAM *s)
}
}
#ifdef HAVE_SELECT
partial:
#endif
if ( to == from ) /* full flush */
{ rc = s->bufp - s->buffer;
s->bufp = s->buffer;
@ -442,52 +512,6 @@ S__flushbufc(int c, IOSTREAM *s)
}
static int
Swait_for_data(IOSTREAM *s)
{ int fd = Sfileno(s);
fd_set wait;
struct timeval time;
int rc;
if ( fd < 0 )
{ errno = EPERM; /* no permission to select */
s->flags |= SIO_FERR;
return -1;
}
time.tv_sec = s->timeout / 1000;
time.tv_usec = (s->timeout % 1000) * 1000;
FD_ZERO(&wait);
#ifdef __WINDOWS__
FD_SET((SOCKET)fd, &wait);
#else
FD_SET(fd, &wait);
#endif
for(;;)
{ rc = select(fd+1, &wait, NULL, NULL, &time);
if ( rc < 0 && errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ errno = EPLEXCEPTION;
return -1;
}
continue;
}
break;
}
if ( rc == 0 )
{ s->flags |= (SIO_TIMEOUT|SIO_FERR);
return -1;
}
return 0; /* ok, data available */
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
S__fillbuf() fills the read-buffer, returning the first character of it.
It also realises the SWI-Prolog timeout facility.
@ -497,8 +521,11 @@ int
S__fillbuf(IOSTREAM *s)
{ int c;
if ( s->flags & (SIO_FEOF|SIO_FERR) )
{ s->flags |= SIO_FEOF2; /* reading past eof */
if ( s->flags & (SIO_FEOF|SIO_FERR) ) /* reading past eof */
{ if ( s->flags & SIO_FEOF2ERR )
s->flags |= (SIO_FEOF2|SIO_FERR);
else
s->flags |= SIO_FEOF2;
return -1;
}
@ -508,7 +535,7 @@ S__fillbuf(IOSTREAM *s)
if ( s->timeout >= 0 && !s->downstream )
{ int rc;
if ( (rc=Swait_for_data(s)) < 0 )
if ( (rc=S__wait(s)) < 0 )
return rc;
}
#endif
@ -517,7 +544,8 @@ S__fillbuf(IOSTREAM *s)
{ char chr;
ssize_t n;
if ( (n=(*s->functions->read)(s->handle, &chr, 1)) == 1 )
n = (*s->functions->read)(s->handle, &chr, 1);
if ( n == 1 )
{ c = char_to_int(chr);
return c;
} else if ( n == 0 )
@ -548,7 +576,8 @@ S__fillbuf(IOSTREAM *s)
len = s->bufsize;
}
if ( (n=(*s->functions->read)(s->handle, s->limitp, len)) > 0 )
n = (*s->functions->read)(s->handle, s->limitp, len);
if ( n > 0 )
{ s->limitp += n;
c = char_to_int(*s->bufp++);
return c;
@ -777,7 +806,7 @@ put_code(int c, IOSTREAM *s)
}
goto simple;
case ENC_ANSI:
{ char b[MB_LEN_MAX];
{ char b[PL_MB_LEN_MAX];
size_t n;
if ( !s->mbstate )
@ -863,7 +892,10 @@ Sputcode(int c, IOSTREAM *s)
if ( s->tee && s->tee->magic == SIO_MAGIC )
Sputcode(c, s->tee);
if ( c == '\n' && (s->flags&SIO_TEXT) && s->newline == SIO_NL_DOS )
if ( c == '\n' &&
(s->flags&SIO_TEXT) &&
s->newline == SIO_NL_DOS &&
s->lastc != '\r' )
{ if ( put_code('\r', s) < 0 )
return -1;
}
@ -886,7 +918,7 @@ Scanrepresent(int c, IOSTREAM *s)
return -1;
case ENC_ANSI:
{ mbstate_t state;
char b[MB_LEN_MAX];
char b[PL_MB_LEN_MAX];
memset(&state, 0, sizeof(state));
if ( wcrtomb(b, (wchar_t)c, &state) != (size_t)-1 )
@ -1072,14 +1104,15 @@ returns \n, but it returns the same for a single \n.
Often, we could keep track of bufp and reset this, but we must deal with
the case where we fetch a new buffer. In this case, we must copy the few
remaining bytes to the `unbuffer' area.
remaining bytes to the `unbuffer' area. If SIO_USERBUF is set, we do not
have this spare buffer space. This is used for reading from strings,
which cannot fetch a new buffer anyway.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int
Speekcode(IOSTREAM *s)
{ int c;
char *start;
IOPOS *psave = s->position;
size_t safe = (size_t)-1;
if ( !s->buffer )
@ -1094,15 +1127,19 @@ Speekcode(IOSTREAM *s)
if ( (s->flags & SIO_FEOF) )
return -1;
if ( s->bufp + UNDO_SIZE > s->limitp )
if ( s->bufp + UNDO_SIZE > s->limitp && !(s->flags&SIO_USERBUF) )
{ safe = s->limitp - s->bufp;
memcpy(s->buffer-safe, s->bufp, safe);
}
start = s->bufp;
s->position = NULL;
c = Sgetcode(s);
s->position = psave;
if ( s->position )
{ IOPOS psave = *s->position;
c = Sgetcode(s);
*s->position = psave;
} else
{ c = Sgetcode(s);
}
if ( Sferror(s) )
return -1;
@ -1110,7 +1147,7 @@ Speekcode(IOSTREAM *s)
if ( s->bufp > start )
{ s->bufp = start;
} else
} else if ( c != -1 )
{ assert(safe != (size_t)-1);
s->bufp = s->buffer-safe;
}
@ -1341,10 +1378,6 @@ Sfeof(IOSTREAM *s)
return -1;
}
if ( s->downstream != NULL &&
Sfeof(s->downstream))
return TRUE;
if ( S__fillbuf(s) == -1 )
return TRUE;
@ -1440,6 +1473,11 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old)
}
s->encoding = enc;
if ( enc == ENC_OCTET )
s->flags &= ~SIO_TEXT;
else
s->flags |= SIO_TEXT;
return 0;
}
@ -1490,23 +1528,23 @@ Sunit_size(IOSTREAM *s)
Return the size of the underlying data object. Should be optimized;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
long
int64_t
Ssize(IOSTREAM *s)
{ if ( s->functions->control )
{ long size;
{ int64_t size;
if ( (*s->functions->control)(s->handle, SIO_GETSIZE, (void *)&size) == 0 )
return size;
}
if ( s->functions->seek )
{ long here = Stell(s);
long end;
{ int64_t here = Stell64(s);
int64_t end;
if ( Sseek(s, 0, SIO_SEEK_END) == 0 )
end = Stell(s);
if ( Sseek64(s, 0, SIO_SEEK_END) == 0 )
end = Stell64(s);
else
end = -1;
Sseek(s, here, SIO_SEEK_SET);
Sseek64(s, here, SIO_SEEK_SET);
return end;
}
@ -1667,13 +1705,13 @@ unallocStream(IOSTREAM *s)
#ifdef O_PLMT
if ( s->mutex )
{ recursiveMutexDelete(s->mutex);
free(s->mutex);
PL_free(s->mutex);
s->mutex = NULL;
}
#endif
if ( !(s->flags & SIO_STATIC) )
free(s);
PL_free(s);
}
@ -1711,7 +1749,7 @@ Sclose(IOSTREAM *s)
#ifdef __WINDOWS__
if ( (s->flags & SIO_ADVLOCK) )
{ OVERLAPPED ov;
HANDLE h = (HANDLE)_get_osfhandle((int)s->handle);
HANDLE h = (HANDLE)_get_osfhandle((int)((uintptr_t)s->handle));
memset(&ov, 0, sizeof(ov));
UnlockFileEx(h, 0, 0, 0xffffffff, &ov);
@ -1732,9 +1770,9 @@ Sclose(IOSTREAM *s)
if ( rval < 0 )
reportStreamError(s);
run_close_hooks(s); /* deletes Prolog registration */
s->magic = SIO_CMAGIC;
SUNLOCK(s);
s->magic = SIO_CMAGIC;
if ( s->message )
free(s->message);
if ( s->references == 0 )
@ -1845,11 +1883,23 @@ Svprintf(const char *fm, va_list args)
}
#define NEXTCHR(s, c) if ( utf8 ) \
{ (s) = utf8_get_char((s), &(c)); \
} else \
{ c = *(s)++; c &= 0xff; \
}
#define NEXTCHR(s, c) \
switch (enc) \
{ case ENC_ANSI: \
c = *(s)++; c &= 0xff; \
break; \
case ENC_UTF8: \
(s) = utf8_get_char((s), &(c)); \
break; \
case ENC_WCHAR: \
{ wchar_t *_w = (wchar_t*)(s); \
c = *_w++; \
(s) = (char*)_w; \
break; \
} \
default: \
break; \
}
#define OUTCHR(s, c) do { printed++; \
if ( Sputcode((c), (s)) < 0 ) goto error; \
@ -1911,7 +1961,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
char fbuf[100], *fs = fbuf, *fe = fbuf;
int islong = 0;
int pad = ' ';
int utf8 = FALSE;
IOENC enc = ENC_ANSI;
for(;;)
{ switch(*fm)
@ -1952,13 +2002,19 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
{ islong++; /* 1: %ld */
fm++;
}
if ( *fm == 'l' )
{ islong++; /* 2: %lld */
fm++;
}
if ( *fm == 'U' ) /* %Us: UTF-8 string */
{ utf8 = TRUE;
fm++;
switch ( *fm )
{ case 'l':
islong++; /* 2: %lld */
fm++;
break;
case 'U': /* %Us: UTF-8 string */
enc = ENC_UTF8;
fm++;
break;
case 'W': /* %Ws: wide string */
enc = ENC_WCHAR;
fm++;
break;
}
switch(*fm)
@ -1983,41 +2039,53 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
case 'u':
case 'x':
case 'X':
{ intptr_t v = 0; /* make compiler silent */
int64_t vl = 0;
{ int vi = 0;
long vl = 0; /* make compiler silent */
int64_t vll = 0;
char fmbuf[8], *fp=fmbuf;
switch( islong )
{ case 0:
v = va_arg(args, int);
vi = va_arg(args, int);
break;
case 1:
v = va_arg(args, long);
vl = va_arg(args, long);
break;
case 2:
vl = va_arg(args, int64_t);
vll = va_arg(args, int64_t);
break;
default:
assert(0);
}
*fp++ = '%';
if ( modified )
*fp++ = '#';
*fp++ = 'l';
if ( islong < 2 )
{ *fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, v);
} else
{
switch( islong )
{ case 0:
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vi);
break;
case 1:
*fp++ = 'l';
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vl);
break;
case 2:
#ifdef __WINDOWS__
strcat(fp-1, "I64"); /* Synchronise with INT64_FORMAT! */
fp += strlen(fp);
*fp++ = 'I'; /* Synchronise with INT64_FORMAT! */
*fp++ = '6';
*fp++ = '4';
#else
*fp++ = 'l';
*fp++ = 'l';
*fp++ = 'l';
#endif
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vl);
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vll);
break;
}
break;
@ -2075,12 +2143,25 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
{ size_t w;
if ( fs == fbuf )
w = fe - fs;
else
w = strlen(fs);
if ( utf8 )
w = utf8_strlen(fs, w);
{ w = fe - fs;
} else
{ switch(enc)
{ case ENC_ANSI:
w = strlen(fs);
break;
case ENC_UTF8:
w = strlen(fs);
w = utf8_strlen(fs, w);
break;
case ENC_WCHAR:
w = wcslen((wchar_t*)fs);
break;
default:
assert(0);
w = 0; /* make compiler happy */
break;
}
}
if ( (ssize_t)w < arg1 )
{ w = arg1 - w;
@ -2609,7 +2690,7 @@ Scontrol_file(void *handle, int action, void *arg)
switch(action)
{ case SIO_GETSIZE:
{ intptr_t *rval = arg;
{ int64_t *rval = arg;
struct stat buf;
if ( fstat(fd, &buf) == 0 )
@ -2621,6 +2702,11 @@ Scontrol_file(void *handle, int action, void *arg)
case SIO_SETENCODING:
case SIO_FLUSHOUTPUT:
return 0;
case SIO_GETFILENO:
{ int *p = arg;
*p = fd;
return 0;
}
default:
return -1;
}
@ -2662,13 +2748,20 @@ provide the socket-id through Sfileno, this code crashes on
tcp_open_socket(). As ttys and its detection is of no value on Windows
anyway, we skip this. Second, Windows doesn't have fork(), so FD_CLOEXEC
is of no value.
For now, we use PL_malloc_uncollectable(). In the end, this is really
one of the object-types we want to leave to GC.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef FD_CLOEXEC /* This is not defined in MacOS */
#define FD_CLOEXEC 1
#endif
IOSTREAM *
Snew(void *handle, int flags, IOFUNCTIONS *functions)
{ IOSTREAM *s;
if ( !(s = malloc(sizeof(IOSTREAM))) )
if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) )
{ errno = ENOMEM;
return NULL;
}
@ -2680,7 +2773,11 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
s->functions = functions;
s->timeout = -1; /* infinite */
s->posbuf.lineno = 1;
s->encoding = ENC_ISO_LATIN_1;
if ( (flags&SIO_TEXT) )
{ s->encoding = initEncoding();
} else
{ s->encoding = ENC_OCTET;
}
#if CRLF_MAPPING
s->newline = SIO_NL_DOS;
#endif
@ -2688,8 +2785,8 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
s->position = &s->posbuf;
#ifdef O_PLMT
if ( !(flags & SIO_NOMUTEX) )
{ if ( !(s->mutex = malloc(sizeof(recursiveMutex))) )
{ free(s);
{ if ( !(s->mutex = PL_malloc(sizeof(recursiveMutex))) )
{ PL_free(s);
return NULL;
}
recursiveMutexInit(s->mutex);
@ -2701,7 +2798,7 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
if ( (fd = Sfileno(s)) >= 0 )
{ if ( isatty(fd) )
s->flags |= SIO_ISATTY;
#if defined(F_SETFD) && defined(FD_CLOEXEC)
#ifdef F_SETFD
fcntl(fd, F_SETFD, FD_CLOEXEC);
#endif
}
@ -2804,13 +2901,23 @@ Sopen_file(const char *path, const char *how)
struct flock buf;
memset(&buf, 0, sizeof(buf));
buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK);
buf.l_whence = SEEK_SET;
buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK);
if ( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) < 0 )
{ int save = errno;
close(fd);
errno = save;
return NULL;
while( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) != 0 )
{ if ( errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ close(fd);
return NULL;
}
continue;
} else
{ int save = errno;
close(fd);
errno = save;
return NULL;
}
}
#else /* we don't have locking */
#if __WINDOWS__
@ -2891,12 +2998,10 @@ Sfileno(IOSTREAM *s)
if ( s->flags & SIO_FILE )
{ intptr_t h = (intptr_t)s->handle;
n = (int)h;
} else if ( s->flags & SIO_PIPE )
{ n = fileno((FILE *)s->handle);
} else if ( s->functions->control &&
(*s->functions->control)(s->handle,
SIO_GETFILENO,
(void *)&n) == 0 )
(void *)&n) == 0 )
{ ;
} else
{ errno = EINVAL;
@ -2907,6 +3012,30 @@ Sfileno(IOSTREAM *s)
}
#ifdef __WINDOWS__
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
On Windows, type SOCKET is an unsigned int and all values
[0..INVALID_SOCKET) are valid. It is also not allowed to run normal
file-functions on it or the application will crash. There seems to be no
way out except for introducing an extra function at this level :-(
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
SOCKET
Swinsock(IOSTREAM *s)
{ SOCKET n = INVALID_SOCKET;
if ( s->functions->control &&
(*s->functions->control)(s->handle,
SIO_GETWINSOCK,
(void *)&n) == 0 )
{ return n;
}
errno = EINVAL;
return INVALID_SOCKET;
}
#endif
/*******************************
* PIPES *
*******************************/
@ -2915,13 +3044,9 @@ Sfileno(IOSTREAM *s)
#ifdef __WINDOWS__
#include "windows/popen.c"
#ifdef popen
#undef popen
#endif
#define popen(cmd, how) pt_popen(cmd, how)
#ifdef pclose
#undef pclose
#endif
#define popen(cmd, how) pt_popen(cmd, how)
#define pclose(fd) pt_pclose(fd)
#endif
@ -2958,11 +3083,31 @@ Sclose_pipe(void *handle)
}
static int
Scontrol_pipe(void *handle, int action, void *arg)
{ FILE *fp = handle;
switch(action)
{ case SIO_GETFILENO:
{ int *ap = arg;
*ap = fileno(fp);
return 0;
}
case SIO_FLUSHOUTPUT:
case SIO_SETENCODING:
return 0;
default:
return -1;
}
}
IOFUNCTIONS Spipefunctions =
{ Sread_pipe,
Swrite_pipe,
(Sseek_function)0,
Sclose_pipe
Sclose_pipe,
Scontrol_pipe
};
@ -2983,9 +3128,9 @@ Sopen_pipe(const char *command, const char *type)
{ int flags;
if ( *type == 'r' )
flags = SIO_PIPE|SIO_INPUT|SIO_FBUF;
flags = SIO_INPUT|SIO_FBUF;
else
flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF;
flags = SIO_OUTPUT|SIO_FBUF;
return Snew((void *)fd, flags, &Spipefunctions);
}
@ -3229,12 +3374,20 @@ Sopenmem(char **buffer, size_t *sizep, const char *mode)
static ssize_t
Sread_string(void *handle, char *buf, size_t size)
{ return 0; /* signal EOF */
{ (void)handle;
(void)buf;
(void)size;
return 0; /* signal EOF */
}
static ssize_t
Swrite_string(void *handle, char *buf, size_t size)
{ errno = ENOSPC; /* signal error */
{ (void)handle;
(void)buf;
(void)size;
errno = ENOSPC; /* signal error */
return -1;
}
@ -3267,7 +3420,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
{ int flags = SIO_FBUF|SIO_USERBUF;
if ( !s )
{ if ( !(s = malloc(sizeof(IOSTREAM))) )
{ if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) ) /* TBD: Use GC */
{ errno = ENOMEM;
return NULL;
}
@ -3310,7 +3463,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
#define STDIO(n, f) { NULL, NULL, NULL, NULL, \
EOF, SIO_MAGIC, 0, f, {0, 0, 0}, NULL, \
((void *)(n)), &Sttyfunctions, \
(void *)(n), &Sttyfunctions, \
0, NULL, \
(void (*)(void *))0, NULL, \
-1, \
@ -3321,7 +3474,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
#define SIO_STDIO (SIO_FILE|SIO_STATIC|SIO_NOCLOSE|SIO_ISATTY|SIO_TEXT)
#define STDIO_STREAMS \
STDIO(0, SIO_STDIO|SIO_LBUF|SIO_INPUT|SIO_NOFEOF), /* Sinput */ \
STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \
STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \
STDIO(2, SIO_STDIO|SIO_NBUF|SIO_OUTPUT|SIO_REPPL) /* Serror */
@ -3335,31 +3488,33 @@ static const IOSTREAM S__iob0[] =
};
/* vsc: Scleanup should reset init done */
static int done;
static int S__initialised = FALSE;
void
SinitStreams(void)
{
if ( !done++ )
{ if ( !S__initialised )
{ int i;
IOENC enc = initEncoding();
IOENC enc;
S__initialised = TRUE;
enc = initEncoding();
for(i=0; i<=2; i++)
{ if ( !isatty(i) )
{ S__iob[i].flags &= ~SIO_ISATTY;
S__iob[i].functions = &Sfilefunctions; /* Check for pipe? */
{ IOSTREAM *s = &S__iob[i];
if ( !isatty(i) )
{ s->flags &= ~SIO_ISATTY;
s->functions = &Sfilefunctions; /* Check for pipe? */
}
if ( S__iob[i].encoding == ENC_ISO_LATIN_1 )
S__iob[i].encoding = enc;
if ( s->encoding == ENC_ISO_LATIN_1 )
s->encoding = enc;
#ifdef O_PLMT
S__iob[i].mutex = malloc(sizeof(recursiveMutex));
recursiveMutexInit(S__iob[i].mutex);
s->mutex = PL_malloc(sizeof(recursiveMutex));
recursiveMutexInit(s->mutex);
#endif
#if CRLF_MAPPING
_setmode(i, O_BINARY);
S__iob[i].newline = SIO_NL_DOS;
s->newline = SIO_NL_DOS;
#endif
}
@ -3371,7 +3526,7 @@ SinitStreams(void)
IOSTREAM *
S__getiob()
S__getiob(void)
{ return S__iob;
}
@ -3461,11 +3616,12 @@ Scleanup(void)
S__iob[i].mutex = NULL;
recursiveMutexDelete(m);
free(m);
PL_free(m);
}
#endif
*s = S__iob0[i]; /* re-initialise */
}
done = 0;
S__initialised = FALSE;
}

48
os/pl-string.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -34,45 +34,10 @@ String operations that are needed for the shared IO library.
* ALLOCATION *
*******************************/
#ifdef O_DEBUG
#define CHAR_INUSE 0x42
#define CHAR_FREED 0x41
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+2);
*copy++ = CHAR_INUSE;
strcpy(copy, s);
return copy;
} else
{ return NULL;
}
}
void
remove_string(char *s)
{ if ( s )
{ GET_LD
assert(s[-1] == CHAR_INUSE);
s[-1] = CHAR_FREED;
freeHeap(s-1, strlen(s)+2);
}
}
#else /*O_DEBUG*/
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+1);
{ char *copy = (char *)allocHeapOrHalt(strlen(s)+1);
strcpy(copy, s);
return copy;
@ -85,14 +50,9 @@ store_string(const char *s)
void
remove_string(char *s)
{ if ( s )
{ GET_LD
freeHeap(s, strlen(s)+1);
}
}
#endif /*O_DEBUG*/
/*******************************
* NUMBERS *
*******************************/
@ -239,13 +199,13 @@ int_mbscoll(const char *s1, const char *s2, int icase)
if ( l1 < 1024 && (w1 = alloca(sizeof(wchar_t)*(l1+1))) )
{ ml1 = FALSE;
} else
{ w1 = PL_malloc(sizeof(wchar_t)*(l1+1));
{ w1 = PL_malloc_atomic(sizeof(wchar_t)*(l1+1));
ml1 = TRUE;
}
if ( l2 < 1024 && (w2 = alloca(sizeof(wchar_t)*(l2+1))) )
{ ml2 = FALSE;
} else
{ w2 = PL_malloc(sizeof(wchar_t)*(l2+1));
{ w2 = PL_malloc_atomic(sizeof(wchar_t)*(l2+1));
ml2 = TRUE;
}

4
os/pl-string.h Normal file → Executable file

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef PL_STRING_H_INCLUDED
@ -27,7 +27,7 @@
COMMON(char *) store_string(const char *s);
COMMON(void) remove_string(char *s);
COMMON(char) digitName(int n, int smll);
//COMMON(char) digitName(int n, int small);
COMMON(int) digitValue(int b, int c);
COMMON(bool) strprefix(const char *string, const char *prefix);
COMMON(bool) strpostfix(const char *string, const char *postfix);

176
os/pl-table.c

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/*#define O_DEBUG 1*/
@ -41,35 +40,35 @@ create, advance over and destroy enumerator objects. These objects are
used to enumerate the symbols of these tables, used primarily for the
pl_current_* predicates.
The enumerators cause two things: (1) as intptr_t enumerators are
The enumerators cause two things: (1) as long as enumerators are
associated, the table will not be rehashed and (2) if symbols are
deleted that are referenced by an enumerator, the enumerator is
automatically advanced to the next free symbol. This, in general, makes
automatically advanced to the next free symbol. This, in general, makes
the enumeration of hash-tables safe.
TODO: abort should delete any pending enumerators. This should be
thread-local, as thread_exit/1 should do the same.
TBD: Resizing hash-tables causes major headaches for concurrent access.
We can avoid this by using a dynamic array for the list of hash-entries.
Ongoing work in the RDF store shows hash-tables that can handle
concurrent lock-free access.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
allocHTableEntries(Table ht)
{ GET_LD
int n;
static Symbol *
allocHTableEntries(int buckets)
{ size_t bytes = buckets * sizeof(Symbol);
Symbol *p;
ht->entries = allocHeap(ht->buckets * sizeof(Symbol));
p = allocHeapOrHalt(bytes);
memset(p, 0, bytes);
for(n=0, p = &ht->entries[0]; n < ht->buckets; n++, p++)
*p = NULL;
return p;
}
Table
newHTable(int buckets)
{ GET_LD
Table ht;
{ Table ht;
ht = allocHeap(sizeof(struct table));
ht = allocHeapOrHalt(sizeof(struct table));
ht->buckets = (buckets & ~TABLE_MASK);
ht->size = 0;
ht->enumerators = NULL;
@ -79,25 +78,24 @@ newHTable(int buckets)
if ( (buckets & TABLE_UNLOCKED) )
ht->mutex = NULL;
else
{ ht->mutex = allocHeap(sizeof(simpleMutex));
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
allocHTableEntries(ht);
ht->entries = allocHTableEntries(ht->buckets);
return ht;
}
void
destroyHTable(Table ht)
{ GET_LD
{
#ifdef O_PLMT
if ( ht->mutex )
{ simpleMutexDelete(ht->mutex);
freeHeap(ht->mutex, sizeof(*ht->mutex));
ht->mutex = NULL;
ht->mutex = NULL;
}
#endif
@ -107,19 +105,19 @@ destroyHTable(Table ht)
}
#if O_DEBUG || O_HASHSTAT
#define HASHSTAT(c) c
#if O_DEBUG
static int lookups;
static int cmps;
void
exitTables(int status, void *arg)
{ Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
{ (void)status;
(void)arg;
Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
lookups, cmps);
}
#else
#define HASHSTAT(c)
#endif /*O_DEBUG*/
#endif
void
@ -129,7 +127,7 @@ initTables(void)
if ( !done )
{ done = TRUE;
HASHSTAT(PL_on_halt(exitTables, NULL));
DEBUG(MSG_HASH_STAT, PL_on_halt(exitTables, NULL));
}
}
@ -138,9 +136,9 @@ Symbol
lookupHTable(Table ht, void *name)
{ Symbol s = ht->entries[pointerHashValue(name, ht->buckets)];
HASHSTAT(lookups++);
DEBUG(MSG_HASH_STAT, lookups++);
for( ; s; s = s->next)
{ HASHSTAT(cmps++);
{ DEBUG(MSG_HASH_STAT, cmps++);
if ( s->name == name )
return s;
}
@ -170,41 +168,79 @@ checkHTable(Table ht)
/* MT: Locked by calling addHTable()
*/
static void
rehashHTable(Table ht)
{ GET_LD
Symbol *oldtab;
int oldbucks;
int i;
static Symbol
rehashHTable(Table ht, Symbol map)
{ Symbol *newentries, *oldentries;
int newbuckets, oldbuckets;
int i;
#ifdef O_PLMT
int safe_copy = (ht->mutex != NULL);
#else
int safe_copy = TRUE;
#endif
oldtab = ht->entries;
oldbucks = ht->buckets;
ht->buckets *= 2;
allocHTableEntries(ht);
newbuckets = ht->buckets*2;
newentries = allocHTableEntries(newbuckets);
DEBUG(1, Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
DEBUG(MSG_HASH_STAT,
Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
for(i=0; i<oldbucks; i++)
for(i=0; i<ht->buckets; i++)
{ Symbol s, n;
for(s=oldtab[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, ht->buckets);
if ( safe_copy )
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
Symbol s2 = allocHeapOrHalt(sizeof(*s2));
n = s->next;
s->next = ht->entries[v];
ht->entries[v] = s;
n = s->next;
if ( s == map )
map = s2;
*s2 = *s;
s2->next = newentries[v];
newentries[v] = s2;
}
} else
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
n = s->next;
s->next = newentries[v];
newentries[v] = s;
}
}
}
freeHeap(oldtab, oldbucks * sizeof(Symbol));
DEBUG(0, checkHTable(ht));
oldentries = ht->entries;
oldbuckets = ht->buckets;
ht->entries = newentries;
ht->buckets = newbuckets;
if ( safe_copy )
{ /* Here we should be waiting until */
/* active lookup are finished */
for(i=0; i<oldbuckets; i++)
{ Symbol s, n;
for(s=oldentries[i]; s; s = n)
{ n = s->next;
s->next = NULL; /* that causes old readers to stop */
freeHeap(s, sizeof(*s));
}
}
}
freeHeap(oldentries, oldbuckets * sizeof(Symbol));
DEBUG(CHK_SECURE, checkHTable(ht));
return map;
}
Symbol
addHTable(Table ht, void *name, void *value)
{ GET_LD
Symbol s;
{ Symbol s;
int v;
LOCK_TABLE(ht);
@ -213,7 +249,7 @@ addHTable(Table ht, void *name, void *value)
{ UNLOCK_TABLE(ht);
return NULL;
}
s = allocHeap(sizeof(struct symbol));
s = allocHeapOrHalt(sizeof(struct symbol));
s->name = name;
s->value = value;
s->next = ht->entries[v];
@ -223,7 +259,7 @@ addHTable(Table ht, void *name, void *value)
ht, name, value, ht->size));
if ( ht->buckets * 2 < ht->size && !ht->enumerators )
rehashHTable(ht);
s = rehashHTable(ht, s);
UNLOCK_TABLE(ht);
DEBUG(1, checkHTable(ht));
@ -237,8 +273,7 @@ Note: s must be in the table!
void
deleteSymbolHTable(Table ht, Symbol s)
{ GET_LD
int v;
{ int v;
Symbol *h;
TableEnum e;
@ -255,6 +290,9 @@ deleteSymbolHTable(Table ht, Symbol s)
{ if ( *h == s )
{ *h = (*h)->next;
s->next = NULL; /* force crash */
s->name = NULL;
s->value = NULL;
freeHeap(s, sizeof(struct symbol));
ht->size--;
@ -268,8 +306,7 @@ deleteSymbolHTable(Table ht, Symbol s)
void
clearHTable(Table ht)
{ GET_LD
int n;
{ int n;
TableEnum e;
LOCK_TABLE(ht);
@ -309,24 +346,23 @@ Table copyHTable(Table org)
Table
copyHTable(Table org)
{ GET_LD
Table ht;
{ Table ht;
int n;
ht = allocHeap(sizeof(struct table));
ht = allocHeapOrHalt(sizeof(struct table));
LOCK_TABLE(org);
*ht = *org; /* copy all attributes */
#ifdef O_PLMT
ht->mutex = NULL;
#endif
allocHTableEntries(ht);
ht->entries = allocHTableEntries(ht->buckets);
for(n=0; n < ht->buckets; n++)
{ Symbol s, *q;
q = &ht->entries[n];
for(s = org->entries[n]; s; s = s->next)
{ Symbol s2 = allocHeap(sizeof(*s2));
{ Symbol s2 = allocHeapOrHalt(sizeof(*s2));
*q = s2;
q = &s2->next;
@ -340,7 +376,7 @@ copyHTable(Table org)
}
#ifdef O_PLMT
if ( org->mutex )
{ ht->mutex = allocHeap(sizeof(simpleMutex));
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
@ -356,8 +392,7 @@ copyHTable(Table org)
TableEnum
newTableEnum(Table ht)
{ GET_LD
TableEnum e = allocHeap(sizeof(struct table_enum));
{ TableEnum e = allocHeapOrHalt(sizeof(struct table_enum));
Symbol n;
LOCK_TABLE(ht);
@ -378,8 +413,7 @@ newTableEnum(Table ht)
void
freeTableEnum(TableEnum e)
{ GET_LD
TableEnum *ep;
{ TableEnum *ep;
Table ht;
if ( !e )

30
os/pl-table.h

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef TABLE_H_INCLUDED
@ -27,7 +27,7 @@
typedef struct table * Table; /* (numeric) hash table */
typedef struct symbol * Symbol; /* symbol of hash table */
typedef struct table_enum * TableEnum; /* Enumerate table entries */
typedef struct table_enum * TableEnum; /* Enumerate table entries */
struct table
{ int buckets; /* size of hash table */
@ -36,8 +36,8 @@ struct table
#ifdef O_PLMT
simpleMutex *mutex; /* Mutex to guard table */
#endif
void (*copy_symbol)(Symbol s);
void (*free_symbol)(Symbol s);
void (*copy_symbol)(Symbol s);
void (*free_symbol)(Symbol s);
Symbol *entries; /* array of hash symbols */
};
@ -54,17 +54,17 @@ struct table_enum
TableEnum next; /* More choice points */
};
COMMON(void) initTables(void);
COMMON(Table) newHTable(int size);
COMMON(void) destroyHTable(Table ht);
COMMON(Symbol) lookupHTable(Table ht, void *name);
COMMON(Symbol) addHTable(Table ht, void *name, void *value);
COMMON(void) deleteSymbolHTable(Table ht, Symbol s);
COMMON(void) clearHTable(Table ht);
COMMON(Table) copyHTable(Table org);
COMMON(TableEnum) newTableEnum(Table ht);
COMMON(void) freeTableEnum(TableEnum e);
COMMON(Symbol) advanceTableEnum(TableEnum e);
COMMON(void) initTables(void);
COMMON(Table) newHTable(int size);
COMMON(void) destroyHTable(Table ht);
COMMON(Symbol) lookupHTable(Table ht, void *name);
COMMON(Symbol) addHTable(Table ht, void *name, void *value);
COMMON(void) deleteSymbolHTable(Table ht, Symbol s);
COMMON(void) clearHTable(Table ht);
COMMON(Table) copyHTable(Table org);
COMMON(TableEnum) newTableEnum(Table ht);
COMMON(void) freeTableEnum(TableEnum e);
COMMON(Symbol) advanceTableEnum(TableEnum e);
#define TABLE_UNLOCKED 0x10000000L /* do not create mutex for table */
#define TABLE_MASK 0xf0000000UL

172
os/pl-tai.c

@ -1,11 +1,9 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2010, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
@ -20,17 +18,10 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS
is supposed to give the POSIX standard one.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if defined(__sun__) || defined(__sun)
#define _POSIX_PTHREAD_SEMANTICS 1
#endif
#define __MINGW_USE_VC2005_COMPAT /* Get Windows time_t as 64-bit */
#include <math.h>
#include "pl-incl.h"
@ -62,37 +53,6 @@ extern long timezone;
#endif
#endif
#if defined(__MINGW32__)
#include <stdlib.h>
#include <time.h>
#include <string.h>
#ifndef localtime_r
struct tm *localtime_r (const time_t *, struct tm *);
struct tm *
localtime_r (const time_t *timer, struct tm *result)
{
struct tm *local_result;
local_result = localtime (timer);
if (local_result == NULL || result == NULL)
return NULL;
memcpy (result, local_result, sizeof (result));
return result;
}
#endif
#ifndef asctime_r
#define asctime_r(_Tm, _Buf) ({ char *___tmp_tm = asctime((_Tm)); \
if (___tmp_tm) \
___tmp_tm = \
strcpy((_Buf),___tmp_tm);\
___tmp_tm; })
#endif
#endif
#define TAI_UTC_OFFSET LL(4611686018427387914)
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -102,6 +62,8 @@ struct ftm is a `floating' version of the system struct tm.
#define HAS_STAMP 0x0001
#define HAS_WYDAY 0x0002
#define NO_UTC_OFFSET 0x7fffffff
typedef struct ftm
{ struct tm tm; /* System time structure */
double sec; /* float version of tm.tm_sec */
@ -147,7 +109,7 @@ tz_offset(void)
{ time_t t = time(NULL);
struct tm tm;
localtime_r(&t, &tm);
PL_localtime_r(&t, &tm);
offset = -tm.tm_gmtoff;
if ( tm.tm_isdst > 0 )
@ -177,7 +139,7 @@ static atom_t
tz_name_as_atom(int dst)
{ static atom_t a[2];
dst = (dst != 0); /* 0 or 1 */
dst = (dst > 0); /* 0 or 1 */
if ( !a[dst] )
{ wchar_t wbuf[256];
@ -245,10 +207,12 @@ get_tz_arg(int i, term_t t, term_t a, atom_t *tz)
atom_t name;
_PL_get_arg(i, t, a);
if ( !PL_get_atom_ex(a, &name) )
fail;
if ( name != ATOM_minus )
*tz = name;
if ( !PL_is_variable(a) )
{ if ( !PL_get_atom_ex(a, &name) )
fail;
if ( name != ATOM_minus )
*tz = name;
}
succeed;
}
@ -264,6 +228,21 @@ get_int_arg(int i, term_t t, term_t a, int *val)
}
static int
get_voff_arg(int i, term_t t, term_t a, int *val)
{ GET_LD
_PL_get_arg(i, t, a);
if ( PL_is_variable(a) )
{ *val = NO_UTC_OFFSET;
return TRUE;
} else
{ return PL_get_integer_ex(a, val);
}
}
static int
get_float_arg(int i, term_t t, term_t a, double *val)
{ GET_LD
@ -275,7 +254,7 @@ get_float_arg(int i, term_t t, term_t a, double *val)
static int
get_bool_arg(int i, term_t t, term_t a, int *val)
get_dst_arg(int i, term_t t, term_t a, int *val)
{ GET_LD
atom_t name;
@ -284,10 +263,16 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
{ if ( name == ATOM_true )
{ *val = TRUE;
return TRUE;
} else if ( name == ATOM_false || name == ATOM_minus )
} else if ( name == ATOM_false )
{ *val = FALSE;
return TRUE;
} else if ( name == ATOM_minus )
{ *val = -1;
return TRUE;
}
} else if ( PL_is_variable(a) )
{ *val = -2;
return TRUE;
}
return PL_get_bool_ex(a, val); /* generate an error */
@ -297,23 +282,25 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
static int
get_ftm(term_t t, ftm *ftm)
{ GET_LD
term_t tmp = PL_new_term_ref();
int date9;
if ( PL_is_functor(t, FUNCTOR_date9) )
{ term_t tmp = PL_new_term_ref();
memset(ftm, 0, sizeof(*ftm));
memset(ftm, 0, sizeof(*ftm));
if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
if ( (date9=PL_is_functor(t, FUNCTOR_date9)) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) &&
get_int_arg (4, t, tmp, &ftm->tm.tm_hour) &&
get_int_arg (5, t, tmp, &ftm->tm.tm_min) &&
get_float_arg(6, t, tmp, &ftm->sec) &&
get_int_arg (7, t, tmp, &ftm->utcoff) &&
get_voff_arg (7, t, tmp, &ftm->utcoff) &&
get_tz_arg (8, t, tmp, &ftm->tzname) &&
get_bool_arg (9, t, tmp, &ftm->isdst) )
get_dst_arg (9, t, tmp, &ftm->isdst) )
{ double fp, ip;
ftm->tm.tm_isdst = (ftm->isdst == -2 ? -1 : ftm->isdst);
fixup:
fp = modf(ftm->sec, &ip);
if ( fp < 0.0 )
@ -325,20 +312,62 @@ get_ftm(term_t t, ftm *ftm)
ftm->tm.tm_year -= 1900; /* 1900 based */
ftm->tm.tm_mon--; /* 0-based */
if ( ftm->utcoff == NO_UTC_OFFSET )
{ if ( ftm->tm.tm_isdst < 0 ) /* unknown DST */
{ int offset;
if ( mktime(&ftm->tm) == (time_t)-1 )
return PL_representation_error("dst");
ftm->flags |= HAS_WYDAY;
offset = tz_offset();
if ( ftm->tm.tm_isdst > 0 )
offset -= 3600;
ftm->utcoff = offset;
if ( date9 ) /* variable */
{ _PL_get_arg(7, t, tmp);
if ( !PL_unify_integer(tmp, ftm->utcoff) )
return FALSE;
} else
{ ftm->utcoff = offset;
}
}
if ( ftm->isdst == -2 )
{ ftm->isdst = ftm->tm.tm_isdst;
_PL_get_arg(9, t, tmp);
if ( ftm->isdst < 0 )
{ if ( !PL_unify_atom(tmp, ATOM_minus) )
return FALSE;
} else
{ if ( !PL_unify_bool(tmp, ftm->isdst) )
return FALSE;
}
}
if ( !ftm->tzname )
{ ftm->tzname = tz_name_as_atom(ftm->isdst);
_PL_get_arg(8, t, tmp);
if ( PL_is_variable(tmp) &&
!PL_unify_atom(tmp, ftm->tzname) )
return FALSE;
}
}
succeed;
}
} else if ( PL_is_functor(t, FUNCTOR_date3) )
{ term_t tmp = PL_new_term_ref();
memset(ftm, 0, sizeof(*ftm));
if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) )
{ ftm->tm.tm_isdst = -1;
ftm->utcoff = NO_UTC_OFFSET;
goto fixup;
}
}
fail;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, t);
}
@ -407,7 +436,7 @@ PRED_IMPL("stamp_date_time", 3, stamp_date_time, 0)
if ( (int64_t)unixt == ut64 )
{ double ip;
localtime_r(&unixt, &tm);
PL_localtime_r(&unixt, &tm);
sec = (double)tm.tm_sec + modf(argsec, &ip);
ct.date.year = tm.tm_year+1900;
ct.date.month = tm.tm_mon+1;
@ -562,7 +591,7 @@ fmt_not_implemented(int c)
{ format_time(fd, f, ftm, posix); \
}
#define OUTCHR(fd, c) \
{ Sputcode(c, fd); \
{ Sputcode(c, fd); \
}
#define OUTSTR(str) \
{ Sfputs(str, fd); \
@ -654,7 +683,6 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
case_b:
{ char fmt[3];
char buf[256];
size_t n;
fmt[0] = '%';
fmt[1] = (char)c;
@ -662,7 +690,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
cal_ftm(ftm, HAS_STAMP|HAS_WYDAY);
/* conversion is not thread-safe under locale switch */
n = strftime(buf, sizeof(buf), fmt, &ftm->tm);
strftime(buf, sizeof(buf), fmt, &ftm->tm);
OUTSTRA(buf);
break;
}
@ -856,7 +884,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
{ char buf[26];
cal_ftm(ftm, HAS_WYDAY);
asctime_r(&ftm->tm, buf);
PL_asctime_r(&ftm->tm, buf);
buf[24] = EOS;
OUTSTRA(buf);
}
@ -920,7 +948,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
if ( (int64_t)unixt == ut64 )
{ tb.utcoff = tz_offset();
localtime_r(&unixt, &tb.tm);
PL_localtime_r(&unixt, &tb.tm);
tb.sec = (double)tb.tm.tm_sec + modf(tb.stamp, &ip);
if ( tb.tm.tm_isdst > 0 )
{ tb.utcoff -= 3600;
@ -942,7 +970,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
tb.utcoff = 0;
}
} else if ( !get_ftm(time, &tb) )
{ return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, time);
{ return FALSE;
}
if ( !setupOutputRedirect(out, &ctx, FALSE) )

77
os/pl-text.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -28,9 +28,6 @@
#include "pl-codelist.h"
#include <errno.h>
#include <stdio.h>
#ifdef __WINDOWS__
#include "pl-mswchar.h" /* Terrible hack */
#endif
#if HAVE_LIMITS_H
#include <limits.h> /* solaris compatibility */
#endif
@ -121,12 +118,52 @@ PL_from_stack_text(PL_chars_t *text)
}
#define INT64_DIGITS 20
static char *
ui64toa(uint64_t val, char *out)
{ char tmpBuf[INT64_DIGITS + 1];
char *ptrOrg = tmpBuf + INT64_DIGITS;
char *ptr = ptrOrg;
size_t nbDigs;
do
{ int rem = val % 10;
*--ptr = rem + '0';
val /= 10;
} while ( val );
nbDigs = ptrOrg - ptr;
memcpy(out, ptr, nbDigs);
out += nbDigs;
*out = '\0';
return out; /* points to the END */
};
static char *
i64toa(int64_t val, char *out)
{ if ( val < 0 )
{ *out++ = '-';
val = -val;
}
return ui64toa((uint64_t)val, out);
}
int
PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{ word w = valHandle(l);
if ( (flags & CVT_ATOM) && isAtom(w) )
#if __YAP_PROLOG__
{ if ( !get_atom_text(atomFromTerm(w), text) )
#else
{ if ( !get_atom_text(w, text) )
#endif
goto maybe_write;
} else if ( (flags & CVT_STRING) && isString(w) )
{ if ( !get_string_text(w, text PASS_LD) )
@ -138,17 +175,20 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
PL_get_number(l, &n);
switch(n.type)
{ case V_INTEGER:
sprintf(text->buf, INT64_FORMAT, n.value.i);
{ char *ep = i64toa(n.value.i, text->buf);
text->text.t = text->buf;
text->length = strlen(text->text.t);
text->length = ep-text->text.t;
text->storage = PL_CHARS_LOCAL;
break;
}
#ifdef O_GMP
case V_MPZ:
{ size_t sz = mpz_sizeinbase(n.value.mpz, 10) + 2;
Buffer b = findBuffer(BUF_RING);
growBuffer(b, sz);
if ( !growBuffer(b, sz) )
outOfCore();
mpz_get_str(b->base, 10, n.value.mpz);
b->top = b->base + strlen(b->base);
text->text.t = baseBuffer(b, char);
@ -196,7 +236,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{ case CVT_partial:
return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
case CVT_nolist:
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
goto error;
case CVT_nocode:
case CVT_nochar:
{ term_t culprit = PL_new_term_ref();
@ -295,7 +335,9 @@ error:
if ( (flags & CVT_EXCEPTION) )
{ atom_t expected;
if ( flags & CVT_LIST )
if ( (flags & CVT_LIST) && !(flags&(CVT_ATOM|CVT_NUMBER)) )
expected = ATOM_list; /* List and/or string object */
else if ( flags & CVT_LIST )
expected = ATOM_text;
else if ( flags & CVT_NUMBER )
expected = ATOM_atomic;
@ -353,7 +395,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
{ word w = textToString(text);
if ( w )
return _PL_unify_string(term, w);
return _PL_unify_atomic(term, w);
else
return FALSE;
}
@ -473,6 +515,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
return FALSE;
}
}
return CLOSE_SEQ_STRING(p, p0, tail, term, l );
}
}
@ -497,6 +540,18 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
if ( offset > text->length || offset + len > text->length )
return FALSE;
if ( len == 1 && type == PL_ATOM )
{ GET_LD
int c;
if ( text->encoding == ENC_ISO_LATIN_1 )
c = text->text.t[offset]&0xff;
else
c = text->text.w[offset];
return PL_unify_atom(term, codeToAtom(c));
}
sub.length = len;
sub.storage = PL_CHARS_HEAP;
if ( text->encoding == ENC_ISO_LATIN_1 )
@ -659,7 +714,7 @@ represented.
static int
wctobuffer(wchar_t c, mbstate_t *mbs, Buffer buf)
{ char b[MB_LEN_MAX];
{ char b[PL_MB_LEN_MAX];
size_t n;
if ( (n=wcrtomb(b, c, mbs)) != (size_t)-1 )

2
os/pl-text.h

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef PL_TEXT_H_INCLUDED

57
os/pl-thread.h

@ -46,26 +46,43 @@ extern void freeSimpleMutex(counting_mutex *m);
extern counting_mutex _PL_mutexes[]; /* Prolog mutexes */
#define L_MISC 0
#define L_ALLOC 1
#define L_ATOM 2
#define L_FLAG 3
#define L_FUNCTOR 4
#define L_RECORD 5
#define L_THREAD 6
#define L_PREDICATE 7
#define L_MODULE 8
#define L_TABLE 9
#define L_BREAK 10
#define L_FILE 11
#define L_PLFLAG 12
#define L_OP 13
#define L_INIT 14
#define L_TERM 15
#define L_GC 16
#define L_AGC 17
#define L_FOREIGN 18
#define L_OS 19
#define L_MISC 0
#define L_ALLOC 1
#define L_ATOM 2
#define L_FLAG 3
#define L_FUNCTOR 4
#define L_RECORD 5
#define L_THREAD 6
#define L_PREDICATE 7
#define L_MODULE 8
#define L_TABLE 9
#define L_BREAK 10
#define L_FILE 11
#define L_SEETELL 12
#define L_PLFLAG 13
#define L_OP 14
#define L_INIT 15
#define L_TERM 16
#define L_GC 17
#define L_AGC 18
#define L_STOPTHEWORLD 19
#define L_FOREIGN 20
#define L_OS 21
#ifdef __WINDOWS__
#define L_DDE 22
#define L_CSTACK 23
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The IF_MT(id, g) macro is used to bypass mutexes if threading is
disabled. We cannot do this for the L_THREAD mutex however as we need to
control when threads can be created.
We assume id == L_THREAD is optimized away if id is known at
compile-time
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define IF_MT(id, g) if ( id == L_THREAD || GD->thread.enabled ) g
#ifdef O_CONTENTION_STATISTICS
#define countingMutexLock(cm) \

2
os/pl-utf8.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include <string.h> /* get size_t */

4
os/pl-utf8.h

@ -19,13 +19,15 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef UTF8_H_INCLUDED
#define UTF8_H_INCLUDED
#define PL_MB_LEN_MAX 16
#define UTF8_MALFORMED_REPLACEMENT 0xfffd
#define ISUTF8_MB(c) ((unsigned)(c) >= 0xc0 && (unsigned)(c) <= 0xfd)

28
os/windows/mswchar.h → os/pl-version.c

@ -5,7 +5,7 @@
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2005, University of Amsterdam
Copyright (C): 1985-2007, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,20 +19,18 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include <wchar.h>
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
See pl-mswchar.cpp for the motivation for this nonsense. Used in
pl-fli.c and pl-text.c.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef __WINDOWS__
#define wcrtomb(s, wc, ps) ms_wcrtomb(s, wc, ps)
#define mbrtowc(pwc, s, n, ps) ms_mbrtowc(pwc, s, n, ps)
extern size_t ms_wcrtomb(char *s, wchar_t wc, mbstate_t *ps);
extern size_t ms_mbrtowc(wchar_t *pwc, const char *s, size_t n, mbstate_t *ps);
#include "pl-incl.h"
#ifdef USE_GIT_VERSION_H
#include <version.h>
#endif
void
setGITVersion(void)
{
#ifdef GIT_VERSION
PL_set_prolog_flag("version_git", PL_ATOM|FF_READONLY, GIT_VERSION);
#endif
}

250
os/pl-write.c

@ -60,16 +60,19 @@ typedef struct
int max_depth; /* depth limit */
int depth; /* current depth */
atom_t spacing; /* Where to insert spaces */
Term module; /* Module for operators */
Term module; /* Module for operators */
IOSTREAM *out; /* stream to write to */
visited *visited; /* visited (attributed-) variables */
term_t portray_goal; /* call/2 activated portray hook */
term_t write_options; /* original write options */
term_t prec_opt; /* term in write options with prec */
} write_options;
word
pl_nl1(term_t stream)
{ IOSTREAM *s;
{ GET_LD
IOSTREAM *s;
if ( getOutputStream(stream, &s) )
if ( getTextOutputStream(stream, &s) )
{ Sputcode('\n', s);
return streamStatus(s);
}
@ -165,6 +168,28 @@ format_float(double f, char *buf)
return buf;
}
static int
bind_varnames(term_t varnames ARG_LD)
{
CACHE_REGS
Term t = Yap_GetFromSlot(varnames PASS_REGS);
while(!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t);
Functor f;
Term tv, t2, t1;
if (!IsApplTerm(tl)) return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq)
return FALSE;
t1 = ArgOfTerm(1, tl);
t2 = ArgOfTerm(2, tl);
tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
if (!Yap_unify(t2, tv))
return FALSE;
t = TailOfTerm(t);
}
return TRUE;
}
char *
varName(term_t t, char *name)
@ -183,7 +208,7 @@ varName(term_t t, char *name)
static bool
writeTerm(term_t t, int prec, write_options *options)
writeTopTerm(term_t t, int prec, write_options *options)
{
CACHE_REGS
UInt yap_flag = Use_SWI_Stream_f;
@ -194,6 +219,8 @@ writeTerm(term_t t, int prec, write_options *options)
yap_flag |= Quote_illegal_f;
if (options->flags & PL_WRT_NUMBERVARS)
yap_flag |= Handle_vars_f;
if (options->flags & PL_WRT_VARNAMES)
yap_flag |= Handle_vars_f;
if (options->flags & PL_WRT_IGNOREOPS)
yap_flag |= Ignore_ops_f;
if (flags & PL_WRT_PORTRAY)
@ -221,21 +248,6 @@ writeAtomToStream(IOSTREAM *s, atom_t atom)
return 1;
}
int
writeAttributeMask(atom_t a)
{ if ( a == ATOM_ignore )
{ return PL_WRT_ATTVAR_IGNORE;
} else if ( a == ATOM_dots )
{ return PL_WRT_ATTVAR_DOTS;
} else if ( a == ATOM_write )
{ return PL_WRT_ATTVAR_WRITE;
} else if ( a == ATOM_portray )
{ return PL_WRT_ATTVAR_PORTRAY;
} else
return 0;
}
static int
writeBlobMask(atom_t a)
{ if ( a == ATOM_default )
@ -247,23 +259,6 @@ writeBlobMask(atom_t a)
}
static const opt_spec write_term_options[] =
{ { ATOM_quoted, OPT_BOOL },
{ ATOM_ignore_ops, OPT_BOOL },
{ ATOM_numbervars, OPT_BOOL },
{ ATOM_portray, OPT_BOOL },
{ ATOM_character_escapes, OPT_BOOL },
{ ATOM_max_depth, OPT_INT },
{ ATOM_module, OPT_ATOM },
{ ATOM_backquoted_string, OPT_BOOL },
{ ATOM_attributes, OPT_ATOM },
{ ATOM_priority, OPT_INT },
{ ATOM_partial, OPT_BOOL },
{ ATOM_spacing, OPT_ATOM },
{ ATOM_blobs, OPT_ATOM },
{ NULL_ATOM, 0 }
};
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PutOpenToken() inserts a space in the output stream if the last-written
and given character require a space to ensure a token-break.
@ -317,6 +312,84 @@ PutOpenToken(int c, IOSTREAM *s)
return TRUE;
}
/*******************************
* TOPLEVEL *
*******************************/
int
writeAttributeMask(atom_t a)
{ if ( a == ATOM_ignore )
{ return PL_WRT_ATTVAR_IGNORE;
} else if ( a == ATOM_dots )
{ return PL_WRT_ATTVAR_DOTS;
} else if ( a == ATOM_write )
{ return PL_WRT_ATTVAR_WRITE;
} else if ( a == ATOM_portray )
{ return PL_WRT_ATTVAR_PORTRAY;
} else
return 0;
}
static const opt_spec write_term_options[] =
{ { ATOM_quoted, OPT_BOOL },
{ ATOM_ignore_ops, OPT_BOOL },
{ ATOM_numbervars, OPT_BOOL },
{ ATOM_portray, OPT_BOOL },
{ ATOM_portray_goal, OPT_TERM },
{ ATOM_character_escapes, OPT_BOOL },
{ ATOM_max_depth, OPT_INT },
{ ATOM_module, OPT_ATOM },
{ ATOM_backquoted_string, OPT_BOOL },
{ ATOM_attributes, OPT_ATOM },
{ ATOM_priority, OPT_INT },
{ ATOM_partial, OPT_BOOL },
{ ATOM_spacing, OPT_ATOM },
{ ATOM_blobs, OPT_ATOM },
{ ATOM_cycles, OPT_BOOL },
{ ATOM_variable_names, OPT_TERM },
{ NULL_ATOM, 0 }
};
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Call user:portray/1 if defined.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
put_write_options(term_t opts_in, write_options *options)
{ GET_LD
term_t newlist = PL_new_term_ref();
term_t precopt = PL_new_term_ref();
fid_t fid = PL_open_foreign_frame();
term_t head = PL_new_term_ref();
term_t tail = PL_copy_term_ref(opts_in);
term_t newhead = PL_new_term_ref();
term_t newtail = PL_copy_term_ref(newlist);
int rc = TRUE;
while(rc && PL_get_list(tail, head, tail))
{ if ( !PL_is_functor(head, FUNCTOR_priority1) )
rc = ( PL_unify_list(newtail, newhead, newtail) &&
PL_unify(newhead, head) );
}
if ( rc )
{ rc = ( PL_unify_list(newtail, head, newtail) &&
PL_unify_functor(head, FUNCTOR_priority1) &&
PL_get_arg(1, head, precopt) &&
PL_unify_nil(newtail) );
}
if ( rc )
{ options->write_options = newlist;
options->prec_opt = precopt;
}
PL_close_foreign_frame(fid);
return rc;
}
word
pl_write_term3(term_t stream, term_t term, term_t opts)
{ GET_LD
@ -324,6 +397,7 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
bool ignore_ops = FALSE;
bool numbervars = -1; /* not set */
bool portray = FALSE;
term_t gportray = 0;
bool bqstring = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
bool charescape = -1; /* not set */
atom_t mname = ATOM_user;
@ -331,7 +405,10 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
atom_t blobs = ATOM_nil;
int priority = 1200;
bool partial = FALSE;
IOSTREAM *s;
bool cycles = TRUE;
term_t varnames = 0;
int local_varnames;
IOSTREAM *s = NULL;
write_options options;
int rc;
@ -339,10 +416,10 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
options.spacing = ATOM_standard;
if ( !scan_options(opts, 0, ATOM_write_option, write_term_options,
&quoted, &ignore_ops, &numbervars, &portray,
&quoted, &ignore_ops, &numbervars, &portray, &gportray,
&charescape, &options.max_depth, &mname,
&bqstring, &attr, &priority, &partial, &options.spacing,
&blobs) )
&blobs, &cycles, &varnames) )
fail;
if ( attr == ATOM_nil )
@ -381,14 +458,21 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
}
}
if ( !getOutputStream(stream, &s) )
fail;
options.module = lookupModule(mname);
if ( charescape == TRUE ||
// (charescape == -1 && true(options.module, CHARESCAPE)) )
charEscapeWriteOption(options))
(charescape == -1
#ifndef __YAP_PROLOG__
&& true(options.module, M_CHARESCAPE)
#endif
) )
options.flags |= PL_WRT_CHARESCAPES;
if ( gportray )
{ options.portray_goal = gportray;
if ( !put_write_options(opts, &options) ||
!PL_qualify(options.portray_goal, options.portray_goal) )
return FALSE;
portray = TRUE;
}
if ( numbervars == -1 )
numbervars = (portray ? TRUE : FALSE);
@ -397,19 +481,35 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
if ( numbervars ) options.flags |= PL_WRT_NUMBERVARS;
if ( portray ) options.flags |= PL_WRT_PORTRAY;
if ( bqstring ) options.flags |= PL_WRT_BACKQUOTED_STRING;
if ( !cycles ) options.flags |= PL_WRT_NO_CYCLES;
local_varnames = (varnames && false(&options, PL_WRT_NUMBERVARS));
BEGIN_NUMBERVARS(local_varnames);
if ( varnames )
{ if ( (rc=bind_varnames(varnames PASS_LD)) )
options.flags |= PL_WRT_VARNAMES;
else
goto out;
}
if ( !(rc=getTextOutputStream(stream, &s)) )
goto out;
options.out = s;
if ( !partial )
PutOpenToken(EOF, s); /* reset this */
if ( (options.flags & PL_WRT_QUOTED) && !(s->flags&SIO_REPPL) )
{ s->flags |= SIO_REPPL;
rc = writeTerm(term, priority, &options);
rc = writeTopTerm(term, priority, &options);
s->flags &= ~SIO_REPPL;
} else
{ rc = writeTerm(term, priority, &options);
{ rc = writeTopTerm(term, priority, &options);
}
return streamStatus(s) && rc;
out:
END_NUMBERVARS(local_varnames);
return (!s || streamStatus(s)) && rc;
}
@ -426,10 +526,10 @@ PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags)
memset(&options, 0, sizeof(options));
options.flags = flags;
options.out = s;
options.module = USER_MODULE; //MODULE_user;
options.module = MODULE_user;
PutOpenToken(EOF, s); /* reset this */
return writeTerm(term, precedence, &options);
return writeTopTerm(term, precedence, &options);
}
@ -438,22 +538,27 @@ do_write2(term_t stream, term_t term, int flags)
{ GET_LD
IOSTREAM *s;
if ( getOutputStream(stream, &s) )
if ( getTextOutputStream(stream, &s) )
{ write_options options;
int rc;
memset(&options, 0, sizeof(options));
options.flags = flags;
options.out = s;
options.module = USER_MODULE; // MODULE_user;
// if ( options.module && true(options.module, CHARESCAPE) )
if (charEscapeWriteOption(options))
options.module = MODULE_user;
if ( options.module
#ifndef __YAP_PROLOG__
&& true(options.module, M_CHARESCAPE)
#endif
)
options.flags |= PL_WRT_CHARESCAPES;
if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
options.flags |= PL_WRT_BACKQUOTED_STRING;
PutOpenToken(EOF, s); /* reset this */
rc = writeTerm(term, 1200, &options);
rc = writeTopTerm(term, 1200, &options);
if ( rc && (flags&PL_WRT_NEWLINE) )
rc = Putc('\n', s);
return streamStatus(s) && rc;
}
@ -481,25 +586,22 @@ pl_print2(term_t stream, term_t term)
word
pl_write_canonical2(term_t stream, term_t term)
{ GET_LD
fid_t fid;
nv_options options;
word rc;
if ( !(fid = PL_open_foreign_frame()) )
return FALSE;
BEGIN_NUMBERVARS(TRUE);
options.functor = FUNCTOR_isovar1;
options.on_attvar = AV_SKIP;
options.singletons = TRUE;
#if __YAP_PROLOG__
LOCAL_FunctorVar = FunctorHiddenVar;
#endif
numberVars(term, &options, 0 PASS_LD);
rc = do_write2(stream, term,
PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS);
#if __YAP_PROLOG__
LOCAL_FunctorVar = FunctorVar;
#endif
PL_discard_foreign_frame(fid);
options.singletons = PL_is_acyclic(term);
options.numbered_check = FALSE;
rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
do_write2(stream, term,
PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS)
);
END_NUMBERVARS(TRUE);
return rc;
}
@ -524,17 +626,13 @@ pl_write_canonical(term_t term)
{ return pl_write_canonical2(0, term);
}
word /* for debugging purposes! */
word
pl_writeln(term_t term)
{ if ( PL_write_term(Serror, term, 1200,
PL_WRT_QUOTED|PL_WRT_NUMBERVARS) &&
Sdprintf("\n") >= 0 )
succeed;
fail;
{ return do_write2(0, term, PL_WRT_NUMBERVARS|PL_WRT_NEWLINE);
}
/*******************************
* PUBLISH PREDICATES *
*******************************/

8
os/windows/dirent.h

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef _DIRENT_H_INCLUDED
@ -28,8 +28,8 @@
#include <io.h>
#undef _export
#if defined(_UXNT_KERNEL) && !defined(__LCC__)
#define _export __declspec(dllexport)
#if defined(_UXNT_KERNEL) && !defined(__MINGW32__)
#define _export _declspec(dllexport)
#else
#define _export extern
#endif
@ -37,7 +37,7 @@
#define DIRENT_MAX 512
typedef struct dirent
{ void * data; /* actually WIN32_FIND_DATA * */
{ void * data; /* actually WIN32_FIND_DATA * */
int first;
void * handle; /* actually HANDLE */
/* dirent */

4
os/windows/popen.c

@ -297,9 +297,9 @@ pt_popen(const char *cmd, const char *mode)
}
if ( pc->mode == 'r' )
fptr = _fdopen(_open_osfhandle((long)pc->out[0],_O_BINARY),"r");
fptr = _fdopen(_open_osfhandle((intptr_t)pc->out[0],_O_BINARY),"r");
else
fptr = _fdopen(_open_osfhandle((long)pc->in[1],_O_BINARY),"w");
fptr = _fdopen(_open_osfhandle((intptr_t)pc->in[1],_O_BINARY),"w");
finito:
if ( fptr )

8
os/windows/utf8.c

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "utf8.h"
@ -31,7 +31,7 @@ UTF-8 Decoding, based on http://www.cl.cam.ac.uk/~mgk25/unicode.html
#define CONT(i) ISUTF8_CB(in[1])
#define VAL(i, s) ((in[i]&0x3f) << s)
char *
static char *
_xos_utf8_get_char(const char *in, int *chr)
{ /* 2-byte, 0x80-0x7ff */
if ( (in[0]&0xe0) == 0xc0 && CONT(1) )
@ -60,12 +60,12 @@ _xos_utf8_get_char(const char *in, int *chr)
}
*chr = *in;
return (char *)in+1;
}
char *
static char *
_xos_utf8_put_char(char *out, int chr)
{ if ( chr < 0x80 )
{ *out++ = chr;

6
os/windows/utf8.h

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
@ -52,7 +52,7 @@
((chr) < 0x80 ? out[0]=(char)(chr), out+1 \
: _xos_utf8_put_char(out, (chr)))
extern char *_xos_utf8_get_char(const char *in, int *chr);
extern char *_xos_utf8_put_char(char *out, int chr);
static char *_xos_utf8_get_char(const char *in, int *chr);
static char *_xos_utf8_put_char(char *out, int chr);
#endif /*UTF8_H_INCLUDED*/

157
os/windows/uxnt.c

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
Vu University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#define UNICODE 1
@ -52,11 +51,6 @@
#define FALSE 0
#endif
#ifndef MAXPATHLEN
#define MAXPATHLEN 256
#endif
#ifdef __LCC__
#define _close close
#define _read read
@ -72,6 +66,10 @@
#define XENOMAP 1
#define XENOMEM 2
#ifndef PATH_MAX
#define PATH_MAX 260
#endif
/*******************************
* ERRNO *
@ -146,6 +144,21 @@ utf8towcs(wchar_t *dest, const char *src, size_t len)
}
static size_t
utf8_strlen(const char *s, size_t len)
{ const char *e = &s[len];
unsigned int l = 0;
while(s<e)
{ int chr;
s = utf8_get_char(s, &chr);
l++;
}
return l;
}
/*******************************
@ -169,11 +182,11 @@ existsAndWriteableDir(const TCHAR *name)
char *
_xos_home() /* expansion of ~ */
{ static char home[MAXPATHLEN];
{ static char home[PATH_MAX];
static int done = FALSE;
if ( !done )
{ TCHAR h[MAXPATHLEN];
{ TCHAR h[PATH_MAX];
/* Unix, set by user */
if ( GetEnvironmentVariable(_T("HOME"), h, sizeof(h)) &&
@ -184,8 +197,8 @@ _xos_home() /* expansion of ~ */
{ _xos_canonical_filenameW(h, home, sizeof(home), 0);
} else
{ TCHAR d[100];
TCHAR p[MAXPATHLEN];
TCHAR tmp[MAXPATHLEN];
TCHAR p[PATH_MAX];
TCHAR tmp[PATH_MAX];
int haved, havep;
haved = GetEnvironmentVariable(_T("HOMEDRIVE"), d, sizeof(d));
@ -245,7 +258,8 @@ _xos_os_filenameW(const char *cname, wchar_t *osname, size_t len)
q += 3;
}
if ( q[0] == '/' || q[0] == '\\' ) /* deal with //host/share */
if ( (q[0] == '/' || q[0] == '\\') &&
(q[1] == '/' || q[1] == '\\') ) /* deal with //host/share */
{ if ( s+1 >= e )
{ errno = ENAMETOOLONG;
return NULL;
@ -600,7 +614,6 @@ _xos_fopen(const char *path, const char *mode)
}
/*******************************
* FILE MANIPULATIONS *
*******************************/
@ -608,11 +621,101 @@ _xos_fopen(const char *path, const char *mode)
int
_xos_access(const char *path, int mode)
{ TCHAR buf[PATH_MAX];
char sd_buf[512];
SECURITY_DESCRIPTOR *sd;
BOOL access_status;
DWORD desired_access = 0;
DWORD sd_size, granted_access;
HANDLE token = 0, imp_token = 0;
GENERIC_MAPPING generic_mapping;
PRIVILEGE_SET privelege_set;
DWORD priv_set_len = sizeof(PRIVILEGE_SET);
int retval = -1;
SECURITY_INFORMATION sec_info =
DACL_SECURITY_INFORMATION |
OWNER_SECURITY_INFORMATION |
GROUP_SECURITY_INFORMATION;
if ( !_xos_os_filenameW(path, buf, PATH_MAX) )
return -1;
return _waccess(buf, mode);
if ( mode == F_OK )
return _waccess(buf, F_OK);
sd = (SECURITY_DESCRIPTOR*)&sd_buf;
if ( !GetFileSecurity(buf, sec_info, sd, sizeof(sd_buf), &sd_size) )
{ if ( GetLastError() == ERROR_INVALID_FUNCTION )
{ goto simple;
} else if ( GetLastError() != ERROR_INSUFFICIENT_BUFFER )
{ errno = ENOENT;
return -1;
}
if ( !(sd = malloc(sd_size)) )
{ errno = ENOMEM;
return -1;
}
if ( !GetFileSecurity(buf, sec_info, sd, sd_size, &sd_size) )
goto simple;
}
if ( mode & W_OK )
{ if ( _waccess(buf, W_OK ) < 0 ) /* read-only bit set */
goto out;
}
if ( !OpenThreadToken(GetCurrentThread(),
TOKEN_DUPLICATE | TOKEN_READ,
TRUE,
&token) )
{ if ( GetLastError() != ERROR_NO_TOKEN )
goto simple;
if ( !OpenProcessToken(GetCurrentProcess(),
TOKEN_DUPLICATE | TOKEN_READ,
&token) )
goto simple;
}
if ( !DuplicateToken(token,
SecurityImpersonation,
&imp_token) )
goto simple;
if (mode & R_OK) desired_access |= GENERIC_READ;
if (mode & W_OK) desired_access |= GENERIC_WRITE;
if (mode & X_OK) desired_access |= GENERIC_EXECUTE;
generic_mapping.GenericRead = FILE_GENERIC_READ;
generic_mapping.GenericWrite = FILE_GENERIC_WRITE;
generic_mapping.GenericExecute = FILE_GENERIC_EXECUTE;
generic_mapping.GenericAll = FILE_ALL_ACCESS;
MapGenericMask(&desired_access, &generic_mapping);
if ( !AccessCheck(sd,
imp_token,
desired_access,
&generic_mapping,
&privelege_set,
&priv_set_len,
&granted_access,
&access_status) )
goto simple;
if ( access_status )
retval = 0;
out:
if ( sd && (char*)sd != sd_buf ) free(sd);
if (imp_token) CloseHandle(imp_token);
if (token) CloseHandle(token);
return retval;
simple:
retval = _waccess(buf, mode);
goto out;
}
@ -858,6 +961,7 @@ _xos_getenv(const char *name, char *buf, size_t buflen)
size = GetEnvironmentVariable(nm, valp, size+1);
}
size = wcslen(valp); /* return sometimes holds 0-bytes */
if ( wcstoutf8(buf, valp, buflen) )
rc = strlen(buf);
else
@ -876,16 +980,27 @@ _xos_getenv(const char *name, char *buf, size_t buflen)
int
_xos_setenv(const char *name, char *value, int overwrite)
{ TCHAR nm[PATH_MAX];
TCHAR val[PATH_MAX];
TCHAR buf[PATH_MAX];
TCHAR *val = buf;
int rc;
if ( !utf8towcs(nm, name, PATH_MAX) )
return -1;
if ( !overwrite && GetEnvironmentVariable(nm, NULL, 0) > 0 )
return 0;
if ( !utf8towcs(val, value, PATH_MAX) )
return -1;
{ size_t wlen = utf8_strlen(value, strlen(value)) + 1;
if ( SetEnvironmentVariable(nm, val) )
if ( (val = malloc(wlen*sizeof(TCHAR))) == NULL )
return -1;
utf8towcs(val, value, wlen);
}
rc = SetEnvironmentVariable(nm, val);
if ( val != buf )
free(val);
if ( rc )
return 0;
return -1; /* TBD: convert error */

2
packages/Dialect.defs.in

@ -37,7 +37,7 @@ LIBDIR=@libdir@
YAPLIBDIR=@libdir@/Yap
SHAREDIR=$(ROOTDIR)/share/Yap
abs_top_builddir=@abs_top_builddir@
PL=@INSTALL_ENV@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss
PL=@PRE_INSTALL_ENV@ $(abs_top_builddir)/yap $(abs_top_builddir)/startup.yss
CC=@CC@
LD=@SHLIB_LD@

2
packages/RDF

@ -1 +1 @@
Subproject commit 270146c1f4117ebb58d20c2f06e58d7d23cbc9ca
Subproject commit 79a369f81a44a6cbf16d50351fbfbffc23f90f03

Some files were not shown because too many files have changed in this diff Show More