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

fix C major issues

Browse Source 
- use delays to implement setup_call
- fix user_* flag
- error handling i CXX should b local
- fix mess on  how to call openQuert
- deter pt -> from a pointer to another one
- avoid text forms when you can use C: LOCLS to locals.h
- fux seto_call
- new gated call
- mem streams
This commit is contained in:
Vitor Santos Costa
2017-08-21 12:29:58 +01:00
parent f8f1d75ad6
commit 54234c7e1d
37 changed files with 1233 additions and 2579 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
C/bignum.c
View File

@@ -127,12 +127,13 @@ Term Yap_RatTermToApplTerm(Term t) {
#endif
Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, CELL **pt) {
Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, void *pt) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR + 2);
CELL *ret = HR;
CELL **blobp;
nlimbs = ALIGN_BY_TYPE(bytes, CELL) / CellSize;
if (nlimbs > (ASP - ret) - 1024) {
return TermNil;
@@ -144,13 +145,14 @@ Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, CELL **pt) {
HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials;
HR++;
*pt = (CELL *)(dst + 1);
blobp = (CELL **)pt;
*blobp = (CELL *)(dst + 1);
return AbsAppl(ret);
}
int Yap_CleanOpaqueVariable(CELL d) {
CELL blob_info, blob_tag;
MP_INT *blobp;
CELL *pt = RepAppl(HeadOfTerm(d));
#ifdef DEBUG
/* sanity checking */

7
C/c_interface.c
View File

@@ -2134,6 +2134,13 @@ X_API int YAP_InitConsult(int mode, const char *filename, char *full,
return sno;
}
/// given a stream descriptor or stream alias (see open/3),
/// return YAP's internal handle.
X_API void *YAP_GetStreamFromId(int no)
{
return GLOBAL_Stream+no;
}
X_API FILE *YAP_TermToStream(Term t) {
BACKUP_MACHINE_REGS();
FILE *s;

203
C/exec.c
View File

@@ -723,23 +723,19 @@ static void prune_inner_computation(choiceptr parent) {
Int oENV = LCL0 - ENV;
cut_pt = B;
while (cut_pt < parent) {
/* make sure we
e C-choicepoints */
if (POP_CHOICE_POINT(cut_pt->cp_b)) {
POP_EXECUTE();
}
while (cut_pt->cp_b < parent) {
cut_pt = cut_pt->cp_b;
}
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif
B = parent;
B = cut_pt;
Yap_TrimTrail();
LOCAL_AllowRestart = FALSE;
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
B = parent;
}
/**
@@ -781,7 +777,7 @@ static Int Yap_ignore(Term t USES_REGS) {
CP = oCP;
ENV = LCL0 - oENV;
YENV = LCL0 - oYENV;
B = (choiceptr)(LCL0-oB);
B = (choiceptr)(LCL0 - oB);
return false;
}
@@ -819,43 +815,29 @@ static bool watch_cut(Term ext USES_REGS) {
// called after backtracking..
//
Term task = TailOfTerm(ext);
Term box = ArgOfTerm(1, task);
Term port = ArgOfTerm(2, task);
Term cleanup = ArgOfTerm(3, task);
Term cleaned = ArgOfTerm(6, task);
bool first = Deref(ArgOfTerm(5, task)) == MkIntTerm(0);
bool done = first && !IsVarTerm(Deref(ArgOfTerm(4, task)));
bool previous = !IsVarTerm(Deref(ArgOfTerm(6, task)));
if (done || previous)
bool complete = !IsVarTerm(Deref(ArgOfTerm(4, task)));
bool active = ArgOfTerm(5, task) == TermTrue;
if (complete) {
return true;
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
}
CELL *port_pt = deref_ptr(RepAppl(task) + 2);
if (Yap_HasException()) {
Term e = Yap_GetException();
Term t;
if (first) {
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
} else {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
if (!Yap_unify(port, t))
return false;
port_pt[0] = t;
} else {
if (!Yap_unify(port, TermCut))
return false;
port_pt[0] = TermCut;
}
if (IsVarTerm(cleaned) && box != TermTrue)
{
*VarOfTerm(cleaned) = Deref(port);
}
else
{
return true;
}
Yap_ignore(cleanup);
CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
complete_pt[0] = TermTrue;
if (Yap_RaiseException())
return false;
return true;
@@ -876,58 +858,39 @@ static bool watch_retry(Term d0 USES_REGS) {
choiceptr B0 = (choiceptr)(LCL0 - d);
Term task = TailOfTerm(d0);
Term box = ArgOfTerm(1, task);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
Term port = ArgOfTerm(2, task);
Term cleaned = ArgOfTerm(6, task);
bool first = Deref(ArgOfTerm(5, task)) == MkIntTerm(0);
bool done = first && !IsVarTerm(Deref(ArgOfTerm(4, task)));
bool previous = !IsVarTerm(Deref(ArgOfTerm(6, task)));
bool ex = false;
if (done || previous)
bool complete = !IsVarTerm(ArgOfTerm(4, task));
bool active = ArgOfTerm(5, task) == TermTrue;
if ( complete)
return true;
CELL *port_pt= deref_ptr(RepAppl(Deref(task))+ 2);
CELL *complete_pt= deref_ptr(RepAppl(Deref(task))+ 4);
Term t;
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (Yap_HasException())
{
B = B->cp_b;
if (Yap_HasException()) {
Term e = Yap_GetException();
Term t;
ex = true;
if (first)
{
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
}
else
{
} else {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
if (!Yap_unify(port, t))
return false;
}
else if(B < B0)
{
if (box != TermTrue) {
return true;
}
if (!Yap_unify(port, TermRetry)) {
return false;
}
} else if (first) {
if (!Yap_unify(port, TermFail))
return false;
} else {
return true;
}
if (IsVarTerm(cleaned) && box != TermTrue) {
*VarOfTerm(cleaned) = Deref(port);
complete_pt[0] = t;
} else if (B >= B0) {
t = TermFail;
complete_pt[0] = t;
} else if (box) {
t = TermRetry;
} else {
return true;
}
port_pt[0] = t;
Yap_ignore(cleanup);
if (!ex && Yap_RaiseException())
if ( Yap_RaiseException())
return false;
return true;
}
@@ -958,7 +921,7 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
}
if (!rc) {
complete_inner_computation(B0);
// We'll pass it through
// We'll pass it throughs
return false;
} else {
@@ -971,52 +934,40 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
return rc;
}
static Int tag_cleanup(USES_REGS1)
{
static Int tag_cleanup(USES_REGS1) {
Int iB = LCL0 - (CELL *)B;
set_watch(iB, Deref(ARG2));
return Yap_unify(ARG1, MkIntegerTerm(iB));
}
static Int cleanup_on_exit(USES_REGS1)
{
static Int cleanup_on_exit(USES_REGS1) {
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
Term box = ArgOfTerm(1, task);
Term cleanup = ArgOfTerm(3, task);
Term catcher = ArgOfTerm(2, task);
Term tag = ArgOfTerm(4, task);
Term cleaned = ArgOfTerm(6, task);
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (B < B0)
{
// non-deterministic
set_watch(LCL0 - (CELL *)B, task);
if (box == TermTrue)
{
if (!Yap_unify(catcher, TermAnswer))
return false;
B->cp_tr++;
Yap_ignore(cleanup);
B->cp_tr--;
}
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
Term catcher = ArgOfTerm(2, task);
Term complete = !IsVarTerm( ArgOfTerm(4, task));
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (complete )
return true;
CELL *catcher_p = deref_ptr(RepAppl(Deref(task))+2);
if (B < B0)
{
// non-deterministic
set_watch(LCL0 - (CELL *)B, task);
catcher_p[0] = TermAnswer;
if (!box) {
return true;
}
if (!Yap_unify(catcher, TermExit))
return false;
if (IsVarTerm(tag))
*VarOfTerm(tag) = TermTrue;
if (IsVarTerm(cleaned) && box != TermTrue)
{
*VarOfTerm(cleaned) = TermExit;
}
else
{
return true;
}
Yap_ignore(cleanup);
} else {
catcher_p[0] = TermExit;
CELL *complete_p = deref_ptr(RepAppl(Deref(task))+4);
complete_p[0] = TermExit;
}
Yap_ignore(cleanup);
return true;
}
@@ -1490,8 +1441,6 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) {
// PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */
out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS);
if (top)
Yap_flush();
// if (out) {
// out = Yap_GetFromSlot(sl);
// }
@@ -1987,30 +1936,6 @@ static Int JumpToEnv() {
}
POP_FAIL(handler);
B = handler;
// Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
/* can recover Heap thanks to copy term :-( */
/* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
// handler->cp_h = HR;
/* try to recover space */
/* can only do that when we recover space */
/* first, backtrack */
/* so that I recover memory execute op_fail */
// now put the ball in place
// Yap_CopyException(dbt);
Term t = Yap_GetException();
if (t == 0) {
return false;
} else if (IsVarTerm(t)) {
t = Yap_MkApplTerm(FunctorGVar, 1, &t);
}
Yap_unify(t, B->cp_a2);
B->cp_h = HR;
TR--;
}
P = FAILCODE;
return true;
}

12
C/flags.c
View File

@@ -186,25 +186,19 @@ static Term stream(Term inp) {
static bool set_error_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream));
LOCAL_c_error_stream = Yap_CheckStream(
inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetErrorStream( inp );
}
static bool set_input_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream));
LOCAL_c_input_stream =
Yap_CheckStream(inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetInputStream( inp );
}
static bool set_output_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream));
LOCAL_c_output_stream = Yap_CheckStream(
inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetOutputStream( inp );
}
static Term isground(Term inp) {

10
C/heapgc.c
View File

@@ -134,7 +134,7 @@ gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0 USES_REGS)
#endif
/* could not find more trail */
save_machine_regs();
siglongjmp(*LOCAL_gc_restore, 2);
siglongjmp(LOCAL_gc_restore, 2);
}
}
@@ -397,7 +397,7 @@ check_pr_trail( tr_fr_ptr rc USES_REGS)
if (!Yap_locked_growtrail(0, TRUE) || TRUE) {
/* could not find more trail */
save_machine_regs();
siglongjmp(*LOCAL_gc_restore, 2);
siglongjmp( LOCAL_gc_restore, 2);
}
rc = TR-n;
}
@@ -525,7 +525,7 @@ pop_registers(Int num_regs, yamop *nextop USES_REGS)
/* error: we don't have enough room */
/* could not find more trail */
save_machine_regs();
siglongjmp(*LOCAL_gc_restore, 4);
siglongjmp(LOCAL_gc_restore, 4);
}
}
}
@@ -1451,7 +1451,7 @@ mark_variable(CELL_PTR current USES_REGS)
/* error: we don't have enough room */
/* could not find more trail */
save_machine_regs();
siglongjmp(*LOCAL_gc_restore, 3);
siglongjmp(LOCAL_gc_restore, 3);
} else if (n > 0) {
CELL *ptr = LOCAL_extra_gc_cells;
@@ -3931,8 +3931,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
int jmp_res;
sigjmp_buf jmp;
LOCAL_gc_restore = &jmp;
heap_cells = HR-H0;
gc_verbose = is_gc_verbose();
effectiveness = 0;