diff --git a/C/absmi.c b/C/absmi.c index c239cba6b..94848a886 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -792,7 +792,6 @@ Yap_absmi(int inp) noheapleft: { CELL cut_b = LCL0-(CELL *)(SREG[E_CB]); - #ifdef SHADOW_S S = SREG; #endif @@ -2214,7 +2213,15 @@ Yap_absmi(int inp) /* cut */ Op(cut, e); - PREG = NEXTOP(PREG, e); +#ifdef COROUTINING + if (FALSE) { + CACHE_Y_AS_ENV(YREG); + check_stack(NoStackCut, H); + ENDCACHE_Y_AS_ENV(); + } + do_cut: +#endif + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l); { choiceptr d0; /* assume cut is always in stack */ @@ -2254,7 +2261,15 @@ Yap_absmi(int inp) /* cut_t */ /* cut_t does the same as cut */ Op(cut_t, e); - PREG = NEXTOP(PREG, e); +#ifdef COROUTINING + if (FALSE) { + CACHE_Y_AS_ENV(YREG); + check_stack(NoStackCutT, H); + ENDCACHE_Y_AS_ENV(); + } + do_cut_t: +#endif + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l); { choiceptr d0; @@ -2309,7 +2324,15 @@ Yap_absmi(int inp) /* cut_e */ Op(cut_e, e); - PREG = NEXTOP(PREG, e); +#ifdef COROUTINING + if (FALSE) { + CACHE_Y_AS_ENV(YREG); + check_stack(NoStackCutE, H); + ENDCACHE_Y_AS_ENV(); + } + do_cut_e: +#endif + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l); { choiceptr d0; /* we assume dealloc leaves in S the previous env */ @@ -2511,6 +2534,7 @@ Yap_absmi(int inp) PP = PREG->u.pp.p0; if (ActiveSignals & YAP_CDOVF_SIGNAL) { ASP = YREG+E_CB; + SREG = YENV; if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); goto noheapleft; @@ -2666,6 +2690,7 @@ Yap_absmi(int inp) SREG = (CELL *) PREG->u.Osbpp.p; if (ActiveSignals & YAP_CDOVF_SIGNAL) { ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s); + SREG = YENV; if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); goto noheapleft; @@ -2702,7 +2727,9 @@ Yap_absmi(int inp) /* don't do a creep here; also, if our instruction is followed by a execute_c, just wait a bit more */ - if (ActiveSignals & YAP_CREEP_SIGNAL || + if ( (ActiveSignals & YAP_CREEP_SIGNAL && + /* keep on going if there is something else */ + !(ActiveSignals & ~YAP_CREEP_SIGNAL)) || (PREG->opc != Yap_opcode(_procceed) && PREG->opc != Yap_opcode(_cut_e))) { GONext(); @@ -2740,6 +2767,66 @@ Yap_absmi(int inp) #ifdef COROUTINING + /* This is easier: I know there is an environment so I cannot do allocate */ + NoStackCut: + /* find something to fool S */ + if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) { + goto do_cut; + } + if (ActiveSignals & YAP_FAIL_SIGNAL) { + ActiveSignals &= ~YAP_FAIL_SIGNAL; + if (!ActiveSignals) + CreepFlag = CalculateStackGap(); + FAIL(); + } + if (!(ActiveSignals & YAP_CREEP_SIGNAL)) { + SREG = (CELL *)PredRestoreRegs; + XREGS[0] = MkIntegerTerm(LCL0-(CELL *)YREG[E_CB]); + PREG = NEXTOP(PREG,e); + goto creep_either; + } + /* don't do debugging and friends here */ + goto do_cut; + + NoStackCutT: + /* find something to fool S */ + if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) { + goto do_cut_t; + } + if (ActiveSignals & YAP_FAIL_SIGNAL) { + ActiveSignals &= ~YAP_FAIL_SIGNAL; + if (!ActiveSignals) + CreepFlag = CalculateStackGap(); + FAIL(); + } + if (!(ActiveSignals & YAP_CREEP_SIGNAL)) { + SREG = (CELL *)PredRestoreRegs; + XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]); + PREG = NEXTOP(PREG,e); + goto creep_either; + } + /* don't do debugging and friends here */ + goto do_cut_t; + + NoStackCutE: + if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) { + goto do_cut_t; + } + if (ActiveSignals & YAP_FAIL_SIGNAL) { + ActiveSignals &= ~YAP_FAIL_SIGNAL; + if (!ActiveSignals) + CreepFlag = CalculateStackGap(); + FAIL(); + } + if (!(ActiveSignals & YAP_CREEP_SIGNAL)) { + SREG = (CELL *)PredRestoreRegs; + XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]); + PREG = NEXTOP(PREG,e); + goto creep_either; + } + /* don't do debugging and friends here */ + goto do_cut_e; + /* This is easier: I know there is an environment so I cannot do allocate */ NoStackCommitY: PP = PREG->u.yp.p0; @@ -2754,7 +2841,7 @@ Yap_absmi(int inp) FAIL(); } if (!(ActiveSignals & YAP_CREEP_SIGNAL)) { - SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0)); + SREG = (CELL *)PredRestoreRegs; XREGS[0] = YREG[PREG->u.yp.y]; PREG = NEXTOP(PREG,yp); goto creep_either; @@ -2776,7 +2863,7 @@ Yap_absmi(int inp) FAIL(); } if (!(ActiveSignals & YAP_CREEP_SIGNAL)) { - SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0)); + SREG = (CELL *)PredRestoreRegs; #if USE_THREADED_CODE if (PREG->opc == (OPCODE)OpAddress[_fcall]) #else @@ -2840,6 +2927,7 @@ Yap_absmi(int inp) ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s); if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); + SREG = YENV; goto noheapleft; } if (ActiveSignals) { @@ -2963,6 +3051,7 @@ Yap_absmi(int inp) ASP = YREG+E_CB; if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); + SREG = YENV; goto noheapleft; } if (ActiveSignals) @@ -14472,6 +14561,7 @@ Yap_absmi(int inp) if (ActiveSignals) { if (ActiveSignals & YAP_CDOVF_SIGNAL) { UNLOCK(SignalLock); + SREG = YENV; goto noheapleft; } UNLOCK(SignalLock); diff --git a/C/agc.c b/C/agc.c index d81b692ac..7f37a92db 100755 --- a/C/agc.c +++ b/C/agc.c @@ -143,6 +143,7 @@ static Term AdjustDBTerm(Term, Term *); #define OpcodeAdjust(P) (P) #define ModuleAdjust(P) (P) #define ExternalFunctionAdjust(P) (P) +#define DBRecordAdjust(P) (P) #define PredEntryAdjust(P) (P) #define ModEntryPtrAdjust(P) (P) #define AtomEntryAdjust(P) (P) @@ -200,6 +201,8 @@ static Term AdjustDBTerm(Term, Term *); #include "rheap.h" + + static void RestoreHashPreds(void) { diff --git a/C/alloc.c b/C/alloc.c index 98ae23471..a0b0fe53b 100755 --- a/C/alloc.c +++ b/C/alloc.c @@ -1595,15 +1595,29 @@ Yap_ExtendWorkSpaceThroughHole(UInt s) WorkSpaceTop = WorkSpaceTop0; return -1; } +#endif +#elif SIZEOF_INT_P==8 + { + int n = 1024*1024; + while (n) { + /* progress 1 MB */ + WorkSpaceTop += 512*1024; + if (ExtendWorkSpace(s, MAP_FIXED)) { + Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); + Yap_ErrorMessage = NULL; + return WorkSpaceTop-WorkSpaceTop0; + } +#if defined(_WIN32) + /* 487 happens when you step over someone else's memory */ + if (GetLastError() != 487) { + WorkSpaceTop = WorkSpaceTop0; + return -1; + } +#endif + } #endif } WorkSpaceTop = WorkSpaceTop0; -#endif - if (ExtendWorkSpace(s, 0)) { - Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); - Yap_ErrorMessage = NULL; - return WorkSpaceTop-WorkSpaceTop0; - } #endif return -1; } diff --git a/C/amasm.c b/C/amasm.c index c5702d73a..1c8ebbcbe 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -3397,8 +3397,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp code_p = a_cnp(_native_me, code_p, pass_no, cip); break; case cutexit_op: - code_p = a_cut(&clinfo, code_p, pass_no, cip); - if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && + if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found) code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip); @@ -3409,7 +3408,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp !clinfo.alloc_found) code_p = a_e(_unlock_lu, code_p, pass_no); #endif - code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no); + code_p = a_cut(&clinfo, code_p, pass_no, cip); break; case allocate_op: clinfo.alloc_found = 2; diff --git a/C/c_interface.c b/C/c_interface.c index eef287b9f..eac1cb109 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1413,8 +1413,13 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code) if (pe->PredFlags & SWIEnvPredFlag) { CPredicateV codev = (CPredicateV)exec_code; struct foreign_context ctx; + UInt i; + Int sl = 0; ctx.engine = NULL; - return ((codev)((&ARG1)-LCL0,0,&ctx)); + for (i=pe->ArityOfPE; i > 0; i--) { + sl = Yap_InitSlot(XREGS[i]); + } + return ((codev)(sl,0,&ctx)); } if (pe->PredFlags & CArgsPredFlag) { Int out = execute_cargs(pe, exec_code); @@ -3147,20 +3152,77 @@ YAP_FileDescriptorFromStream(Term t) X_API void * YAP_Record(Term t) { - - return (void *)Yap_StoreTermInDB(Deref(t), 0); + DBTerm *dbterm; + DBRecordList *dbt; + + dbterm = Yap_StoreTermInDB(Deref(t), 0); + if (dbterm == NULL) + return NULL; + dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list)); + while (dbt == NULL) { + if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) { + /* be a good neighbor */ + Yap_FreeCodeSpace((void *)dbterm); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "using YAP_Record"); + return NULL; + } + } + if (Yap_Records) { + Yap_Records->prev_rec = dbt; + } + dbt->next_rec = Yap_Records; + dbt->prev_rec = NULL; + dbt->dbrecord = dbterm; + Yap_Records = dbt; + return dbt; } X_API Term YAP_Recorded(void *handle) { - return Yap_FetchTermFromDB((DBTerm *)handle); + Term t; + DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord; + + BACKUP_MACHINE_REGS(); + do { + Yap_Error_TYPE = YAP_NO_ERROR; + t = Yap_FetchTermFromDB(dbterm); + if (Yap_Error_TYPE == YAP_NO_ERROR) { + RECOVER_MACHINE_REGS(); + return t; + } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + RECOVER_MACHINE_REGS(); + return FALSE; + } + } else { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growstack(dbterm->NOfCells*CellSize)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + RECOVER_MACHINE_REGS(); + return FALSE; + } + } + } while (t == (CELL)0); + RECOVER_MACHINE_REGS(); + return t; } X_API int YAP_Erase(void *handle) { - Yap_ReleaseTermFromDB((DBTerm *)handle); + DBRecordList *dbr = (DBRecordList *)handle; + Yap_ReleaseTermFromDB(dbr->dbrecord); + if (dbr->next_rec) + dbr->next_rec->prev_rec = dbr->prev_rec; + if (dbr->prev_rec) + dbr->next_rec->prev_rec = dbr->next_rec; + else if (Yap_Records == dbr) { + Yap_Records = dbr->next_rec; + } + Yap_FreeCodeSpace(handle); return 1; } diff --git a/C/cdmgr.c b/C/cdmgr.c index 8a1929aa7..33f063da4 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -918,6 +918,7 @@ split_megaclause(PredEntry *ap) } return; } + break; } Yap_ClauseSpace += sizeof(StaticClause)+mcl->ClItemSize+(UInt)NEXTOP((yamop *)NULL,p); new->ClFlags = StaticMask|FactMask; diff --git a/C/compiler.c b/C/compiler.c index 8c949b142..9d79e28bc 100755 --- a/C/compiler.c +++ b/C/compiler.c @@ -1495,12 +1495,19 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) PELOCK(42,cglobs->cint.CurrentPred); if (is_tabled(cglobs->cint.CurrentPred)) { Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint); + /* needs to adjust previous commits */ + Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint); + Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); } else #endif /* TABLING */ { Yap_emit_3ops(cutexit_op, Zero, Zero, Zero, &cglobs->cint); + /* needs to adjust previous commits */ + Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint); + Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint); + Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); } #ifdef TABLING UNLOCK(cglobs->cint.CurrentPred->PELock); @@ -1509,6 +1516,8 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) else { Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint); /* needs to adjust previous commits */ + Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint); + Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint); adjust_current_commits(cglobs); } return; diff --git a/C/index.c b/C/index.c index 7e0425c96..5ce457be5 100644 --- a/C/index.c +++ b/C/index.c @@ -2430,18 +2430,15 @@ count_consts(GroupDef *grp) static UInt count_blobs(GroupDef *grp) { - Term current = MkAtomTerm(AtomFoundVar); - UInt i = 0; - ClauseDef *cl = grp->FirstClause; + UInt i = 1; + ClauseDef *cl = grp->FirstClause+1; + Term current = grp->FirstClause->Tag; - while (TRUE) { + while (cl <= grp->LastClause) { if (current != cl->Tag) { i++; current = cl->Tag; } - if (cl == grp->LastClause) { - return i; - } cl++; } return i; @@ -3224,7 +3221,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin Yap_emit(label_op, labl, Zero, cint); Yap_emit(index_dbref_op, Zero, Zero, cint); sort_group(group,(CELL *)(group+1),cint); - do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1); + do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group+1)); return labl; } } @@ -3261,7 +3258,7 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint else Yap_emit(index_long_op, Zero, Zero, cint); sort_group(group,(CELL *)(group+1),cint); - do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1); + do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group+1)); return labl; } } diff --git a/C/iopreds.c b/C/iopreds.c index 5430ddc4b..76f3f9fbc 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -827,12 +827,16 @@ IOSWIPutc(int sno, int ch) static int IOSWIGetc(int sno) { - int i; + int ch; Yap_StartSlots(); - i = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr); + ch = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr); + if (ch == EOF) { + return post_process_eof(Stream+sno); + } + return post_process_read_char(ch, Stream+sno); Yap_CloseSlots(); YENV = ENV; - return i; + return ch; } /* static */ @@ -851,12 +855,16 @@ IOSWIWidePutc(int sno, int ch) static int IOSWIWideGetc(int sno) { - int i; + int ch; Yap_StartSlots(); - i = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr); + ch = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr); + if (ch == EOF) { + return post_process_eof(Stream+sno); + } + return post_process_read_char(ch, Stream+sno); Yap_CloseSlots(); YENV = ENV; - return i; + return ch; } #if USE_SOCKET @@ -4759,6 +4767,9 @@ StreamPosition(int sno) Term sargs[5]; Int cpos; cpos = Stream[sno].charcount; + if (Stream[sno].status & SWI_Stream_f) { + return Yap_get_stream_position(Stream[sno].u.swi_stream.swi_ptr); + } if (Stream[sno].stream_getc == PlUnGetc) { cpos--; } diff --git a/C/save.c b/C/save.c index dcb3b7600..f09151dc9 100755 --- a/C/save.c +++ b/C/save.c @@ -1691,6 +1691,20 @@ UnmarkTrEntries(void) int in_limbo = FALSE; +/* cleanup any records we had in the saved state. They are now inaccessible */ +static void +FreeRecords(void) { + struct record_list *ptr; + + ptr = Yap_Records; + Yap_Records = NULL; + while (ptr) { + struct record_list *optr = ptr; + Yap_ReleaseTermFromDB(ptr->dbrecord); + ptr = ptr->next_rec; + Yap_FreeCodeSpace((void *)optr); + } +} /* * This function is called when wanting only to restore the heap and @@ -1748,6 +1762,7 @@ Restore(char *s, char *lib_dir) Yap_InitPreAllocCodeSpace(); } #endif + FreeRecords(); CloseRestore(); if (which_save == 2) { Yap_unify(ARG2, MkIntTerm(0)); diff --git a/C/scanner.c b/C/scanner.c index 590ab78cf..4eb362753 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -636,10 +636,6 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted char *sp0 = sp; char cbuff = ch; - if (yap_flags[STRICT_ISO_FLAG] && ch == 'E') { - Yap_ErrorMessage = "Float format not allowed in ISO mode"; - return TermNil; - } if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; return TermNil; @@ -721,6 +717,9 @@ Yap_scan_num(int (*Nxtch) (int)) return TermNil; } ch = Nxtch(-1); + while (chtype(ch) == BS) { + ch = Nxtch(-1); + } if (ch == '-') { sign = -1; ch = Nxtch(-1); diff --git a/C/tracer.c b/C/tracer.c index 4f1a68986..fe1004cce 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -172,6 +172,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; + if (vsc_count==29) + jmp_deb(1); #ifdef THREADS MY_ThreadHandle.thread_inst_count++; #endif diff --git a/H/Yap.h b/H/Yap.h index eda704e84..a5c917c84 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -268,6 +268,8 @@ extern char Yap_Option[20]; #define MMAP_ADDR 0x200000000 #elif defined(__APPLE__) && !__LP64__ #define MMAP_ADDR 0x20000000 +#elif defined(__powerpc__) +#define MMAP_ADDR 0x20000000 #else #define MMAP_ADDR 0x10000000 #endif diff --git a/H/YapHeap.h b/H/YapHeap.h index fe815007a..f18faf678 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -29,6 +29,7 @@ typedef int (*SWI_GetWideFunction)(void *); typedef int (*SWI_CloseFunction)(void *); typedef int (*SWI_FlushFunction)(void *); typedef int (*SWI_PLGetStreamFunction)(void *); +typedef int (*SWI_PLGetStreamPositionFunction)(void *); #include "../include/dswiatoms.h" @@ -94,6 +95,12 @@ typedef struct scratch_block_struct { UInt sz, msz; } scratch_block; +typedef struct record_list { + /* a list of dbterms associated with a clause */ + struct DB_TERM *dbrecord; + struct record_list *next_rec, *prev_rec; +} DBRecordList; + typedef struct restore_info { Int base_diff; Int cl_diff; diff --git a/H/Yapproto.h b/H/Yapproto.h index 5048b856f..6ac8085c9 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -462,6 +462,7 @@ void STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void)); void STD_PROTO(Yap_swi_install,(void)); void STD_PROTO(Yap_InitSWIHash,(void)); int STD_PROTO(Yap_get_stream_handle,(Term, int, int, void *)); +Term STD_PROTO(Yap_get_stream_position,(void *)); /* ypsocks.c */ void STD_PROTO(Yap_InitSockets,(void)); diff --git a/H/dglobals.h b/H/dglobals.h index 36d72d2b4..17c514015 100644 --- a/H/dglobals.h +++ b/H/dglobals.h @@ -188,6 +188,7 @@ #define SWIClose Yap_global->swi_close #define SWIFlush Yap_global->swi_flush #define SWIGetStream Yap_global->swi_get_stream_f +#define SWIGetStreamPosition Yap_global->swi_get_stream_position_f #define Yap_AllowLocalExpansion Yap_global->allow_local_expansion #define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion diff --git a/H/dhstruct.h b/H/dhstruct.h index 1da642d95..4e8f34a96 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -133,6 +133,7 @@ #define PredHandleThrow Yap_heap_regs->pred_handle_throw #define PredIs Yap_heap_regs->pred_is #define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup +#define PredRestoreRegs Yap_heap_regs->pred_restore_regs #ifdef YAPOR #define PredGetwork Yap_heap_regs->pred_getwork #define PredGetworkSeq Yap_heap_regs->pred_getwork_seq @@ -297,6 +298,8 @@ #define ForeignCodeTop Yap_heap_regs->foreign_code_top #define ForeignCodeMax Yap_heap_regs->foreign_code_max +#define Yap_Records Yap_heap_regs->yap_records + #define SWI_Atoms Yap_heap_regs->swi_atoms #define SWI_Functors Yap_heap_regs->swi_functors #define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash diff --git a/H/hglobals.h b/H/hglobals.h index 09c3587a1..87719458c 100644 --- a/H/hglobals.h +++ b/H/hglobals.h @@ -190,6 +190,7 @@ typedef struct worker_shared { SWI_CloseFunction swi_close; SWI_FlushFunction swi_flush; SWI_PLGetStreamFunction swi_get_stream_f; + SWI_PLGetStreamPositionFunction swi_get_stream_position_f; int allow_local_expansion; int allow_global_expansion; diff --git a/H/hstruct.h b/H/hstruct.h index f74108565..21e8c2765 100644 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -133,6 +133,7 @@ struct pred_entry *pred_handle_throw; struct pred_entry *pred_is; struct pred_entry *pred_safe_call_cleanup; + struct pred_entry *pred_restore_regs; #ifdef YAPOR struct pred_entry *pred_getwork; struct pred_entry *pred_getwork_seq; @@ -297,6 +298,8 @@ ADDR foreign_code_top; ADDR foreign_code_max; + struct record_list *yap_records; + Atom swi_atoms[N_SWI_ATOMS]; Functor swi_functors[N_SWI_FUNCTORS]; struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH]; diff --git a/H/iglobals.h b/H/iglobals.h index 978c91658..4c6012a7e 100644 --- a/H/iglobals.h +++ b/H/iglobals.h @@ -188,6 +188,7 @@ static void InitGlobal(void) { Yap_global->swi_close = NULL; Yap_global->swi_flush = NULL; Yap_global->swi_get_stream_f = NULL; + Yap_global->swi_get_stream_position_f = NULL; Yap_global->allow_local_expansion = TRUE; Yap_global->allow_global_expansion = TRUE; diff --git a/H/ihstruct.h b/H/ihstruct.h index 612d0af6d..3589fa71e 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -133,6 +133,7 @@ Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE)); Yap_heap_regs->pred_is = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE)); Yap_heap_regs->pred_safe_call_cleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE)); + Yap_heap_regs->pred_restore_regs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE)); #ifdef YAPOR Yap_heap_regs->pred_getwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE)); Yap_heap_regs->pred_getwork_seq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE)); @@ -297,6 +298,8 @@ Yap_heap_regs->foreign_code_top = NULL; Yap_heap_regs->foreign_code_max = NULL; + Yap_heap_regs->yap_records = NULL; + InitSWIAtoms(); diff --git a/H/rglobals.h b/H/rglobals.h index 81d3bb0e2..7aaa8d045 100644 --- a/H/rglobals.h +++ b/H/rglobals.h @@ -199,6 +199,7 @@ static void RestoreGlobal(void) { + #if HAVE_LIBREADLINE diff --git a/H/rheap.h b/H/rheap.h index 4011ae629..e69a712c0 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -983,6 +983,21 @@ RestoreForeignCode(void) } } +static void +RestoreYapRecords(void) +{ + struct record_list *ptr; + + Yap_Records = DBRecordAdjust(Yap_Records); + ptr = Yap_Records; + while (ptr) { + ptr->next_rec = DBRecordAdjust(ptr->next_rec); + ptr->prev_rec = DBRecordAdjust(ptr->prev_rec); + ptr->dbrecord = DBTermAdjust(ptr->dbrecord); + RestoreDBTerm(ptr->dbrecord, FALSE); + } +} + static void RestoreBallTerm(int wid) { diff --git a/H/rhstruct.h b/H/rhstruct.h index e92e86c56..383728d95 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -133,6 +133,7 @@ Yap_heap_regs->pred_handle_throw = PtoPredAdjust(Yap_heap_regs->pred_handle_throw); Yap_heap_regs->pred_is = PtoPredAdjust(Yap_heap_regs->pred_is); Yap_heap_regs->pred_safe_call_cleanup = PtoPredAdjust(Yap_heap_regs->pred_safe_call_cleanup); + Yap_heap_regs->pred_restore_regs = PtoPredAdjust(Yap_heap_regs->pred_restore_regs); #ifdef YAPOR Yap_heap_regs->pred_getwork = PtoPredAdjust(Yap_heap_regs->pred_getwork); Yap_heap_regs->pred_getwork_seq = PtoPredAdjust(Yap_heap_regs->pred_getwork_seq); @@ -297,6 +298,8 @@ + RestoreYapRecords(); + RestoreSWIAtoms(); diff --git a/H/sshift.h b/H/sshift.h index 96d6fdf07..6ac683f0a 100755 --- a/H/sshift.h +++ b/H/sshift.h @@ -309,6 +309,16 @@ HoldEntryAdjust (HoldEntry * ptr) return (HoldEntry *) (((HoldEntry *) (CharP (ptr) + HDiff))); } +inline EXTERN struct record_list *DBRecordAdjust (struct record_list *); + +inline EXTERN struct record_list * +DBRecordAdjust (struct record_list * ptr) +{ + if (!ptr) + return ptr; + return (struct record_list *) (CharP (ptr) + HDiff); +} + #if USE_OFFSETS diff --git a/Makefile.in b/Makefile.in index beed44add..305987761 100755 --- a/Makefile.in +++ b/Makefile.in @@ -28,7 +28,7 @@ INCLUDEDIR=$(ROOTDIR)/include/Yap # INFODIR=$(SHAREDIR)/info # -# where to store documentaion files +# where to store documentation files # DOCSDIR=$(SHAREDIR)/doc/Yap @@ -96,6 +96,7 @@ TEXI2DVI=texi2dvi TEXI2HTML=texi2html TEXI2PDF=texi2pdf YAPLIB=@YAPLIB@ +SONAMEFLAG=@SONAMEFLAG@ #4.1VPATH=@srcdir@:@srcdir@/OPTYap CWD=$(PWD) @@ -539,7 +540,7 @@ libYap.a: $(LIB_OBJECTS) $(RANLIB) libYap.a @DYNYAPLIB@: $(LIB_OBJECTS) - @YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) + @YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) $(SONAMEFLAG) install: install_bin install_data @@ -635,7 +636,11 @@ install_library: @YAPLIB@ mkdir -p $(DESTDIR)$(INCLUDEDIR) for h in $(HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done -install_data: +install_data: install_copied_files install_bin + @ENABLE_CHR@ (cd packages/chr ; $(MAKE) install) + @ENABLE_CHR@ (cd packages/clpqr ; $(MAKE) install) + +install_copied_files: (cd library ; $(MAKE) install) (cd packages/swi-minisat2; $(MAKE) install) (cd LGPL ; $(MAKE) install) @@ -646,9 +651,6 @@ install_data: (cd packages/CLPBN ; $(MAKE) install) (cd packages/meld; $(MAKE) install) (cd packages/ProbLog ; $(MAKE) install) - @ENABLE_CHR@ (cd packages/chr ; $(MAKE) install) - @ENABLE_CHR@ (cd packages/clpqr ; $(MAKE) install) - ########## TAGS: $(C_SOURCES) $(PL_SOURCES) $(HEADERS) diff --git a/configure b/configure index 6e81b8aef..4d9c0eb39 100755 --- a/configure +++ b/configure @@ -643,6 +643,7 @@ ENABLE_CLPQR ENABLE_CHR NO_BUILTIN_REGEXP YAP_EXTRAS +SONAMEFLAG DYNYAPLIB YAPLIB EXTRA_LIBS_FOR_SWIDLLS @@ -6932,6 +6933,7 @@ fi fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="-Wl,-soname=$DYNYAPLIB" fi if test "$have_nsl" = yes then @@ -6961,6 +6963,7 @@ fi INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7004,6 +7007,7 @@ fi fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7017,6 +7021,7 @@ fi #INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7073,6 +7078,7 @@ fi fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7087,6 +7093,7 @@ fi INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7164,7 +7171,8 @@ fi fi CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2" DYNYAPLIB=libYap."$SO" - YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.dylib" + SONAMEFLAG="" + YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO" PRE_INSTALL_ENV="DYLD_LIBRARY_PATH=\$(abs_top_builddir)" ;; *netbsd*|*openbsd*|*freebsd*|*dragonfly*) @@ -7187,6 +7195,7 @@ fi fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)" DYNYAPLIB=libYap."$SO" + 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)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -7203,6 +7212,7 @@ fi INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="-Wl,--soname=$DYNYAPLIB" if test "$dynamic_loading" = "yes" then YAPLIB_LD="\$(CC)" @@ -7221,6 +7231,7 @@ fi # and -fomit-frame-point -DBP_FREE YAPLIB="yap.dll" DYNYAPLIB="yap.dll" + SONAMEFLAG="" SHLIB_CFLAGS="$CFLAGS" SHLIB_CXXFLAGS="$CXXFLAGS" if test "$target_win64" = no @@ -7300,6 +7311,7 @@ fi fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -8442,6 +8454,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc threaded code" >&5 diff --git a/configure.in b/configure.in index ea2984c93..1a05ef71e 100755 --- a/configure.in +++ b/configure.in @@ -915,6 +915,7 @@ case "$target_os" in fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="-Wl,-soname=$DYNYAPLIB" fi if test "$have_nsl" = yes then @@ -944,6 +945,7 @@ case "$target_os" in INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -983,6 +985,7 @@ case "$target_os" in fi LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -996,6 +999,7 @@ case "$target_os" in #INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -1014,6 +1018,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) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -1028,6 +1033,7 @@ dnl Linux has both elf and a.out, in this case we found elf INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -1066,7 +1072,8 @@ dnl Linux has both elf and a.out, in this case we found elf fi CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2" DYNYAPLIB=libYap."$SO" - YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.dylib" + SONAMEFLAG="" + YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO" PRE_INSTALL_ENV="DYLD_LIBRARY_PATH=\$(abs_top_builddir)" ;; *netbsd*|*openbsd*|*freebsd*|*dragonfly*) @@ -1089,6 +1096,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" + 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)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -1105,6 +1113,7 @@ dnl Linux has both elf and a.out, in this case we found elf INSTALL_DLLS="" LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="-Wl,--soname=$DYNYAPLIB" if test "$dynamic_loading" = "yes" then YAPLIB_LD="\$(CC)" @@ -1123,6 +1132,7 @@ dnl Linux has both elf and a.out, in this case we found elf # and -fomit-frame-point -DBP_FREE YAPLIB="yap.dll" DYNYAPLIB="yap.dll" + SONAMEFLAG="" SHLIB_CFLAGS="$CFLAGS" SHLIB_CXXFLAGS="$CXXFLAGS" if test "$target_win64" = no @@ -1163,6 +1173,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) -Wl,-R,\$(YAPLIBDIR)" DYNYAPLIB=libYap."$SO" + SONAMEFLAG="" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)" INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -1469,6 +1480,7 @@ dnl objects in YAP library AC_SUBST(YAPLIB) AC_SUBST(DYNYAPLIB) AC_SUBST(LDFLAGS) +AC_SUBST(SONAMEFLAG) dnl install_info AC_SUBST(INSTALL_INFO) dnl let YAP_EXTRAS fall through configure, from the env into Makefile diff --git a/docs/yap.tex b/docs/yap.tex index 7de3b0c48..a7dffd36e 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -1,4 +1,4 @@ -�a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*- +\input texinfo @c -*- mode: texinfo; coding: latin-1; -*- @c %**start of header @setfilename yap.info @@ -9267,6 +9267,18 @@ Succeeds if @var{Set3} unifies with the intersection of @var{Set1} and need not be ordered. @end table +@item subtract(+@var{Set}, +@var{Delete}, ?@var{Result}) +@findex subtract/3 +@syindex subtract/3 +@cnindex subtract/3 +Delete all elements from @var{Set} that occur in @var{Delete} (a set) +and unify the result with @var{Result}. Deletion is based on +unification using @code{memberchk/2}. The complexity is +@code{|Delete|*|Set|}. + +See @code{ord_subtract/3}. +@end table + @node LineUtilities, MapList, Lists, Library @section Line Manipulation Utilities @cindex Line Utilities Library diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index a3b301169..7a5e77311 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -699,6 +699,7 @@ typedef struct SWI_IO { void *flush_s; void *close_s; void *get_stream_handle; + void *get_stream_position; } swi_io_struct; /* SWI stream info */ diff --git a/library/Makefile.in b/library/Makefile.in index 6053c0ca3..bab726884 100644 --- a/library/Makefile.in +++ b/library/Makefile.in @@ -77,6 +77,8 @@ PROGRAMS= \ $(srcdir)/wundgraphs.yap \ $(srcdir)/lam_mpi.yap \ $(srcdir)/ypp.yap \ + $(srcdir)/c_alarms.yap \ + $(srcdir)/flags.yap \ $(srcdir)/block_diagram.yap MYDDAS_PROGRAMS= $(srcdir)/MYDDAS/myddas.ypp \ diff --git a/library/c_alarms.yap b/library/c_alarms.yap new file mode 100644 index 000000000..e238f1dae --- /dev/null +++ b/library/c_alarms.yap @@ -0,0 +1,397 @@ +%%% -*- Mode: Prolog; -*- + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Concurrent alarms was developed at Katholieke Universiteit Leuven +% +% Copyright 2010 +% Katholieke Universiteit Leuven +% +% Contributions to this file: +% Author: Theofrastos Mantadelis +% $Date: 2011-02-01 18:36:41 +0100 (Tue, 01 Feb 2011) $ +% $Revision: 7 $ +% Contributions: The timer implementation is inspired by Bernd Gutmann's timers +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Artistic License 2.0 +% +% Copyright (c) 2000-2006, The Perl Foundation. +% +% Everyone is permitted to copy and distribute verbatim copies of this +% license document, but changing it is not allowed. Preamble +% +% This license establishes the terms under which a given free software +% Package may be copied, modified, distributed, and/or +% redistributed. The intent is that the Copyright Holder maintains some +% artistic control over the development of that Package while still +% keeping the Package available as open source and free software. +% +% You are always permitted to make arrangements wholly outside of this +% license directly with the Copyright Holder of a given Package. If the +% terms of this license do not permit the full use that you propose to +% make of the Package, you should contact the Copyright Holder and seek +% a different licensing arrangement. Definitions +% +% "Copyright Holder" means the individual(s) or organization(s) named in +% the copyright notice for the entire Package. +% +% "Contributor" means any party that has contributed code or other +% material to the Package, in accordance with the Copyright Holder's +% procedures. +% +% "You" and "your" means any person who would like to copy, distribute, +% or modify the Package. +% +% "Package" means the collection of files distributed by the Copyright +% Holder, and derivatives of that collection and/or of those files. A +% given Package may consist of either the Standard Version, or a +% Modified Version. +% +% "Distribute" means providing a copy of the Package or making it +% accessible to anyone else, or in the case of a company or +% organization, to others outside of your company or organization. +% +% "Distributor Fee" means any fee that you charge for Distributing this +% Package or providing support for this Package to another party. It +% does not mean licensing fees. +% +% "Standard Version" refers to the Package if it has not been modified, +% or has been modified only in ways explicitly requested by the +% Copyright Holder. +% +% "Modified Version" means the Package, if it has been changed, and such +% changes were not explicitly requested by the Copyright Holder. +% +% "Original License" means this Artistic License as Distributed with the +% Standard Version of the Package, in its current version or as it may +% be modified by The Perl Foundation in the future. +% +% "Source" form means the source code, documentation source, and +% configuration files for the Package. +% +% "Compiled" form means the compiled bytecode, object code, binary, or +% any other form resulting from mechanical transformation or translation +% of the Source form. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Permission for Use and Modification Without Distribution +% +% (1) You are permitted to use the Standard Version and create and use +% Modified Versions for any purpose without restriction, provided that +% you do not Distribute the Modified Version. +% +% Permissions for Redistribution of the Standard Version +% +% (2) You may Distribute verbatim copies of the Source form of the +% Standard Version of this Package in any medium without restriction, +% either gratis or for a Distributor Fee, provided that you duplicate +% all of the original copyright notices and associated disclaimers. At +% your discretion, such verbatim copies may or may not include a +% Compiled form of the Package. +% +% (3) You may apply any bug fixes, portability changes, and other +% modifications made available from the Copyright Holder. The resulting +% Package will still be considered the Standard Version, and as such +% will be subject to the Original License. +% +% Distribution of Modified Versions of the Package as Source +% +% (4) You may Distribute your Modified Version as Source (either gratis +% or for a Distributor Fee, and with or without a Compiled form of the +% Modified Version) provided that you clearly document how it differs +% from the Standard Version, including, but not limited to, documenting +% any non-standard features, executables, or modules, and provided that +% you do at least ONE of the following: +% +% (a) make the Modified Version available to the Copyright Holder of the +% Standard Version, under the Original License, so that the Copyright +% Holder may include your modifications in the Standard Version. (b) +% ensure that installation of your Modified Version does not prevent the +% user installing or running the Standard Version. In addition, the +% modified Version must bear a name that is different from the name of +% the Standard Version. (c) allow anyone who receives a copy of the +% Modified Version to make the Source form of the Modified Version +% available to others under (i) the Original License or (ii) a license +% that permits the licensee to freely copy, modify and redistribute the +% Modified Version using the same licensing terms that apply to the copy +% that the licensee received, and requires that the Source form of the +% Modified Version, and of any works derived from it, be made freely +% available in that license fees are prohibited but Distributor Fees are +% allowed. +% +% Distribution of Compiled Forms of the Standard Version or +% Modified Versions without the Source +% +% (5) You may Distribute Compiled forms of the Standard Version without +% the Source, provided that you include complete instructions on how to +% get the Source of the Standard Version. Such instructions must be +% valid at the time of your distribution. If these instructions, at any +% time while you are carrying out such distribution, become invalid, you +% must provide new instructions on demand or cease further +% distribution. If you provide valid instructions or cease distribution +% within thirty days after you become aware that the instructions are +% invalid, then you do not forfeit any of your rights under this +% license. +% +% (6) You may Distribute a Modified Version in Compiled form without the +% Source, provided that you comply with Section 4 with respect to the +% Source of the Modified Version. +% +% Aggregating or Linking the Package +% +% (7) You may aggregate the Package (either the Standard Version or +% Modified Version) with other packages and Distribute the resulting +% aggregation provided that you do not charge a licensing fee for the +% Package. Distributor Fees are permitted, and licensing fees for other +% components in the aggregation are permitted. The terms of this license +% apply to the use and Distribution of the Standard or Modified Versions +% as included in the aggregation. +% +% (8) You are permitted to link Modified and Standard Versions with +% other works, to embed the Package in a larger work of your own, or to +% build stand-alone binary or bytecode versions of applications that +% include the Package, and Distribute the result without restriction, +% provided the result does not expose a direct interface to the Package. +% +% Items That are Not Considered Part of a Modified Version +% +% (9) Works (including, but not limited to, modules and scripts) that +% merely extend or make use of the Package, do not, by themselves, cause +% the Package to be a Modified Version. In addition, such works are not +% considered parts of the Package itself, and are not subject to the +% terms of this license. +% +% General Provisions +% +% (10) Any use, modification, and distribution of the Standard or +% Modified Versions is governed by this Artistic License. By using, +% modifying or distributing the Package, you accept this license. Do not +% use, modify, or distribute the Package, if you do not accept this +% license. +% +% (11) If your Modified Version has been derived from a Modified Version +% made by someone other than you, you are nevertheless required to +% ensure that your Modified Version complies with the requirements of +% this license. +% +% (12) This license does not grant you the right to use any trademark, +% service mark, tradename, or logo of the Copyright Holder. +% +% (13) This license includes the non-exclusive, worldwide, +% free-of-charge patent license to make, have made, use, offer to sell, +% sell, import and otherwise transfer the Package with respect to any +% patent claims licensable by the Copyright Holder that are necessarily +% infringed by the Package. If you institute patent litigation +% (including a cross-claim or counterclaim) against any party alleging +% that the Package constitutes direct or contributory patent +% infringement, then this Artistic License to you shall terminate on the +% date that such litigation is filed. +% +% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT +% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED +% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT +% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT +% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, +% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE +% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +:- module(c_alarms, [set_alarm/3, + unset_alarm/1, + time_out_call_once/3, + timer_start/1, + timer_restart/1, + timer_stop/2, + timer_elapsed/2, + timer_pause/2]). + +% set_alarm(+Seconds, +Execute, -ID) +% calls Executes after a time interval of Seconds +% ID is returned to be able to unset the alarm (the call will not be executed) +% set_alarm/3 supports multiple & nested settings of alarms. +% Known Bug: There is the case that an alarm might trigger +-1 second of the set time. +% +% unset_alarm(+ID) +% It will unschedule the alarm. +% It will not affect other concurrent alarms. +% +% time_out_call(+Seconds, +Goal, -Return) +% It will will execute the closure Goal and returns its success or failure at Return. +% If the goal times out in Seconds then Return = timeout. + +:- use_module(library(lists), [member/2, memberchk/2, delete/3]). +:- use_module(library(ordsets), [ord_add_element/3]). +:- use_module(library(apply_macros), [maplist/3]). + +:- dynamic('$timer'/3). + +:- meta_predicate(set_alarm(+, 0, -)). +:- meta_predicate(time_out_call_once(+, 0, -)). +:- meta_predicate(prove_once(0)). + +:- initialization(local_init). + +local_init:- + bb_put(alarms, []), + bb_put(identity, 0). + +get_next_identity(ID):- + bb_get(identity, ID), + NID is ID + 1, + bb_put(identity, NID). + +set_alarm(Seconds, Execute, ID):- + bb_get(alarms, []), + get_next_identity(ID), !, + bb_put(alarms, [alarm(Seconds, ID, Execute)]), + alarm(Seconds, alarm_handler, _). +set_alarm(Seconds, Execute, ID):- + get_next_identity(ID), !, + bb_get(alarms, [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms]), + alarm(0, true, Remaining), + Elapsed is CurrentSeconds - Remaining - 1, + maplist(subtract(Elapsed), [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms], RemainingAlarms), + ord_add_element(RemainingAlarms, alarm(Seconds, ID, Execute), [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]), + bb_put(alarms, [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]), + alarm(NewSeconds, alarm_handler, _). +set_alarm(Seconds, Execute, ID):- + throw(error(permission_error(create, alarm, set_alarm(Seconds, Execute, ID)), 'Non permitted alarm identifier.')). + +subtract(Elapsed, alarm(Seconds, ID, Execute), alarm(NewSeconds, ID, Execute)):- + NewSeconds is Seconds - Elapsed. + +unset_alarm(ID):- + \+ ground(ID), + throw(error(instantiation_error, 'Alarm ID needs to be instantiated.')). +unset_alarm(ID):- + bb_get(alarms, Alarms), + \+ memberchk(alarm(_Seconds, ID, _Execute), Alarms), + throw(error(existence_error(alarm, unset_alarm(ID)), 'Alarm does not exist.')). +unset_alarm(ID):- + alarm(0, true, Remaining), + bb_get(alarms, Alarms), + [alarm(Seconds, _, _)|_] = Alarms, + Elapsed is Seconds - Remaining - 1, + delete_alarm(Alarms, ID, NewAlarms), + bb_put(alarms, NewAlarms), + (NewAlarms = [alarm(NewSeconds, _, _)|_] -> + RemainingSeconds is NewSeconds - Elapsed, + alarm(RemainingSeconds, alarm_handler, _) + ; + true + ). + +delete_alarm(Alarms, ID, NewAlarms):- + memberchk(alarm(Seconds, ID, Execute), Alarms), + delete(Alarms, alarm(Seconds, ID, Execute), NewAlarms). + +alarm_handler:- + bb_get(alarms, [alarm(_, _, CurrentExecute)|[]]), + bb_put(alarms, []), + call(CurrentExecute). +alarm_handler:- + bb_get(alarms, [alarm(Elapsed, CurrentID, CurrentExecute)|Alarms]), + maplist(subtract(Elapsed), Alarms, NewAlarms), + find_zeros(NewAlarms, ZeroAlarms), + findall(alarm(S, ID, E), (member(alarm(S, ID, E), NewAlarms), S > 0), NonZeroAlarms), + bb_put(alarms, NonZeroAlarms), + (NonZeroAlarms = [alarm(NewSeconds, _, _)|_] -> + alarm(NewSeconds, alarm_handler, _) + ; + true + ), + execute([alarm(0, CurrentID, CurrentExecute)|ZeroAlarms]). + +find_zeros([], []). +find_zeros([alarm(0, ID, E)|T], [alarm(0, ID, E)|R]):- + find_zeros(T, R). +find_zeros([alarm(S, _, _)|T], R):- + S > 0, + find_zeros(T, R). + +execute([]). +execute([alarm(_, _, Execute)|R]):- + call(Execute), + execute(R). + +time_out_call_once(Seconds, Goal, Return):- + bb_get(identity, ID), + set_alarm(Seconds, throw(timeout(ID)), ID), + catch(( + prove_once(Goal, Return), + unset_alarm(ID)) + , Exception, ( + (Exception == timeout(ID) -> + Return = timeout + ; + unset_alarm(ID), + throw(Exception) + ))). + +prove_once(Goal, success):- + once(Goal), !. +prove_once(_Goal, failure). + +timer_start(Name):- + \+ ground(Name), + throw(error(instantiation_error, 'Timer name needs to be instantiated.')). +timer_start(Name):- + '$timer'(Name, _, _), + throw(error(permission_error(create, timer, timer_start(Name)), 'Timer already exists.')). +timer_start(Name):- + statistics(walltime, [StartTime, _]), + assertz('$timer'(Name, running, StartTime)). + +timer_restart(Name):- + \+ ground(Name), + throw(error(instantiation_error, 'Timer name needs to be instantiated.')). +timer_restart(Name):- + \+ '$timer'(Name, _, _), !, + statistics(walltime, [StartTime, _]), + assertz('$timer'(Name, running, StartTime)). +timer_restart(Name):- + retract('$timer'(Name, running, _)), !, + statistics(walltime, [StartTime, _]), + assertz('$timer'(Name, running, StartTime)). +timer_restart(Name):- + retract('$timer'(Name, paused, Duration)), + statistics(walltime, [StartTime, _]), + Elapsed is StartTime - Duration, + assertz('$timer'(Name, running, Elapsed)). + +timer_stop(Name, Elapsed):- + \+ '$timer'(Name, _, _), + throw(error(existence_error(timer, timer_stop(Name, Elapsed)), 'Timer does not exist.')). +timer_stop(Name, Elapsed):- + retract('$timer'(Name, running, StartTime)), !, + statistics(walltime, [EndTime, _]), + Elapsed is EndTime - StartTime. +timer_stop(Name, Elapsed):- + retract('$timer'(Name, paused, Elapsed)). + +timer_elapsed(Name, Elapsed):- + \+ '$timer'(Name, _, _), + throw(error(existence_error(timer, timer_elapsed(Name, Elapsed)), 'Timer does not exist.')). +timer_elapsed(Name, Elapsed):- + '$timer'(Name, running, StartTime), !, + statistics(walltime, [EndTime, _]), + Elapsed is EndTime - StartTime. +timer_elapsed(Name, Elapsed):- + '$timer'(Name, paused, Elapsed). + +timer_pause(Name, Elapsed):- + \+ '$timer'(Name, _, _), + throw(error(existence_error(timer, timer_pause(Name, Elapsed)), 'Timer does not exist.')). +timer_pause(Name, Elapsed):- + '$timer'(Name, paused, _), + throw(error(permission_error(timer, timer_pause(Name, Elapsed)), 'Timer already paused.')). +timer_pause(Name, Elapsed):- + retract('$timer'(Name, _, StartTime)), + statistics(walltime, [EndTime, _]), + Elapsed is EndTime - StartTime, + assert('$timer'(Name, paused, Elapsed)). diff --git a/library/charsio.yap b/library/charsio.yap index 416627bf0..0c7b67d11 100644 --- a/library/charsio.yap +++ b/library/charsio.yap @@ -49,13 +49,6 @@ format_to_chars(Form, Args, OUT, L0) :- write_to_chars(Term, OUT) :- write_to_chars(Term, [], OUT). -write_to_chars(Term, L0, OUT) :- - open_mem_write_stream(Stream), - write(Stream, Term), - peek_mem_write_stream(Stream, L0, O), - close(Stream), - O = OUT. - atom_to_chars(Atom, OUT) :- atom_to_chars(Atom, [], OUT). @@ -88,12 +81,6 @@ number_to_chars(Number, L0, OUT) :- number_to_chars(Number, L0, OUT) :- throw(error(type_error(number,Number),number_to_chars(Number, L0, OUT))). -read_from_chars(Chars, Term) :- - open_mem_read_stream(Chars, Stream), - read(Stream, T), - close(Stream), - T = Term. - open_chars_stream(Chars, Stream) :- open_mem_read_stream(Chars, Stream). diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index f15cdc8d0..01552dd8d 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -459,22 +459,35 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) return cv_error(flags); if (IsWideAtom(at)) { - size_t sz = wcslen(RepAtom(at)->WStrOfAE)*sizeof(wchar_t); - if (!(tmp = ensure_space(sp, (sz+1)*sizeof(wchar_t), flags))) + wchar_t* s = RepAtom(at)->WStrOfAE; + size_t sz = wcslen(s)+1; + if (!(tmp = ensure_space(sp, sz*sizeof(wchar_t), flags))) return 0; + memcpy(*sp,s,sz*sizeof(wchar_t)); } else { char *s = RepAtom(at)->StrOfAE; - size_t sz = strlen(RepAtom(at)->StrOfAE)+1; + size_t sz = strlen(s)+1; if (!(tmp = ensure_space(sp, sz, flags))) return 0; - strncpy(*sp,s,sz); + memcpy(*sp,s,sz); } } else if (IsNumTerm(t)) { if (IsFloatTerm(t)) { if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) return cv_error(flags); snprintf(tmp,SWI_BUF_SIZE,"%f",FloatOfTerm(t)); +#if USE_GMP + } else if (YAP_IsBigNumTerm(t)) { + if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) + return cv_error(flags); + MP_INT g; + YAP_BigNumOfTerm(t, (void *)&g); + if (mpz_sizeinbase(&g,2) > SWI_BUF_SIZE-1) { + return 0; + } + mpz_get_str (tmp, 10, &g); +#endif } else { if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) return cv_error(flags); @@ -520,7 +533,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) char *nbf = PL_malloc(sz+1); if (!nbf) return 0; - strncpy(nbf,tmp,sz+1); + memcpy(nbf,tmp,sz+1); free(tmp); *sp = nbf; } @@ -890,7 +903,7 @@ X_API atom_t PL_new_atom_nchars(size_t len, const char *c) return 0L; } } - strncpy(pt, c, len); + memcpy(pt, c, len); pt[len] = '\0'; } else { pt = (char *)c; @@ -1102,7 +1115,8 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s) return FALSE; } } - strncpy(buf, s, len); + memcpy(buf, s, len); + buf[len] = 0; } else { buf = (char *)s; } @@ -1547,7 +1561,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s) if (!buf) return FALSE; - strncpy(buf, s, len); + memcpy(buf, s, len); buf[len] = '\0'; while (!(catom = Yap_LookupAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { @@ -1857,7 +1871,7 @@ LookupMaxAtom(size_t n, char *s) if (!buf) return FALSE; - strncpy(buf, s, n); + memcpy(buf, s, n); buf[n] = '\0'; while (!(catom = Yap_LookupAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { @@ -1910,15 +1924,16 @@ typedef struct { X_API int PL_unify_term(term_t l,...) { va_list ap; - int type; + int type, res; int nels = 1; int depth = 1; Term a[1], *pt; stack_el stack[MAX_DEPTH]; - + BACKUP_MACHINE_REGS(); if (Unsigned(H) > Unsigned(ASP)-CreepFlag) { if (!Yap_gc(0, ENV, CP)) { + RECOVER_MACHINE_REGS(); return FALSE; } } @@ -2123,7 +2138,9 @@ X_API int PL_unify_term(term_t l,...) } } va_end (ap); - return YAP_Unify(Yap_GetFromSlot(l),a[0]); + res = Yap_unify(Yap_GetFromSlot(l),a[0]); + RECOVER_MACHINE_REGS(); + return res; } /* end PL_unify_* functions =============================*/ @@ -2212,7 +2229,7 @@ X_API int PL_is_float(term_t ts) X_API int PL_is_integer(term_t ts) { YAP_Term t = Yap_GetFromSlot(ts); - return YAP_IsIntTerm(t); + return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t); } X_API int PL_is_list(term_t ts) @@ -2224,7 +2241,7 @@ X_API int PL_is_list(term_t ts) X_API int PL_is_number(term_t ts) { YAP_Term t = Yap_GetFromSlot(ts); - return YAP_IsIntTerm(t) || YAP_IsFloatTerm(t); + return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t) || YAP_IsFloatTerm(t); } X_API int PL_is_string(term_t ts) @@ -2312,23 +2329,25 @@ X_API record_t PL_record(term_t ts) { Term t = Yap_GetFromSlot(ts); - return (record_t)Yap_StoreTermInDB(t, 0); + return (record_t)YAP_Record(t); } X_API int PL_recorded(record_t db, term_t ts) { - Term t = Yap_FetchTermFromDB((DBTerm *)db); - if (t == 0L) + Term t = YAP_Recorded((void *)db); + fprintf(stderr,"PL_recorded %ld\n", t); + if (t == ((CELL)0)) return FALSE; Yap_PutInSlot(ts,t); + fprintf(stderr,"PL_recorded\n"); return TRUE; } X_API void PL_erase(record_t db) { - Yap_ReleaseTermFromDB((DBTerm *)db); + YAP_Erase((void *)db); } X_API void PL_halt(int e) @@ -3096,6 +3115,7 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio) SWIFlush = swio->flush_s; SWIClose = swio->close_s; SWIGetStream = swio->get_stream_handle; + SWIGetStreamPosition = swio->get_stream_position; } typedef int (*GetStreamF)(term_t, int, int, IOSTREAM **s); @@ -3115,6 +3135,23 @@ Yap_get_stream_handle(Term t0, int read_mode, int write_mode, void *s){ } +typedef int (*GetStreamPosF)(IOSTREAM *s, term_t); + +Term +Yap_get_stream_position(void *s){ + term_t t; + Term t0; + GetStreamPosF f = (GetStreamPosF)SWIGetStreamPosition; + + t = (term_t)Yap_NewSlots(1); + if (!(*f)(s, t)) + return 0L; + t0 = Yap_GetFromSlot((Int)t); + Yap_RecoverSlots(1); + return t0; +} + + X_API void (*PL_signal(int sig, void (*func)(int)))(int) { // return Yap_signal2(sig,func); diff --git a/library/flags.yap b/library/flags.yap new file mode 100644 index 000000000..9e4b047e8 --- /dev/null +++ b/library/flags.yap @@ -0,0 +1,561 @@ +%%% -*- Mode: Prolog; -*- + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Flags was developed at Katholieke Universiteit Leuven +% +% Copyright 2010 +% Katholieke Universiteit Leuven +% +% Contributions to this file: +% Author: Theofrastos Mantadelis +% Sugestions: Bernd Gutmann, Paulo Moura +% Version: 0.1 +% Date: 19/11/2010 +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Artistic License 2.0 +% +% Copyright (c) 2000-2006, The Perl Foundation. +% +% Everyone is permitted to copy and distribute verbatim copies of this +% license document, but changing it is not allowed. Preamble +% +% This license establishes the terms under which a given free software +% Package may be copied, modified, distributed, and/or +% redistributed. The intent is that the Copyright Holder maintains some +% artistic control over the development of that Package while still +% keeping the Package available as open source and free software. +% +% You are always permitted to make arrangements wholly outside of this +% license directly with the Copyright Holder of a given Package. If the +% terms of this license do not permit the full use that you propose to +% make of the Package, you should contact the Copyright Holder and seek +% a different licensing arrangement. Definitions +% +% "Copyright Holder" means the individual(s) or organization(s) named in +% the copyright notice for the entire Package. +% +% "Contributor" means any party that has contributed code or other +% material to the Package, in accordance with the Copyright Holder's +% procedures. +% +% "You" and "your" means any person who would like to copy, distribute, +% or modify the Package. +% +% "Package" means the collection of files distributed by the Copyright +% Holder, and derivatives of that collection and/or of those files. A +% given Package may consist of either the Standard Version, or a +% Modified Version. +% +% "Distribute" means providing a copy of the Package or making it +% accessible to anyone else, or in the case of a company or +% organization, to others outside of your company or organization. +% +% "Distributor Fee" means any fee that you charge for Distributing this +% Package or providing support for this Package to another party. It +% does not mean licensing fees. +% +% "Standard Version" refers to the Package if it has not been modified, +% or has been modified only in ways explicitly requested by the +% Copyright Holder. +% +% "Modified Version" means the Package, if it has been changed, and such +% changes were not explicitly requested by the Copyright Holder. +% +% "Original License" means this Artistic License as Distributed with the +% Standard Version of the Package, in its current version or as it may +% be modified by The Perl Foundation in the future. +% +% "Source" form means the source code, documentation source, and +% configuration files for the Package. +% +% "Compiled" form means the compiled bytecode, object code, binary, or +% any other form resulting from mechanical transformation or translation +% of the Source form. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Permission for Use and Modification Without Distribution +% +% (1) You are permitted to use the Standard Version and create and use +% Modified Versions for any purpose without restriction, provided that +% you do not Distribute the Modified Version. +% +% Permissions for Redistribution of the Standard Version +% +% (2) You may Distribute verbatim copies of the Source form of the +% Standard Version of this Package in any medium without restriction, +% either gratis or for a Distributor Fee, provided that you duplicate +% all of the original copyright notices and associated disclaimers. At +% your discretion, such verbatim copies may or may not include a +% Compiled form of the Package. +% +% (3) You may apply any bug fixes, portability changes, and other +% modifications made available from the Copyright Holder. The resulting +% Package will still be considered the Standard Version, and as such +% will be subject to the Original License. +% +% Distribution of Modified Versions of the Package as Source +% +% (4) You may Distribute your Modified Version as Source (either gratis +% or for a Distributor Fee, and with or without a Compiled form of the +% Modified Version) provided that you clearly document how it differs +% from the Standard Version, including, but not limited to, documenting +% any non-standard features, executables, or modules, and provided that +% you do at least ONE of the following: +% +% (a) make the Modified Version available to the Copyright Holder of the +% Standard Version, under the Original License, so that the Copyright +% Holder may include your modifications in the Standard Version. (b) +% ensure that installation of your Modified Version does not prevent the +% user installing or running the Standard Version. In addition, the +% modified Version must bear a name that is different from the name of +% the Standard Version. (c) allow anyone who receives a copy of the +% Modified Version to make the Source form of the Modified Version +% available to others under (i) the Original License or (ii) a license +% that permits the licensee to freely copy, modify and redistribute the +% Modified Version using the same licensing terms that apply to the copy +% that the licensee received, and requires that the Source form of the +% Modified Version, and of any works derived from it, be made freely +% available in that license fees are prohibited but Distributor Fees are +% allowed. +% +% Distribution of Compiled Forms of the Standard Version or +% Modified Versions without the Source +% +% (5) You may Distribute Compiled forms of the Standard Version without +% the Source, provided that you include complete instructions on how to +% get the Source of the Standard Version. Such instructions must be +% valid at the time of your distribution. If these instructions, at any +% time while you are carrying out such distribution, become invalid, you +% must provide new instructions on demand or cease further +% distribution. If you provide valid instructions or cease distribution +% within thirty days after you become aware that the instructions are +% invalid, then you do not forfeit any of your rights under this +% license. +% +% (6) You may Distribute a Modified Version in Compiled form without the +% Source, provided that you comply with Section 4 with respect to the +% Source of the Modified Version. +% +% Aggregating or Linking the Package +% +% (7) You may aggregate the Package (either the Standard Version or +% Modified Version) with other packages and Distribute the resulting +% aggregation provided that you do not charge a licensing fee for the +% Package. Distributor Fees are permitted, and licensing fees for other +% components in the aggregation are permitted. The terms of this license +% apply to the use and Distribution of the Standard or Modified Versions +% as included in the aggregation. +% +% (8) You are permitted to link Modified and Standard Versions with +% other works, to embed the Package in a larger work of your own, or to +% build stand-alone binary or bytecode versions of applications that +% include the Package, and Distribute the result without restriction, +% provided the result does not expose a direct interface to the Package. +% +% Items That are Not Considered Part of a Modified Version +% +% (9) Works (including, but not limited to, modules and scripts) that +% merely extend or make use of the Package, do not, by themselves, cause +% the Package to be a Modified Version. In addition, such works are not +% considered parts of the Package itself, and are not subject to the +% terms of this license. +% +% General Provisions +% +% (10) Any use, modification, and distribution of the Standard or +% Modified Versions is governed by this Artistic License. By using, +% modifying or distributing the Package, you accept this license. Do not +% use, modify, or distribute the Package, if you do not accept this +% license. +% +% (11) If your Modified Version has been derived from a Modified Version +% made by someone other than you, you are nevertheless required to +% ensure that your Modified Version complies with the requirements of +% this license. +% +% (12) This license does not grant you the right to use any trademark, +% service mark, tradename, or logo of the Copyright Holder. +% +% (13) This license includes the non-exclusive, worldwide, +% free-of-charge patent license to make, have made, use, offer to sell, +% sell, import and otherwise transfer the Package with respect to any +% patent claims licensable by the Copyright Holder that are necessarily +% infringed by the Package. If you institute patent litigation +% (including a cross-claim or counterclaim) against any party alleging +% that the Package constitutes direct or contributory patent +% infringement, then this Artistic License to you shall terminate on the +% date that such litigation is filed. +% +% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT +% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED +% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT +% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT +% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, +% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE +% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +:- module(flags, [flag_define/2, + flag_define/5, + flag_define/7, + flag_set/2, + flag_set/3, + flag_unsafe_set/2, + flag_get/2, + flags_reset/0, + flags_reset/1, + flags_save/1, + flags_load/1, + flag_groups/1, + flag_group_chk/1, + flag_help/0, + flags_print/0, + defined_flag/7]). + +:- use_module(library(lists), [append/3, memberchk/2, member/2]). + +:- style_check(all). +:- yap_flag(unknown, error). + +:- dynamic(['$defined_flag$'/7, '$store_flag_value$'/2]). +:- meta_predicate(flag_define(+, +, +, ?, ?, ?, :)). +:- meta_predicate(flag_define(+, :)). +:- meta_predicate(validate(+, :, ?, +)). +:- multifile(flags_type_definition/3). + +flag_define(FlagName, InputOptions):- + strip_module(InputOptions, Module, UserOptions), + Defaults = [flag_group(general), flag_type(nonvar), default_value(true), description(FlagName), access(read_write), handler(true)], + append(UserOptions, Defaults, Options), + memberchk(flag_group(FlagGroup), Options), + memberchk(flag_type(FlagType), Options), + memberchk(default_value(DefaultValue), Options), + memberchk(description(Description), Options), + memberchk(access(Access), Options), + memberchk(handler(Handler), Options), + flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler). + +flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description):- + flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, read_write, true). + +flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, MHandler):- + strip_module(MHandler, Module, Handler), + nonvar(FlagName), + nonvar(FlagGroup), + nonvar(FlagType), + nonvar(Access), + nonvar(Handler), !, + (\+ atom(FlagName) -> + throw(error(type_error(atom, FlagName), message('Flag name needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; \+ atom(FlagGroup) -> + throw(error(type_error(atom, FlagGroup), message('Flag group needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; \+ flag_type(FlagType) -> + throw(error(domain_error(flag_type, FlagType), message('Unknown flag type.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Module:Handler)))) + ; \+ validate_type(FlagType) -> + throw(error(evaluation_error(type_validation), message('Validation of flag type failed, check custom domain.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; '$defined_flag$'(FlagName, _FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler) -> + throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]), + throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; \+ callable(Handler) -> + throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) + ; + validate(FlagType, Module:Handler, DefaultValue, FlagName), + assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)), + assertz('$store_flag_value$'(FlagName, DefaultValue)), + (Handler == true -> + true + ; + call(Module:Handler, stored, DefaultValue) + ) + ). +flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):- + throw(error(instantiation_error, message('Flag name, group, type, access and handler need to be instantiated.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler)))). + +flag_groups(FlagGroups):- + all(FlagGroup, ('$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, Access, _Handler), Access \== hidden, Access \== hidden_read_only), FlagGroups). + +flag_group_chk(FlagGroup):- + nonvar(FlagGroup), + '$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler), !. + +flag_type(Type):- + flags_type_definition(Type, _, _). + +% flags_type_definition(TypeName, TypeHandler, TypeValidator). +flags_type_definition(nonvar, nonvar, true). +flags_type_definition(atom, atom, true). +flags_type_definition(atomic, atomic, true). +flags_type_definition(integer, integer, true). +flags_type_definition(float, float, true). +flags_type_definition(number, number, true). +flags_type_definition(ground, ground, true). +flags_type_definition(compound, compound, true). +flags_type_definition(is_list, is_list, true). +flags_type_definition(callable, callable, true). +flags_type_definition(in_interval(Type, Interval), in_interval(Type, Interval), in_interval(Type, Interval)). +flags_type_definition(integer_in_interval(Interval), in_interval(integer, Interval), in_interval(integer, Interval)). +flags_type_definition(positive_integer, in_interval(integer, (0, (+inf))), true). +flags_type_definition(non_negative_integer, in_interval(integer, ([0], (+inf))), true). +flags_type_definition(negative_integer, in_interval(integer, ((-inf), 0)), true). +flags_type_definition(float_in_interval(Interval), in_interval(float, Interval), in_interval(float, Interval)). +flags_type_definition(positive_float, in_interval(float, (0.0, (+inf))), true). +flags_type_definition(non_negative_float, in_interval(float, ([0.0], (+inf))), true). +flags_type_definition(negative_float, in_interval(float, ((-inf), 0.0)), true). +flags_type_definition(number_in_interval(Interval), in_interval(number, Interval), in_interval(number, Interval)). +flags_type_definition(positive_number, in_interval(number, (0.0, (+inf))), true). +flags_type_definition(non_negative_number, in_interval(number, ([0.0], (+inf))), true). +flags_type_definition(negative_number, in_interval(number, ((-inf), 0.0)), true). +flags_type_definition(in_domain(Domain), in_domain(Domain), in_domain(Domain)). +flags_type_definition(boolean, in_domain([true, false]), true). +flags_type_definition(switch, in_domain([on, off]), true). + +in_domain(Domain):- + ground(Domain), + is_list(Domain). +in_domain(Domain, Value):- + ground(Value), + memberchk(Value, Domain). + +in_interval(Type, Interval):- + is_list(Interval), !, + Interval \== [], + in_interval_conj(Type, Interval). +in_interval(Type, Interval):- + in_interval_single(Type, Interval). + +in_interval_conj(_Type, []). +in_interval_conj(Type, [Interval|Rest]):- + in_interval_single(Type, Interval), + in_interval_conj(Type, Rest). + +in_interval_single(Type, ([Min], [Max])):- + !, call(Type, Min), + call(Type, Max), + Min =< Max. + +in_interval_single(Type, ([Min], Max)):- + !, call(Type, Min), + call(Type, Max), + Min < Max. + +in_interval_single(Type, (Min, [Max])):- + !, call(Type, Min), + call(Type, Max), + Min < Max. + +in_interval_single(Type, (Min, Max)):- + call(Type, Min), + call(Type, Max), + Min < Max, + Max - Min > 0.0. + +in_interval(Type, [Interval|_Rest], Value):- + in_interval(Type, Interval, Value), !. +in_interval(Type, [_Interval|Rest], Value):- + in_interval(Type, Rest, Value). + +in_interval(Type, ([Min], [Max]), Value):- + !, call(Type, Value), + Value >= Min, + Value =< Max. + +in_interval(Type, ([Min], Max), Value):- + !, call(Type, Value), + Value >= Min, + Value < Max. + +in_interval(Type, (Min, [Max]), Value):- + !, call(Type, Value), + Value > Min, + Value =< Max. + +in_interval(Type, (Min, Max), Value):- + call(Type, Value), + Value > Min, + Value < Max. + +validate_type(Type):- + flags_type_definition(Type, _, TypeValidater), + call(TypeValidater). + +validate(FlagType, Handler, Value, FlagName):- + strip_module(Handler, _Module, true), + !, flags_type_definition(FlagType, FlagValidator, _), + (call(FlagValidator, Value) -> + true + ; + throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Value, FlagName)))) + ). +validate(FlagType, Handler, Value, FlagName):- + flags_type_definition(FlagType, FlagValidator, _), + ((call(Handler, validating, Value), (call(FlagValidator, Value); call(Handler, validate, Value))) -> + call(Handler, validated, Value) + ; + throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Handler, Value, FlagName)))) + ). + +flag_set(FlagName, FlagValue):- + flag_set(FlagName, _OldValue, FlagValue). +flag_set(FlagName, OldValue, FlagValue):- + atom(FlagName), + '$defined_flag$'(FlagName, _FlagGroup, FlagType, _DefaultValue, _Description, Access, Module:Handler), !, + (Access \== read_only, Access \== hidden_read_only -> + validate(FlagType, Module:Handler, FlagValue, FlagName), + retract('$store_flag_value$'(FlagName, OldValue)), + assertz('$store_flag_value$'(FlagName, FlagValue)), + (Handler == true -> + true + ; + call(Module:Handler, stored, FlagValue) + ) + ; + throw(error(permission_error(set, flag, FlagName), message('Setting the flag value is not allowed.',flag_set(FlagName, OldValue, FlagValue)))) + ). +flag_set(FlagName, OldValue, FlagValue):- + throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_set(FlagName, OldValue, FlagValue)))). + +flag_unsafe_set(FlagName, FlagValue):- + retract('$store_flag_value$'(FlagName, _)), + assertz('$store_flag_value$'(FlagName, FlagValue)). + +flag_get(FlagName, FlagValue):- + '$store_flag_value$'(FlagName, FlagValue). +flag_get(FlagName, FlagValue):- + \+ '$store_flag_value$'(FlagName, _), + throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_get(FlagName, FlagValue)))). + +flags_reset:- + retractall('$store_flag_value$'(_, _)), + '$defined_flag$'(FlagName, _FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler), + assertz('$store_flag_value$'(FlagName, DefaultValue)), + (Handler == true -> + true + ; + call(Module:Handler, stored, DefaultValue) + ), + fail. +flags_reset. + +flags_reset(FlagGroup):- + '$defined_flag$'(FlagName, FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler), + retractall('$store_flag_value$'(FlagName, _)), + assertz('$store_flag_value$'(FlagName, DefaultValue)), + (Handler == true -> + true + ; + call(Module:Handler, stored, DefaultValue) + ), + fail. +flags_reset(_). + +flags_save(FileName):- + tell(FileName), + catch(('$store_flag_value$'(FlagName, Value), + write_canonical('$store_flag_value$'(FlagName, Value)), + write('.'), nl), + Exception, clean_and_throw(told, Exception)), + fail. +flags_save(_FileName):- + told. + +flags_load(FileName):- + see(FileName), + catch((read('$store_flag_value$'(FlagName, Value)), + flag_set(FlagName, Value)), + Exception, clean_and_throw(seen, Exception)), + fail. +flags_load(_FileName):- + seen. + +clean_and_throw(Action, Exception):- + Action, + throw(Exception). + +flag_help:- + format('This is a short tutorial for the flags library.~nExported predicates:~n'), + format(' flag_define/5 : defines a new flag without a handler~n'), + format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description)~n'), + format(' flag_define/6 : defines a new flag with a handler~n'), + format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Handler)~n'), + format(' FlagName : the name of the flag~n'), + format(' FlagGroup : the name of the flag group~n'), + format(' FlagType : the type of the flag available types are:~n'), + flag_help_types, + format(' DefaultValue : the default value for the flag~n'), + format(' Description : a flag description~n'), + format(' Handler : a handler~n'), + flags:flag_help_handler, + format(' flag_groups/1 : returns all the flag groups in a list~n'), + format(' flag_group_chk/1 : checks if a group exists~n'), + format(' flag_set/2 : sets the value of a flag~n'), + format(' flag_get/2 : gets the value of a flag~n'), + format(' flag_store/2 : sets the value of a flag ignoring all tests and handlers~n'), + format(' flag_reset/0 : resets all flags to their default value~n'), + format(' flag_reset/1 : resets all flags of a group to their default value~n'), + format(' flag_help/0 : this screen~n'), + format(' flags_print/0 : shows the current flags/values~n'). +flag_help_types:- + flag_type(FlagType), + format(' ~w~n', [FlagType]), + fail. +flag_help_types. + +flag_help_handler:- + format(' Handler important notes:~n'), + format(' Conjuction: external_handler(validating, Value):-...~n'), + format(' Disjunction: external_handler(validate, Value):-...~n'), + format(' After: external_handler(validated, Value):-...~n'), + format(' After set: external_handler(stored, Value):-...~n'), + format(' this is implemented as (validating,(original;validated))~n'), + format(' validating|original|validate|result~n'), + format(' true | true | true | true~n'), + format(' true | true | fail | true~n'), + format(' true | fail | true | true~n'), + format(' true | fail | fail | fail~n'), + format(' fail | true | true | fail~n'), + format(' fail | true | fail | fail~n'), + format(' fail | fail | true | fail~n'), + format(' fail | fail | fail | fail~n'), + format(' Default behaviour is validating->true, validate->fail~n'), + format(' To completly replace original set validate->true~n'), + format(' To add new values to original set validating->true~n'), + format(' To remove values from original set validate->fail~n'), + format(' Example definition with a handler:~n'), + format(' flag_define(myflag, mygroup, in_interval(integer, [(-5, 5),([15],[25])]), 0, description, my_handler).~n'), + format(' my_handler(validate, Value):-Value is 10.~n'), + format(' my_handler(validating, Value).~n'), + format(' my_handler(validated, Value).~n'), + format(' my_handler(stored, Value).~n'), + format(' This has defined a flag that accepts integers (-5,5)v[15,25].~n'), + format(' The handler adds the value 10 in those.~n'). + +flags_print:- + flag_groups(Groups), + forall(member(Group, Groups), flags_print(Group)). +flags_print(Group):- + format(' ~w:~n~w~38+ ~w~19+ ~w~10+ ~w~10+~n', [Group, 'Description', 'Domain', 'Flag', 'Value']), + fail. +flags_print(FlagGroup):- + '$defined_flag$'(FlagName, FlagGroup, FlagType, _DefaultValue, Description, Access, _Handler), + Access \== hidden, Access \== hidden_read_only, + flag_get(FlagName, Value), + format('~w~38+ ~w~19+ ~w~10+ ~q~10+~n', [Description, FlagType, FlagName, Value]), + fail. +flags_print(_). + +defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):- + '$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler), + Access \== hidden, Access \== hidden_read_only. +defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):- + nonvar(FlagName), nonvar(FlagGroup), + '$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler). + + diff --git a/library/lists.yap b/library/lists.yap index fa84c4e53..c907b9144 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -8,9 +8,14 @@ append/3, append/2, delete/3, + intersection/3, + flatten/2, last/2, + list_concat/2, + max_list/2, member/2, memberchk/2, + min_list/2, nextto/3, nth/3, nth/4, @@ -18,6 +23,7 @@ nth0/4, nth1/3, nth1/4, + numlist/3, permutation/2, prefix/2, remove_duplicates/2, @@ -27,16 +33,11 @@ selectchk/3, sublist/2, substitute/4, + subtract/3, + suffix/2, sum_list/2, sum_list/3, - suffix/2, - sumlist/2, - list_concat/2, - flatten/2, - max_list/2, - min_list/2, - numlist/3, - intersection/3 + sumlist/2 ]). :- use_module(library(error), @@ -400,3 +401,17 @@ intersection([X|T], L, Intersect) :- intersection([_|T], L, R) :- intersection(T, L, R). +%% subtract(+Set, +Delete, -Result) is det. +% +% Delete all elements from `Set' that occur in `Delete' (a set) +% and unify the result with `Result'. Deletion is based on +% unification using memberchk/2. The complexity is |Delete|*|Set|. +% +% @see ord_subtract/3. + +subtract([], _, []) :- !. +subtract([E|T], D, R) :- + memberchk(E, D), !, + subtract(T, D, R). +subtract([H|T], D, [H|R]) :- + subtract(T, D, R). diff --git a/library/matrix/Makefile.in b/library/matrix/Makefile.in index ad180a93b..f1f5134d2 100644 --- a/library/matrix/Makefile.in +++ b/library/matrix/Makefile.in @@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -47,10 +48,10 @@ matrix.o: $(srcdir)/matrix.c $(CC) -c $(CFLAGS) $(srcdir)/matrix.c -o matrix.o @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@matrix.@SO@: matrix.o -@DO_SECOND_LD@ @SHLIB_LD@ -o matrix.@SO@ matrix.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o matrix.@SO@ matrix.o @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/library/random/Makefile.in b/library/random/Makefile.in index fd2150b16..50e573ba2 100644 --- a/library/random/Makefile.in +++ b/library/random/Makefile.in @@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -47,10 +48,10 @@ yap_random.o: $(srcdir)/yap_random.c $(CC) -c $(CFLAGS) $(srcdir)/yap_random.c -o yap_random.o @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@yap_random.@SO@: yap_random.o -@DO_SECOND_LD@ @SHLIB_LD@ -o yap_random.@SO@ yap_random.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o yap_random.@SO@ yap_random.o @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/library/regex/Makefile.in b/library/regex/Makefile.in index 3fa49f6e4..cdb40644a 100644 --- a/library/regex/Makefile.in +++ b/library/regex/Makefile.in @@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -59,22 +60,22 @@ regexec.o: $(srcdir)/regexec.c $(CC) -c $(CFLAGS) $(srcdir)/regexec.c -o regexec.o @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@regexp.@SO@: regexp.o @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o -@DO_SECOND_LD@ @SHLIB_LD@ -o regexp.@SO@ regexp.o @EXTRA_LIBS_FOR_DLLS@ @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regexp.@SO@ regexp.o @EXTRA_LIBS_FOR_DLLS@ @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o @DO_SECOND_LD@regcomp.@SO@: regcomp.o @MERGE_DLL_OBJS@ regfree.o -@DO_SECOND_LD@ @SHLIB_LD@ -o regcomp.@SO@ regcomp.o @MERGE_DLL_OBJS@ regfree.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regcomp.@SO@ regcomp.o @MERGE_DLL_OBJS@ regfree.o @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@regerror.@SO@: regerror.o -@DO_SECOND_LD@ @SHLIB_LD@ -o regerror.@SO@ regerror.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regerror.@SO@ regerror.o @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@regfree.@SO@: regfree.o -@DO_SECOND_LD@ @SHLIB_LD@ -o regfree.@SO@ regfree.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regfree.@SO@ regfree.o @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@regexec.@SO@: regexec.o -@DO_SECOND_LD@ @SHLIB_LD@ -o regexec.@SO@ regexec.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regexec.@SO@ regexec.o @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/library/rltree/Makefile.in b/library/rltree/Makefile.in index 7a697de9a..ca8ad6dac 100644 --- a/library/rltree/Makefile.in +++ b/library/rltree/Makefile.in @@ -25,6 +25,7 @@ YAPLIBDIR=@libdir@/Yap CC=@CC@ MPI_CC=mpicc CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -52,10 +53,10 @@ yaprl.o: $(srcdir)/yap_rl.c $(CC) -c $(CFLAGS) $(srcdir)/yap_rl.c -o yaprl.o @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@yap_rl.@SO@: $(OBJS) -@DO_SECOND_LD@ @SHLIB_LD@ -o yap_rl.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o yap_rl.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ install: all @if test "$(SOBJS)" = "no"; then echo ""; else $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR); fi diff --git a/library/system.yap b/library/system.yap index 5c33d32c0..8270ab653 100644 --- a/library/system.yap +++ b/library/system.yap @@ -43,6 +43,7 @@ mktime/2, tmpnam/1, tmp_file/2, + tmpdir/1, wait/2, working_directory/2 ]). @@ -138,7 +139,7 @@ rm_directory(File, Ignore) :- delete_directory(on, File, Ignore) :- directory_files(File, FileList, Ignore), - dir_separator(D), + path_separator(D), atom_concat(File, D, FileP), delete_dirfiles(FileList, FileP, Ignore), rmdir(File, Ignore). @@ -501,13 +502,13 @@ tmp_file(Base,X) :- throw(error(instantiation_error,tmp_file(Base,X))). tmp_file(Base,X) :- atom(Base), !, - tmpdir(Dir, Error), - handle_system_error(Error, off, tmp_file(Base,Error)), + tmpdir(Dir), + handle_system_error(Error, off, tmp_file(Base,X)), pid(PID, Error), - handle_system_error(Error, off, tmp_file(Base,Error)), + handle_system_error(Error, off, tmp_file(Base,X)), tmp_file_sequence(I), - dir_separator(D), - atomic_concat([Dir,D,yap_,Base,'_',PID,'_',I],X). +% path_separator(D), + atomic_concat([Dir,yap_,Base,'_',PID,'_',I],X). tmp_file(Base,X) :- throw(error(type_error(atom,Base),tmp_file(Base,X))). @@ -518,3 +519,18 @@ tmp_file_sequence(X) :- tmp_file_sequence(0) :- assert(tmp_file_sequence_counter(1)). +%%% Added from Theo, path_seperator is used to replace the c predicate dir_separator which is not OS aware + +tmpdir(TmpDir):- + tmpdir(Dir, Error), + handle_system_error(Error, off, tmpdir(Dir)), + path_separator(D), + (atom_concat(_, D, Dir) -> + TmpDir = Dir + ; + atom_concat(Dir, D, TmpDir) + ). + +path_separator('\\'):- + win, !. +path_separator('/'). diff --git a/library/system/Makefile.in b/library/system/Makefile.in index 79871fc62..d799392b1 100644 --- a/library/system/Makefile.in +++ b/library/system/Makefile.in @@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -47,10 +48,10 @@ sys.o: $(srcdir)/sys.c $(CC) -c $(CFLAGS) $(srcdir)/sys.c -o sys.o @DO_SECOND_LD@@DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@sys.@SO@: sys.o -@DO_SECOND_LD@ @SHLIB_LD@ -o sys.@SO@ sys.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o sys.@SO@ sys.o @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/library/tries/Makefile.in b/library/tries/Makefile.in index b8ddc06e2..aff464d86 100644 --- a/library/tries/Makefile.in +++ b/library/tries/Makefile.in @@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -60,13 +61,13 @@ itries.o: $(srcdir)/core_tries.h $(srcdir)/base_itries.h $(srcdir)/itries.c $(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/itries.c -o itries.o @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@tries.@SO@: core_tries.o base_tries.o tries.o -@DO_SECOND_LD@ @SHLIB_LD@ -o tries.@SO@ core_tries.o base_tries.o tries.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o tries.@SO@ core_tries.o base_tries.o tries.o @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@itries.@SO@: core_tries.o base_itries.o itries.o -@DO_SECOND_LD@ @SHLIB_LD@ -o itries.@SO@ core_tries.o base_itries.o itries.o @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o itries.@SO@ core_tries.o base_itries.o itries.o @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/misc/GLOBALS b/misc/GLOBALS index 1219f8c65..1dcda6810 100644 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -211,6 +211,7 @@ SWI_PutWideFunction swi_wputc SWIWidePutc =NULL SWI_CloseFunction swi_close SWIClose =NULL SWI_FlushFunction swi_flush SWIFlush =NULL SWI_PLGetStreamFunction swi_get_stream_f SWIGetStream =NULL +SWI_PLGetStreamPositionFunction swi_get_stream_position_f SWIGetStreamPosition =NULL // stack overflow expansion/gc control int allow_local_expansion Yap_AllowLocalExpansion =TRUE diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index f578658ce..a5ddebc25 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -141,6 +141,7 @@ struct pred_entry *pred_throw PredThrow MkPred FunctorThrow PROLOG_MODULE struct pred_entry *pred_handle_throw PredHandleThrow MkPred FunctorHandleThrow PROLOG_MODULE struct pred_entry *pred_is PredIs MkPred FunctorIs PROLOG_MODULE struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup MkPred FunctorSafeCallCleanup PROLOG_MODULE +struct pred_entry *pred_restore_regs PredRestoreRegs MkPred FunctorRestoreRegs PROLOG_MODULE #ifdef YAPOR struct pred_entry *pred_getwork PredGetwork MkPred AtomGetwork 0 PROLOG_MODULE struct pred_entry *pred_getwork_seq PredGetworkSeq MkPred AtomGetworkSeq 0 PROLOG_MODULE @@ -338,6 +339,9 @@ ADDR foreign_code_base ForeignCodeBase =NULL void ADDR foreign_code_top ForeignCodeTop =NULL void ADDR foreign_code_max ForeignCodeMax =NULL void +/* recorded terms */ +struct record_list *yap_records Yap_Records =NULL RestoreYapRecords() + /* SWI atoms and functors */ Atom swi_atoms[N_SWI_ATOMS] SWI_Atoms InitSWIAtoms() RestoreSWIAtoms() Functor swi_functors[N_SWI_FUNCTORS] SWI_Functors void void diff --git a/packages/PLStream/Makefile.in b/packages/PLStream/Makefile.in index 110a96dfb..19a9d5306 100755 --- a/packages/PLStream/Makefile.in +++ b/packages/PLStream/Makefile.in @@ -22,6 +22,7 @@ YAPLIBDIR=@libdir@/Yap DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1 CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@ +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -78,10 +79,10 @@ uxnt.o: $(srcdir)/uxnt/uxnt.c $(CC) -c $(CFLAGS) $< -o $@ @DO_SECOND_LD@%.@SO@: %.o -@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@ @DO_SECOND_LD@libplstream.@SO@: $(OBJS) -@DO_SECOND_LD@ @SHLIB_LD@ -o libplstream.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o libplstream.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index 6c0fef260..60ba85a9a 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -4344,12 +4344,18 @@ get_stream_handle_no_errors(term_t t, int read, int write, IOSTREAM **s) { GET_LD if ( t == 0 ) { if (write) *s = getStream(Scurout); - else *s = getStream(Scurout); + else *s = getStream(Scurin); return TRUE; } return get_stream_handle(t, s, SH_ALIAS); } +static int +get_stream_position(IOSTREAM *s, term_t t) +{ GET_LD + return stream_position_prop(s, t); +} + static void init_yap_extras(void) { @@ -4363,6 +4369,7 @@ init_yap_extras(void) swiio.flush_s = Sflush; swiio.close_s = closeStream; swiio.get_stream_handle = get_stream_handle_no_errors; + swiio.get_stream_position = get_stream_position; PL_YAP_InitSWIIO(&swiio); initCharTypes(); initFiles(); diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index 23ea671bc..cb70ad91d 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -2,8 +2,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -% $Date: 2010-12-15 11:12:48 +0100 (Wed, 15 Dec 2010) $ -% $Revision: 5138 $ +% $Date: 2011-01-16 19:24:10 +0100 (Sun, 16 Jan 2011) $ +% $Revision: 5260 $ % % This file is part of ProbLog % http://dtai.cs.kuleuven.be/problog @@ -521,6 +521,7 @@ init_global_params :- problog_define_flag(bdd_result, problog_flag_validate_file, 'file to store result calculated from BDD', example_bdd_res, bdd, flags:working_file_handler), problog_define_flag(bdd_file, problog_flag_validate_file, 'file for BDD script', example_bdd, bdd, flags:bdd_file_handler), problog_define_flag(static_order_file, problog_flag_validate_file, 'file for BDD static order', example_bdd_order, bdd, flags:working_file_handler), + problog_define_flag(map_file, problog_flag_validate_file, 'the file to output the variable map', map_file, output, flags:working_file_handler), %%%%%%%%%%%% % montecarlo: recalculate current approximation after N samples % montecarlo: write log to this file @@ -2458,6 +2459,7 @@ montecarlo(Goal,Delta,K,File) :- format(Log,'# goal: ~q~n#delta: ~w~n',[Goal,Delta]), format(Log,'# num_programs prob low high diff time~2n',[]), close(Log), + timer_reset(monte_carlo), timer_start(monte_carlo), format_if_verbose(user,'search for ~q~n',[Goal]), montecarlo(Goal,Delta,K,0,File,0), diff --git a/packages/ProbLog/problog/ptree.yap b/packages/ProbLog/problog/ptree.yap index 409895e22..2d8afb1d2 100644 --- a/packages/ProbLog/problog/ptree.yap +++ b/packages/ProbLog/problog/ptree.yap @@ -2,8 +2,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -% $Date: 2010-12-16 13:33:43 +0100 (Thu, 16 Dec 2010) $ -% $Revision: 5156 $ +% $Date: 2011-01-16 19:24:10 +0100 (Sun, 16 Jan 2011) $ +% $Revision: 5260 $ % % This file is part of ProbLog % http://dtai.cs.kuleuven.be/problog @@ -282,7 +282,8 @@ problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false), problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true), problog_define_flag(use_dec_trie, problog_flag_validate_boolean, 'use the decomposition method', false), - problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false) + problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false), + problog_define_flag(export_map_file, problog_flag_validate_boolean, 'activates export of a variable map file', false, output) )). @@ -657,40 +658,52 @@ bdd_ptree_script(Trie, FileBDD, FileParam) :- retractall(compression(_, _)). % write parameter file by iterating over all var/not(var) occuring in the tree -bdd_vars_script([]). -bdd_vars_script([A|B]) :- - ( - A=not(ID) - -> - bdd_vars_script_intern(ID); - bdd_vars_script_intern(A) - ), - bdd_vars_script(B). -bdd_vars_script_intern(A) :- - ( - number(A) - -> - ( - % it's a ground fact - get_var_name(A,NameA), - (problog:decision_fact(A,_) -> - % it's a ground decision - (problog:problog_control(check,internal_strategy) -> - problog:get_fact_probability(A,P), - format('@~w~n~12f~n~w~n',[NameA,P,1]) - ; - format('@~w~n~12f~n~w~n',[NameA,0,1]) - ) - ; - % it's a normal ProbLog fact + +bdd_vars_script(Vars):- + bdd_vars_script(Vars, Names), + (problog_flag(export_map_file, true) -> + problog_flag(map_file, MapFile), + os:convert_filename_to_working_path(MapFile, MapFileName), + flush_output, + tell(MapFileName), + problog:get_fact_list(Vars, Facts), + writemap(Names, Facts), + flush_output, + told + ; + true + ). +writemap([],[]). +writemap([Name|Names],[Fact|Facts]):- + write(map(Name,Fact)),nl, + writemap(Names, Facts). + +bdd_vars_script([], []). +bdd_vars_script([not(A)|B], Names) :- + !, bdd_vars_script([A|B], Names). +bdd_vars_script([A|B], [NameA|Names]) :- + bdd_vars_script_intern(A, NameA), + bdd_vars_script(B, Names). + +bdd_vars_script_intern(A, NameA) :- + (number(A) -> % it's a ground fact + get_var_name(A,NameA), + (problog:decision_fact(A,_) -> % it's a ground decision + (problog:problog_control(check,internal_strategy) -> problog:get_fact_probability(A,P), - format('@~w~n~12f~n',[NameA,P]) + format('@~w~n~12f~n~w~n',[NameA,P,1]) + ; + format('@~w~n~12f~n~w~n',[NameA,0,1]) ) - ); % it's somethin else, call the specialist - % it's a non-ground or continuous fact - bdd_vars_script_intern2(A) - ). -bdd_vars_script_intern2(A) :- + ; % it's a normal ProbLog fact + problog:get_fact_probability(A,P), + format('@~w~n~12f~n',[NameA,P]) + ) + ; % it's somethin else, call the specialist - it's a non-ground or continuous fact + bdd_vars_script_intern2(A, NameA) + ). + +bdd_vars_script_intern2(A, NameA) :- get_var_name(A,NameA), atom_codes(A,A_Codes), diff --git a/packages/clib/Makefile.in b/packages/clib/Makefile.in index 4a5a5753b..feb2f0c52 100755 --- a/packages/clib/Makefile.in +++ b/packages/clib/Makefile.in @@ -39,7 +39,7 @@ CRYPTLIBS=@CLIB_CRYPTLIBS@ PTHREADLIBS=@CLIB_PTHREADS@ LD=@DO_SECOND_LD@ @SHLIB_LD@ -LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ +LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@ BINTARGET=$(DESTDIR)$(YAPLIBDIR) PLTARGET=$(DESTDIR)$(SHAREDIR) diff --git a/packages/http/Makefile.in b/packages/http/Makefile.in index 8609697af..dff4493c9 100755 --- a/packages/http/Makefile.in +++ b/packages/http/Makefile.in @@ -39,7 +39,7 @@ CWD=$(PWD) # LD=@DO_SECOND_LD@ @SHLIB_LD@ -LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ +LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@ BINTARGET=$(DESTDIR)$(YAPLIBDIR) PLTARGET=$(DESTDIR)$(SHAREDIR)/http diff --git a/packages/jpl b/packages/jpl index 73e4e086d..29151b2fe 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit 73e4e086d06c54210100f0faaeccbea276c707eb +Subproject commit 29151b2fe68f2dc727cdc07040e1fa1ad4fcca20 diff --git a/packages/semweb/Makefile.in b/packages/semweb/Makefile.in index 49d7617c6..54e505886 100755 --- a/packages/semweb/Makefile.in +++ b/packages/semweb/Makefile.in @@ -48,7 +48,7 @@ CWD=$(PWD) # LD=@DO_SECOND_LD@ @SHLIB_LD@ -LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ +LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@ BINTARGET=$(DESTDIR)$(YAPLIBDIR) PLTARGET=$(DESTDIR)$(SHAREDIR)/semweb diff --git a/packages/sgml/Makefile.in b/packages/sgml/Makefile.in index 3eb6c81b1..a76209cbc 100755 --- a/packages/sgml/Makefile.in +++ b/packages/sgml/Makefile.in @@ -31,6 +31,7 @@ LN_S=@LN_S@ DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1 CC=@CC@ CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@ +LDFLAGS=@LDFLAGS@ MKINDEX=true LD=$(CC) @@ -117,7 +118,7 @@ ifeq (@PROLOG_SYSTEM@,yap) $(CC) $(CFLAGS) -o $@ -c $< @DO_SECOND_LD@sgml2pl.@SO@: $(PLOBJ) -@DO_SECOND_LD@ @SHLIB_LD@ -o sgml2pl.@SO@ $(PLOBJ) @EXTRA_LIBS_FOR_SWIDLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o sgml2pl.@SO@ $(PLOBJ) @EXTRA_LIBS_FOR_SWIDLLS@ all: $(TARGETS) $(PROGRAMS) diff --git a/packages/swi-minisat2/C/Makefile.in b/packages/swi-minisat2/C/Makefile.in index 0ccf74b4a..0b9c11f05 100755 --- a/packages/swi-minisat2/C/Makefile.in +++ b/packages/swi-minisat2/C/Makefile.in @@ -23,6 +23,7 @@ DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1 CC=@CC@ CXX=@CXX@ CXXFLAGS= @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../../.. -I$(srcdir)/../../../include @CPPFLAGS@ +LDFLAGS=@LDFLAGS@ # # # You shouldn't need to change what follows. @@ -70,7 +71,7 @@ pl-minisat.o : $(srcdir)/pl-minisat.C $(CXX) -c $(CXXFLAGS) $(srcdir)/pl-minisat.C -o pl-minisat.o @DO_SECOND_LD@pl-minisat.@SO@: $(OBJS) -@DO_SECOND_LD@ @SHLIB_CXX_LD@ -o pl-minisat.@SO@ $(OBJS) @EXTRA_LIBS_FOR_SWIDLLS@ +@DO_SECOND_LD@ @SHLIB_CXX_LD@ $(LDFLAGS) -o pl-minisat.@SO@ $(OBJS) @EXTRA_LIBS_FOR_SWIDLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/packages/tai/Makefile.in b/packages/tai/Makefile.in index 1ad6a6045..3e8e4b422 100755 --- a/packages/tai/Makefile.in +++ b/packages/tai/Makefile.in @@ -49,7 +49,7 @@ pl-tai.o: $(srcdir)/pl-tai.c $(CC) -c $(CFLAGS) $(srcdir)/pl-tai.c -o pl-tai.o @DO_SECOND_LD@pl-tai.@SO@: pl-tai.o -@DO_SECOND_LD@ @SHLIB_LD@ -o pl-tai.@SO@ pl-tai.o libtai/libtai.a @EXTRA_LIBS_FOR_SWIDLLS@ +@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o pl-tai.@SO@ pl-tai.o libtai/libtai.a @EXTRA_LIBS_FOR_SWIDLLS@ install: all $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) diff --git a/packages/zlib/Makefile.in b/packages/zlib/Makefile.in index 9793bcf22..fe9f41f0e 100644 --- a/packages/zlib/Makefile.in +++ b/packages/zlib/Makefile.in @@ -46,7 +46,7 @@ CWD=$(PWD) # LD=@DO_SECOND_LD@ @SHLIB_LD@ -LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ +LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@ BINTARGET=$(DESTDIR)$(YAPLIBDIR) PLTARGET=$(DESTDIR)$(SHAREDIR) diff --git a/pl/boot.yap b/pl/boot.yap index eac15a1b2..11080bdc7 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -515,7 +515,7 @@ true :- true. X == '$', !, ( recorded('$reconsulting',_,R) -> erase(R) ). -'$prompt_alternatives_on'(groundness). +'$prompt_alternatives_on'(determinism). /* Executing a query */ @@ -536,7 +536,8 @@ true :- true. % end of YAPOR '$query'(G,[]) :- - '$prompt_alternatives_on'(groundness), !, + '$prompt_alternatives_on'(OPT), + ( OPT = groundness ; OPT = determinism), !, '$yes_no'(G,(?-)). '$query'(G,V) :- ( diff --git a/pl/checker.yap b/pl/checker.yap index 6e52d9a53..87d8995a8 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -149,7 +149,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). ; get_value('$syntaxcheckmultiple',on) )), - recorded('$reconsulting',File,_), + nb_getval('$consulting_file',File), '$xtract_head'(T,M,NM,_,F,A), \+ ( % allow duplicates if we are not the last predicate to have diff --git a/pl/init.yap b/pl/init.yap index 7123b3a54..31085f9fd 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -206,5 +206,5 @@ file_search_path(system, Dir) :- prolog_flag(host_type, Dir). file_search_path(foreign, yap('lib/Yap')). -%:- yap_flag(unknown,error). +:- yap_flag(unknown,error). diff --git a/pl/signals.yap b/pl/signals.yap index 298e7bf93..cd7eb7612 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -191,11 +191,21 @@ Run \= off, '$zip'(-1, G, Mod), !, '$signal_creep', - '$execute_nonstop'(G,Mod). + '$execute_goal'(G, Mod). '$start_creep'([Mod|G]) :- CP is '$last_choice_pt', '$do_spy'(G, Mod, CP, no). +'$execute_goal'(G, Mod) :- + ( + '$is_metapredicate'(G, Mod) + -> + '$meta_call'(G,Mod) + ; + '$execute_nonstop'(G,Mod) + ). + + '$signal_do'(Sig, Goal) :- recorded('$signal_handler', action(Sig,Goal), _), !. '$signal_do'(Sig, Goal) :- diff --git a/pl/utils.yap b/pl/utils.yap index 5315dc5a1..80829018f 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -668,10 +668,14 @@ sub_atom(At, Bef, Size, After, SubAt) :- atom_to_term(Atom, Term, Bindings) :- atom_codes(Atom, Chars), charsio:open_mem_read_stream(Chars, Stream), - read_term(Stream, T, [variable_names(Bindings)]), + catch(read_term(Stream, T, [variable_names(Bindings)]),Error,'$handle_atom_to_term_error'(Stream, Error)), close(Stream), T = Term. +'$handle_atom_to_term_error'(Stream, Error) :- + close(Stream), + throw(Error). + term_to_atom(Term,Atom) :- nonvar(Atom), !, atom_codes(Atom,S), @@ -680,6 +684,23 @@ term_to_atom(Term,Atom) :- charsio:write_to_chars(Term,S), atom_codes(Atom,S). +% +% hack this here. +% +charsio:write_to_chars(Term, L0, OUT) :- + charsio:open_mem_write_stream(Stream), + prolog:write(Stream, Term), + charsio:peek_mem_write_stream(Stream, L0, O), + prolog:close(Stream), + O = OUT. + +charsio:read_from_chars(Chars, Term) :- + charsio:open_mem_read_stream(Chars, Stream), + prolog:read(Stream, T), + prolog:close(Stream), + T = Term. + + simple(V) :- var(V), !. simple(A) :- atom(A), !. simple(N) :- number(N).