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

library(system) plus several new support builtins 

much improved garbage collector
improvements to compiler
yaptab compiles again


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@34 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-05-21 20:00:05 +00:00
parent e5498326b2
commit 8dcee4415b
38 changed files with 2211 additions and 1920 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
C/absmi.c
View File

@ -292,7 +292,7 @@ absmi(int inp)
#endif /* USE_THREADED_CODE */
noheapleft:
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -1604,7 +1604,7 @@ absmi(int inp)
ASP = (CELL *)B;
goto noheapleft;
}
if (CFREG != MinStackGap*(stack_overflows+1))
if (CFREG != CalculateStackGap())
goto creep;
else
goto NoStackExec;
@ -1752,12 +1752,12 @@ absmi(int inp)
if (ReadTimedVar(WokenGoals) != TermNil)
goto creepc;
else {
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
JMPNext();
}
}
#endif
if (CFREG != MinStackGap*(stack_overflows+1))
if (CFREG != CalculateStackGap())
goto creepc;
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
if (ASP > (CELL *)B)
@ -1830,11 +1830,11 @@ absmi(int inp)
if (ReadTimedVar(WokenGoals) != TermNil)
goto creep_either;
else {
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
JMPNext();
}
}
if (CFREG != MinStackGap*(stack_overflows+1)) {
if (CFREG != CalculateStackGap()) {
goto either_notest;
}
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
@ -1916,12 +1916,12 @@ absmi(int inp)
if (ReadTimedVar(WokenGoals) != TermNil)
goto creepde;
else {
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
JMPNext();
}
}
#endif
if (CFREG != MinStackGap*(stack_overflows+1))
if (CFREG != CalculateStackGap())
goto creepde;
NoStackExec:
@ -2041,10 +2041,10 @@ absmi(int inp)
/* no more goals to wake up */
UpdateTimedVar(WokenGoals, TermNil);
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
}
else {
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
/* We haven't changed P yet so this means redo the
* same instruction */
JMPNext();
@ -2101,7 +2101,7 @@ absmi(int inp)
ARG1 = (Term) AbsPair(H);
H += 2;
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
SREG = (CELL *) (Unsigned(CreepCode) - sizeof(SMALLUNSGN));
#ifdef COROUTINING
@ -5920,7 +5920,7 @@ absmi(int inp)
{
Prop p = GetPredProp (at, 1);
if (p == NIL) {
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
FAIL();
} else {
PredEntry *undefpe;
@ -5932,7 +5932,7 @@ absmi(int inp)
}
}
PREG = (yamop *)pred_entry_from_code(UndefCode)->CodeOfPred;
CFREG = MinStackGap*(stack_overflows+1);
CFREG = CalculateStackGap();
CACHE_A1();
JMPNext();
ENDBOp();
@ -10144,7 +10144,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
setregs();
goto restart_func2s;
}
@ -10242,7 +10242,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
setregs();
goto restart_func2s_cv;
}
@ -10339,7 +10339,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
setregs();
goto restart_func2s_vc;
}
@ -10433,7 +10433,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
setregs();
goto restart_func2s_y;
}
@ -10553,7 +10553,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
setregs();
goto restart_func2s_y_cv;
}
@ -10682,7 +10682,7 @@ absmi(int inp)
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
/* make sure we have something to show for our trouble */
saveregs();
gc(3, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
gc(0, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
setregs();
goto restart_func2s_y_vc;
}

5
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.6 2001-05-07 19:56:02 vsc Exp $ *
* version:$Id: alloc.c,v 1.7 2001-05-21 20:00:05 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -537,6 +537,7 @@ ExtendWorkSpace(Int s)
{
#ifdef YAPOR
abort_optyap("function ExtendWorkSpace called");
return(FALSE);
#else
MALLOC_T a;
@ -614,9 +615,9 @@ ExtendWorkSpace(Int s)
return FALSE;
}
#endif /* YAPOR */
WorkSpaceTop = (char *) a + s;
return TRUE;
#endif /* YAPOR */
}
int

3
C/attvar.c
View File

@ -199,6 +199,8 @@ CurrentTime(void) {
static Int
InitVarTime(void) {
return(0);
#ifdef BEFORE_TRAIL_COMPRESSION
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
@ -206,6 +208,7 @@ InitVarTime(void) {
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
return((CELL *)(B->cp_tr)-(CELL *)TrailBase);
#endif
}
static Int

77
C/c_interface.c
View File

@ -81,6 +81,8 @@ X_API void *STD_PROTO(YapAllocSpaceFromYap,(unsigned int));
X_API void STD_PROTO(YapFreeSpaceFromYap,(void *));
X_API void STD_PROTO(YapFreeSpaceFromYap,(void *));
X_API int STD_PROTO(YapStringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YapBufferToString, (char *));
X_API Term STD_PROTO(YapBufferToAtomList, (char *));
X_API void STD_PROTO(YapError,(char *));
X_API int STD_PROTO(YapRunGoal,(Term));
X_API int STD_PROTO(YapRestartGoal,(void));
@ -96,6 +98,8 @@ X_API int STD_PROTO(YapReset, (void));
X_API void STD_PROTO(YapExit, (int));
X_API void STD_PROTO(YapInitSocks, (char *, long));
X_API void STD_PROTO(YapSetOutputMessage, (void));
X_API int STD_PROTO(YapStreamToFileNo, (Term));
X_API int STD_PROTO(YapPopen, (Term));
X_API Term
YapA(int i)
@ -359,12 +363,14 @@ YapUnify(Term pt1, Term pt2)
return(out);
}
Int YapExecute(CPredicate code)
Int
YapExecute(CPredicate code)
{
return((code)());
}
X_API Int YapCallProlog(Term t)
X_API Int
YapCallProlog(Term t)
{
Int out;
BACKUP_MACHINE_REGS();
@ -375,7 +381,8 @@ X_API Int YapCallProlog(Term t)
return(out);
}
X_API void *YapAllocSpaceFromYap(unsigned int size)
X_API void *
YapAllocSpaceFromYap(unsigned int size)
{
void *ptr;
BACKUP_MACHINE_REGS();
@ -391,13 +398,15 @@ X_API void *YapAllocSpaceFromYap(unsigned int size)
return(ptr);
}
X_API void YapFreeSpaceFromYap(void *ptr)
X_API void
YapFreeSpaceFromYap(void *ptr)
{
FreeCodeSpace(ptr);
}
/* copy a string to a buffer */
X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
X_API int
YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
{
unsigned int j = 0;
@ -419,7 +428,10 @@ X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
return(FALSE);
}
buf[j++] = i;
if (j > bufsize) return(FALSE);
if (j > bufsize) {
buf[j-1] = '\0';
return(FALSE);
}
t = TailOfTerm(t);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"user defined procedure");
@ -434,6 +446,33 @@ X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
}
/* copy a string to a buffer */
X_API Term
YapBufferToString(char *s)
{
Term t;
BACKUP_H();
t = StringToList(s);
RECOVER_H();
return(t);
}
/* copy a string to a buffer */
X_API Term
YapBufferToAtomList(char *s)
{
Term t;
BACKUP_H();
t = StringToListOfAtoms(s);
RECOVER_H();
return(t);
}
X_API void
YapError(char *buf)
{
@ -742,3 +781,29 @@ YapSetOutputMessage(void)
#endif
}
X_API int
YapStreamToFileNo(Term t)
{
return(StreamToFileNo(t));
}
X_API void
YapCloseAllOpenStreams(void)
{
BACKUP_H();
return(CloseStreams(FALSE));
RECOVER_H();
}
X_API Term
YapOpenStream(void *fh, char *name, Term nm, int flags)
{
BACKUP_H();
return(OpenStream((FILE *)fh, name, nm, flags));
RECOVER_H();
}

9
C/cdmgr.c
View File

@ -2032,6 +2032,7 @@ Int
PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
Int i_table;
Int val;
AtomEntry *chain;
for (i_table = 0; i_table < MaxHash; i_table++) {
Atom a;
@ -2048,6 +2049,14 @@ PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
}
READ_UNLOCK(HashChain[i_table].AERWLock);
}
chain = RepAtom(INVISIBLECHAIN.Entry);
while (!EndOfPAEntr(chain) != 0) {
if ((val = check_code_in_atom(chain, codeptr, parity, pmodule)) != 0) {
*pat = AbsAtom(chain);
return(val);
}
chain = RepAtom(chain->NextOfAE);
}
/* we didn't find it, must be one of the hidden predicates */
return(0);
}

23
C/compiler.c
View File

@ -329,7 +329,7 @@ optimize_ce(Term t, unsigned int arity)
CExpEntry *p = common_exps, *parent = common_exps;
int cmp = 0;
if (onbranch || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
return (t);
while (p != NULL) {
CELL *OldH = H;
@ -1041,7 +1041,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
save_machine_regs();
longjmp(CompilerBotch,1);
}
} else if (IsNewVar(t3) && cur_branch == 0) {
} else if (IsNewVar(t3) /* && cur_branch == 0 */) {
c_var(t3,f_flag,(unsigned int)Op);
if (Op == _functor) {
emit(empty_call_op, Zero, Zero);
@ -2108,9 +2108,9 @@ CheckUnsafe(PInstr *pc)
add_bvarray_op(pc, vstat, pc->rnd2);
break;
case call_op:
emit(label_op, ++labelno, Zero);
pc->ops.opseqt[1] = (CELL)labelno;
add_bvarray_op(pc, vstat, pc->rnd2);
emit(label_op, ++labelno, Zero);
pc->ops.opseqt[1] = (CELL)labelno;
add_bvarray_op(pc, vstat, pc->rnd2);
case deallocate_op:
{
int n = pc->op == call_op ? pc->rnd2 : 0;
@ -2144,6 +2144,7 @@ CheckVoids(void)
cpc = CodeStart;
while ((ic = cpc->op) != allocate_op) {
ic = cpc->op;
#ifdef M_WILLIAMS
switch ((int) ic) {
#else
@ -2160,14 +2161,12 @@ CheckVoids(void)
ve = ((Ventry *) cpc->rnd1);
if ((ve->FlagsOfVE & PermFlag) == 0 && ve->RCountOfVE <= 1) {
ve->NoOfVE = ve->KindOfVE = VoidVar;
#ifndef SFUNC
if (ic == get_var_op || ic ==
save_pair_op || ic == save_appl_op) {
#else
if (ic == get_var_op || ic ==
save_appl_op || ic == save_pair_op
|| ic == unify_s_var_op) {
save_pair_op || ic == save_appl_op
#ifdef SFUNC
|| ic == unify_s_var_op
#endif
) {
cpc->op = nop_op;
break;
}
@ -2202,6 +2201,8 @@ checktemp(void)
vreg = vadr & MaskVarAdrs;
if (v->KindOfVE == PermVar || v->KindOfVE == VoidVar)
return (0);
if (v->RCountOfVE == 1)
return(0);
if (vreg) {
--Uses[vreg];
return (1);

2
C/dbase.c
View File

@ -1939,7 +1939,7 @@ GetDBTerm(DBRef DBSP)
pt = CellPtr(DBSP->Contents);
NOf = DBSP->NOfCells;
if (H+NOf > ASP - MinStackGap*(stack_overflows+1)) {
if (H+NOf > ASP-CalculateStackGap()) {
return((Term)0);
}
HeapPtr = cpcells(HOld, pt, NOf);

4
C/errors.c
View File

@ -255,7 +255,7 @@ Abort (char *format,...)
}
else
{
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
#if PUSH_REGS
restore_absmi_regs(&standard_regs);
#endif
@ -1801,7 +1801,7 @@ Error (yap_error_number type, Term where, char *format,...)
if (serious) {
Int depth;
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
if (type == PURE_ABORT)
depth = SetDBForThrow(MkAtomTerm(LookupAtom("abort")));
else

2
C/exec.c
View File

@ -845,7 +845,7 @@ exec_absmi(int top)
B = (choiceptr)(LCL0-depth);
#endif
yap_flags[SPY_CREEP_FLAG] = 0;
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
#if defined(__GNUC__) && defined(hppa)
/* siglongjmp resets the TR hardware register */
restore_TR();

4
C/grow.c
View File

@ -695,7 +695,7 @@ growstack(long size)
fix_tabling_info();
#endif
YAPLeaveCriticalSection();
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
ASP += 256;
growth_time = cputime()-start_growth_time;
total_stack_overflow_time += growth_time;
@ -815,7 +815,7 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
}
AdjustRegs(MaxTemps);
YAPLeaveCriticalSection();
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
ASP += 256;
growth_time = cputime()-start_growth_time;
total_stack_overflow_time += growth_time;

345
C/heapgc.c
View File

@ -21,10 +21,12 @@ static char SccsId[] = "%W% %G%";
#include "absmi.h"
#include "yapio.h"
#define DEBUG 1
#define EARLY_RESET 1
#define EASY_SHUNTING 1
#define HYBRID_SCHEME 1
//#define HYBRID_SCHEME 1
#ifdef MULTI_ASSIGNMENT_VARIABLES
/*
@ -153,6 +155,8 @@ static choiceptr current_B;
static tr_fr_ptr sTR;
#endif
static tr_fr_ptr new_TR;
STATIC_PROTO(void push_registers, (Int, yamop *));
STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
@ -655,7 +659,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
#ifdef DEBUG
/*#define INSTRUMENT_GC 1*/
#define INSTRUMENT_GC 1
/*#define CHECK_CHOICEPOINTS 1*/
#ifdef INSTRUMENT_GC
@ -780,16 +784,25 @@ check_global(void) {
#if INSTRUMENT_GC
if (IsVarTerm(ccurr)) {
if (IsBlobFunctor((Functor)ccurr)) vars[gc_num]++;
else if (ccurr != 0 && ccurr < (CELL)HeapTop) vars[gc_func]++;
else if (ccurr != 0 && ccurr < (CELL)HeapTop) {
/* printf("%p: %s/%d\n", current,
RepAtom(NameOfFunctor((Functor)ccurr))->StrOfAE,
ArityOfFunctor((Functor)ccurr));*/
vars[gc_func]++;
}
else if (IsUnboundVar((CELL)current)) vars[gc_var]++;
else vars[gc_ref]++;
} else if (IsApplTerm(ccurr)) {
// printf("%p: f->%p\n",current,RepAppl(ccurr));
vars[gc_appl]++;
} else if (IsPairTerm(ccurr)) {
// printf("%p: l->%p\n",current,RepPair(ccurr));
vars[gc_list]++;
} else if (IsAtomTerm(ccurr)) {
// printf("%p: %s\n",current,RepAtom(AtomOfTerm(ccurr))->StrOfAE);
vars[gc_atom]++;
} else if (IsIntTerm(ccurr)) {
// printf("%p: %d\n",current,IntOfTerm(ccurr));
vars[gc_int]++;
}
#endif
@ -1202,12 +1215,18 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
mark_external_reference(&TrailTerm(trail_ptr));
UNMARK(&TrailTerm(trail_ptr));
#endif /* EARLY_RESET */
} else {
if (hp < (CELL *)HeapTop) {
} else if (hp < (CELL *)HeapTop) {
/* I decided to allow pointers from the Heap back into the trail.
The point of doing so is to have dynamic arrays */
mark_external_reference(hp);
}
mark_external_reference(hp);
} else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)TrailBase) {
/* clean the trail, avoid dangling pointers! */
RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
RESET_VARIABLE(&TrailVal(trail_ptr));
#endif
discard_trail_entries++;
} else {
#ifdef EASY_SHUNTING
if (hp < gc_H && hp >= H0) {
CELL *cptr = (CELL *)trail_cell;
@ -1300,9 +1319,16 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
#if MULTI_ASSIGNMENT_VARIABLES
while (live_list != NULL) {
CELL trail_cell = TrailTerm(live_list->trptr-1);
CELL trail_cell2 = TrailTerm(live_list->trptr);
if (HEAP_PTR(trail_cell)) {
mark_external_reference(&TrailTerm(live_list->trptr-1));
}
/*
swap the two so that the sweep_trail() knows we have
a multi-assignment binding
*/
TrailTerm(live_list->trptr) = TrailTerm(live_list->trptr-1);
TrailTerm(live_list->trptr-1) = trail_cell2;
live_list = live_list->ma_list;
}
#endif
@ -1325,10 +1351,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
#endif /* TABLING_SCHEDULING */
#endif
#ifdef DEBUG
//#define CHECK_CHOICEPOINTS 1
#endif
#ifdef CHECK_CHOICEPOINTS
#ifndef ANALYST
@ -1379,7 +1401,15 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
case _retry_userc:
case _trust_logical_pred:
case _retry_profiled:
printf("B %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
{
Atom at;
UInt arity;
SMALLUNSGN mod;
if (PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod))
printf("B %p (%s) at %s/%d with %d,%d\nf", gc_B, op_names[opnum], RepAtom(at)->StrOfAE, arity, gc_B->cp_h-H0, total_marked);
else
printf("B %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
}
break;
#ifdef TABLING
case _table_completion:
@ -1389,11 +1419,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
op_numbers caller_op = op_from_opcode(ENV_ToOp(gc_B->cp_cp));
/* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
printf("B %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
printf("B %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
} else if (pe->ArityOfPE)
printf("B %p (%s for %s/%d) with %d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked);
printf("B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
else
printf("B %p (%s for %s/0) with %d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked);
printf("B %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
}
break;
#endif
@ -1403,14 +1433,21 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
if (pe == NULL) {
printf("B %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
} else if (pe->ArityOfPE)
printf("B %p (%s for %s/%d) with %d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked);
printf("B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
else
printf("B %p (%s for %s/0) with %d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked);
printf("B %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
}
}
#endif /* CHECK_CHOICEPOINTS */
mark_trail(saved_TR, gc_B->cp_tr, gc_B->cp_h, gc_B);
saved_TR = gc_B->cp_tr;
{
/* find out how many cells are still alive in the trail */
UInt d0 = discard_trail_entries, diff, orig;
orig = saved_TR-gc_B->cp_tr;
mark_trail(saved_TR, gc_B->cp_tr, gc_B->cp_h, gc_B);
saved_TR = gc_B->cp_tr;
diff = discard_trail_entries-d0;
gc_B->cp_tr = (tr_fr_ptr)(orig-diff);
}
restart_cp:
if (opnum == _or_else || opnum == _or_last) {
/* ; choice point */
@ -1640,15 +1677,26 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
static void
sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
{
tr_fr_ptr trail_ptr;
CELL *cp_H = gc_B->cp_h;
tr_fr_ptr trail_ptr, dest, tri = (tr_fr_ptr)db_vec;
Int OldHeapUsed = HeapUsed;
#ifdef DEBUG
Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0,
hp_in_use_erased = 0, code_entries = 0;
#endif
#if MULTI_ASSIGNMENT_VARIABLES
tr_fr_ptr next_timestamp = NULL;
#endif
/* adjust cp_tr pointers */
{
Int size = old_TR-(tr_fr_ptr)TrailBase;
size -= discard_trail_entries;
while (gc_B != NULL) {
size -= (UInt)(gc_B->cp_tr);
gc_B->cp_tr = (tr_fr_ptr)TrailBase+size;
gc_B = gc_B->cp_b;
}
}
#if DB_SEARCH_METHOD
#if DEBUG
{
@ -1671,129 +1719,173 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
}
/* next, follows the real trail entries */
trail_ptr = old_TR;
while (trail_ptr > (tr_fr_ptr)TrailBase) {
trail_ptr = (tr_fr_ptr)TrailBase;
dest = trail_ptr;
while (trail_ptr < old_TR) {
register CELL trail_cell;
trail_ptr--;
trail_cell = TrailTerm(trail_ptr);
if (gc_B && trail_ptr < gc_B->cp_tr) {
do {
gc_B = gc_B->cp_b;
} while (gc_B && trail_ptr < gc_B->cp_tr);
cp_H = gc_B->cp_h;
}
if (IsVarTerm(trail_cell)) {
/* we need to check whether this is a honest to god trail entry */
if ((CELL *)trail_cell < cp_H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(trail_cell));
}
} else if ((CELL *)trail_cell < (CELL *)HeapTop) {
/* we may have pointers from the heap back into the cell */
UNMARK(CellPtr(trail_cell));
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(CellPtr(trail_cell), GET_NEXT(*(CELL *)trail_cell));
}
} else {
/* clean the trail, avoid dangling pointers! */
if ((CELL *)trail_cell < (CELL *)gc_B && (CELL *)trail_cell >= H0) {
RESET_VARIABLE(&TrailTerm(trail_ptr));
if (trail_cell == (CELL)trail_ptr) {
trail_ptr++;
/* just skip cell */
} else {
TrailTerm(dest) = trail_cell;
#ifdef FROZEN_REGS
RESET_VARIABLE(&TrailVal(trail_ptr));
TrailVal(dest) = TrailVal(trail_ptr);
#endif
discard_trail_entries++;
if (IsVarTerm(trail_cell)) {
/* we need to check whether this is a honest to god trail entry */
if ((CELL *)trail_cell < H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
}
} else if ((CELL *)trail_cell < (CELL *)HeapTop) {
/* we may have pointers from the heap back into the cell */
UNMARK(CellPtr(trail_cell));
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(CellPtr(trail_cell), GET_NEXT(*(CELL *)trail_cell));
}
}
}
#ifdef FROZEN_REGS
if (MARKED(TrailVal(trail_ptr))) {
UNMARK(&TrailVal(trail_ptr));
if (HEAP_PTR(TrailVal(trail_ptr))) {
into_relocation_chain(&TrailVal(trail_ptr), GET_NEXT(TrailVal(trail_ptr)));
if (MARKED(TrailVal(dest))) {
UNMARK(&TrailVal(dest));
if (HEAP_PTR(TrailVal(dest))) {
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
}
}
}
#endif
} else if (IsPairTerm(trail_cell)) {
CELL *pt0 = RepPair(trail_cell);
CELL flags;
} else if (IsPairTerm(trail_cell)) {
CELL *pt0 = RepPair(trail_cell);
CELL flags;
#ifdef FROZEN_REGS /* TRAIL */
/* process all segments */
if (
/* process all segments */
if (
#ifdef SBA
(ADDR) pt0 >= HeapTop
(ADDR) pt0 >= HeapTop
#else
(ADDR) pt0 >= TrailBase
(ADDR) pt0 >= TrailBase
#endif
) {
continue;
}
) {
continue;
}
#endif /* FROZEN_REGS */
flags = Flags((CELL)pt0);
flags = Flags((CELL)pt0);
#ifdef DEBUG
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
hp_entrs++;
if (!FlagOn(GcFoundMask, flags)) {
hp_not_in_use++;
if (FlagOn(ErasedMask, flags)) {
hp_erased++;
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
hp_entrs++;
if (!FlagOn(GcFoundMask, flags)) {
hp_not_in_use++;
if (FlagOn(ErasedMask, flags)) {
hp_erased++;
}
} else {
if (FlagOn(ErasedMask, flags)) {
hp_in_use_erased++;
}
}
} else {
if (FlagOn(ErasedMask, flags)) {
hp_in_use_erased++;
}
code_entries++;
}
} else {
code_entries++;
}
#endif
if (!FlagOn(GcFoundMask, flags)) {
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
if (FlagOn(ErasedMask, flags)) {
ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)));
if (!FlagOn(GcFoundMask, flags)) {
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
if (FlagOn(ErasedMask, flags)) {
ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)));
}
RESET_VARIABLE(&TrailTerm(dest));
discard_trail_entries++;
}
RESET_VARIABLE(trail_ptr);
discard_trail_entries++;
} else {
Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
}
} else {
Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
}
#if MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *old_value_ptr = (CELL *)trail_ptr;
} else {
CELL trail_cell = TrailTerm(trail_ptr);
CELL *ptr;
CELL old = TrailTerm(trail_ptr+1);
if (MARKED(trail_cell)) {
UNMARK(&TrailTerm(trail_ptr));
if (HEAP_PTR(TrailTerm(trail_ptr))) {
into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(trail_cell));
if (MARKED(trail_cell))
ptr = RepAppl(UNMARK_CELL(trail_cell));
else
ptr = RepAppl(trail_cell);
/* now, we must check whether we are looking at a time-stamp */
if (next_timestamp == trail_ptr) {
/* we have a time stamp. Problem is: the trail shifted and we can not trust the
current time stamps */
CELL old_cell = *ptr;
int was_marked = MARKED(old_cell);
tr_fr_ptr old_timestamp;
if (was_marked)
old_cell = UNMARK_CELL(old_cell);
old_timestamp = (tr_fr_ptr)TrailBase+IntegerOfTerm(old_cell);
if (old_timestamp >= trail_ptr) {
/* first time, we found the current timestamp */
old = MkIntTerm(0);
} else {
/* set time stamp to current */
old = old_cell;
}
*ptr = MkIntegerTerm(dest-(tr_fr_ptr)TrailBase);
if (was_marked)
MARK(ptr);
} else if (ptr < H0 || UNMARK_CELL(ptr[-1]) == (CELL)FunctorMutable) {
/* yes, we do have a time stamp */
next_timestamp = trail_ptr+2;
}
}
trail_cell = old_value_ptr[-1];
TrailTerm(dest) = old;
TrailTerm(dest+1) = trail_cell;
if (MARKED(old)) {
UNMARK(&TrailTerm(dest));
if (HEAP_PTR(old)) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(old));
}
}
dest++;
if (MARKED(trail_cell)) {
UNMARK(&TrailTerm(dest));
if (HEAP_PTR(trail_cell)) {
if (next_timestamp == trail_ptr) {
/* wait until we're over to insert in relocation chain */
TrailTerm(tri) = (CELL)dest;
tri++;
} else {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
}
}
}
trail_ptr++;
#ifdef FROZEN_REGS
if (MARKED(TrailVal(trail_ptr))) {
UNMARK(&TrailVal(trail_ptr));
if (HEAP_PTR(TrailVal(trail_ptr))) {
into_relocation_chain(&TrailVal(trail_ptr), GET_NEXT(TrailTerm(trail_ptr)));
TrailVal(dest) = TrailVal(trail_ptr);
if (MARKED(TrailVal(dest))) {
UNMARK(&TrailVal(dest));
if (HEAP_PTR(TrailVal(dest))) {
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest)));
}
}
}
#endif
old_value_ptr--;
if (MARKED(trail_cell)) {
UNMARK(old_value_ptr);
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(old_value_ptr, GET_NEXT(trail_cell));
}
}
trail_ptr = (tr_fr_ptr)old_value_ptr;
#endif
}
trail_ptr++;
dest++;
}
}
while (tri > (tr_fr_ptr)db_vec) {
tr_fr_ptr x = (tr_fr_ptr)TrailTerm(--tri);
CELL trail_cell = TrailTerm(x);
if (HEAP_PTR(trail_cell)) {
into_relocation_chain(&TrailTerm(x), GET_NEXT(trail_cell));
}
}
new_TR = dest;
if (is_gc_verbose()) {
YP_fprintf(YP_stderr,
"[GC] Trail: discarded %d (%ld%%) cells out of %ld\n",
@ -2502,7 +2594,7 @@ icompact_heap(void)
#ifdef EASY_SHUNTING
static void
set_conditionals(CELL *TRo) {
set_conditionals(tr_fr_ptr TRo) {
while (sTR != TRo) {
CELL *cptr = (CELL *)TrailTerm(sTR-1);
*cptr = TrailTerm(sTR-2);
@ -2580,10 +2672,10 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
if (total_marked != iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024)
YP_fprintf(YP_stderr,"[GC] Oops on iptop-H (%d) vs %d\n", iptop-(CELL_PTR *)H, total_marked);
#endif
if (iptop < (CELL_PTR *)ASP-1024 && 10*total_marked < H-H0) {
if (iptop < (CELL_PTR *)ASP /* && 10*total_marked < H-H0 */) {
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
#ifdef DEBUG
fprintf(stderr,"using pointers (%d)\n", effectiveness);
YP_fprintf(YP_stderr,"[GC] using pointers (%d)\n", effectiveness);
#endif
quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
adjust_cp_hbs();
@ -2591,9 +2683,11 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
} else
#endif /* HYBRID_SCHEME */
{
#ifdef DEBUG_IN
#ifdef DEBUG
#ifdef HYBID_SCHEME
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
fprintf(stderr,"not using pointers (%d)\n", effectiveness);
fprintf(stderr,"[GC] not using pointers (%d) ASP: %p, ip %p (expected %p) \n", effectiveness, ASP, iptop, H+total_marked);
#endif
#endif
compact_heap();
}
@ -2690,6 +2784,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
compaction_phase(old_TR, current_env, nextop, max);
TR = old_TR;
pop_registers(predarity, nextop);
TR = new_TR;
c_time = cputime();
YAPLeaveCriticalSection();
if (gc_verbose) {
@ -2714,7 +2809,12 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
int
is_gc_verbose(void)
{
#ifdef INSTRUMENT_GC
/* always give info when we are debugging gc */
return(TRUE);
#else
return(GetValue(AtomGcVerbose) != TermNil);
#endif
}
Int total_gc_time(void)
@ -2765,20 +2865,21 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
gc_margin <<= 1;
}
/* expand the stak if effectiveness is less than 20 % */
if (ASP - H < gc_margin || !gc_on || effectiveness < 20) {
if (FALSE&& ASP - H < gc_margin || !gc_on || effectiveness < 20) {
UInt gap = CalculateStackGap();
if (ASP-H > gc_margin)
gc_margin = (ASP-H)+MinStackGap*(stack_overflows+1);
gc_margin = (ASP-H)+gap;
else
gc_margin = 8 * (gc_margin - (ASP - H));
gc_margin = ((gc_margin >> 16) + 1) << 16;
if (gc_margin < MinStackGap)
gc_margin = MinStackGap;
while (gc_margin >= MinStackGap && !growstack(gc_margin))
if (gc_margin < gap)
gc_margin = gap;
while (gc_margin >= gap && !growstack(gc_margin))
gc_margin = gc_margin/2;
#ifdef DEBUG
check_global();
#endif
return(gc_margin >= MinStackGap);
return(gc_margin >= gap);
}
/*
* debug for(save_total=1; save_total<=N; ++save_total)

2
C/init.c
View File

@ -1015,6 +1015,7 @@ InitYaamRegs(void)
BBREG = B_FZ = B_BASE;
TR = TR_FZ = TR_BASE;
#endif /* FROZEN_REGS */
CreepFlag = CalculateStackGap();
}
@ -1124,7 +1125,6 @@ InitStacks(int Heap,
ReleaseAtom(AtomFoundVar);
LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
LookupAtomWithAddress(".",&(SF_STORE->AtDot));
CreepFlag = MinStackGap;
PutValue(LookupAtom("$catch_counter"),
MkIntTerm(0));
/* InitAbsmi must be done before InitCodes */

359
C/iopreds.c
View File

@ -82,6 +82,9 @@ typedef struct
Int max_size; /* maximum buffer size (may be changed dynamically) */
Int pos;
} mem_string;
struct {
int fd;
} pipe;
#if USE_SOCKET
struct {
socket_domain domain;
@ -111,6 +114,8 @@ STATIC_PROTO (int post_process_read_char, (int, StreamDesc *, int));
STATIC_PROTO (int SocketPutc, (int, int));
STATIC_PROTO (int ConsoleSocketPutc, (int, int));
#endif
STATIC_PROTO (int PipePutc, (int, int));
STATIC_PROTO (int ConsolePipePutc, (int, int));
STATIC_PROTO (int NullPutc, (int, int));
STATIC_PROTO (int ConsolePutc, (int, int));
STATIC_PROTO (Int p_setprompt, (void));
@ -119,6 +124,8 @@ STATIC_PROTO (int PlGetc, (int));
STATIC_PROTO (int MemGetc, (int));
STATIC_PROTO (int ISOGetc, (int));
STATIC_PROTO (int ConsoleGetc, (int));
STATIC_PROTO (int PipeGetc, (int));
STATIC_PROTO (int ConsolePipeGetc, (int));
#if USE_SOCKET
STATIC_PROTO (int SocketGetc, (int));
STATIC_PROTO (int ConsoleSocketGetc, (int));
@ -214,6 +221,8 @@ StreamDesc Stream[MaxStreams];
#define Server_Socket_Stream_f 0x010000
#endif
#define InMemory_Stream_f 0x020000
#define Pipe_Stream_f 0x040000
#define Popen_Stream_f 0x080000
int YP_stdin = 0;
int YP_stdout = 1;
@ -276,7 +285,7 @@ YP_putc(int ch, int sno)
int
YP_fflush(int sno)
{
if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f))
if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f|Pipe_Stream_f))
return(0);
return(fflush(Stream[sno].u.file.file));
}
@ -376,7 +385,11 @@ InitStdStream (int sno, SMALLUNSGN flags, YP_File file, Atom name)
s->stream_getc = ConsoleSocketGetc;
} else
#endif
if (s->status & InMemory_Stream_f) {
if (s->status & Pipe_Stream_f) {
/* Console is a socket and socket will prompt */
s->stream_putc = ConsolePipePutc;
s->stream_getc = ConsolePipeGetc;
} else if (s->status & InMemory_Stream_f) {
s->stream_putc = MemPutc;
s->stream_getc = MemGetc;
} else {
@ -629,8 +642,42 @@ SocketPutc (int sno, int ch)
console_count_output_char(ch,s,sno);
return ((int) ch);
}
#endif
/* static */
static int
ConsolePipePutc (int sno, int ch)
{
StreamDesc *s = &Stream[sno];
char c = ch;
#if MAC || _MSC_VER
if (ch == 10)
{
ch = '\n';
}
#endif
write(s->u.pipe.fd, &c, sizeof(c));
count_output_char(ch,s,sno);
return ((int) ch);
}
static int
PipePutc (int sno, int ch)
{
StreamDesc *s = &Stream[sno];
char c = ch;
#if MAC || _MSC_VER
if (ch == 10)
{
ch = '\n';
}
#endif
write(s->u.pipe.fd, &c, sizeof(c));
console_count_output_char(ch,s,sno);
return ((int) ch);
}
static int
NullPutc (int sno, int ch)
{
@ -793,7 +840,12 @@ EOFGetc(int sno)
s->stream_putc = SocketPutc;
} else
#endif
if (s->status & InMemory_Stream_f) {
if (s->status & Pipe_Stream_f) {
if (s->status & Promptable_Stream_f)
s->stream_putc = ConsolePipePutc;
else
s->stream_putc = PipePutc;
} else if (s->status & InMemory_Stream_f) {
s->stream_getc = MemGetc;
s->stream_putc = MemPutc;
} else if (s->status & Promptable_Stream_f) {
@ -946,6 +998,61 @@ ConsoleSocketGetc(int sno)
}
#endif
static int
PipeGetc(int sno)
{
register StreamDesc *s = &Stream[sno];
register int ch;
char c;
int count;
/* should be able to use a buffer */
count = read(s->u.pipe.fd, &c, sizeof(char));
if (count == 0) {
ch = EOF;
} else if (count > 0) {
ch = c;
} else {
Error(SYSTEM_ERROR, TermNil, "read");
return(EOF);
}
return(post_process_read_char(ch, s, sno));
}
/*
Basically, the same as console but also sends a prompt and takes care of
finding out whether we are at the start of a newline.
*/
static int
ConsolePipeGetc(int sno)
{
register StreamDesc *s = &Stream[sno];
register int ch;
char c;
int count;
/* send the prompt away */
if (newline) {
char *cptr = Prompt, ch;
/* use the default routine */
while ((ch = *cptr++) != '\0') {
Stream[StdErrStream].stream_putc(StdErrStream, ch);
}
strncpy(Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
newline = FALSE;
}
/* should be able to use a buffer */
count = read(s->u.pipe.fd, &c, sizeof(char));
if (count == 0) {
ch = EOF;
} else if (count > 0) {
ch = c;
} else {
Error(SYSTEM_ERROR, TermNil, "read");
return(EOF);
}
return(console_post_process_read_char(ch, s, sno));
}
/* standard routine, it should read from anything pointed by a FILE *.
It could be made more efficient by doing our own buffering and avoiding
post_process_read_char, something to think about */
@ -1132,7 +1239,9 @@ GetStreamFd(int sno)
return(Stream[sno].u.socket.fd);
} else
#endif
if (Stream[sno].status & InMemory_Stream_f) {
if (Stream[sno].status & Pipe_Stream_f) {
return(Stream[sno].u.pipe.fd);
} else if (Stream[sno].status & InMemory_Stream_f) {
return(-1);
}
return(YP_fileno(Stream[sno].u.file.file));
@ -1338,7 +1447,10 @@ p_open (void)
st->stream_getc = SocketGetc;
} else
#endif
if (st->status & InMemory_Stream_f) {
if (st->status & Pipe_Stream_f) {
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
} else if (st->status & InMemory_Stream_f) {
st->stream_putc = MemPutc;
st->stream_getc = MemGetc;
} else {
@ -1498,6 +1610,111 @@ p_open_null_stream (void)
return (unify (ARG1, t));
}
Term
OpenStream(FILE *fd, char *name, Term file_name, int flags)
{
Term t;
StreamDesc *st;
int sno;
for (sno = 0; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
break;
if (sno == MaxStreams)
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1"));
st = &Stream[sno];
st->status = 0;
if (flags & YAP_INPUT_STREAM)
st->status |= Input_Stream_f;
if (flags & YAP_OUTPUT_STREAM)
st->status |= Output_Stream_f;
if (flags & YAP_APPEND_STREAM)
st->status |= Append_Stream_f;
/*
pipes assume an integer file descriptor, not a FILE *:
if (flags & YAP_PIPE_STREAM)
st->status |= Pipe_Stream_f;
*/
if (flags & YAP_TTY_STREAM)
st->status |= Tty_Stream_f;
if (flags & YAP_POPEN_STREAM)
st->status |= Popen_Stream_f;
if (flags & YAP_BINARY_STREAM)
st->status |= Binary_Stream_f;
if (flags & YAP_SEEKABLE_STREAM)
st->status |= Seekable_Stream_f;
st->charcount = 0;
st->linecount = 1;
st->u.file.name = LookupAtom(name);
st->u.file.user_name = file_name;
st->u.file.file = fd;
st->linepos = 0;
if (flags & YAP_PIPE_STREAM) {
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
} else if (flags & YAP_TTY_STREAM) {
st->stream_putc = ConsolePutc;
st->stream_getc = ConsoleGetc;
} else {
st->stream_putc = FilePutc;
st->stream_getc = PlGetc;
unix_upd_stream_info (st);
}
if (CharConversionTable != NULL)
st->stream_getc_for_read = ISOGetc;
else
st->stream_getc_for_read = st->stream_getc;
t = MkStream (sno);
return (t);
}
static Int
p_open_pipe_stream (void)
{
Term t1, t2;
StreamDesc *st;
int sno;
int filedes[2];
if (pipe(filedes) != 0) {
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
}
for (sno = 0; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
break;
if (sno == MaxStreams)
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
st = &Stream[sno];
st->status = Input_Stream_f | Pipe_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
st->stream_getc_for_read = PipeGetc;
st->u.pipe.fd = filedes[0];
t1 = MkStream (sno);
for (; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
break;
if (sno == MaxStreams)
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
st = &Stream[sno];
st->status = Output_Stream_f | Pipe_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
if (CharConversionTable != NULL)
st->stream_getc_for_read = ISOGetc;
else
st->stream_getc_for_read = st->stream_getc;
st->u.pipe.fd = filedes[1];
t2 = MkStream (sno);
return (unify (ARG1, t1) && unify (ARG2, t2));
}
static Int
p_open_mem_read_stream (void) /* $open_mem_read_stream(+List,-Stream) */
{
@ -1839,11 +2056,42 @@ p_check_if_stream (void)
!= -1);
}
static Term
StreamName(int i)
{
#if USE_SOCKET
if (Stream[i].status & Socket_Stream_f)
return(MkAtomTerm(LookupAtom("socket")));
else
#endif
if (Stream[i].status & Pipe_Stream_f)
return(MkAtomTerm(LookupAtom("pipe")));
if (Stream[i].status & InMemory_Stream_f)
return(MkAtomTerm(LookupAtom("charsio")));
else
return(MkAtomTerm(Stream[i].u.file.name));
}
static Int
init_cur_s (void)
{ /* Init current_stream */
EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0);
return (cont_cur_s ());
Term t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
Int i = CheckStream (t3, Input_Stream_f|Output_Stream_f, "current_stream/3");
Term t1 = StreamName(i), t2;
t2 = (Stream[i].status & Input_Stream_f ?
MkAtomTerm (AtomRead) :
MkAtomTerm (AtomWrite));
if (unify(ARG1,t1) && unify(ARG2,t2)) {
cut_succeed();
} else {
cut_fail();
}
} else {
EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0);
return (cont_cur_s ());
}
}
static Int
@ -1858,15 +2106,7 @@ cont_cur_s (void)
++i;
continue;
}
#if USE_SOCKET
if (Stream[i].status & Socket_Stream_f)
t1 = MkAtomTerm(LookupAtom("socket"));
else
#endif
if (Stream[i].status & InMemory_Stream_f)
t1 = MkAtomTerm(LookupAtom("charsio"));
else
t1 = MkAtomTerm(Stream[i].u.file.name);
t1 = StreamName(i);
t2 = (Stream[i].status & Input_Stream_f ?
MkAtomTerm (AtomRead) :
MkAtomTerm (AtomWrite));
@ -1893,40 +2133,43 @@ void
CloseStreams (int loud)
{
int sno;
for (sno = 3; sno < MaxStreams; ++sno)
{
if (Stream[sno].status & Free_Stream_f)
continue;
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
YP_fclose (Stream[sno].u.file.file);
for (sno = 3; sno < MaxStreams; ++sno) {
if (Stream[sno].status & Free_Stream_f)
continue;
if ((Stream[sno].status & Popen_Stream_f))
pclose (Stream[sno].u.file.file);
if ((Stream[sno].status & (Pipe_Stream_f|Socket_Stream_f)))
close (Stream[sno].u.pipe.fd);
#if USE_SOCKET
else if (Stream[sno].status & (Socket_Stream_f)) {
CloseSocket(Stream[sno].u.socket.fd,
Stream[sno].u.socket.flags,
Stream[sno].u.socket.domain);
}
else if (Stream[sno].status & (Socket_Stream_f)) {
CloseSocket(Stream[sno].u.socket.fd,
Stream[sno].u.socket.flags,
Stream[sno].u.socket.domain);
}
#endif
else {
else if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
YP_fclose (Stream[sno].u.file.file);
else {
if (loud)
YP_fprintf (YP_stderr, "[ Error: while closing stream: %s ]\n", RepAtom (Stream[sno].u.file.name)->StrOfAE);
if (c_input_stream == sno)
{
c_input_stream = StdInStream;
}
else if (c_output_stream == sno)
{
c_output_stream = StdOutStream;
}
}
Stream[sno].status = Free_Stream_f;
}
if (c_input_stream == sno)
{
c_input_stream = StdInStream;
}
else if (c_output_stream == sno)
{
c_output_stream = StdOutStream;
}
}
Stream[sno].status = Free_Stream_f;
}
void
CloseStream(int sno)
{
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f|Pipe_Stream_f)))
YP_fclose (Stream[sno].u.file.file);
#if USE_SOCKET
else if (Stream[sno].status & (Socket_Stream_f)) {
@ -1935,6 +2178,9 @@ CloseStream(int sno)
Stream[sno].u.socket.domain);
}
#endif
else if (Stream[sno].status & (Pipe_Stream_f)) {
close(Stream[sno].u.pipe.fd);
}
else if (Stream[sno].status & (InMemory_Stream_f)) {
FreeAtomSpace(Stream[sno].u.mem_string.buf);
}
@ -2332,7 +2578,7 @@ p_read (void)
/* Scans the term using stack space */
eot_before_eof = FALSE;
if ((Stream[c_input_stream].status & (Promptable_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || CharConversionTable != NULL)
if ((Stream[c_input_stream].status & (Promptable_Stream_f|Pipe_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || CharConversionTable != NULL)
tokstart = tokptr = toktide = tokenizer (Stream[c_input_stream].stream_getc_for_read, Stream[c_input_stream].stream_getc);
else {
tokstart = tokptr = toktide = fast_tokenizer ();
@ -2507,7 +2753,9 @@ p_user_file_name (void)
tout = MkAtomTerm(LookupAtom("socket"));
else
#endif
if (Stream[sno].status & InMemory_Stream_f)
if (Stream[sno].status & Pipe_Stream_f)
tout = MkAtomTerm(LookupAtom("pipe"));
else if (Stream[sno].status & InMemory_Stream_f)
tout = MkAtomTerm(LookupAtom("charsio"));
else
tout = Stream[sno].u.file.user_name;
@ -2526,7 +2774,9 @@ p_file_name (void)
tout = MkAtomTerm(LookupAtom("socket"));
else
#endif
if (Stream[sno].status & InMemory_Stream_f)
if (Stream[sno].status & Pipe_Stream_f)
tout = MkAtomTerm(LookupAtom("pipe"));
else if (Stream[sno].status & InMemory_Stream_f)
tout = MkAtomTerm(LookupAtom("charsio"));
else
tout = MkAtomTerm(Stream[sno].u.file.name);
@ -2552,13 +2802,16 @@ p_cur_line_no (void)
my_stream = LookupAtom("socket");
else
#endif
if (Stream[sno].status & Pipe_Stream_f)
my_stream = LookupAtom("pipe");
else
if (Stream[sno].status & InMemory_Stream_f)
my_stream = LookupAtom("charsio");
else
my_stream = Stream[sno].u.file.name;
for (i = 0; i < MaxStreams; i++)
{
if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|InMemory_Stream_f)) &&
if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)) &&
Stream[i].u.file.name == my_stream)
no += Stream[i].linecount - 1;
}
@ -2643,7 +2896,7 @@ p_show_stream_position (void)
CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "stream_position/2");
if (sno < 0)
return (FALSE);
if (Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|InMemory_Stream_f))
if (Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f))
sargs[0] = MkIntTerm (Stream[sno].charcount);
else if (Stream[sno].status & Null_Stream_f)
sargs[0] = MkIntTerm (Stream[sno].charcount);
@ -3897,7 +4150,7 @@ p_flush (void)
int sno = CheckStream (ARG1, Output_Stream_f, "flush_output/1");
if (sno < 0)
return (FALSE);
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)))
YP_fflush (sno);
return (TRUE);
}
@ -4250,6 +4503,21 @@ p_all_char_conversions(void)
return(unify(ARG1,out));
}
int
StreamToFileNo(Term t)
{
int sno =
CheckStream(t, (Input_Stream_f|Output_Stream_f), "StreamToFileNo");
if (Stream[sno].status & Pipe_Stream_f) {
return(Stream[sno].u.pipe.fd);
} else if (Stream[sno].status & Socket_Stream_f) {
return(Stream[sno].u.socket.fd);
} else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) {
return(-1);
} else {
return(YP_fileno(Stream[sno].u.file.file));
}
}
void
InitBackIO (void)
@ -4274,6 +4542,7 @@ InitIOPreds(void)
InitCPred ("$get_byte", 2, p_get_byte, SafePredFlag|SyncPredFlag);
InitCPred ("$open", 4, p_open, SafePredFlag|SyncPredFlag);
InitCPred ("$open_null_stream", 1, p_open_null_stream, SafePredFlag|SyncPredFlag);
InitCPred ("$open_pipe_stream", 2, p_open_pipe_stream, SafePredFlag|SyncPredFlag);
InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag);

17
C/mavar.c
View File

@ -92,12 +92,11 @@ p_setarg(void)
timestamps.
Because of !, the only timestamp one can trust is the trailpointer
(ouch..). The trail is not reclaimed during backtracking. Also, if
there was a conditional binding, the trail is sure to have been
increased since the last choicepoint. For maximum effect, we can
actually store the current value of TR in the timestamp field,
giving a way to actually follow a link of all trailings for these
variables.
(ouch..). The trail is not reclaimed after cuts. Also, if there was
a conditional binding, the trail is sure to have been increased
since the last choicepoint. For maximum effect, we can actually
store the current value of TR in the timestamp field, giving a way
to actually follow a link of all trailings for these variables.
*/
@ -114,6 +113,8 @@ static void
CreateTimedVar(Term val)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntTerm(0);
#ifdef BEFORE_TRAIL_COMPRESSION
tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
@ -121,6 +122,7 @@ CreateTimedVar(Term val)
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
#endif
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
}
@ -129,6 +131,8 @@ static void
CreateEmptyTimedVar(void)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntTerm(0);
#ifdef BEFORE_TRAIL_COMPRESSION
tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
@ -136,6 +140,7 @@ CreateEmptyTimedVar(void)
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
#endif
RESET_VARIABLE(&(tv->value));
H += sizeof(timed_var)/sizeof(CELL);
}

2
C/stdpreds.c
View File

@ -1247,7 +1247,7 @@ static Int
p_abort(void)
{ /* abort */
/* make sure we won't go creeping around */
CreepFlag = MinStackGap*(stack_overflows+1);
CreepFlag = CalculateStackGap();
yap_flags[SPY_CREEP_FLAG] = 0;
Error(PURE_ABORT,TermNil,"");
return(FALSE);

45
C/sysbits.c
View File

@ -82,12 +82,6 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
#ifdef __MINGW32__
#ifdef HAVE_ENVIRON
#undef HAVE_ENVIRON
#endif
#endif
STATIC_PROTO (void InitPageSize, (void));
STATIC_PROTO (void InitTime, (void));
STATIC_PROTO (void InitWTime, (void));
@ -98,11 +92,11 @@ STATIC_PROTO (Int p_mv, (void));
STATIC_PROTO (Int p_cd, (void));
STATIC_PROTO (Int p_getcwd, (void));
STATIC_PROTO (Int p_dir_sp, (void));
STATIC_PROTO (Int p_getenv, (void));
STATIC_PROTO (Int p_environ, (void));
STATIC_PROTO (void InitRandom, (void));
STATIC_PROTO (Int p_srandom, (void));
STATIC_PROTO (Int p_alarm, (void));
STATIC_PROTO (Int p_getenv, (void));
STATIC_PROTO (Int p_putenv, (void));
#ifdef MACYAP
STATIC_PROTO (int chdir, (char *));
/* #define signal skel_signal */
@ -1233,7 +1227,7 @@ HandleSIGINT (int sig)
#else
#ifdef HAVE_SETBUF
/* make sure we are not waiting for the end of line */
YP_setbuf (YP_stdin, NULL);
YP_setbuf (stdin, NULL);
#endif
my_signal(SIGINT, HandleSIGINT);
#endif
@ -1800,35 +1794,6 @@ SetTextFile (name)
#endif
/* return YAP's environment */
static Int p_environ(void)
{
#if HAVE_ENVIRON
extern char **environ;
Term t1 = Deref(ARG1);
Int i;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1,
"first arg of environ/2");
return(FALSE);
} else if (!IsIntTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1,
"first arg of environ/2");
return(FALSE);
} else i = IntOfTerm(t1);
if (environ[i] == NULL)
return(FALSE);
else {
Term t = StringToList(environ[i]);
return(unify(t, ARG2));
}
#else
Error(SYSTEM_ERROR, TermNil,
"environ not available in this configuration");
return (FALSE);
#endif
}
/* return YAP's environment */
static Int p_getenv(void)
@ -1903,7 +1868,6 @@ static Int p_putenv(void)
#endif
}
/* wrapper for alarm system call */
#if defined(_WIN32)
static VOID CALLBACK HandleTimer(LPVOID v, DWORD d1, DWORD d2) {
@ -2028,10 +1992,9 @@ InitSysPreds(void)
InitCPred ("$cd", 1, p_cd, SafePredFlag|SyncPredFlag);
InitCPred ("$getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag);
InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag);
InitCPred ("$environ", 2, p_environ, SafePredFlag);
InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
}

4
C/tracer.c
View File

@ -129,10 +129,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
extern int gc_calls;
vsc_count++;
if (vsc_count < 2810) return;
/* if (vsc_count < 4382) return;*/
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
YP_fprintf(YP_stderr,"%lu ",vsc_count);
YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H);
/* check_trail_consistency(); */
if (pred == NULL) {
return;

9
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h *
* mods: *
* comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.1.1.1 2001-04-09 19:53:39 vsc Exp $ *
* version: $Id: Regs.h,v 1.2 2001-05-21 20:00:05 vsc Exp $ *
*************************************************************************/
@ -682,3 +682,10 @@ EXTERN inline void restore_B(void) {
REGSTORE standard_regs;
#endif /* PUSH_REGS */
static inline UInt
CalculateStackGap(void)
{
UInt gmin = (LCL0-H0)>>1;
UInt min_gap = MinStackGap;
return(gmin < min_gap ? min_gap : gmin );
}

12
H/yapio.h
View File

@ -259,9 +259,21 @@ int STD_PROTO(GetStreamFd,(int));
void STD_PROTO(CloseStream,(int));
int STD_PROTO(PlGetchar,(void));
int STD_PROTO(PlFGetchar,(void));
int STD_PROTO(StreamToFileNo,(Term));
extern int c_input_stream, c_output_stream, c_error_stream;
#define YAP_INPUT_STREAM 0x01
#define YAP_OUTPUT_STREAM 0x02
#define YAP_APPEND_STREAM 0x04
#define YAP_PIPE_STREAM 0x08
#define YAP_TTY_STREAM 0x10
#define YAP_POPEN_STREAM 0x20
#define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80
Term STD_PROTO(OpenStream,(FILE *,char *,Term,int));
/* routines in sysbits.c */
char *STD_PROTO(pfgets,(char *,int,YP_File));

3
Makefile.in
View File

@ -450,6 +450,7 @@ install_unix:
(cd $(srcdir)/CLPQR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
(cd $(srcdir)/CHR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
@INSTALL_DLLS@ (cd library/regex; make install)
@INSTALL_DLLS@ (cd library/system; make install)
-mkdir -p $(DESTDIR)$(INCLUDEDIR)
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
@ -473,6 +474,8 @@ install_mingw32:
(cd $(srcdir)/CHR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
(cd library/regex; make install_mingw32)
# (cd library/system; make install_mingw32)
install_library: libYap.a
$(INSTALL_DATA) -m 644 libYap.a $(DESTDIR)$(LIBDIR)/libYap.a
-mkdir $(DESTDIR)$(INCLUDEDIR)

4
OPTYap/or.engine.c
View File

@ -539,8 +539,8 @@ void share_private_nodes(int worker_q) {
/* frozen stack segment */
if (! next_node_on_branch)
next_node_on_branch = sharing_node;
STACK_PUSH(or_frame, stack, stack_top);
STACK_PUSH(sharing_node, stack, stack_top);
STACK_PUSH(or_frame, stack, stack_top, stack_base);
STACK_PUSH(sharing_node, stack, stack_top, stack_base);
sharing_node = consumer_cp;
dep_frame = DepFr_next(dep_frame);
consumer_cp = DepFr_cons_cp(dep_frame);

2
OPTYap/tab.suspend.c
View File

@ -4,6 +4,8 @@
#include "Yap.h"
#if defined(TABLING) && defined(YAPOR)
#include "Yatom.h"
#include "Heap.h"
#include "tab.macros.h"
#include "or.macros.h"

8
TO_DO
View File

@ -1,4 +1,5 @@
BEFORE 4.4:
- weird going ons with prompt
- mixed constraints and delays.
- write infinite terms
- constraints in DB.
@ -8,7 +9,11 @@ BEFORE 4.4:
- timestamps on files.
- warnings in documentation file.
- system library
- fixed restore when code is moved around.
- fix restore when code is moved around.
- library(system) for WIN32
- document system(library)
- document new interface functions.
- logtalk.
TO CHECK:
- bad register allocation for a(X,Y) :- X is Y+2.3 ?
@ -16,6 +21,7 @@ TO CHECK:
TABLING
- pass all tabling tests from Kostis and Bart paper
- handle floats, long ints and friends in tables.
- knap-sack
AFTER 4.4(?)
- change compilation order for arguments

1
changes.css Normal file
View File

@ -0,0 +1 @@
body { color: black; background-color: #FFE4C4; font-family: sans-serif; margin-left: 2em; margin-right: 2em; } h1, h2, h3, h4, h5, h6 { color: maroon; font-family: helvetica, arial, sans-serif; text-align: center; } code, pre { font-family: courier, monospace; }

2889
changes4.3.html
View File

File diff suppressed because it is too large Load Diff

18
config.h.in
View File

@ -26,10 +26,12 @@
#undef HAVE_ARPA_INET_H
#undef HAVE_CTYPE_H
#undef HAVE_DIRECT_H
#undef HAVE_DIRENT_H
#undef HAVE_ERRNO_H
#undef HAVE_FCNTL_H
#undef HAVE_FENV_H
#undef HAVE_FPU_CONTROL_H
#undef HAVE_GMP_H
#undef HAVE_IEEEFP_H
#undef HAVE_LIMITS_H
#undef HAVE_MEMORY_H
@ -37,6 +39,7 @@
#undef HAVE_NETINET_IN_H
#undef HAVE_REGEX_H
#undef HAVE_SIGINFO_H
#undef HAVE_SIGNAL_H
#undef HAVE_STDARG_H
#undef HAVE_STRING_H
#undef HAVE_SYS_FILE_H
@ -56,7 +59,6 @@
#undef HAVE_UNISTD_H
#undef HAVE_WINSOCK_H
#undef HAVE_WINSOCK2_H
#undef HAVE_GMP_H
/* Do we have restartable syscalls */
#undef HAVE_RESTARTABLE_SYSCALLS
@ -101,6 +103,9 @@
#undef HAVE_DUP2
#undef HAVE_FETESTEXCEPT
#undef HAVE_FINITE
#undef HAVE_GETHOSTBYNAME
#undef HAVE_GETHOSTID
#undef HAVE_GETHOSTNAME
#undef HAVE_GETRUSAGE
#undef HAVE_GETCWD
#undef HAVE_GETENV
@ -110,15 +115,22 @@
#undef HAVE_GETWD
#undef HAVE_ISATTY
#undef HAVE_ISNAN
#undef HAVE_KILL
#undef HAVE_LABS
#undef HAVE_LINK
#undef HAVE_LOCALTIME
#undef HAVE_LSTAT
#undef HAVE_MMAP
#undef HAVE_MEMCPY
#undef HAVE_MEMMOVE
#undef HAVE_MKSTEMP
#undef HAVE_MKTEMP
#undef HAVE_OPENDIR
#undef HAVE_POPEN
#undef HAVE_PUTENV
#undef HAVE_RAND
#undef HAVE_RANDOM
#undef HAVE_RENAME
#undef HAVE_RINT
#undef HAVE_SBRK
#undef HAVE_STAT
@ -132,6 +144,7 @@
#undef HAVE_SIGPROCMASK
#undef HAVE_SIGSEGV
#undef HAVE_SIGSETJMP
#undef HAVE_SLEEP
#undef HAVE_SNPRINTF
#undef HAVE_SOCKET
#undef HAVE_STRERROR
@ -140,9 +153,12 @@
#undef HAVE_STRCHR
#undef HAVE_STRTOD
#undef HAVE_SYSTEM
#undef HAVE_TIME
#undef HAVE_TIMES
#undef HAVE_TMPNAM
#undef HAVE_USLEEP
#undef HAVE_VSNPRINTF
#undef HAVE_WAITPID
#undef HAVE_ENVIRON
#undef HAVE_MPZ_XOR

125
configure vendored
View File

@ -2461,7 +2461,7 @@ else
fi
done
for ac_hdr in sys/select.h direct.h
for ac_hdr in sys/select.h direct.h dirent.h signal.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
@ -3612,7 +3612,7 @@ else
fi
done
for ac_func in setlinebuf
for ac_func in setlinebuf lstat opendir localtime time gethostname
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:3619: checking for $ac_func" >&5
@ -3667,15 +3667,125 @@ else
fi
done
for ac_func in gethostid gethostbyname kill mktemp popen rename waitpid
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:3674: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 3679 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:3702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
for ac_func in sleep usleep
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:3729: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 3734 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:3757: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
echo $ac_n "checking for mpz_xor""... $ac_c" 1>&6
echo "configure:3673: checking for mpz_xor" >&5
echo "configure:3783: checking for mpz_xor" >&5
if eval "test \"`echo '$''{'yap_mpz_xor'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 3679 "configure"
#line 3789 "configure"
#include "confdefs.h"
#include <gmp.h>
void check(mpz_t rop,mpz_t op1,mpz_t op2) {
@ -3686,7 +3796,7 @@ int main() {
; return 0; }
EOF
if { (eval echo configure:3690: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:3800: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
yap_mpz_xor=yes
else
@ -3713,6 +3823,7 @@ EOF
fi
mkdir -p library/regex
mkdir -p library/system
trap '' 1 2 15
cat > confcache <<\EOF
@ -3815,7 +3926,7 @@ done
ac_given_srcdir=$srcdir
ac_given_INSTALL="$INSTALL"
trap 'rm -fr `echo "Makefile library/regex/Makefile .depend config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
trap 'rm -fr `echo "Makefile library/regex/Makefile library/system/Makefile .depend config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@ -3925,7 +4036,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile library/regex/Makefile .depend"}
CONFIG_FILES=\${CONFIG_FILES-"Makefile library/regex/Makefile library/system/Makefile .depend"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then

9
configure.in
View File

@ -395,7 +395,7 @@ AC_CHECK_HEADERS(sys/param.h errno.h netdb.h netinet/in.h arpa/inet.h)
AC_CHECK_HEADERS(string.h memory.h sys/mman.h sys/stat.h stdarg.h ctype.h)
AC_CHECK_HEADERS(sys/resource.h limits.h siginfo.h time.h fenv.h)
AC_CHECK_HEADERS(fpu_control.h sys/shm.h regex.h winsock.h winsock2.h)
AC_CHECK_HEADERS(sys/select.h direct.h)
AC_CHECK_HEADERS(sys/select.h direct.h dirent.h signal.h)
if test "$yap_cv_gmp" != "no"
then
AC_CHECK_HEADERS(gmp.h)
@ -567,7 +567,9 @@ AC_CHECK_FUNCS(snprintf vsnprintf setbuf system link getpwnam dup2 sigprocmask)
AC_CHECK_FUNCS(labs strncat tmpnam getenv gettimeofday gethrtime putenv)
AC_CHECK_FUNCS(strerror socket memmove alarm asinh acosh atanh rint)
AC_CHECK_FUNCS(stat select fetestexcept finite strncpy mkstemp isnan)
AC_CHECK_FUNCS(setlinebuf)
AC_CHECK_FUNCS(setlinebuf lstat opendir localtime time gethostname)
AC_CHECK_FUNCS(gethostid gethostbyname kill mktemp popen rename waitpid)
AC_CHECK_FUNCS(sleep usleep)
dnl check for mpz_xor
AC_MSG_CHECKING(for mpz_xor)
@ -589,8 +591,9 @@ AC_DEFINE(HAVE_MPZ_XOR,0)
fi
mkdir -p library/regex
mkdir -p library/system
AC_OUTPUT(Makefile library/regex/Makefile .depend)
AC_OUTPUT(Makefile library/regex/Makefile library/system/Makefile .depend)
make depend

5
docs/yap.tex
View File

@ -3250,7 +3250,8 @@ YAP currently ignores these options.
@cnindex current_stream/3
Defines the relation: The stream @var{S} is opened on the file @var{F} in
mode @var{M}. It might be used to obtain all open streams (by
backtracking) or to access the stream for a file @var{F} in mode @var{M}.
backtracking), to access the stream for a file @var{F} in mode @var{M},
or to find properties for a stream @var{S}.
@item flush_output [ISO]
@findex flush_output/0
@ -11521,7 +11522,7 @@ void init_my_predicates()
The commands to compile the above file depend on the operating
system. Under Linux (i386 and Alpha) you should use:
@example
gcc -c -shared -fPIC my_process.c -o my_process.o
gcc -c -shared -fPIC my_process.c
ld -shared -o my_process.so my_process.o
@end example
@noindent

48
include/c_interface.h
View File

@ -504,6 +504,24 @@ static void (YapIStringToBuffer)() = YapStringToBuffer;
#define StringToBuffer(T,BUF,SIZE) YapStringToBuffer(T,BUF,SIZE)
#endif
/* int BufferToString(char *) */
extern X_API Term PROTO(YapBufferToString,(char *));
#ifdef IndirectCalls
static void (YapIBufferToString)() = YapBufferToString;
#define BufferToString(BUF) (*YapIBufferToString)(BUF)
#else
#define BufferToString(BUF) YapBufferToString(BUF)
#endif
/* int BufferToAtomList(char *) */
extern X_API Term PROTO(YapBufferToAtomList,(char *));
#ifdef IndirectCalls
static void (YapIBufferToAtomList)() = YapBufferToAtomList;
#define BufferToAtomList(BUF) (*YapIBufferToAtomList)(BUF)
#else
#define BufferToAtomList(BUF) YapBufferToAtomList(BUF)
#endif
/* void YapInitSocks(char *,long) */
extern X_API int PROTO(YapInitSocks,(char *,long));
#ifdef IndirectCalls
@ -534,6 +552,36 @@ static void (*YapISetOutputMessage)() = YapSetOutputMessage;
#define YapSetOutputMessage() (*YapISetOutputMessage)()
#endif
/* Term YapSetOutputMessage() */
extern X_API int PROTO(YapStreamToFileNo,(Term));
#ifdef IndirectCalls
static void (*YapIStreamToFileNo)() = YapStreamToFileNo;
#define YapStreamToFileNo() (*YapIStreamToFileNo)()
#endif
/* Term YapSetOutputMessage() */
extern X_API void PROTO(YapCloseAllOpenStreams,(void));
#ifdef IndirectCalls
static void (*YapICloseAllOpenStreams)() = YapCloseAllOpenStreams;
#define YapCloseAllOpenStreams() (*YapICloseAllOpenStreams)()
#endif
#define YAP_INPUT_STREAM 0x01
#define YAP_OUTPUT_STREAM 0x02
#define YAP_APPEND_STREAM 0x04
#define YAP_PIPE_STREAM 0x08
#define YAP_TTY_STREAM 0x10
#define YAP_POPEN_STREAM 0x20
#define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80
/* Term YapP() */
extern X_API Term PROTO(YapOpenStream,(void *, char *, Term, int));
#ifdef IndirectCalls
static Term (*YapIOpenStream)() = YapOpenStream;
#define YapOpenStream(FD,S,T,FL) (*YapIOpenStream)(FD,S,T,FL)
#endif
#define InitCPred(N,A,F) UserCPredicate(N,F,A)

6
misc/yap.def
View File

@ -42,6 +42,8 @@ Yapcut_succeed
YapAllocSpaceFromYap
YapFreeSpaceFromYap
YapStringToBuffer
YapBufferToString
YapBufferToAtomList
YapError
YapRunGoal
YapContinueGoal
@ -58,4 +60,6 @@ YapSetOutputMessage
YapWrite
YapInitConsult
YapEndConsult
YapStreamToFileNo
YapCloseAllOpenStreams
YapOpenStream

5
pl/arith.yap
View File

@ -36,6 +36,11 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
'$c_built_in'(IN, IN).
'$do_c_built_in'(\+ G, OUT) :-
nonvar(G),
G = (A = B),
!,
OUT = (A \= B).
'$do_c_built_in'(recorded(K,T,R), OUT) :-
nonvar(K),
!,

8
pl/boot.yap
View File

@ -116,7 +116,8 @@ set_output(Stream) :-
8 use portray(_)
*/
write(T) :- current_output(S), '$write'(S,4,T).
write(T) :- current_output(S), '$write'(S,4,T), fail.
write(_).
write(Stream,T) :-
'$write'(Stream,4,T),
@ -127,7 +128,8 @@ put(Stream,N) :- N1 is N, '$put'(Stream,N1).
nl(Stream) :- '$put'(Stream,10).
nl :- current_output(Stream), '$put'(Stream,10).
nl :- current_output(Stream), '$put'(Stream,10), fail.
nl.
/* main execution loop */
'$read_vars'(Stream,T,V) :-
@ -1049,7 +1051,7 @@ add_to_path(New) :- add_to_path(New,last).
add_to_path(New,Pos) :- '$check_path'(New,Str), '$add_to_path'(Str,Pos).
'$add_to_path'(New,_) :- '$recorded'('$path',New,R), erase(R), fail.
'$add_to_path'(New,last) :- '$recordz'('$path',New,_).
'$add_to_path'(New,last) :- !, '$recordz'('$path',New,_).
'$add_to_path'(New,first) :- '$recorda'('$path',New,_).
remove_from_path(New) :- '$check_path'(New,Path),

6
pl/errors.yap
View File

@ -101,6 +101,9 @@ print_message(help,M) :-
'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
format(user_error,"[ DOMAIN ERROR- ~w: invalid list of codes ~w ]~n",
[Where,Opt]).
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
format(user_error,"[ DOMAIN ERROR- ~w: invalid list of options ~w ]~n",
[Where,Opt]).
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
format(user_error,"[ DOMAIN ERROR- ~w: invalid operator specifier ~w ]~n",
[Where,Op]).
@ -284,6 +287,9 @@ print_message(help,M) :-
'$output_error_message'(system_error, Where) :-
format(user_error,"[ SYSTEM ERROR- ~w ]~n",
[Where]).
'$output_error_message'(system_error(Message), Where) :-
format(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
[Message,Where]).
'$output_error_message'(type_error(T,_,Err,M), Where) :-
format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
[T,Err,M]).

1
pl/preds.yap
View File

@ -61,6 +61,7 @@ assert(C) :- '$assert'(C,last,_,assert(C)).
throw(error(permission_error(modify,static_procedure,Na/Ar),P))
).
'$assert_dynamic'(V,Where,R,P) :- var(V), !,
'$current_module'(M),
throw(error(instantiation_error,P)).

2
pl/tabling.yap
View File

@ -51,7 +51,7 @@ show_trie(X) :- var(X), !,
show_trie(A/N) :- integer(N), atom(A), !,
functor(T,A,N), $flags(T,F,F),
(
X is F /\ 8'000100, X =\= 0, !, $show_trie(T)
X is F /\ 8'000100, X =\= 0, !, $show_trie(T,_)
;
write(user_error, '[ Error: '),
write(user_error, A/N),

27
pl/utils.yap
View File

@ -249,26 +249,6 @@ rename(Old,New) :- atom(Old), atom(New), !,
name(Old,SOld), name(New,SNew),
'$rename'(SOld,SNew).
environ(Na,Val) :- atom(Na), !,
'$getenv'(Na,Val).
environ(Na,Val) :-
'$environ_enum'(0,I),
( '$environ'(I,S) -> '$environ_split'(S,SNa,SVal) ; !, fail ),
atom_codes(Na, SNa),
atom_codes(Val, SVal).
'$environ_enum'(X,X).
'$environ_enum'(X,X1) :-
Xi is X+1,
'$environ_enum'(Xi,X1).
'$environ_split'([61|SVal], [], SVal) :- !.
'$environ_split'([C|S],[C|SNa],SVal) :-
'$environ_split'(S,SNa,SVal).
putenv(Na,Val) :-
'$putenv'(Na,Val).
unix(V) :- var(V), !,
throw(error(instantiation_error,unix(V))).
unix(argv(L)) :- (var(L) ; atom(L)), !, '$argv'(L).
@ -280,7 +260,7 @@ unix(cd(V)) :- var(V), !,
unix(cd(A)) :- atomic(A), !, cd(A).
unix(cd(V)) :-
throw(error(type_error(atomic,V),unix(cd(V)))).
unix(environ(X,Y)) :- environ(X,Y).
unix(environ(X,Y)) :- do_environ(X,Y).
unix(getcwd(X)) :- getcwd(X).
unix(shell(V)) :- var(V), !,
throw(error(instantiation_error,unix(shell(V)))).
@ -295,6 +275,11 @@ unix(system(V)) :-
unix(shell) :- sh.
unix(putenv(X,Y)) :- '$putenv'(X,Y).
putenv(Na,Val) :-
'$putenv'(Na,Val).
getenv(Na,Val) :-
'$getenv'(Na,Val).
alarm(_, _, _) :-
recorded('$alarm_handler',_, Ref), erase(Ref), fail.

2
pl/yio.yap
View File

@ -236,6 +236,8 @@ open(F,T,S,Opts) :-
open_null_stream(S) :- '$open_null_stream'(S).
open_pipe_streams(P1,P2) :- '$open_pipe_stream'(P1, P2).
fileerrors :- '$set_value'(fileerrors,1).
nofileerrors :- '$set_value'(fileerrors,0).