diff --git a/.gitignore b/.gitignore index 61cbac0e4..7e7d41595 100644 --- a/.gitignore +++ b/.gitignore @@ -62,3 +62,5 @@ cmake_install.cmake cmake_clean.cmake *.build Makefile + +C/myabsmi.c diff --git a/.gitmodules b/.gitmodules index 53938f34b..34547fe40 100644 --- a/.gitmodules +++ b/.gitmodules @@ -15,7 +15,7 @@ url = git://git.code.sf.net/p/yap/http [submodule "packages/clib"] path = packages/clib - url = sssh://git.code.sf.net/p/yap/clib + url = git://git.code.sf.net/p/yap/clib [submodule "packages/sgml"] path = packages/sgml url = git://git.code.sf.net/p/yap/sgml diff --git a/C/cdmgr.c b/C/cdmgr.c index 830a01263..362b438d4 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -527,12 +527,14 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); (CODEADDR)(P) < (CODEADDR)(B)+(SZ)) static PredEntry * -PredForChoicePt(yamop *p_code) { +PredForChoicePt(yamop *p_code, op_numbers *opn) { while (TRUE) { op_numbers opnum; if (!p_code) return NULL; opnum = Yap_op_from_opcode(p_code->opc); + if (opn) + *opn = opnum; switch(opnum) { case _Nstop: return NULL; @@ -626,10 +628,10 @@ PredForChoicePt(yamop *p_code) { } PredEntry * -Yap_PredForChoicePt(choiceptr cp) { +Yap_PredForChoicePt(choiceptr cp, op_numbers *op) { if (cp == NULL) return NULL; - return PredForChoicePt(cp->cp_ap); + return PredForChoicePt(cp->cp_ap, op); } static void @@ -974,9 +976,9 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; - Yap_DebugPutc(LOCAL_c_error_stream,'\t'); + Yap_DebugPutc(stderr,'\t'); Yap_DebugPlWrite(tmod); - Yap_DebugPutc(LOCAL_c_error_stream,':'); + Yap_DebugPutc(stderr,':'); if (ap->ModuleOfPred == IDB_MODULE) { Term t = Deref(ARG1); if (IsAtomTerm(t)) { @@ -987,7 +989,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) Functor f = FunctorOfTerm(t); Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); - Yap_DebugPutc(LOCAL_c_error_stream,'/'); + Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f))); } } else { @@ -998,11 +1000,11 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) Functor f = ap->FunctorOfPred; Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); - Yap_DebugPutc(LOCAL_c_error_stream,'/'); + Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f))); } } - Yap_DebugPutc(LOCAL_c_error_stream,'\n'); + Yap_DebugPutc(stderr,'\n'); } #endif /* Do not try to index a dynamic predicate or one whithout args */ @@ -1030,7 +1032,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) } #ifdef DEBUG if (GLOBAL_Option['i' - 'a' + 1]) - Yap_DebugPutc(LOCAL_c_error_stream,'\n'); + Yap_DebugPutc(stderr,'\n'); #endif } @@ -1638,7 +1640,7 @@ source_pred(PredEntry *p, yamop *q) return FALSE; if (p->PredFlags & MultiFileFlag) return TRUE; - if (yap_flags[SOURCE_MODE_FLAG]) { + if (trueGlobalPrologFlag(SOURCE_FLAG)) { return TRUE; } return FALSE; @@ -2290,6 +2292,21 @@ goal_expansion_support(PredEntry *p, Term tf) } } +Int +Yap_source_line_no( void ) +{ + CACHE_REGS + return LOCAL_SourceFileLineno; +} + +Atom +Yap_source_file_name( void ) +{ + CACHE_REGS + return LOCAL_SourceFileName; +} + + static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) /* @@ -3605,7 +3622,7 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything) /* now mark the choicepoint */ if (b_ptr) - pe = PredForChoicePt(b_ptr->cp_ap); + pe = PredForChoicePt(b_ptr->cp_ap, NULL); else return FALSE; if (pe == p) { @@ -3671,6 +3688,7 @@ do_toggle_static_predicates_in_use(int mask) do { PredEntry *pe; + /* check first environments that are younger than our latest choicepoint */ while (b_ptr > (choiceptr)env_ptr) { PredEntry *pe = EnvPreg((yamop *)env_ptr[E_CP]); @@ -3680,7 +3698,7 @@ do_toggle_static_predicates_in_use(int mask) } /* now mark the choicepoint */ if ((b_ptr)) { - if ((pe = PredForChoicePt(b_ptr->cp_ap))) { + if ((pe = PredForChoicePt(b_ptr->cp_ap, NULL))) { mark_pred(mask, pe); } } @@ -3814,7 +3832,7 @@ all_calls( USES_REGS1 ) ts[0] = MkIntegerTerm((Int)P); ts[1] = MkIntegerTerm((Int)CP); - if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) { + if (trueLocalPrologFlag(STACK_DUMP_ON_ERROR_FLAG)) { ts[2] = all_envs(ENV PASS_REGS); ts[3] = all_cps(B PASS_REGS); if (ts[2] == 0L || @@ -4128,7 +4146,7 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, arity_t *p PredEntry *p; if (where_from == FIND_PRED_FROM_CP) { - p = PredForChoicePt(codeptr); + p = PredForChoicePt(codeptr, NULL); } else if (where_from == FIND_PRED_FROM_ENV) { p = EnvPreg(codeptr); if (p) { @@ -4320,7 +4338,7 @@ PredEntry * Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, CODEADDR *startp, CODEADDR *endp) { CACHE_REGS if (where_from == FIND_PRED_FROM_CP) { - PredEntry *pp = PredForChoicePt(codeptr); + PredEntry *pp = PredForChoicePt(codeptr, NULL); if (cl_code_in_pred(pp, codeptr, startp, endp)) { return pp; } @@ -6663,6 +6681,68 @@ p_nth_instance( USES_REGS1 ) } +static Int predicate_flags(USES_REGS1) { /* $predicate_flags(+Functor,+Mod,?OldFlags,?NewFlags) */ + PredEntry *pe; + pred_flags_t newFl; + Term t1 = Deref(ARG1); + Term mod = Deref(ARG2); + + if (IsVarTerm(mod) || !IsAtomTerm(mod)) { + return (FALSE); + } + if (IsVarTerm(t1)) + return (FALSE); + if (IsAtomTerm(t1)) { + while ((pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod))) == NULL) { + if (!Yap_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate"); + return FALSE; + } + t1 = Deref(ARG1); + mod = Deref(ARG2); + } + } else if (IsApplTerm(t1)) { + Functor funt = FunctorOfTerm(t1); + while ((pe = RepPredProp(PredPropByFunc(funt, mod))) == NULL) { + if (!Yap_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate"); + return FALSE; + } + t1 = Deref(ARG1); + mod = Deref(ARG2); + } + } else + return (FALSE); + if (EndOfPAEntr(pe)) + return (FALSE); + PELOCK(92, pe); + if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) { + UNLOCK(pe->PELock); + return (FALSE); + } + ARG4 = Deref(ARG4); + if (IsVarTerm(ARG4)) { + UNLOCK(pe->PELock); + return (TRUE); + } else if (!IsIntegerTerm(ARG4)) { + Term te = Yap_Eval(ARG4); + + if (IsIntegerTerm(te)) { + newFl = IntegerOfTerm(te); + } else { + UNLOCK(pe->PELock); + Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags"); + return (FALSE); + } + } else + newFl = IntegerOfTerm(ARG4); + pe->PredFlags = newFl; + UNLOCK(pe->PELock); + return TRUE; +} + + + void Yap_InitCdMgr(void) { @@ -6677,6 +6757,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$rm_spy", 2, p_rmspy, SafePredFlag|SyncPredFlag); /* gc() may happen during compilation, hence these predicates are now unsafe */ + Yap_InitCPred("$predicate_flags", 4, predicate_flags, SyncPredFlag); Yap_InitCPred("$compile", 4, p_compile, SyncPredFlag); Yap_InitCPred("$compile_dynamic", 5, p_compile_dynamic, SyncPredFlag); Yap_InitCPred("$purge_clauses", 2, p_purge_clauses, SafePredFlag|SyncPredFlag); diff --git a/C/errors.c b/C/errors.c index 9e7b5ca6e..892b4e2af 100755 --- a/C/errors.c +++ b/C/errors.c @@ -38,12 +38,12 @@ Yap_PrintPredName( PredEntry *ap ) if (!tmod) tmod = TermProlog; #if THREADS Yap_DebugPlWrite(MkIntegerTerm(worker_id)); - Yap_DebugPutc(LOCAL_c_error_stream,' '); + Yap_DebugPutc(stderr,' '); #endif - Yap_DebugPutc(LOCAL_c_error_stream,'>'); - Yap_DebugPutc(LOCAL_c_error_stream,'\t'); + Yap_DebugPutc(stderr,'>'); + Yap_DebugPutc(stderr,'\t'); Yap_DebugPlWrite(tmod); - Yap_DebugPutc(LOCAL_c_error_stream,':'); + Yap_DebugPutc(stderr,':'); if (ap->ModuleOfPred == IDB_MODULE) { Term t = Deref(ARG1); if (IsAtomTerm(t)) { @@ -54,7 +54,7 @@ Yap_PrintPredName( PredEntry *ap ) Functor f = FunctorOfTerm(t); Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); - Yap_DebugPutc(LOCAL_c_error_stream,'/'); + Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f))); } } else { @@ -65,14 +65,40 @@ Yap_PrintPredName( PredEntry *ap ) Functor f = ap->FunctorOfPred; Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); - Yap_DebugPutc(LOCAL_c_error_stream,'/'); + Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f))); } } - Yap_DebugPutc(LOCAL_c_error_stream,'\n'); + char s[1024]; + if (ap->PredFlags & StandardPredFlag) + fprintf(stderr,"S"); + if (ap->PredFlags & CPredFlag) + fprintf(stderr,"C"); + if (ap->PredFlags & UserCPredFlag) + fprintf(stderr,"U"); + if (ap->PredFlags & SyncPredFlag) + fprintf(stderr,"Y"); + if (ap->PredFlags & LogUpdatePredFlag) + fprintf(stderr,"Y"); + if (ap->PredFlags & HiddenPredFlag) + fprintf(stderr,"H"); + sprintf(s," %llx\n",ap->PredFlags); + Yap_DebugPuts(stderr,s); } #endif +bool +Yap_Warning( const char *s, ... ) +{ + va_list args; + + va_start(args, s); + fprintf(stderr,"warning: %s\n", s); + va_end(args); + + return true; +} + int Yap_HandleError( const char *s, ... ) { CACHE_REGS yap_error_number err = LOCAL_Error_TYPE; @@ -208,18 +234,11 @@ legal_env (CELL *ep USES_REGS) } static int -YapPutc(int sno, wchar_t ch) +YapPutc(FILE *f, wchar_t ch) { - return (putc(ch, stderr)); + return (putc(ch, f)); } -static void -YapPlWrite(Term t) -{ - Yap_plwrite(t, NULL, 15, 0, 1200); -} - - void DumpActiveGoals ( USES_REGS1 ) { @@ -261,16 +280,16 @@ DumpActiveGoals ( USES_REGS1 ) if (first++ == 1) fprintf(stderr,"Active ancestors:\n"); if (pe->ModuleOfPred) mod = pe->ModuleOfPred; - YapPlWrite (mod); - YapPutc (LOCAL_c_error_stream,':'); + Yap_DebugPlWrite (mod); + YapPutc (stderr,':'); if (pe->ArityOfPE == 0) { - YapPlWrite (MkAtomTerm ((Atom)f)); + Yap_DebugPlWrite (MkAtomTerm ((Atom)f)); } else { - YapPlWrite (MkAtomTerm (NameOfFunctor (f))); - YapPutc (LOCAL_c_error_stream,'/'); - YapPlWrite (MkIntTerm (ArityOfFunctor (f))); + Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); + YapPutc (stderr,'/'); + Yap_DebugPlWrite (MkIntTerm (ArityOfFunctor (f))); } - YapPutc (LOCAL_c_error_stream,'\n'); + YapPutc (stderr,'\n'); } else { UNLOCK(pe->PELock); } @@ -282,13 +301,14 @@ DumpActiveGoals ( USES_REGS1 ) while (TRUE) { PredEntry *pe; - + op_numbers opnum; if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL) break; - pe = Yap_PredForChoicePt(b_ptr); - if (!pe) - break; - { + fprintf(stderr,"%p ", b_ptr); + pe = Yap_PredForChoicePt(b_ptr, &opnum); + if (opnum == _Nstop) { + fprintf(stderr, " ********** C-Code Interface Boundary ***********\n"); + } else { Functor f; Term mod = PROLOG_MODULE; @@ -298,23 +318,58 @@ DumpActiveGoals ( USES_REGS1 ) else mod = TermProlog; if (mod != TermProlog && mod != MkAtomTerm(AtomUser) ) { - YapPlWrite (mod); - YapPutc (LOCAL_c_error_stream,':'); + Yap_DebugPlWrite (mod); + YapPutc (stderr,':'); } - if (pe->ArityOfPE == 0) { - YapPlWrite (MkAtomTerm ((Atom)f)); + if (mod == IDB_MODULE) { + if (pe->PredFlags & NumberDBPredFlag) { + Int id = pe->src.IndxId; + Yap_DebugPlWrite(MkIntegerTerm(id)); + } else if (pe->PredFlags & AtomDBPredFlag) { + Atom At = (Atom)pe->FunctorOfPred; + Yap_DebugPlWrite(MkAtomTerm(At)); + } else { + Functor f = pe->FunctorOfPred; + Atom At = NameOfFunctor(f); + arity_t arity = ArityOfFunctor(f); + int i; + + Yap_DebugPlWrite(MkAtomTerm(At)); + YapPutc (stderr,'('); + for (i= 0; i < arity; i++) { + if (i > 0) YapPutc (stderr,','); + YapPutc (stderr,'_'); + } + YapPutc (stderr,')'); + } + YapPutc (stderr,'('); + Yap_DebugPlWrite(b_ptr->cp_a2); + YapPutc (stderr,')'); + } else if (pe->ArityOfPE == 0) { + Yap_DebugPlWrite (MkAtomTerm ((Atom)f)); } else { Int i = 0, arity = pe->ArityOfPE; - Term *args = &(b_ptr->cp_a1); - YapPlWrite (MkAtomTerm (NameOfFunctor (f))); - YapPutc (LOCAL_c_error_stream,'('); - for (i= 0; i < arity; i++) { - if (i > 0) YapPutc (LOCAL_c_error_stream,','); - YapPlWrite(args[i]); + if (opnum == _or_last|| + opnum == _or_else) { + Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); + YapPutc (stderr,'('); + for (i= 0; i < arity; i++) { + if (i > 0) YapPutc (stderr,','); + YapPutc(stderr, '_'); + } + Yap_DebugErrorPuts (") :- ... ( _ ; _ "); + } else { + Term *args = &(b_ptr->cp_a1); + Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); + YapPutc (stderr,'('); + for (i= 0; i < arity; i++) { + if (i > 0) YapPutc (stderr,','); + Yap_DebugPlWrite(args[i]); + } } - YapPutc (LOCAL_c_error_stream,')'); + YapPutc (stderr,')'); } - YapPutc (LOCAL_c_error_stream,'\n'); + YapPutc (stderr,'\n'); } b_ptr = b_ptr->cp_b; } @@ -559,7 +614,7 @@ Yap_Error(yap_error_number type, Term where, const char *format,...) where = TermNil; #if DEBUG_STRICT if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode)) - fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_ActiveSignals,LOCAL_PrologMode,format); + fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_Signals,LOCAL_PrologMode,format); else fprintf(stderr,"***** Processing Error %d (%x) %s***\n", type,LOCAL_PrologMode,format); #endif @@ -620,7 +675,6 @@ Yap_Error(yap_error_number type, Term where, const char *format,...) fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR); detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256); fprintf (stderr,"%% Continuation: %s\n",(char *)HR); - DumpActiveGoals( PASS_REGS1 ); error_exit_yap (1); } if (P == (yamop *)(FAILCODE)) @@ -669,8 +723,8 @@ Yap_Error(yap_error_number type, Term where, const char *format,...) fprintf(stderr,"%% YAP Fatal Error: %s exiting....\n",tmpbuf); error_exit_yap (1); } -#ifdef DEBUGX - DumpActiveGoals( USES_REGS1 ); +#ifdef DEBUG + // DumpActiveGoals( USES_REGS1 ); #endif /* DEBUG */ switch (type) { case INTERNAL_ERROR: @@ -1883,6 +1937,20 @@ Yap_Error(yap_error_number type, Term where, const char *format,...) serious = TRUE; } break; + case TYPE_ERROR_PARAMETER: + { + int i; + Term ti[2]; + + i = strlen(tmpbuf); + ti[0] = MkAtomTerm(AtomParameter); + ti[1] = where; + nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti); + psize -= i; + fun = FunctorError; + serious = TRUE; + } + break; case TYPE_ERROR_PREDICATE_INDICATOR: { int i; diff --git a/C/exo.c b/C/exo.c index 2593c60c7..7a4531bf4 100755 --- a/C/exo.c +++ b/C/exo.c @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -39,7 +40,7 @@ #endif bool YAP_NewExo( PredEntry *ap, size_t data, struct udi_info *udi); -bool YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t m); +bool YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t offset, size_t m); //static int exo_write=FALSE; @@ -719,20 +720,22 @@ store_exo(yamop *pc, UInt arity, Term t0) for (i = 0; i< arity; i++) { DerefAndCheck(t, tp[0]); *cpc = t; + Yap_DebugPlWrite(t); fprintf(stderr,"\n"); tp++; cpc++; } + fprintf(stderr,"\n"); return TRUE; } bool -YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t m) +YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t offset, size_t m) { MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause); size_t i, n = pe->cs.p_code.NOfClauses; ADDR base = (ADDR)mcl->ClCode+2*sizeof(struct index_t *); - for (i=0; iClItemSize)); + for (i=0; iClItemSize)); store_exo( ptr, pe->ArityOfPE, ts[i]); } return true; diff --git a/C/init.c b/C/init.c index eed6dce9d..44e0f9863 100755 --- a/C/init.c +++ b/C/init.c @@ -69,7 +69,6 @@ static void InitOps(void); static void InitDebug(void); static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate); static void InitStdPreds(void); -static void InitFlags(void); static void InitCodes(void); static void InitVersion(void); void exit(int); @@ -86,7 +85,7 @@ static char *optypes[] = {"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"}; /* OS page size for memory allocation */ -int Yap_page_size; +size_t Yap_page_size; #if DEBUG #if COROUTINING @@ -439,7 +438,7 @@ InitDebug(void) fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n"); fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n"); fprintf(stderr,"m Machine\t p parser\n"); - while ((ch = YP_putchar(YP_getchar())) != '\n') + while ((ch = putchar(getchar())) != '\n') if (ch >= 'a' && ch <= 'z') GLOBAL_Option[ch - 'a' + 1] = 1; if (GLOBAL_Option['l' - 96]) { @@ -977,17 +976,15 @@ Yap_InitCPredBack_(const char *Name, UInt Arity, static void InitStdPreds(void) { - void initIO(void); - Yap_InitCPreds(); Yap_InitBackCPreds(); BACKUP_MACHINE_REGS(); Yap_InitYaamRegs( 0 ); - + Yap_InitPlIO(); + Yap_InitFlags(false); #if HAVE_MPE Yap_InitMPE (); #endif - initIO(); } @@ -1084,6 +1081,7 @@ InitSWIAtoms(void) #include "iswiatoms.h" Yap_InitSWIHash(); ATOM_ = PL_new_atom(""); + */ } static void @@ -1326,6 +1324,9 @@ InitCodes(void) /* make sure no one else can use these two atoms */ LOCAL_SourceModule = CurrentModule = 0; Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar)); + /* flags require atom table done, but must be done as soon as possible, + definitely before any predicate initialization */ + // Yap_InitFlags(); moved to HEAPFIELDS /* make sure we have undefp defined */ /* predicates can only be defined after this point */ { @@ -1353,7 +1354,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s int n_workers, int sch_loop, int delay_load) { CACHE_REGS - int i; /* initialise system stuff */ #if PUSH_REGS @@ -1425,9 +1425,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s Yap_InitTime( 0 ); /* InitAbsmi must be done before InitCodes */ /* This must be done before initialising predicates */ - for (i = 0; i < NUMBER_OF_YAP_FLAGS; i++) { - yap_flags[i] = 0; - } #ifdef MPW Yap_InitAbsmi(REGS, FunctorList); #else @@ -1440,7 +1437,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s #if THREADS /* make sure we use the correct value of regcache */ regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key)); - LOCAL_PL_local_data_p->reg_cache = regcache; #endif #if USE_SYSTEM_MALLOC if (Trail < MinTrailSpace) @@ -1513,6 +1509,6 @@ Yap_exit (int value) run_halt_hooks(value); Yap_ShutdownLoadForeign(); } - closeFiles(TRUE); + Yap_CloseStreams (false); exit(value); } diff --git a/C/iopreds.c b/C/iopreds.c deleted file mode 100644 index e75eca86f..000000000 --- a/C/iopreds.c +++ /dev/null @@ -1,1052 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: iopreds.c * -* Last rev: 5/2/88 * -* mods: * -* comments: Input/Output C implemented predicates * -* * -*************************************************************************/ -#ifdef SCCS -static char SccsId[] = "%W% %G%"; -#endif - -/* - * This file includes the definition of a miscellania of standard predicates - * for yap refering to: Files and Streams, Simple Input/Output, - * - */ - -#include "Yap.h" -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#include "eval.h" -/* stuff we want to use in standard YAP code */ -#include "pl-shared.h" -#include "YapText.h" -#include -#if HAVE_STDARG_H -#include -#endif -#if HAVE_CTYPE_H -#include -#endif -#if HAVE_WCTYPE_H -#include -#endif -#if HAVE_SYS_TIME_H -#include -#endif -#if HAVE_SYS_TYPES_H -#include -#endif -#ifdef HAVE_SYS_STAT_H -#include -#endif -#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) -#include -#endif -#ifdef HAVE_UNISTD_H -#include -#endif -#if HAVE_STRING_H -#include -#endif -#if HAVE_SIGNAL_H -#include -#endif -#if HAVE_FCNTL_H -/* for O_BINARY and O_TEXT in WIN32 */ -#include -#endif -#ifdef _WIN32 -#if HAVE_IO_H -/* Windows */ -#include -#endif -#endif -#if !HAVE_STRNCAT -#define strncat(X,Y,Z) strcat(X,Y) -#endif -#if !HAVE_STRNCPY -#define strncpy(X,Y,Z) strcpy(X,Y) -#endif -#if _MSC_VER || defined(__MINGW32__) -#include -#ifndef S_ISDIR -#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) -#endif -#endif -#include "iopreds.h" -#include "pl-read.h" - -static Int p_set_read_error_handler( USES_REGS1 ); -static Int p_get_read_error_handler( USES_REGS1 ); -static Int p_startline( USES_REGS1 ); -static Int p_change_type_of_char( USES_REGS1 ); -static Int p_type_of_char( USES_REGS1 ); - -extern Atom Yap_FileName(IOSTREAM *s); - -static Term -StreamName(IOSTREAM *s) -{ - return MkAtomTerm(Yap_FileName(s)); -} - - -void -Yap_InitStdStreams (void) -{ -} - -void -Yap_InitPlIO (void) -{ -} - -/* - * Used by the prompts to check if they are after a newline, and then a - * prompt should be output, or if we are in the middle of a line. - */ -static int newline = TRUE; - -#ifdef DEBUG - -static int eolflg = 1; - - - -static char my_line[200] = {0}; -static char *lp = my_line; - -static YP_File curfile; - -#ifdef MACC - -static void -InTTYLine(char *line) -{ - char *p = line; - char ch; - while ((ch = InKey()) != '\n' && ch != '\r') - if (ch == 8) { - if (line < p) - BackupTTY(*--p); - } else - TTYChar(*p++ = ch); - TTYChar('\n'); - *p = 0; -} - -#endif - -void -Yap_DebugSetIFile(char *fname) -{ - if (curfile) - YP_fclose(curfile); - curfile = YP_fopen(fname, "r"); - if (curfile == NULL) { - curfile = stdin; - fprintf(stderr,"%% YAP Warning: can not open %s for input\n", fname); - } -} - -void -Yap_DebugEndline() -{ - *lp = 0; - -} - -int -Yap_DebugGetc() -{ - int ch; - if (eolflg) { - if (curfile != NULL) { - if (YP_fgets(my_line, 200, curfile) == 0) - curfile = NULL; - } - if (curfile == NULL) - if (YP_fgets(my_line, 200, stdin) == NULL) { - return EOF; - } - eolflg = 0; - lp = my_line; - } - if ((ch = *lp++) == 0) - ch = '\n', eolflg = 1; - if (GLOBAL_Option['l' - 96]) - putc(ch, GLOBAL_logfile); - return (ch); -} - -int -Yap_DebugPutc(int sno, wchar_t ch) -{ - if (GLOBAL_Option['l' - 96]) - (void) putc(ch, GLOBAL_logfile); - return (Sputc(ch, GLOBAL_stderr)); -} - -static int -Yap_DebugPuts(int sno, const char * s) -{ - if (GLOBAL_Option['l' - 96]) - (void) fputs(s, GLOBAL_logfile); - return (Sfputs(s, GLOBAL_stderr)); -} - -void -Yap_DebugPlWrite(Term t) -{ - Yap_plwrite(t, NULL, 15, 0, 1200); -} - -void -Yap_DebugErrorPutc(int c) -{ - CACHE_REGS - Yap_DebugPutc (LOCAL_c_error_stream, c); -} - -void -Yap_DebugErrorPuts(const char *s) -{ - CACHE_REGS - Yap_DebugPuts (LOCAL_c_error_stream, s); -} - -#endif - - - - -int -Yap_GetCharForSIGINT(void) -{ - int ch; - /* ask for a new line */ - Sfprintf(Serror, "\nAction (h for help): "); - ch = Sgetchar(); - /* first process up to end of line */ - while ((Sfgetc(Sinput)) != '\n'); - newline = TRUE; - return ch; -} - - - -typedef struct stream_ref -{ struct io_stream *read; - struct io_stream *write; -} stream_ref; - -#ifdef BEAM -int beam_write (void) -{ - Yap_StartSlots(); - Yap_plwrite (ARG1, NULL, 0, 0, 1200); - LOCAL_CurSlot = CurSlot; - if (EX != 0L) { - Term ball = Yap_PopTermFromDB(EX); - EX = 0L; - Yap_JumpToEnv(ball); - return(FALSE); - } - return (TRUE); -} -#endif - -static void -clean_vars(VarEntry *p) -{ - if (p == NULL) return; - p->VarAdr = TermNil; - clean_vars(p->VarLeft); - clean_vars(p->VarRight); -} - -static Term -syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) -{ - CACHE_REGS - Term info; - int count = 0, out = 0; - Int start, err = 0, end; - Term tf[7]; - Term *error = tf+3; - CELL *Hi = HR; - int has_qq = FALSE; - - /* make sure to globalise variable */ - start = tokptr->TokPos; - clean_vars(LOCAL_VarTable); - clean_vars(LOCAL_AnonVarTable); - while (1) { - Term ts[2]; - if (HR > ASP-1024) { - tf[3] = TermNil; - err = 0; - end = 0; - /* for some reason moving this earlier confuses gcc on solaris */ - HR = Hi; - break; - } - if (tokptr == LOCAL_toktide) { - err = tokptr->TokPos; - out = count; - } - info = tokptr->TokInfo; - switch (tokptr->Tok) { - case Name_tok: - { - Term t0[1]; - t0[0] = MkAtomTerm((Atom)info); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0); - } - break; - case QuasiQuotes_tok: - case WQuasiQuotes_tok: - { - if (has_qq) { - Term t0[1]; - t0[0] = MkAtomTerm(Yap_LookupAtom("{|")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0); - has_qq = FALSE; - } else { - Term t0[1]; - t0[0] = MkAtomTerm(Yap_LookupAtom("|| ... |}")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0); - has_qq = TRUE; - } - } - break; - case Number_tok: - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo)); - break; - case Var_tok: - { - Term t[3]; - VarEntry *varinfo = (VarEntry *)info; - - t[0] = MkIntTerm(0); - t[1] = Yap_CharsToListOfCodes((const char *)varinfo->VarRep PASS_REGS); - if (varinfo->VarAdr == TermNil) { - t[2] = varinfo->VarAdr = MkVarTerm(); - } else { - t[2] = varinfo->VarAdr; - } - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar,3),3,t); - } - break; - case String_tok: - { - Term t0 = Yap_CharsToListOfCodes((const char *)info PASS_REGS); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); - } - break; - case StringTerm_tok: - { - Term t0 = MkStringTerm((const char *)info); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); - } - break; - case WString_tok: - { - Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); - } - break; - case Error_tok: - case eot_tok: - break; - case Ponctuation_tok: - { - char s[2]; - s[1] = '\0'; - s[0] = (char)info; - if (s[0] == 'l') - s[0] = '('; - ts[0] = MkAtomTerm(Yap_LookupAtom(s)); - } - } - if (tokptr->Tok == Ord (eot_tok)) { - *error = TermNil; - end = tokptr->TokPos; - break; - } else if (tokptr->Tok != Ord (Error_tok)) { - ts[1] = MkIntegerTerm(tokptr->TokPos); - *error = - MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil); - error = RepPair(*error)+1; - count++; - } - tokptr = tokptr->TokNext; - } - /* now we can throw away tokens, so we can unify and possibly overwrite TR */ - Yap_unify(*outp, MkVarTerm()); - if (IsVarTerm(*outp) && (VarOfTerm(*outp) > HR || VarOfTerm(*outp) < H0)) { - tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1); - } else { - tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp); - } - { - Term t[3]; - - t[0] = MkIntegerTerm(start); - t[1] = MkIntegerTerm(err); - t[2] = MkIntegerTerm(end); - tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t); - } - tf[2] = MkAtomTerm(AtomHERE); - tf[4] = MkIntegerTerm(out); - tf[5] = MkIntegerTerm(err); - tf[6] = StreamName(st); - return(Yap_MkApplTerm(FunctorSyntaxError,7,tf)); -} - -static void -GenerateSyntaxError(Term *tp, TokEntry *tokstart, IOSTREAM *sno, Term msg USES_REGS) -{ - if (tp) { - Term et[2]; - Term t = MkVarTerm(); - et[1] = MkPairTerm(syntax_error(tokstart, sno, &t), msg); - t = MkAtomTerm(AtomSyntaxError); - et[0] = Yap_MkApplTerm(FunctorShortSyntaxError,1,&t); - *tp = Yap_MkApplTerm(FunctorError, 2, et); - } -} - -Int -Yap_FirstLineInParse (void) -{ - CACHE_REGS - return LOCAL_StartLine; -} - -static Int -p_startline ( USES_REGS1 ) -{ - return (Yap_unify_constant (ARG1, MkIntegerTerm (LOCAL_StartLine))); -} - -/* control the parser error handler */ -static Int -p_set_read_error_handler( USES_REGS1 ) -{ - Term t = Deref(ARG1); - char *s; - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,t,"set_read_error_handler"); - return(FALSE); - } - if (!IsAtomTerm(t)) { - Yap_Error(TYPE_ERROR_ATOM,t,"bad syntax_error handler"); - return(FALSE); - } - s = RepAtom(AtomOfTerm(t))->StrOfAE; - if (!strcmp(s, "fail")) { - ParserErrorStyle = FAIL_ON_PARSER_ERROR; - } else if (!strcmp(s, "error")) { - ParserErrorStyle = EXCEPTION_ON_PARSER_ERROR; - } else if (!strcmp(s, "quiet")) { - ParserErrorStyle = QUIET_ON_PARSER_ERROR; - } else if (!strcmp(s, "dec10")) { - ParserErrorStyle = CONTINUE_ON_PARSER_ERROR; - } else { - Yap_Error(DOMAIN_ERROR_SYNTAX_ERROR_HANDLER,t,"bad syntax_error handler"); - return(FALSE); - } - return(TRUE); -} - -/* return the status for the parser error handler */ -static Int -p_get_read_error_handler( USES_REGS1 ) -{ - Term t; - - switch (ParserErrorStyle) { - case FAIL_ON_PARSER_ERROR: - t = MkAtomTerm(AtomFail); - break; - case EXCEPTION_ON_PARSER_ERROR: - t = MkAtomTerm(AtomError); - break; - case QUIET_ON_PARSER_ERROR: - t = MkAtomTerm(AtomQuiet); - break; - case CONTINUE_ON_PARSER_ERROR: - t = MkAtomTerm(AtomDec10); - break; - default: - Yap_Error(SYSTEM_ERROR,TermNil,"corrupted syntax_error handler"); - return(FALSE); - } - return (Yap_unify_constant (ARG1, t)); -} - - - -int -Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) -{ - CACHE_REGS - TokEntry *tokstart; - Term t; - Term OCurrentModule = CurrentModule, tmod, tpos; - int store_comments = rd->comments; - - if (inp_stream == NULL) { - return FALSE; - } - LOCAL_Error_TYPE = YAP_NO_ERROR; - while (TRUE) { - CELL *old_H; - int64_t cpos = 0; - int seekable = inp_stream->functions->seek != NULL; - - /* two cases where we can seek: memory and console */ - if (seekable) { - cpos = inp_stream->posbuf.byteno; - } - /* Scans the term using stack space */ - while (TRUE) { - old_H = HR; - LOCAL_Comments = TermNil; - LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL; - tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos, rd); - if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) { - HR = old_H; - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); - if (seekable) { - Sseek64(inp_stream, cpos, SIO_SEEK_SET); - } - if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growtrail (sizeof(CELL) * K16, FALSE)) { - return FALSE; - } - } else if (LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - return FALSE; - } - } else if (LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growheap(FALSE, 0, NULL)) { - return FALSE; - } - } else if (LOCAL_Error_TYPE == OUT_OF_STACK_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_dogc( 0, NULL PASS_REGS )) { - return FALSE; - } - } - } else { - /* done with this */ - break; - } - } - LOCAL_Error_TYPE = YAP_NO_ERROR; - /* preserve value of H after scanning: otherwise we may lose strings - and floats */ - old_H = HR; - if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) { - /* did we get the end of file from an abort? */ - if (LOCAL_ErrorMessage && - !strcmp(LOCAL_ErrorMessage,"Abort")) { - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); - return FALSE; - } else { - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); - rd->varnames = 0; - rd->singles = 0; - return Yap_unify_constant( Yap_GetFromSlot( t0), MkAtomTerm (AtomEof)); - } - } - repeat_cycle: - CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME); - if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) { - CurrentModule = OCurrentModule; - if (LOCAL_ErrorMessage) { - int res; - - if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow") || - !strcmp(LOCAL_ErrorMessage,"Trail Overflow") || - !strcmp(LOCAL_ErrorMessage,"Heap Overflow")) { - /* ignore term we just built */ - tr_fr_ptr old_TR = TR; - - - HR = old_H; - TR = (tr_fr_ptr)LOCAL_ScannerStack; - - if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) - res = Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - else if (!strcmp(LOCAL_ErrorMessage,"Heap Overflow")) - res = Yap_growheap_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - else - res = Yap_growtrail_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - if (res) { - LOCAL_ScannerStack = (char *)TR; - TR = old_TR; - old_H = HR; - LOCAL_tokptr = LOCAL_toktide = tokstart; - LOCAL_ErrorMessage = NULL; - goto repeat_cycle; - } - LOCAL_ScannerStack = (char *)TR; - TR = old_TR; - } - } - { - Term terror; - if (LOCAL_ErrorMessage == NULL) - LOCAL_ErrorMessage = "SYNTAX ERROR"; - GenerateSyntaxError(&terror, tokstart, inp_stream, MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)) PASS_REGS); - - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); - rd->has_exception = TRUE; - rd->exception = Yap_InitSlot(terror); - CurrentModule = OCurrentModule; - return FALSE; - } - } else { - CurrentModule = OCurrentModule; - /* parsing succeeded */ - break; - } - } - if (!Yap_unify(t, Yap_GetFromSlot( t0))) - return FALSE; - if (store_comments && !Yap_unify(LOCAL_Comments, Yap_GetFromSlot( rd->comments ))) - return FALSE; - if (rd->varnames) { - Term v; - while (TRUE) { - CELL *old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - v = Yap_VarNames(LOCAL_VarTable, TermNil); - break; - } else { - tr_fr_ptr old_TR; - restore_machine_regs(); - - old_TR = TR; - /* restart global */ - HR = old_H; - TR = (tr_fr_ptr)LOCAL_ScannerStack; - Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - LOCAL_ScannerStack = (char *)TR; - TR = old_TR; - } - } - LOCAL_VarNames = v; - if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames ))) { - CurrentModule = OCurrentModule; - return FALSE; - } - } - - if (rd->variables) { - Term v; - while (TRUE) { - CELL *old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - v = Yap_Variables(LOCAL_VarTable, TermNil); - break; - } else { - tr_fr_ptr old_TR; - restore_machine_regs(); - - old_TR = TR; - /* restart global */ - HR = old_H; - TR = (tr_fr_ptr)LOCAL_ScannerStack; - Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - LOCAL_ScannerStack = (char *)TR; - TR = old_TR; - } - } - if (!Yap_unify(v, Yap_GetFromSlot( rd->variables ) )) { - CurrentModule = OCurrentModule; - return FALSE; - } - } - if (rd->singles) { - Term v; - while (TRUE) { - CELL *old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - v = Yap_Singletons(LOCAL_VarTable, TermNil); - break; - } else { - tr_fr_ptr old_TR; - restore_machine_regs(); - - old_TR = TR; - /* restart global */ - HR = old_H; - TR = (tr_fr_ptr)LOCAL_ScannerStack; - Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); - LOCAL_ScannerStack = (char *)TR; - TR = old_TR; - } - } - if (rd->singles == 1) { - if (IsPairTerm(v)) - rd->singles = Yap_InitSlot( v ); - else - rd->singles = FALSE; - } else if (rd->singles) { - if (!Yap_unify( v, Yap_GetFromSlot( rd->singles ))) { - CurrentModule = OCurrentModule; - return FALSE; - } - } - } - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); - CurrentModule = OCurrentModule; - return TRUE; -} - -static Int -p_change_type_of_char ( USES_REGS1 ) -{ /* change_type_of_char(+char,+type) */ - Term t1 = Deref (ARG1); - Term t2 = Deref (ARG2); - if (!IsVarTerm (t1) && !IsIntegerTerm (t1)) - return FALSE; - if (!IsVarTerm(t2) && !IsIntegerTerm(t2)) - return FALSE; - Yap_chtype[IntegerOfTerm(t1)] = IntegerOfTerm(t2); - return TRUE; -} - -static Int -p_type_of_char ( USES_REGS1 ) -{ /* type_of_char(+char,-type) */ - Term t; - - Term t1 = Deref (ARG1); - if (!IsVarTerm (t1) && !IsIntegerTerm (t1)) - return FALSE; - t = MkIntTerm(Yap_chtype[IntegerOfTerm (t1)]); - return Yap_unify(t,ARG2); -} - - -static Int -p_force_char_conversion( USES_REGS1 ) -{ - /* don't actually enable it until someone tries to add a conversion */ - if (CharConversionTable2 == NULL) - return(TRUE); - CharConversionTable = CharConversionTable2; - return(TRUE); -} - -static Int -p_disable_char_conversion( USES_REGS1 ) -{ - CharConversionTable = NULL; - return(TRUE); -} - -static Int -p_char_conversion( USES_REGS1 ) -{ - Term t0 = Deref(ARG1), t1 = Deref(ARG2); - char *s0, *s1; - - if (IsVarTerm(t0)) { - Yap_Error(INSTANTIATION_ERROR, t0, "char_conversion/2"); - return (FALSE); - } - if (!IsAtomTerm(t0)) { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "char_conversion/2"); - return (FALSE); - } - s0 = RepAtom(AtomOfTerm(t0))->StrOfAE; - if (s0[1] != '\0') { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "char_conversion/2"); - return (FALSE); - } - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "char_conversion/2"); - return (FALSE); - } - if (!IsAtomTerm(t1)) { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "char_conversion/2"); - return (FALSE); - } - s1 = RepAtom(AtomOfTerm(t1))->StrOfAE; - if (s1[1] != '\0') { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "char_conversion/2"); - return (FALSE); - } - /* check if we do have a table for converting characters */ - if (CharConversionTable2 == NULL) { - GET_LD - int i; - - /* don't create a table if we don't need to */ - if (s0[0] == s1[0]) - return(TRUE); - CharConversionTable2 = Yap_AllocCodeSpace(NUMBER_OF_CHARS*sizeof(char)); - while (CharConversionTable2 == NULL) { - if (!Yap_growheap(FALSE, NUMBER_OF_CHARS*sizeof(char), NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); - return(FALSE); - } - } - if (truePrologFlag(PLFLAG_CHARCONVERSION)) { - if (p_force_char_conversion( PASS_REGS1 ) == FALSE) - return(FALSE); - } - for (i = 0; i < NUMBER_OF_CHARS; i++) - CharConversionTable2[i] = i; - } - /* just add the new entry */ - CharConversionTable2[(int)s0[0]] = s1[0]; - /* done */ - return(TRUE); -} - -static Int -p_current_char_conversion( USES_REGS1 ) -{ - Term t0, t1; - char *s0, *s1; - - if (CharConversionTable == NULL) { - return(FALSE); - } - t0 = Deref(ARG1); - if (IsVarTerm(t0)) { - Yap_Error(INSTANTIATION_ERROR, t0, "current_char_conversion/2"); - return (FALSE); - } - if (!IsAtomTerm(t0)) { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "current_char_conversion/2"); - return (FALSE); - } - s0 = RepAtom(AtomOfTerm(t0))->StrOfAE; - if (s0[1] != '\0') { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "current_char_conversion/2"); - return (FALSE); - } - t1 = Deref(ARG2); - if (IsVarTerm(t1)) { - char out[2]; - if (CharConversionTable[(int)s0[0]] == '\0') return(FALSE); - out[0] = CharConversionTable[(int)s0[0]]; - out[1] = '\0'; - return(Yap_unify(ARG2,MkAtomTerm(Yap_LookupAtom(out)))); - } - if (!IsAtomTerm(t1)) { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "current_char_conversion/2"); - return (FALSE); - } - s1 = RepAtom(AtomOfTerm(t1))->StrOfAE; - if (s1[1] != '\0') { - Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "current_char_conversion/2"); - return (FALSE); - } else { - return (CharConversionTable[(int)s0[0]] == '\0' && - CharConversionTable[(int)s0[0]] == s1[0] ); - } -} - -static Int -p_all_char_conversions( USES_REGS1 ) -{ - Term out = TermNil; - int i; - - if (CharConversionTable == NULL) { - return(FALSE); - } - for (i = NUMBER_OF_CHARS; i > 0; ) { - i--; - if (CharConversionTable[i] != '\0') { - Term t1, t2; - char s[2]; - s[1] = '\0'; - s[0] = CharConversionTable[i]; - t1 = MkAtomTerm(Yap_LookupAtom(s)); - out = MkPairTerm(t1,out); - s[0] = i; - t2 = MkAtomTerm(Yap_LookupAtom(s)); - out = MkPairTerm(t2,out); - } - } - return(Yap_unify(ARG1,out)); -} - -static Int -p_float_format( USES_REGS1 ) -{ - Term in = Deref(ARG1); - if (IsVarTerm(in)) - return Yap_unify(ARG1, MkAtomTerm(AtomFloatFormat)); - AtomFloatFormat = AtomOfTerm(in); - return TRUE; -} - - -static Int -p_style_checker( USES_REGS1 ) -{ - Term t = Deref( ARG1 ); - LD_FROM_REGS - - if (IsVarTerm(t)) { - Term t = TermNil; - if ( debugstatus.styleCheck & LONGATOM_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomAtom), t ); - } - if ( debugstatus.styleCheck & SINGLETON_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomSingleton), t ); - } - if ( debugstatus.styleCheck & MULTITON_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomVarBranches), t ); - } - if ( debugstatus.styleCheck & DISCONTIGUOUS_STYLE) { - t = MkPairTerm( MkAtomTerm(AtomDiscontiguous), t ); - } - if ( debugstatus.styleCheck & NOEFFECT_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomNoEffect), t ); - } - if ( debugstatus.styleCheck & CHARSET_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomCharset), t ); - } - if ( debugstatus.styleCheck & MULTIPLE_CHECK) { - t = MkPairTerm( MkAtomTerm(AtomMultiple), t ); - } - } else { - while (IsPairTerm(t)) { - Term h = HeadOfTerm( t ); - t = TailOfTerm( t ); - - if (IsVarTerm(h)) { - Yap_Error(INSTANTIATION_ERROR, t, "style_check/1"); - return (FALSE); - } if (IsAtomTerm(h)) { - Atom at = AtomOfTerm( h ); - if (at == AtomAtom) debugstatus.styleCheck |= LONGATOM_CHECK; - else if (at == AtomSingleton) debugstatus.styleCheck |= SINGLETON_CHECK; - else if (at == AtomVarBranches) debugstatus.styleCheck |= MULTITON_CHECK; - else if (at == AtomDiscontiguous) debugstatus.styleCheck |= DISCONTIGUOUS_STYLE; - else if (at == AtomNoEffect) debugstatus.styleCheck |= NOEFFECT_CHECK; - else if (at == AtomCharset) debugstatus.styleCheck |= CHARSET_CHECK; - else if (at == AtomMultiple) debugstatus.styleCheck |= MULTIPLE_CHECK; - } else { - Atom at = AtomOfTerm( ArgOfTerm( 1, h ) ); - if (at == AtomAtom) debugstatus.styleCheck |= LONGATOM_CHECK; - else if (at == AtomSingleton) debugstatus.styleCheck &= ~SINGLETON_CHECK; - else if (at == AtomVarBranches) debugstatus.styleCheck &= ~MULTITON_CHECK; - else if (at == AtomDiscontiguous) debugstatus.styleCheck &= ~DISCONTIGUOUS_STYLE; - else if (at == AtomNoEffect) debugstatus.styleCheck &= ~NOEFFECT_CHECK; - else if (at == AtomMultiple) debugstatus.styleCheck &= ~MULTIPLE_CHECK; - } - } - } - return TRUE; -} - - -void -Yap_InitBackIO (void) -{ -} - -#ifdef DEBUG -static Int -p_write_string( USES_REGS1 ) -{ - Term in = Deref(ARG1); - char *s; - size_t length; - int encoding; - char buf[256]; - - if ((s = Yap_TermToString( in, buf, 256, &length, &encoding, 0))) - fprintf(stderr,"%s\n", s); - return TRUE; -} -#endif - -void -Yap_InitIOPreds(void) -{ - /* here the Input/Output predicates */ - Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag); -#ifdef DEBUG - Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag); -#endif - Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("char_conversion", 2, p_char_conversion, SyncPredFlag); -/** @pred char_conversion(+ _IN_,+ _OUT_) is iso - - -While reading terms convert unquoted occurrences of the character - _IN_ to the character _OUT_. Both _IN_ and _OUT_ must be -bound to single characters atoms. - -Character conversion only works if the flag `char_conversion` is -on. This is default in the `iso` and `sicstus` language -modes. As an example, character conversion can be used for instance to -convert characters from the ISO-LATIN-1 character set to ASCII. - -If _IN_ is the same character as _OUT_, char_conversion/2 -will remove this conversion from the table. - - -*/ - Yap_InitCPred ("$current_char_conversion", 2, p_current_char_conversion, SyncPredFlag); - Yap_InitCPred ("$all_char_conversions", 1, p_all_char_conversions, SyncPredFlag); - Yap_InitCPred ("$force_char_conversion", 0, p_force_char_conversion, SyncPredFlag); - Yap_InitCPred ("$disable_char_conversion", 0, p_disable_char_conversion, SyncPredFlag); -#if HAVE_SELECT - // Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag); -/** @pred stream_select(+ _STREAMS_,+ _TIMEOUT_,- _READSTREAMS_) - - -Given a list of open _STREAMS_ opened in read mode and a _TIMEOUT_ -return a list of streams who are now available for reading. - -If the _TIMEOUT_ is instantiated to `off`, -stream_select/3 will wait indefinitely for a stream to become -open. Otherwise the timeout must be of the form `SECS:USECS` where -`SECS` is an integer gives the number of seconds to wait for a timeout -and `USECS` adds the number of micro-seconds. - -This built-in is only defined if the system call `select` is -available in the system. - - -*/ -#endif - Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$style_checker", 1, p_style_checker, SyncPredFlag); -} diff --git a/C/load_foreign.c b/C/load_foreign.c index 1115998a0..ac3b5b653 100644 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -21,7 +21,6 @@ static char SccsId[] = "%W% %G%.2"; #include "Yatom.h" #include "YapHeap.h" #include "yapio.h" -#include "pl-shared.h" #include "YapText.h" #include #if HAVE_STRING_H @@ -51,6 +50,9 @@ p_load_foreign( USES_REGS1 ) yhandle_t CurSlot = Yap_StartSlots(); strcpy(LOCAL_ErrorSay,"Invalid arguments"); + Yap_DebugPlWrite(ARG1); printf("%s\n", " \n"); + Yap_DebugPlWrite(ARG2); printf("%s\n", " \n"); + Yap_DebugPlWrite(ARG3); printf("%s\n", " \n"); /* collect the list of object files */ t = Deref(ARG1); diff --git a/C/modules.c b/C/modules.c index a3912ad4c..39af5002d 100644 --- a/C/modules.c +++ b/C/modules.c @@ -44,7 +44,9 @@ static ModEntry *LookupModule(Term a); } READ_UNLOCK(ae->ARWLock); return NULL; -}inline static ModEntry *GetModuleEntry(Atom at) +} + +inline static ModEntry *GetModuleEntry(Atom at) /* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; @@ -60,6 +62,7 @@ static ModEntry *LookupModule(Term a); } { CACHE_REGS + ModEntry *old; new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new)); INIT_RWLOCK(new->ModRWLock); new->KindOfPE = ModProperty; @@ -67,23 +70,33 @@ static ModEntry *LookupModule(Term a); new->NextME = CurrentModules; CurrentModules = new; new->AtomOfME = ae; - if (at == AtomProlog) - new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE; - else - new->flags = LookupModule(LOCAL_SourceModule)->flags; + if (CurrentModule == PROLOG_MODULE || AtomOfTerm(CurrentModule) == at) { + old = NULL; + } else + old = GetModuleEntry(AtomOfTerm(CurrentModule)); + Yap_setModuleFlags(new, old); AddPropToAtom(ae, (PropEntry *)new); } return new; } -unsigned int getUnknownModule(ModEntry *m) { - if (m && m->flags & UNKNOWN_MASK) - return m->flags & UNKNOWN_MASK; - else { - return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK; +Term Yap_getUnknownModule(ModEntry *m) { + if (m && m->flags & UNKNOWN_ERROR) { + return TermError; + } else if (m && m->flags & UNKNOWN_WARNING) { + return TermWarning; + } else { + return TermFail; } } + + bool Yap_CharacterEscapes(Term mt) { + if (mt == PROLOG_MODULE) mt = TermProlog; + return GetModuleEntry(AtomOfTerm(mt))->flags & M_CHARESCAPE; +} + + #define ByteAdr(X) ((char *)&(X)) Term Yap_Module_Name(PredEntry *ap) { CACHE_REGS @@ -395,8 +408,6 @@ void Yap_InitModulesC(void) { Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("context_module", 1, p_context_module, 0); - Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, - cont_current_module, SafePredFlag | SyncPredFlag); Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module, SafePredFlag | SyncPredFlag); Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module, diff --git a/C/pl-yap.c b/C/pl-yap.c index 91ce833f9..21ccd9068 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -31,8 +31,6 @@ //#define LOCK() PL_LOCK(L_PLFLAG) //#define UNLOCK() PL_UNLOCK(L_PLFLAG) -int fileerrors; - PL_local_data_t lds; gds_t gds; @@ -173,19 +171,6 @@ Yap_Eval(YAP_Term t USES_REGS) return Yap_InnerEval__(t PASS_REGS); } -IOENC -Yap_DefaultEncoding(void) -{ - GET_LD - return LD->encoding; -} - -void -Yap_SetDefaultEncoding(IOENC new_encoding) -{ - GET_LD - LD->encoding = new_encoding; -} int PL_qualify(term_t raw, term_t qualified) @@ -926,7 +911,7 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int } char * -Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags) +Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, int *encoding, int flags) { char *buf; @@ -1357,7 +1342,7 @@ setAccessLevel(access_level_t accept) } static bool -vsysError(const char *fm, va_list args) +sysError(const char *fm, va_list args) { static int active = 0; switch ( active++ ) @@ -1406,18 +1391,6 @@ sysError(const char *fm, ...) PL_fail; } -Int -Yap_source_line_no( void ) -{ GET_LD - return source_line_no; -} - -Atom -Yap_source_file_name( void ) -{ GET_LD - return YAP_AtomFromSWIAtom(source_file_name); -} - atom_t accessLevel(void) { GET_LD diff --git a/C/save.c b/C/save.c index 883c629e8..93a8b9a84 100755 --- a/C/save.c +++ b/C/save.c @@ -86,9 +86,9 @@ void initIO(void); #endif -static int myread(IOSTREAM *, char *, Int); -static Int mywrite(IOSTREAM *, char *, Int); -static IOSTREAM *open_file(char *, int); +static int myread(FILE *, char *, Int); +static Int mywrite(FILE *, char *, Int); +static FILE *open_file(char *, int); static int close_file(void); static Int putout(CELL); static Int putcellptr(CELL *); @@ -124,7 +124,7 @@ static void restore_heap(void); static void ShowAtoms(void); static void ShowEntries(PropEntry *); #endif -static int OpenRestore(char *, char *, CELL *, CELL *, CELL *, CELL *, IOSTREAM **); +static int OpenRestore(char *, char *, CELL *, CELL *, CELL *, CELL *, FILE **); static void CloseRestore(void); #ifndef _WIN32 static int check_opcodes(OPCODE []); @@ -184,11 +184,11 @@ do_system_error(yap_error_number etype, const char *msg) inline static -int myread(IOSTREAM *fd, char *buffer, Int len) { +int myread(FILE *fd, char *buffer, Int len) { ssize_t nread; while (len > 0) { - nread = Sfread(buffer, 1, (int)len, fd); + nread = fread(buffer, 1, (int)len, fd); if (nread < 1) { return do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"bad read on saved state"); } @@ -200,11 +200,11 @@ int myread(IOSTREAM *fd, char *buffer, Int len) { inline static Int -mywrite(IOSTREAM *fd, char *buff, Int len) { +mywrite(FILE *fd, char *buff, Int len) { ssize_t nwritten; - + while (len > 0) { - nwritten = Sfwrite(buff, 1, (size_t)len, fd); + nwritten = fwrite(buff, 1, (size_t)len, fd); if (nwritten < 0) { return do_system_error(SYSTEM_ERROR,"bad write on saved state"); } @@ -222,7 +222,7 @@ mywrite(IOSTREAM *fd, char *buff, Int len) { typedef CELL *CELLPOINTER; -static IOSTREAM *splfild = NULL; +static FILE *splfild = NULL; #ifdef DEBUG @@ -239,10 +239,10 @@ static Int OldHeapUsed; static CELL which_save; /* Open a file to read or to write */ -static IOSTREAM * +static FILE * open_file(char *my_file, int flag) { - IOSTREAM *splfild; + FILE *splfild; char flags[6]; int i=0; @@ -264,7 +264,7 @@ open_file(char *my_file, int flag) } #endif flags[i] = '\0'; - splfild = Sopen_file( my_file, flags); + splfild = fopen( my_file, flags); #ifdef undf0 fprintf(errout, "Opened file %s\n", my_file); #endif @@ -276,7 +276,7 @@ close_file(void) { if (splfild == 0) return 0; - if (Sclose(splfild) < 0) + if (fclose(splfild) < 0) return do_system_error(SYSTEM_ERROR,"bad close on saved state"); splfild = 0; return 1; @@ -313,7 +313,7 @@ get_header_cell(void) size_t count = 0; int n; while (count < sizeof(CELL)) { - if ((n = Sfread(&l, 1, sizeof(CELL)-count, splfild)) < 0) { + if ((n = fread(&l, 1, sizeof(CELL)-count, splfild)) < 0) { do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to read saved state header"); return 0L; } @@ -578,7 +578,6 @@ save_crc(void) static Int do_save(int mode USES_REGS) { - extern void Scleanup(void); Term t1 = Deref(ARG1); if (Yap_HoleSize) { @@ -590,7 +589,6 @@ do_save(int mode USES_REGS) { Yap_Error(TYPE_ERROR_LIST,t1,"save/1"); return FALSE; } - Scleanup(); Yap_CloseStreams(TRUE); if ((splfild = open_file(LOCAL_FileNameBuf, O_WRONLY | O_CREAT)) < 0) { Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), @@ -670,7 +668,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS) /* skip the first line */ pp[0] = '\0'; do { - if ((n = Sfread(pp, 1, 1, splfild)) <= 0) { + if ((n = fread(pp, 1, 1, splfild)) <= 0) { do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to scan first line from saved state"); return FAIL_RESTORE; } @@ -680,7 +678,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS) { int count = 0, n, to_read = Unsigned(strlen(msg) + 1); while (count < to_read) { - if ((n = Sfread(pp, 1, to_read-count, splfild)) <= 0) { + if ((n = fread(pp, 1, to_read-count, splfild)) <= 0) { do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to scan version info from saved state"); return FAIL_RESTORE; } @@ -1205,7 +1203,7 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS) static void RestoreSWIHash(void) { - Yap_InitSWIHash(); + // Yap_InitSWIHash(); } @@ -1394,12 +1392,10 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A return(FAIL_RESTORE); LOCAL_PrologMode = BootMode; if (Yap_HeapBase) { - extern void Scleanup(void); - if (!yap_flags[HALT_AFTER_CONSULT_FLAG] && !yap_flags[QUIET_MODE_FLAG]) { + if (falseGlobalPrologFlag( HALT_AFTER_CONSULT_FLAG ) && !silentMode( )) { Yap_TrueFileName(s,LOCAL_FileNameBuf2, YAP_FILENAME_MAX); fprintf(stderr, "%% Restoring file %s\n", LOCAL_FileNameBuf2); } - Scleanup(); Yap_CloseStreams(TRUE); } #ifdef DEBUG_RESTORE4 @@ -1411,11 +1407,11 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A return mode; } -static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, IOSTREAM **streamp) { +static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp) { int mode; if (streamp) { - if ((*streamp = Sopen_file(inpf, "rb"))) { + if ((*streamp = fopen(inpf, "rb"))) { return DO_ONLY_CODE; } return FAIL_RESTORE; @@ -1432,7 +1428,7 @@ static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL * } static int -OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, IOSTREAM **streamp) +OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp) { CACHE_REGS @@ -1441,7 +1437,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac if (!Yap_trueFileName( inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_SAVED_STATE, true, true)) return false; - if (fname != NULL && + if (fname[0] && (mode = try_open(fname,Astate,ATrail,AStack,AHeap,streamp)) != FAIL_RESTORE) { return mode; } @@ -1456,10 +1452,10 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac return FAIL_RESTORE; } -IOSTREAM * +FILE * Yap_OpenRestore(char *inpf, char *YapLibDir) { - IOSTREAM *stream = NULL; + FILE *stream = NULL; OpenRestore(inpf, YapLibDir, NULL, NULL, NULL, NULL, &stream); return stream; @@ -1677,7 +1673,7 @@ Restore(char *s, char *lib_dir USES_REGS) Yap_ReOpenLoadForeign(); FreeRecords(); /* restart IO */ - initIO(); + // initIO(); /* reset time */ Yap_ReInitWallTime(); #if USE_DL_MALLOC || USE_SYSTEM_MALLOC diff --git a/C/scanner.c b/C/scanner.c index ab98f588b..d17cfa455 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -410,8 +410,6 @@ writing, writing a BOM can be requested using the option #include "alloc.h" #include "eval.h" /* stuff we want to use in standard YAP code */ -#include "pl-shared.h" -#include "pl-read.h" #include "YapText.h" #if _MSC_VER || defined(__MINGW32__) #if HAVE_FINITE == 1 @@ -437,7 +435,25 @@ writing, writing a BOM can be requested using the option #define my_islower(C) (C >= 'a' && C <= 'z') static Term float_send(char *, int); -static Term get_num(int *, int *, IOSTREAM *, char *, UInt, int); +static Term get_num(int *, int *, struct stream_desc *, char *, UInt, int); + +static void +Yap_setCurrentSourceLocation( struct stream_desc *s ) +{ + CACHE_REGS + #if HAVE_SOCKET + if (s->status & Socket_Stream_f) + LOCAL_SourceFileName = AtomSocket; + else +#endif + if (s->status & Pipe_Stream_f) + LOCAL_SourceFileName =AtomPipe; + else if (s->status & InMemory_Stream_f) + LOCAL_SourceFileName = AtomCharsio; + else + LOCAL_SourceFileName = s->name; + LOCAL_SourceFileLineno = s->linecount; + } /* token table with some help from Richard O'Keefe's PD scanner */ static char chtype0[NUMBER_OF_CHARS + 1] = { @@ -538,21 +554,16 @@ int Yap_wide_chtype(Int ch) { return BS; } -static inline int getchr__(IOSTREAM *inp) { - int c = Sgetcode(inp); - - if (!CharConversionTable || c < 0 || c >= 256) +static inline int getchr__(struct stream_desc* inp) { + int c = inp->stream_wgetc_for_read(inp-GLOBAL_Stream); + if (!GLOBAL_CharConversionTable || c < 0 || c >= 256) return c; - return CharConversionTable[c]; + return GLOBAL_CharConversionTable[c]; } #define getchr(inp) getchr__(inp) -#define getchrq(inp) Sgetcode(inp) - -static int GetCurInpPos(IOSTREAM *inp_stream) { - return inp_stream->posbuf.lineno; -} +#define getchrq(inp) inp->stream_wgetc(inp-GLOBAL_Stream) /* in case there is an overflow */ typedef struct scanner_extra_alloc { @@ -617,24 +628,27 @@ char *Yap_AllocScannerMemory(unsigned int size) { extern double atof(const char *); static Term float_send(char *s, int sign) { - GET_LD Float f = (Float)(sign * atof(s)); #if HAVE_ISFINITE || defined(isfinite) - if (truePrologFlag(PLFLAG_ISO)) { /* iso */ + if (trueGlobalPrologFlag(ISO_FLAG)) { /* iso */ if (!isfinite(f)) { + CACHE_REGS LOCAL_ErrorMessage = "Float overflow while scanning"; return (MkEvalFl(f)); } } #elif HAVE_FINITE - if (truePrologFlag(PLFLAG_ISO)) { /* iso */ + if (trueGlobalPrologFlag(ISO_FLAG)) { /* iso */ if (!finite(f)) { LOCAL_ErrorMessage = "Float overflow while scanning"; return (MkEvalFl(f)); } } #endif - return (MkEvalFl(f)); + { + CACHE_REGS + return (MkEvalFl(f)); + } } /* we have an overflow at s */ @@ -663,9 +677,8 @@ static int send_error_message(char s[]) { return 0; } -static wchar_t read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream) { - GET_LD - int ch; +static wchar_t read_quoted_char(int *scan_nextp, struct stream_desc* inp_stream) { + int ch; /* escape sequence */ do_switch: @@ -749,7 +762,7 @@ do_switch: case '`': return '`'; case '^': - if (truePrologFlag(PLFLAG_ISO)) { + if (trueGlobalPrologFlag(ISO_FLAG)) { return send_error_message("invalid escape sequence"); } else { ch = getchrq(inp_stream); @@ -846,9 +859,8 @@ static int num_send_error_message(char s[]) { /* reads a number, either integer or float */ -static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, +static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s, UInt max_size, int sign) { - GET_LD char *sp = s; int ch = *chp; Int val = 0L, base = ch - '0'; @@ -880,6 +892,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, *sp++ = ch; ch = getchr(inp_stream); if (base == 0) { + CACHE_REGS wchar_t ascii = ch; int scan_extra = TRUE; @@ -956,6 +969,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, *sp++ = ch; } if (ch - '0' >= base) { + CACHE_REGS if (sign == -1) return MkIntegerTerm(-val); return MkIntegerTerm(val); @@ -973,10 +987,11 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, if (chtype(ch = getchr(inp_stream)) != NU) { if (ch == 'e' || ch == 'E') { - if (truePrologFlag(PLFLAG_ISO)) + if (trueGlobalPrologFlag(ISO_FLAG)) return num_send_error_message( "Float format not allowed in ISO mode"); } else { /* followed by a letter, end of term? */ + CACHE_REGS sp[0] = '\0'; *chbuffp = '.'; *chp = ch; @@ -1026,6 +1041,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, ch = getchr(inp_stream); } if (chtype(ch) != NU) { + CACHE_REGS if (has_dot) return float_send(s, sign); return MkIntegerTerm(sign * val); @@ -1056,6 +1072,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, return read_int_overflow(s + 3, base, val, sign); return read_int_overflow(s, base, val, sign); } else { + CACHE_REGS *chp = ch; return MkIntegerTerm(val * sign); } @@ -1063,7 +1080,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, /* given a function getchr scan until we either find the number or end of file */ -Term Yap_scan_num(IOSTREAM *inp) { +Term Yap_scan_num(StreamDesc *inp) { CACHE_REGS Term out; int sign = 1; @@ -1089,7 +1106,7 @@ Term Yap_scan_num(IOSTREAM *inp) { ch = getchr(inp); } if (chtype(ch) != NU) { - Yap_clean_tokenizer(NULL, NULL, NULL, 0L); + Yap_clean_tokenizer(NULL, NULL, NULL); return TermNil; } cherr = '\0'; @@ -1097,7 +1114,7 @@ Term Yap_scan_num(IOSTREAM *inp) { return TermNil; out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */ PopScannerMemory(ptr, 4096); - Yap_clean_tokenizer(NULL, NULL, NULL, 0L); + Yap_clean_tokenizer(NULL, NULL, NULL); if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) return TermNil; return out; @@ -1109,12 +1126,12 @@ Term Yap_scan_num(IOSTREAM *inp) { LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \ LOCAL_Error_Size = 0L; \ if (p) \ - p->Tok = Ord(kind = eot_tok); \ + p->Tok = Ord(kind = eot_tok); \ /* serious error now */ \ return l; \ } -static void open_comment(int ch, IOSTREAM *inp_stream USES_REGS) { +static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) { CELL *h0 = HR; HR += 5; h0[0] = AbsAppl(h0 + 2); @@ -1129,7 +1146,8 @@ static void open_comment(int ch, IOSTREAM *inp_stream USES_REGS) { LOCAL_CommentsTail = h0 + 1; h0 += 2; h0[0] = (CELL)FunctorMinus; - h0[1] = Yap_StreamPosition(inp_stream); + h0[1] = Yap_StreamPosition(inp_stream-GLOBAL_Stream + ); h0[2] = TermNil; LOCAL_CommentsNextChar = h0 + 2; LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t)); @@ -1203,16 +1221,16 @@ static wchar_t *ch_to_wide(char *base, char *charp) { } \ } -TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, - void *rd0) { - GET_LD +TokEntry *Yap_tokenizer( struct stream_desc *inp_stream, + bool store_comments, Term *tposp) { + + CACHE_REGS TokEntry *t, *l, *p; enum TokenKinds kind; int solo_flag = TRUE; int ch; wchar_t *wcharp; struct qq_struct_t *cur_qq = NULL; - struct read_data_t *rd = rd0; LOCAL_ErrorMessage = NULL; LOCAL_Error_Size = 0; @@ -1226,9 +1244,9 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, while (chtype(ch) == BS) { ch = getchr(inp_stream); } - *tposp = Yap_StreamPosition(inp_stream); - Yap_setCurrentSourceLocation(rd); - LOCAL_StartLine = inp_stream->posbuf.lineno; + *tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); + Yap_setCurrentSourceLocation(inp_stream); + LOCAL_StartLine = inp_stream->linecount; do { wchar_t och; int quote, isvar; @@ -1290,8 +1308,8 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, ch = getchr(inp_stream); } CHECK_SPACE(); - *tposp = Yap_StreamPosition(inp_stream); - Yap_setCurrentSourceLocation(rd); + *tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); + Yap_setCurrentSourceLocation(inp_stream); } goto restart; } else { @@ -1324,7 +1342,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, } add_ch_to_buff(ch); } - while (ch == '\'' && isvar && yap_flags[VARS_CAN_HAVE_QUOTE_FLAG]) { + while (ch == '\'' && isvar &&trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) { if (charp == (char *)AuxSp - 1024) { goto huge_var_error; } @@ -1492,7 +1510,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, "Heap Overflow While Scanning: please increase code space (-h)"; break; } - if (ch == 10 && truePrologFlag(PLFLAG_ISO)) { + if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) { /* in ISO a new line terminates a string */ LOCAL_ErrorMessage = "layout character \n inside quotes"; break; @@ -1605,7 +1623,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, break; case SY: - if (ch == '`' && truePrologFlag(PLFLAG_BACKQUOTED_STRING)) + if (ch == '`' && trueGlobalPrologFlag(BACKQUOTED_STRING_FLAG)) goto quoted_string; och = ch; ch = getchr(inp_stream); @@ -1641,8 +1659,8 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, ch = getchr(inp_stream); } CHECK_SPACE(); - *tposp = Yap_StreamPosition(inp_stream); - Yap_setCurrentSourceLocation(rd); + *tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); + Yap_setCurrentSourceLocation(inp_stream); } } goto restart; @@ -1757,11 +1775,15 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, cur_qq = qq; } t->TokInfo = (CELL)qq; - qq->start.byteno = inp_stream->position->byteno; - qq->start.lineno = inp_stream->position->lineno; - qq->start.linepos = inp_stream->position->linepos - 1; - qq->start.charno = inp_stream->position->charno - 1; - t->Tok = Ord(kind = QuasiQuotes_tok); + if (inp_stream->status & Seekable_Stream_f ) { + qq->start.byteno = fseek (inp_stream->file, 0, 0); + }else { + qq->start.byteno = inp_stream->charcount - 1; + } + qq->start.lineno = inp_stream->linecount; + qq->start.linepos = inp_stream->linepos - 1; + qq->start.charno = inp_stream->charcount - 1; + t->Tok = Ord(kind = QuasiQuotes_tok); ch = getchr(inp_stream); solo_flag = FALSE; break; @@ -1788,10 +1810,14 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, } cur_qq = NULL; t->TokInfo = (CELL)qq; - qq->mid.byteno = inp_stream->position->byteno; - qq->mid.lineno = inp_stream->position->lineno; - qq->mid.linepos = inp_stream->position->linepos - 1; - qq->mid.charno = inp_stream->position->charno - 1; + if (inp_stream->status & Seekable_Stream_f ) { + qq->mid.byteno = fseek (inp_stream->file, 0, 0); + }else { + qq->mid.byteno = inp_stream->charcount - 1; + } + qq->mid.lineno = inp_stream->linecount; + qq->mid.linepos = inp_stream->linepos - 1; + qq->mid.charno = inp_stream->charcount - 1; t->Tok = Ord(kind = QuasiQuotes_tok); ch = getchr(inp_stream); @@ -1849,10 +1875,14 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, strncpy(mp, TokImage, len + 1); qq->text = (unsigned char *)mp; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); - qq->end.byteno = inp_stream->position->byteno; - qq->end.lineno = inp_stream->position->lineno; - qq->end.linepos = inp_stream->position->linepos - 1; - qq->end.charno = inp_stream->position->charno - 1; + if (inp_stream->status & Seekable_Stream_f ) { + qq->end.byteno = fseek (inp_stream->file, 0, 0); + }else { + qq->end.byteno = inp_stream->charcount - 1; + } + qq->end.lineno = inp_stream->linecount; + qq->end.linepos = inp_stream->linepos - 1; + qq->end.charno = inp_stream->charcount - 1; if (!(t->TokInfo)) { LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; LOCAL_ErrorMessage = "Code Space Overflow"; @@ -1905,8 +1935,9 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, return (l); } -void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, - VarEntry *anonvartable, Term commentable) { +void Yap_clean_tokenizer(TokEntry *tokstart, + VarEntry *vartable, + VarEntry *anonvartable) { CACHE_REGS struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; while (ptr) { diff --git a/C/signals.c b/C/signals.c index 73d220592..2f149f403 100755 --- a/C/signals.c +++ b/C/signals.c @@ -21,6 +21,9 @@ static char SccsId[] = "%W% %G%"; #define HAS_CACHE_REGS 1 #include "Yap.h" +#if HAVE_UNISTD_H +#include +#endif #if _WIN32 #include #include @@ -57,7 +60,7 @@ static yap_signals InteractSIGINT(int ch) { #ifdef HAVE_SETBUF /* make sure we are not waiting for the end of line */ - YP_setbuf (stdin, NULL); + setbuf (stdin, NULL); #endif switch (ch) { case 'a': @@ -337,7 +340,7 @@ p_first_signal( USES_REGS1 ) #elif HAVE_FFSLL sig = ffsll(mask); #else - sig = Yap_msb( mask )+1; + sig = Yap_msb( mask PASS_REGS)+1; #endif if (get_signal(sig PASS_REGS)) { break; diff --git a/C/text.c b/C/text.c index d394f6235..23a6f5e37 100644 --- a/C/text.c +++ b/C/text.c @@ -22,6 +22,12 @@ #include "yapio.h" #include "YapText.h" +#if defined(__BIG_ENDIAN__) +#define ENC_WCHAR ENC_ISO_UTF32_BE +#else +#define ENC_WCHAR ENC_ISO_UTF32_LE +#endif + #include #include @@ -389,8 +395,8 @@ gen_type_error(int flags) { return TYPE_ERROR_NUMBER; } -static void * -read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS) + void * +Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS) { char *s; wchar_t *ws; @@ -414,7 +420,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng return 0L; } // this is a term, extract the UTF8 representation - *enc = YAP_UTF8; + *enc = ENC_ISO_UTF8; *minimal = FALSE; *lengp = strlen(s); return (void *)s; @@ -428,7 +434,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (!s) { return NULL; } - *enc = ( wide ? YAP_WCHAR : YAP_CHAR ); + *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); } return s; case YAP_STRING_ATOMS: @@ -438,8 +444,8 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng int wide = FALSE; s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); if (!s) return NULL; - if (wide) { *enc = YAP_WCHAR; } - else { *enc = YAP_CHAR; } + if (wide) { *enc = ENC_WCHAR; } + else { *enc = ENC_ISO_LATIN1; } } return s; case YAP_STRING_ATOMS_CODES: @@ -451,7 +457,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (!s) { return NULL; } - *enc = ( wide ? YAP_WCHAR : YAP_CHAR ); + *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); } return s; case YAP_STRING_ATOM: @@ -470,12 +476,12 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (IsWideAtom(at)) { ws = at->WStrOfAE; *lengp = wcslen(ws); - *enc = YAP_WCHAR; + *enc = ENC_WCHAR; return ws; } else { s = at->StrOfAE; *lengp = strlen(s); - *enc = YAP_CHAR; + *enc = ENC_ISO_LATIN1; return s; } } @@ -487,7 +493,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, inp->val.i) < 0) { AUX_ERROR( MkIntTerm(inp->val.i), 2*LOCAL_MAX_SIZE, s, char); } - *enc = YAP_CHAR; + *enc = ENC_ISO_LATIN1; *lengp = strlen(s); return s; case YAP_STRING_FLOAT: @@ -498,7 +504,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng AUX_ERROR( MkFloatTerm(inp->val.f), 2*LOCAL_MAX_SIZE, s, char); } *lengp = strlen(s); - *enc = YAP_CHAR; + *enc = ENC_ISO_LATIN1; return s; #if USE_GMP case YAP_STRING_BIG: @@ -507,19 +513,19 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if ( !Yap_mpz_to_string( inp->val.b, s, LOCAL_MAX_SIZE-1 , 10 ) ) { AUX_ERROR( MkIntTerm(0), LOCAL_MAX_SIZE, s, char); } - *enc = YAP_CHAR; + *enc = ENC_ISO_LATIN1; *lengp = strlen(s); return s; #endif case YAP_STRING_CHARS: - *enc = YAP_CHAR; + *enc = ENC_ISO_LATIN1; if (inp->type & YAP_STRING_NCHARS) *lengp = inp->sz; else *lengp = strlen(inp->val.c); return (void *)inp->val.c; case YAP_STRING_WCHARS: - *enc = YAP_WCHAR; + *enc = ENC_WCHAR; if (inp->type & YAP_STRING_NCHARS) *lengp = inp->sz; else @@ -527,23 +533,11 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng return (void *)inp->val.w; case YAP_STRING_LITERAL: { - yhandle_t CurSlot = Yap_StartSlots( ); + char *s, *o; if (buf) s = buf; else s = Yap_PreAllocCodeSpace(); size_t sz = LOCAL_MAX_SIZE-1; - IOSTREAM *fd; - AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); - CurSlot = Yap_StartSlots(); - fd = Sopenmem(&s, &sz, "w"); - fd->encoding = ENC_UTF8; - if ( ! PL_write_term(fd, Yap_InitSlot(inp->val.t), 1200, 0) || - Sputcode(EOS, fd) < 0 || - Sflush(fd) < 0 ) { - AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); - } - *enc = YAP_UTF8; - *lengp = strlen(s); - Yap_CloseSlots(CurSlot); + o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0); return s; } default: @@ -558,7 +552,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng } else if (IsStringTerm(t)) { if (inp->type & (YAP_STRING_STRING)) { inp->type &= (YAP_STRING_STRING); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_Term = t; @@ -566,7 +560,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng } else if (IsPairTerm(t) ) { if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) { inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_Term = t; @@ -574,11 +568,11 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng } else if (IsAtomTerm(t)) { if (t == TermNil && inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) { inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else if (inp->type & (YAP_STRING_ATOM)) { inp->type &= (YAP_STRING_ATOM); inp->val.t = t; - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); // [] is special... } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); @@ -588,7 +582,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (inp->type & (YAP_STRING_INT)) { inp->type &= (YAP_STRING_INT); inp->val.i = IntegerOfTerm(t); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_Term = t; @@ -597,7 +591,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (inp->type & (YAP_STRING_FLOAT)) { inp->type &= (YAP_STRING_FLOAT); inp->val.f = FloatOfTerm(t); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_Term = t; @@ -607,7 +601,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng if (inp->type & (YAP_STRING_BIG)) { inp->type &= (YAP_STRING_BIG); inp->val.b = Yap_BigIntOfTerm(t); - return read_Text( buf, inp, enc, minimal, lengp PASS_REGS); + return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); } else { LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_Term = t; @@ -634,7 +628,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng } switch (enc) { - case YAP_UTF8: + case ENC_ISO_UTF8: { char *s = s0, *lim = s + (max = strnlen(s, max)); Term t = init_tstring( PASS_REGS1 ); char *cp = s, *buf; @@ -656,7 +650,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng out->val.t = t; } break; - case YAP_CHAR: + case ENC_ISO_LATIN1: { unsigned char *s = s0, *lim = s + (max = strnlen(s0, max)); Term t = init_tstring( PASS_REGS1 ); unsigned char *cp = s; @@ -678,7 +672,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng out->val.t = t; } break; - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *s = s0, *lim = s + (max = wcsnlen(s, max)); Term t = init_tstring( PASS_REGS1 ); wchar_t *wp = s; @@ -699,6 +693,9 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng close_tstring( buf PASS_REGS ); out->val.t = t; } + break; + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } return out->val.t; @@ -719,7 +716,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } switch (enc) { - case YAP_UTF8: + case ENC_ISO_UTF8: { char *s = s0, *lim = s + strnlen(s, max); char *cp = s; wchar_t w[2]; @@ -740,7 +737,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } break; } - case YAP_CHAR: + case ENC_ISO_LATIN1: { unsigned char *s = s0, *lim = s + strnlen(s0, max); unsigned char *cp = s; char w[2]; @@ -760,7 +757,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } break; } - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *s = s0, *lim = s + wcsnlen(s, max); wchar_t *cp = s; wchar_t w[2]; @@ -778,7 +775,10 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U sz++; if (sz == max) break; } + break; } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } if (out->type & YAP_STRING_DIFF) { if (sz == 0) t = out->dif; @@ -804,7 +804,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } switch (enc) { - case YAP_UTF8: + case ENC_ISO_UTF8: { char *s = s0, *lim = s + strnlen(s, max); char *cp = s; LOCAL_TERM_ERROR( 2*(lim-s) ); @@ -819,7 +819,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } break; } - case YAP_CHAR: + case ENC_ISO_LATIN1: { unsigned char *s = s0, *lim = s + strnlen(s0, max); unsigned char *cp = s; @@ -835,7 +835,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } break; } - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *s = s0, *lim = s + wcsnlen(s, max); wchar_t *cp = s; @@ -849,7 +849,10 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U sz++; if (sz == max) break; } + break; } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } while (sz < min) { HR[0] = MkIntTerm(MkIntTerm(0)); @@ -878,7 +881,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US } switch (enc) { - case YAP_UTF8: + case ENC_ISO_UTF8: { char *s = s0, *lim = s + strnlen(s, max); wchar_t *buf = malloc(sizeof(wchar_t)*((lim+1)-s)), *ptr = buf; Atom at; @@ -894,7 +897,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US out->val.a = at; return at; } - case YAP_CHAR: + case ENC_ISO_LATIN1: { char *s = s0; Atom at; @@ -903,7 +906,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US out->val.a = at; return at; } - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *s = s0; Atom at; @@ -911,6 +914,8 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US out->val.a = at = Yap_LookupMaybeWideAtomWithLength(s, max); return at; } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } return NULL; } @@ -927,21 +932,23 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng } switch (enc) { - case YAP_UTF8: + case ENC_ISO_UTF8: { const char *s = s0; return utf8_strlen1(s); } - case YAP_CHAR: + case ENC_ISO_LATIN1: { const char *s = s0; return strnlen(s, max); } - case YAP_WCHAR: + case ENC_WCHAR: { const wchar_t *s = s0; return wcsnlen(s, max); } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } return (size_t)-1; } @@ -949,71 +956,13 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng static Term write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USES_REGS) { - // call the scanner - IOSTREAM *st; - char *s = s0; - Term t = 0L; - if ( (st=Sopenmem( &s, NULL, "r")) != NULL ) - { - if (enc == YAP_UTF8) - st->encoding = ENC_UTF8; - else if (enc == YAP_WCHAR) - st->encoding = ENC_WCHAR; - else - st->encoding = ENC_OCTET; - t = Yap_scan_num(st); - Sclose(st); - /* not ever iso */ - if (t == TermNil && yap_flags[LANGUAGE_MODE_FLAG] != 1) { - s = s0; - int sign = 1; - if (s[0] == '+') { - s++; - } - if (s[0] == '-') { - s++; - sign = -1; - } - if(strcmp(s,"inf") == 0) { - if (sign > 0) { - return MkFloatTerm(INFINITY); - } else { - return MkFloatTerm(-INFINITY); - } - } - if(strcmp(s,"nan") == 0) { - if (sign > 0) { - return MkFloatTerm(NAN); - } else { - return MkFloatTerm(-NAN); - } - } - } - if (t == TermNil) - return 0; - return t; - } - return 0L; + return Yap_StringToNumberTerm(s0, enc); } static Term -write_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) +string_to_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) { - // call the scanner - IOSTREAM *st; - size_t len = out->sz; - Term t = 0L; - if ( (st=Sopenmem( s0, &len, "r")) ) - { - if (enc == YAP_UTF8) - st->encoding = ENC_UTF8; - else if (enc == YAP_WCHAR) - st->encoding = ENC_WCHAR; - else - st->encoding = ENC_OCTET; - return t; - } - return 0L; + return Yap_StringToTerm(s0, strlen(s0)+1, enc, 1200, NULL); } @@ -1072,13 +1021,13 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U } if (out->type & (YAP_STRING_LITERAL)) if ((out->val.t = - write_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L) + string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L) return out->val.t != 0; return FALSE; } } -int + int Yap_CVT_Text( seq_tv_t *inp, seq_tv_t *out USES_REGS) { encoding_t enc; @@ -1086,7 +1035,7 @@ Yap_CVT_Text( seq_tv_t *inp, seq_tv_t *out USES_REGS) char *buf; size_t leng; - buf = read_Text( NULL, inp, &enc, &minimal, &leng PASS_REGS ); + buf = Yap_readText( NULL, inp, &enc, &minimal, &leng PASS_REGS ); if (!buf) return 0L; return write_Text( buf, out, enc, minimal, leng PASS_REGS ); @@ -1096,17 +1045,19 @@ static void * compute_end( void *s0, encoding_t enc ) { switch (enc) { - case YAP_CHAR: - case YAP_UTF8: + case ENC_ISO_LATIN1: + case ENC_ISO_UTF8: { char *s = (char *)s0; return s+(1+strlen(s)); } - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *s = (wchar_t *)s0; return s + (1+wcslen(s)); } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } return NULL; } @@ -1115,12 +1066,14 @@ static void * advance_Text( void *s, int l, encoding_t enc ) { switch (enc) { - case YAP_CHAR: + case ENC_ISO_LATIN1: return ((char *)s)+l; - case YAP_UTF8: + case ENC_ISO_UTF8: return (char *)utf8_skip((const char *)s,l); - case YAP_WCHAR: + case ENC_WCHAR: return ((wchar_t *)s)+l; + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); } return s; } @@ -1130,77 +1083,85 @@ cmp_Text( void *s1, void *s2, int l, encoding_t enc1, encoding_t enc2 ) { Int i; switch (enc1) { - case YAP_CHAR: + case ENC_ISO_LATIN1: { char *w1 = (char *)s1; switch (enc2) { - case YAP_CHAR: + case ENC_ISO_LATIN1: return strncmp(s1, s2, l); - case YAP_UTF8: + case ENC_ISO_UTF8: { int chr1, chr2; char *w2 = s2; for (i = 0; i < l; i++) { chr1 = *w1++; w2 = utf8_get_char(w2, &chr2); if (chr1-chr2) return chr1-chr2; } } return 0; - case YAP_WCHAR: + case ENC_WCHAR: { int chr1, chr2; wchar_t *w2 = s2; for (i = 0; i < l; i++) { chr1 = *w1++; chr2 = *w2++; if (chr1-chr2) return chr1-chr2; } } return 0; + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__); } - } - case YAP_UTF8: + } + case ENC_ISO_UTF8: { char *w1 = (char *)s1; switch (enc2) { - case YAP_CHAR: + case ENC_ISO_LATIN1: { int chr1, chr2; char *w2 = s2; for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; } } return 0; - case YAP_UTF8: + case ENC_ISO_UTF8: { int chr1, chr2; char *w2 = s2; for (i = 0; i < l; i++) { w2 = utf8_get_char(w2, &chr2); w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; } } return 0; - case YAP_WCHAR: + case ENC_WCHAR: { int chr1, chr2; wchar_t *w2 = s2; for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; } } return 0; - } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__); + } } - case YAP_WCHAR: + case ENC_WCHAR: { wchar_t *w1 = (wchar_t *)s1; switch (enc2) { - case YAP_CHAR: + case ENC_ISO_LATIN1: { int chr1, chr2; char *w2 = s2; for (i = 0; i < l; i++) { chr1 = *w1++; chr2 = *w2++; if (chr1-chr2) return chr1-chr2; } } return 0; - case YAP_UTF8: + case ENC_ISO_UTF8: { int chr1, chr2; char *w2 = s2; for (i = 0; i < l; i++) { chr1 = *w1++; w2 = utf8_get_char(w2, &chr2); if (chr1-chr2) return chr1-chr2; } } return 0; - case YAP_WCHAR: + case ENC_WCHAR: return wcsncmp(s1, s2, l); + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__); } } + default: + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc1), __FUNCTION__); } return 0; } @@ -1214,11 +1175,11 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES char *buf = buf_from_tstring(HR); int i; for (i = 0; i < n; i++) { - if (encv[i] == YAP_WCHAR) { + if (encv[i] == ENC_WCHAR) { wchar_t *ptr = sv[i]; int chr; while ( (chr = *ptr++) ) buf = utf8_put_char(buf, chr); - } else if (encv[i] == YAP_CHAR) { + } else if (encv[i] == ENC_ISO_LATIN1) { char *ptr = sv[i]; int chr; while ( (chr = *ptr++) ) buf = utf8_put_char(buf, chr); @@ -1233,28 +1194,28 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES out->val.t = t; return HR; } else { - encoding_t enc = YAP_CHAR; + encoding_t enc = ENC_ISO_LATIN1; size_t sz = 0; int i; for (i = 0; i < n; i++) { - if (encv[i] != YAP_CHAR) { - enc = YAP_WCHAR; + if (encv[i] != ENC_ISO_LATIN1) { + enc = ENC_WCHAR; } sz += write_length(sv[i], out, encv[i], FALSE, lengv[i] PASS_REGS); } - if (enc == YAP_WCHAR) { + if (enc == ENC_WCHAR) { /* wide atom */ wchar_t *buf = (wchar_t *)HR; Atom at; Term t = ARG1; LOCAL_ERROR( sz+3 ); for (i = 0; i < n ; i ++) { - if (encv[i] == YAP_WCHAR) { + if (encv[i] == ENC_WCHAR) { wchar_t *ptr = sv[i]; int chr; while ( (chr = *ptr++) != '\0' ) *buf++ = chr; - } else if (encv[i] == YAP_CHAR) { + } else if (encv[i] == ENC_ISO_LATIN1) { char *ptr = sv[i]; int chr; while ( (chr = *ptr++) != '\0' ) *buf++ = (unsigned char)chr; @@ -1294,11 +1255,11 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG /* we assume we concatenate strings only, or ASCII stuff like numbers */ Term t = init_tstring( PASS_REGS1 ); char *nbuf = buf_from_tstring(HR); - if (enc == YAP_WCHAR) { + if (enc == ENC_WCHAR) { wchar_t *ptr = (wchar_t *)buf + min; int chr; while ( min++ < max ) { chr = *ptr++; nbuf = utf8_put_char(nbuf, chr); } - } else if (enc == YAP_CHAR) { + } else if (enc == ENC_ISO_LATIN1) { char *ptr = (char *)buf + min; int chr; while ( min++ < max ) { chr = *ptr++; nbuf = utf8_put_char(nbuf, chr); } @@ -1315,7 +1276,7 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG } else { Atom at; /* atom */ - if (enc == YAP_WCHAR) { + if (enc == ENC_WCHAR) { /* wide atom */ wchar_t *nbuf = (wchar_t *)HR; Term t = TermNil; @@ -1326,7 +1287,7 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG } nbuf[max-min] = '\0'; at = Yap_LookupMaybeWideAtom( nbuf ); - } else if (enc == YAP_CHAR) { + } else if (enc == ENC_ISO_LATIN1) { /* atom */ char *nbuf = (char *)HR; @@ -1375,7 +1336,7 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS) HEAP_ERROR(encv, encoding_t); buf = NULL; for (i = 0 ; i < n ; i++) { - void *nbuf = read_Text( buf, inp+i, encv+i, &minimal, &leng PASS_REGS ); + void *nbuf = Yap_readText( buf, inp+i, encv+i, &minimal, &leng PASS_REGS ); if (!nbuf) return 0L; @@ -1401,7 +1362,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv size_t l, leng; int i, min; - buf = read_Text( NULL, inp, &enc, &minimal, &leng PASS_REGS ); + buf = Yap_readText( NULL, inp, &enc, &minimal, &leng PASS_REGS ); if (!buf) return NULL; l = write_length( buf, inp, enc, minimal, leng PASS_REGS); @@ -1422,7 +1383,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv void *buf0, *buf1; if (outv[0].val.t) { - buf0 = read_Text( store, outv, &enc0, &minimal0, &leng0 PASS_REGS ); + buf0 = Yap_readText( store, outv, &enc0, &minimal0, &leng0 PASS_REGS ); if (!buf0) return NULL; l0 = write_length( buf0, outv, enc, minimal0, leng0 PASS_REGS); @@ -1436,7 +1397,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv encv[1] = enc; return buf1; } else /* if (outv[1].val.t) */ { - buf1 = read_Text( store, outv+1, &enc1, &minimal1, &leng1 PASS_REGS ); + buf1 = Yap_readText( store, outv+1, &enc1, &minimal1, &leng1 PASS_REGS ); if (!buf1) return NULL; l1 = write_length( buf1, outv+1, enc1, minimal1, leng1 PASS_REGS); diff --git a/C/threads.c b/C/threads.c index 9a3ea9caa..3082a0002 100644 --- a/C/threads.c +++ b/C/threads.c @@ -28,9 +28,8 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "eval.h" #include "yapio.h" -#include "pl-shared.h" +#include "blobs.h" #include -#include #if HAVE_STRING_H #include #endif @@ -39,8 +38,8 @@ static char SccsId[] = "%W% %G%"; #endif /* TABLING */ -PL_blob_t PL_Message_Queue = { - PL_BLOB_MAGIC, +blob_type_t PL_Message_Queue = { + YAP_BLOB_MAGIC_B, PL_BLOB_UNIQUE | PL_BLOB_NOCOPY, "message_queue", 0, // release @@ -64,32 +63,6 @@ static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; debug_pe_locks = 0; #include "threads.h" -/* - * This file includes the definition of threads in Yap. Threads - * are supposed to be compatible with the SWI-Prolog thread package. - * - */ - -static void -set_system_thread_id(int wid, PL_thread_info_t *info) -{ - if (!info) - info = (PL_thread_info_t *)malloc(sizeof(PL_thread_info_t)); - info = SWI_thread_info(wid, info); - info->tid = pthread_self(); - info->has_tid = TRUE; -#ifdef HAVE_GETTID_SYSCALL - info->pid = syscall(__NR_gettid); -#else -#ifdef HAVE_GETTID_MACRO - info->pid = gettid(); -#else -#ifdef __WINDOWS__ - info->w32id = GetCurrentThreadId(); -#endif -#endif -#endif -} int Yap_ThreadID( void ) @@ -358,7 +331,6 @@ kill_thread_engine (int wid, int always_die) free(REMOTE_ScratchPad(wid).ptr); // if (REMOTE_TmpPred(wid).ptr) // free(REMOTE_TmpPred(wid).ptr); - REMOTE_PL_local_data_p(wid)->reg_cache = REMOTE_ThreadHandle(wid).current_yaam_regs = NULL; if (REMOTE_ThreadHandle(wid).start_of_timesp) free(REMOTE_ThreadHandle(wid).start_of_timesp); @@ -394,7 +366,6 @@ setup_engine(int myworker_id, int init_thread) CACHE_REGS REGSTORE *standard_regs; - set_system_thread_id( myworker_id, NULL ); standard_regs = (REGSTORE *)calloc(1,sizeof(REGSTORE)); if (!standard_regs) return FALSE; @@ -402,7 +373,6 @@ setup_engine(int myworker_id, int init_thread) /* create the YAAM descriptor */ REMOTE_ThreadHandle(myworker_id).default_yaam_regs = standard_regs; REMOTE_ThreadHandle(myworker_id).current_yaam_regs = standard_regs; - REMOTE_PL_local_data_p(myworker_id)->reg_cache = standard_regs; Yap_InitExStacks(myworker_id, REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize); REMOTE_SourceModule(myworker_id) = CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod; // create a mbox @@ -711,12 +681,10 @@ Yap_thread_attach_engine(int wid) if (REMOTE_ThreadHandle(wid).ref_count ) { REMOTE_ThreadHandle(wid).ref_count++; REMOTE_ThreadHandle(wid).pthread_handle = pthread_self(); - set_system_thread_id(wid, SWI_thread_info(wid, NULL)); MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock)); return TRUE; } REMOTE_ThreadHandle(wid).pthread_handle = pthread_self(); - set_system_thread_id(wid, SWI_thread_info(wid, NULL)); REMOTE_ThreadHandle(wid).ref_count++; pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(wid).current_yaam_regs); MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock)); @@ -1196,7 +1164,7 @@ p_with_mutex( USES_REGS1 ) } if ( pe->OpcodeOfPred != FAIL_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL, true PASS_REGS) ) { rc = TRUE; } end: @@ -1592,38 +1560,29 @@ p_thread_unlock( USES_REGS1 ) } intptr_t -system_thread_id(PL_thread_info_t *info) -{ if ( !info ) - { CACHE_REGS - if ( LOCAL ) - info = SWI_thread_info(worker_id, NULL); - else - return -1; - } -#ifdef __linux__ - return info->pid; -#else -#ifdef __WINDOWS__ - return info->w32id; -#else - return (intptr_t)info->tid; -#endif +system_thread_id(void) +{ +#ifdef HAVE_GETTID_SYSCALL + return syscall(__NR_gettid); +#elif defined( HAVE_GETTID_MACRO ) + return gettid(); +#elif defined(__WINDOWS__) + return GetCurrentThreadId(); #endif } + + void Yap_InitFirstWorkerThreadHandle(void) { CACHE_REGS - set_system_thread_id(0, NULL); LOCAL_ThreadHandle.id = 0; LOCAL_ThreadHandle.in_use = TRUE; LOCAL_ThreadHandle.default_yaam_regs = &Yap_standard_regs; LOCAL_ThreadHandle.current_yaam_regs = &Yap_standard_regs; - LOCAL_PL_local_data_p->reg_cache = - &Yap_standard_regs; LOCAL_ThreadHandle.pthread_handle = pthread_self(); pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock, NULL); pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL); @@ -1840,7 +1799,7 @@ p_new_mutex(void) } if ( pe->OpcodeOfPred != FAIL_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL, false PASS_REGS) ) { rc = TRUE; } end: diff --git a/C/traced_absmi_insts.h b/C/traced_absmi_insts.h index 41bf1b198..51badeada 100644 --- a/C/traced_absmi_insts.h +++ b/C/traced_absmi_insts.h @@ -1,4 +1,9 @@ +#ifndef THREADS #define PASS_REGS +#else +#define PASS_REGS , regcache +#endif + #define undef_goal( x ) if (P == NULL) goto fail; @@ -1506,7 +1511,7 @@ Op(cut, s); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l); /* assume cut is always in stack */ saveregs(); - prune((choiceptr)YREG[E_CB]); + prune((choiceptr)YREG[E_CB] PASS_REGS); setregs(); GONext(); ENDOp(); @@ -1528,7 +1533,7 @@ Op(cut, s); SET_ASP(YREG, PREG->y_u.s.s); /* assume cut is always in stack */ saveregs(); -prune((choiceptr)YREG[E_CB]); + prune((choiceptr)YREG[E_CB] PASS_REGS); setregs(); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l); GONext(); @@ -1550,7 +1555,7 @@ prune((choiceptr)YREG[E_CB]); SET_ASP(YREG, PREG->y_u.s.s); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l); saveregs(); - prune((choiceptr)SREG[E_CB]); + prune((choiceptr)SREG[E_CB] PASS_REGS); setregs(); GONext(); ENDOp(); @@ -1617,7 +1622,7 @@ prune((choiceptr)YREG[E_CB]); #endif /* YAPOR_SBA && FROZEN_STACKS */ EMIT_SIMPLE_BLOCK_TEST(COMMIT_B_X_POST_YSBA_FROZEN); saveregs(); - prune(pt0); + prune(pt0 PASS_REGS); setregs(); } GONext(); @@ -1660,7 +1665,7 @@ prune((choiceptr)YREG[E_CB]); #endif EMIT_SIMPLE_BLOCK_TEST(COMMIT_B_Y_POST_YSBA_FROZEN); saveregs(); - prune(pt0); + prune(pt0 PASS_REGS); setregs(); } GONext(); @@ -2016,11 +2021,11 @@ prune((choiceptr)YREG[E_CB]); GONext(); ENDOp(); -/********************************************** -* OPTYap instructions * -**********************************************/ - +#if EAM +/********************************************** +* EAM instructions * +**********************************************/ Op(retry_eam, e); //goto retry_eam; @@ -2031,6 +2036,9 @@ prune((choiceptr)YREG[E_CB]); { printf("run_eam not supported by JIT!!\n"); exit(1); } ENDOp(); +#endif + + /************************************************************************\ * Get Instructions * \************************************************************************/ @@ -6814,24 +6822,18 @@ S_SREG = RepAppl(d0); JMPNext(); ENDBOp(); +#if THREADS BOp(thread_local, e); { -#if THREADS - EMIT_ENTRY_BLOCK(PREG,THREAD_LOCAL_INSTINIT); + EMIT_ENTRY_BLOCK(PREG,THREAD_LOCAL_INSTINIT); PredEntry *ap = PredFromDefCode(PREG); ap = Yap_GetThreadPred(ap PASS_REGS); PREG = ap->CodeOfPred; -#else - saveregs(); - undef_goal( PASS_REGS1 ); - setregs(); - /* for profiler */ -#endif CACHE_A1(); - } - + } JMPNext(); ENDBOp(); +#endif BOp(expand_index, e); { @@ -9200,7 +9202,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_PLUS_VV_PLUS_VV_NVAR_NVAR_NOINT); saveregs(); - d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9252,7 +9254,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_PLUS_VC_PLUS_VC_NVAR_NOINT); saveregs(); - d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9300,7 +9302,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_PLUS_Y_VV_PLUS_Y_VV_NVAR_NVAR_NOINT); saveregs(); - d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9356,7 +9358,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_PLUS_Y_VC_PLUS_Y_VC_NVAR_NOINT); saveregs(); - d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9407,7 +9409,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_MINUS_VV_MINUS_VV_NVAR_NVAR_NOINT); saveregs(); - d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9457,7 +9459,7 @@ S_SREG = RepAppl(d0); else { EMIT_SIMPLE_BLOCK_TEST(P_MINUS_CV_MINUS_CV_NVAR_NOINT); saveregs(); - d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0)); + d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9511,7 +9513,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_MINUS_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -9583,7 +9585,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_MINUS_Y_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0)); + d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -9636,13 +9638,13 @@ S_SREG = RepAppl(d0); if (IsIntTerm(d0) && IsIntTerm(d1)) { EMIT_CONDITIONAL_SUCCESS("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VV_TIMES_VV_NVAR_NVAR_INT); - d0 = times_int(IntOfTerm(d0), IntOfTerm(d1)); + d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS); } else { EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VV_TIMES_VV_NVAR_NVAR_NOINT); saveregs(); - d0 = p_times(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9688,13 +9690,13 @@ S_SREG = RepAppl(d0); if (IsIntTerm(d0)) { EMIT_CONDITIONAL_SUCCESS("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VC_TIMES_VC_NVAR_INT); - d0 = times_int(IntOfTerm(d0), d1); + d0 = times_int(IntOfTerm(d0), d1 PASS_REGS); } else { EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VC_TIMES_VC_NVAR_NOINT); saveregs(); - d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9741,14 +9743,14 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_TIMES_Y_VV_INTTERM); ///#endif - d0 = times_int(IntOfTerm(d0), IntOfTerm(d1)); + d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_TIMES_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_times(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -9806,12 +9808,12 @@ S_SREG = RepAppl(d0); Int d1 = PREG->y_u.yxn.c; if (IsIntTerm(d0)) { EMIT_SIMPLE_BLOCK_TEST(P_TIMES_Y_VC_TIMES_Y_VC_NVAR_INT); - d0 = times_int(IntOfTerm(d0), d1); + d0 = times_int(IntOfTerm(d0), d1 PASS_REGS); } else { EMIT_SIMPLE_BLOCK_TEST(P_TIMES_Y_VC_TIMES_Y_VC_NVAR_NOINT); saveregs(); - d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9870,8 +9872,8 @@ S_SREG = RepAppl(d0); else { EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_DIV_VV_DIV_VV_NVAR_NVAR_NOINT); - saveregs(); - d0 = p_div(Yap_Eval(d0), Yap_Eval(d1)); + saveregs(); + d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -9930,7 +9932,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_DIV_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1)); + d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10001,7 +10003,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_DIV_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0)); + d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_DIV_CV_D0EQUALS0L); @@ -10075,7 +10077,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_DIV_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_div(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10147,7 +10149,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_DIV_Y_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1)); + d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10221,7 +10223,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_DIV_Y_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0)); + d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10281,7 +10283,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)"); EMIT_SIMPLE_BLOCK_TEST(P_AND_VV_AND_VV_NVAR_NVAR_NOINT); saveregs(); - d0 = p_and(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -10333,7 +10335,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_AND_VC_AND_VC_NVAR_NOINT); saveregs(); - d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -10387,7 +10389,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_AND_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_and(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10459,7 +10461,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_AND_Y_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10525,7 +10527,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_OR_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_or(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10594,7 +10596,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_OR_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_OR_VC_D0EQUALS0L); @@ -10655,7 +10657,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_OR_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_or(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10727,7 +10729,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_OR_Y_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -10795,7 +10797,7 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_VV_INTTERM_GREATER); ///#endif - d0 = do_sll(IntOfTerm(d0),i2); + d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS); } } else { @@ -10803,7 +10805,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLL_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); } if (d0 == 0L) { @@ -10865,14 +10867,14 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_VC_INTTERM); ///#endif - d0 = do_sll(IntOfTerm(d0), (Int)d1); + d0 = do_sll(IntOfTerm(d0), (Int)d1 PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); } } @@ -10921,13 +10923,13 @@ S_SREG = RepAppl(d0); if (i2 < 0) { d0 = MkIntegerTerm(SLR(d1, -i2)); } else { - d0 = do_sll(d1,i2); + d0 = do_sll(d1,i2 PASS_REGS); } } else { EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_SLL_CV_SLL_CV_NVAR_NOINT); saveregs(); - d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0)); + d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS); setregs(); } } @@ -10984,14 +10986,14 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_VV_INTTERM_GREATER); ///#endif - d0 = do_sll(IntOfTerm(d0),i2); + d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS); } } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); } if (d0 == 0L) { @@ -11056,14 +11058,14 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_VC_INTTERM); ///#endif - d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1)); + d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1) PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); } } @@ -11128,14 +11130,14 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_CV_INTTERM_GREATER); ///#endif - d0 = do_sll(d1,i2); + d0 = do_sll(d1,i2 PASS_REGS); } } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLL_Y_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0)); + d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0) PASS_REGS); setregs(); } } @@ -11198,7 +11200,7 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_VV_INTTERM_LESS); ///#endif - d0 = do_sll(IntOfTerm(d0), -i2); + d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_VV_INTTERM_GREATER); @@ -11210,7 +11212,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLR_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); } if (d0 == 0L) { @@ -11272,7 +11274,7 @@ S_SREG = RepAppl(d0); EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)"); EMIT_SIMPLE_BLOCK_TEST(P_SLR_VC_SLR_VC_NVAR_NOINT); saveregs(); - d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { saveregs(); @@ -11320,7 +11322,7 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_CV_INTTERM_LESS); ///#endif - d0 = do_sll(d1, -i2); + d0 = do_sll(d1, -i2 PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_CV_INTTERM_GREATER); @@ -11332,7 +11334,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLR_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0)); + d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS); setregs(); } } @@ -11392,7 +11394,7 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_INTTERM_LESS); ///#endif - d0 = do_sll(IntOfTerm(d0), -i2); + d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_INTTERM_GREATER); @@ -11404,7 +11406,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_NOINTTERM); ///#endif saveregs(); - d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1)); + d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); setregs(); } BEGP(pt0); @@ -11476,7 +11478,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLR_Y_VC_NOINTTERM); ///#endif saveregs(); - d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1)); + d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS); setregs(); if (d0 == 0L) { ///#ifdef PROFILED_ABSMI @@ -11534,7 +11536,7 @@ S_SREG = RepAppl(d0); ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_INTTERM_LESS); ///#endif - d0 = do_sll(d1, -i2); + d0 = do_sll(d1, -i2 PASS_REGS); } else { ///#ifdef PROFILED_ABSMI EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_INTTERM_GREATER); @@ -11546,7 +11548,7 @@ S_SREG = RepAppl(d0); EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_NOINTTERM); ///#endif saveregs(); - d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0)); + d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS); setregs(); } } diff --git a/C/tracer.c b/C/tracer.c index 4e5c3ea4d..19c240c37 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -25,41 +25,39 @@ #include "yapio.h" #include "clause.h" #include "tracer.h" -#include "SWI-Stream.h" -static void send_tracer_message(char *, char *, Int, char *, CELL *); static void send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args) { if (name == NULL) { #ifdef YAPOR - Sfprintf(GLOBAL_stderr, "(%d)%s", worker_id, start); + fprintf(stderr, "(%d)%s", worker_id, start); #else - Sfprintf(GLOBAL_stderr, "%s", start); + fprintf(stderr, "%s", start); #endif } else { int i; if (arity) { if (args) - Sfprintf(GLOBAL_stderr, "%s %s:%s(", start, mname, name); + fprintf(stderr, "%s %s:%s(", start, mname, name); else - Sfprintf(GLOBAL_stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity); + fprintf(stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity); } else { - Sfprintf(GLOBAL_stderr, "%s %s:%s", start, mname, name); + fprintf(stderr, "%s %s:%s", start, mname, name); } if (args) { for (i= 0; i < arity; i++) { - if (i > 0) Sfprintf(GLOBAL_stderr, ","); - Yap_plwrite(args[i], GLOBAL_stderr, 15, Handle_vars_f|AttVar_Portray_f, 1200); + if (i > 0) fprintf(stderr, ","); + Yap_plwrite(args[i], NULL, 15, Handle_vars_f|AttVar_Portray_f, 1200); } if (arity) { - Sfprintf(GLOBAL_stderr, ")"); + fprintf(stderr, ")"); } } } - Sfprintf(GLOBAL_stderr, "\n"); + fprintf(stderr, "\n"); } #if defined(__GNUC__) @@ -121,7 +119,7 @@ check_area(void) first = i; found = TRUE; } - Sfprintf(stderr,"%lld changed %d\n",vsc_count,i); + fprintf(stderr,"%lld changed %d\n",vsc_count,i); } array[i] = ((CELL *)0x187a800)[i]; } @@ -163,12 +161,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; //if (vsc_count == 161862) jmp_deb(1); - // Sfprintf(stderr,"B=%p ", B); + // fprintf(stderr,"B=%p ", B); #ifdef THREADS LOCAL_ThreadHandle.thread_inst_count++; #endif #ifdef COMMENTED - Sfprintf(stderr,"in %p\n"); + fprintf(stderr,"in %p\n"); CELL * gc_ENV = ENV; while (gc_ENV != NULL) { /* no more environments */ fprintf(stderr,"%ld\n", LCL0-gc_ENV); @@ -197,7 +195,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) if (vsc_count % 1LL == 0) { UInt sz = Yap_regp->H0_[17]; UInt end = sizeof(MP_INT)/sizeof(CELL)+sz+1; - Sfprintf(GLOBAL_stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]); + fprintf(stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]); } } else return; @@ -309,9 +307,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) printf("\n"); } #endif - Sfprintf(GLOBAL_stderr,"%lld ",vsc_count); + fprintf(stderr,"%lld ",vsc_count); #if defined(THREADS) || defined(YAPOR) - Sfprintf(GLOBAL_stderr,"(%d)", worker_id); + fprintf(stderr,"(%d)", worker_id); #endif /* check_trail_consistency(); */ if (pred == NULL) { @@ -394,7 +392,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) } break; } - Sflush(GLOBAL_stderr); fflush(NULL); UNLOCK(Yap_heap_regs->low_level_trace_lock); } @@ -405,32 +402,31 @@ toggle_low_level_trace(void) Yap_do_low_level_trace = !Yap_do_low_level_trace; } -static Int p_start_low_level_trace( USES_REGS1 ) +static Int start_low_level_trace( USES_REGS1 ) { - GLOBAL_stderr = Serror; //Sopen_file("TRACER_LOG", "w"); Yap_do_low_level_trace = TRUE; return(TRUE); } -static Int p_total_choicepoints( USES_REGS1 ) +static Int total_choicepoints( USES_REGS1 ) { return Yap_unify(MkIntegerTerm(LOCAL_total_choicepoints),ARG1); } -static Int p_reset_total_choicepoints( USES_REGS1 ) +static Int reset_total_choicepoints( USES_REGS1 ) { LOCAL_total_choicepoints = 0; return TRUE; } -static Int p_show_low_level_trace( USES_REGS1 ) +static Int show_low_level_trace( USES_REGS1 ) { - Sfprintf(GLOBAL_stderr,"Call counter=%lld\n",vsc_count); + fprintf(stderr,"Call counter=%lld\n",vsc_count); return(TRUE); } #ifdef THREADS -static Int p_start_low_level_trace2( USES_REGS1 ) +static Int start_low_level_trace2( USES_REGS1 ) { thread_trace = IntegerOfTerm(Deref(ARG1))+1; Yap_do_low_level_trace = TRUE; @@ -440,7 +436,15 @@ static Int p_start_low_level_trace2( USES_REGS1 ) #include -static Int p_stop_low_level_trace( USES_REGS1 ) +/** @pred stop_low_level_trace + +Stop displaying messages at procedure entry and retry. + +Note that using this compile-time option will slow down execution, even if messages are +not being output. + + */ +static Int stop_low_level_trace( USES_REGS1 ) { Yap_do_low_level_trace = FALSE; LOCAL_do_trace_primitives = TRUE; @@ -450,19 +454,24 @@ static Int p_stop_low_level_trace( USES_REGS1 ) return(TRUE); } -volatile int vsc_wait; +volatile int v_wait; -static Int p_vsc_wait( USES_REGS1 ) +static Int vsc_wait( USES_REGS1 ) { - while (!vsc_wait); - vsc_wait=1; - return(TRUE); + while (!v_wait); + return true; +} + +static Int vsc_go( USES_REGS1 ) +{ + v_wait=1; + return true; } void Yap_InitLowLevelTrace(void) { - Yap_InitCPred("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag); + Yap_InitCPred("start_low_level_trace", 0, start_low_level_trace, SafePredFlag); /** @pred start_low_level_trace @@ -471,23 +480,14 @@ Begin display of messages at procedure entry and retry. */ #if THREADS - Yap_InitCPred("start_low_level_trace", 1, p_start_low_level_trace2, SafePredFlag); + Yap_InitCPred("start_low_level_trace", 1, start_low_level_trace2, SafePredFlag); #endif - Yap_InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag); -/** @pred stop_low_level_trace - - -Stop display of messages at procedure entry and retry. - - -Note that this compile-time option will slow down execution. - - - */ - Yap_InitCPred("show_low_level_trace", 0, p_show_low_level_trace, SafePredFlag); - Yap_InitCPred("total_choicepoints", 1, p_total_choicepoints, SafePredFlag); - Yap_InitCPred("reset_total_choicepoints", 0, p_reset_total_choicepoints, SafePredFlag); - Yap_InitCPred("vsc_wait", 0, p_vsc_wait, SafePredFlag); + Yap_InitCPred("stop_low_level_trace", 0, stop_low_level_trace, SafePredFlag); + Yap_InitCPred("show_low_level_trace", 0, show_low_level_trace, SafePredFlag); + Yap_InitCPred("total_choicepoints", 1, total_choicepoints, SafePredFlag); + Yap_InitCPred("reset_total_choicepoints", 0, reset_total_choicepoints, SafePredFlag); + Yap_InitCPred("vsc_wait", 0, vsc_wait, SafePredFlag); + Yap_InitCPred("vsc_go", 0, vsc_go, SafePredFlag); } #endif diff --git a/C/write.c b/C/write.c index 3b13ca510..474848be0 100644 --- a/C/write.c +++ b/C/write.c @@ -28,7 +28,7 @@ static char SccsId[] = "%W% %G%"; #if COROUTINING #include "attvar.h" #endif -#include "pl-shared.h" +#include "iopreds.h" #include "pl-utf8.h" #if HAVE_STRING_H @@ -43,12 +43,13 @@ static char SccsId[] = "%W% %G%"; /* describe the type of the previous term to have been written */ typedef enum { + start, /* initialization */ separator, /* the previous term was a separator like ',', ')', ... */ alphanum, /* the previous term was an atom or number */ symbol /* the previous term was a symbol like +, -, *, .... */ } wtype; -typedef void *wrf; +typedef StreamDesc *wrf; typedef struct union_slots { Int old; @@ -69,7 +70,7 @@ typedef struct rewind_term { } rwts; typedef struct write_globs { - IOSTREAM *stream; + StreamDesc *stream; int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; int Keep_terms; int Write_Loops; @@ -89,7 +90,7 @@ static bool callPortray(Term t, struct DB_TERM **old_EXp USES_REGS) { EX = NULL; if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, &t PASS_REGS)) { + Yap_execute_pred(pe, &t, true PASS_REGS)) { choiceptr B0 = (choiceptr)(LCL0 - b0); if (EX && !*old_EXp) *old_EXp = EX; @@ -112,14 +113,14 @@ static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); -#define wrputc(X, WF) Sputcode(X, WF) /* writes a character */ +#define wrputc(WF, X) (X)->stream_wputc(X-GLOBAL_Stream, WF) /* writes a character */ /* protect bracket from merging with previoous character. avoid stuff like not (2,3) -> not(2,3) or */ static void wropen_bracket(struct write_globs *wglb, int protect) { - wrf stream = wglb->stream; + StreamDesc *stream = wglb->stream; if (lastw != separator && protect) wrputc(' ', stream); @@ -176,7 +177,11 @@ static void wrputn(Int n, protect_close_number(wglb, ob); } -#define wrputs(s, stream) Sfputs(s, stream) +inline static void +wrputs(char *s, StreamDesc *stream) { + int c; + while ((c = *s++)) wrputc(c, stream); +} static void wrputws(wchar_t *s, wrf stream) /* writes a string */ { @@ -274,7 +279,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, blob_info = big_tag - USER_BLOB_START; if (GLOBAL_OpaqueHandlers && (f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) { - (f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0); + (f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0); return; } } @@ -284,8 +289,10 @@ static void writebig(Term t, int p, int depth, int rinfixarg, static void wrputf(Float f, struct write_globs *wglb) /* writes a float */ { - char s[256]; - wrf stream = wglb->stream; +#if THREADS + char s[256]; +#endif + wrf stream = wglb->stream; int sgn; int ob; @@ -358,30 +365,28 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */ wrputs(".0", stream); } #else - char *format_float(double f, char *buf); - char *buf; + char buf[256]; if (lastw == symbol || lastw == alphanum) { wrputc(' ', stream); } /* use SWI's format_float */ - buf = format_float(f, s); - if (!buf) - return; + sprintf(buf, floatFormat(),f); + wrputs(buf, stream); #endif protect_close_number(wglb, ob); } int Yap_FormatFloat(Float f, const char *s, size_t sz) { + CACHE_REGS struct write_globs wglb; - char *ws = (char *)s; - IOSTREAM *smem = Sopenmem(&ws, &sz, "w"); - wglb.stream = smem; - wglb.lw = separator; - wglb.last_atom_minus = FALSE; - wrputf(f, &wglb); - Sclose(smem); + int sno; + sno = Yap_open_buf_read_stream(s, strlen(s)+1, LOCAL_encoding, MEM_BUF_USER); + if (sno < 0) + return FALSE; + wrputf(f, &wglb); + GLOBAL_Stream[sno].status = Free_Stream_f; return TRUE; } @@ -404,22 +409,13 @@ static void wrputref(CODEADDR ref, int Quote_illegal, /* writes a blob (default) */ static int wrputblob(AtomEntry *ref, int Quote_illegal, struct write_globs *wglb) { - char s[256]; wrf stream = wglb->stream; - PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t; - - if (type->write) { - atom_t at = YAP_SWIAtomFromAtom(AbsAtom(ref)); - return type->write(stream, at, 0); - } else { - putAtom(AtomSWIStream, Quote_illegal, wglb); -#if defined(__linux__) || defined(__APPLE__) - sprintf(s, "(%p)", ref); -#else - sprintf(s, "(0x%p)", ref); -#endif - wrputs(s, stream); - } + int rc; + int Yap_write_blob(AtomEntry *ref, StreamDesc *stream); + + if ((rc = Yap_write_blob(ref, stream))) { + return rc; + } lastw = alphanum; return 1; } @@ -550,7 +546,7 @@ static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) { static void write_string(const char *s, struct write_globs *wglb) /* writes an integer */ { - IOSTREAM *stream = wglb->stream; + StreamDesc *stream = wglb->stream; int chr, qt; char *ptr = (char *)s; @@ -622,7 +618,7 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) { } } -void Yap_WriteAtom(IOSTREAM *s, Atom atom) { +void Yap_WriteAtom(StreamDesc *s, Atom atom) { struct write_globs wglb; wglb.stream = s; wglb.Quote_illegal = FALSE; @@ -727,8 +723,8 @@ static CELL *restore_from_write(struct rewind_term *rwt, if (wglb->Keep_terms) { ptr = (CELL *)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS); - if (!Yap_RecoverSlots(2, rwt->u_sd.s.ptr PASS_REGS)) - return NULL; + Yap_RecoverSlots(2, rwt->u_sd.s.old PASS_REGS); + // printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ; } else { ptr = rwt->u_sd.d.ptr; } @@ -875,13 +871,13 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, struct rewind_term nrwt; nrwt.parent = rwt; nrwt.u_sd.s.ptr = 0; - + if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; } - if (EX) - return; + DBTerm *oEX = EX; + EX = NULL; t = Deref(t); if (IsVarTerm(t)) { write_var((CELL *)t, wglb, &nrwt); @@ -903,12 +899,15 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, FALSE, wglb, &nrwt); restore_from_write(&nrwt, wglb); wrclose_bracket(wglb, TRUE); + EX = oEX; return; } - if (wglb->Use_portray) - if (callPortray(t, &EX PASS_REGS)) - return; - if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) { + if (wglb->Use_portray) + if (callPortray(t, &EX PASS_REGS)) { + EX = oEX; + return; + } + if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) { putString(t, wglb); } else { wrputc('[', wglb->stream); @@ -978,8 +977,10 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } #endif if (wglb->Use_portray) { - if (callPortray(t, &EX PASS_REGS)) + if (callPortray(t, &EX PASS_REGS)) { + EX = oEX; return; + } } if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) { Term tright = ArgOfTerm(1, t); @@ -1187,21 +1188,23 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrclose_bracket(wglb, TRUE); } } + EX = oEX; } -struct write_globs wglb; -struct rewind_term rwt; - -void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority) +void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority) /* term to be written */ /* consumer */ /* write options */ { - if (!mywrite) - wglb.stream = Serror; - else + struct write_globs wglb; + struct rewind_term rwt; + + if (!mywrite) { + CACHE_REGS + wglb.stream = GLOBAL_Stream+LOCAL_c_error_stream; + } else wglb.stream = mywrite; - wglb.lw = separator; + wglb.lw = start; wglb.last_atom_minus = FALSE; wglb.Quote_illegal = flags & Quote_illegal_f; wglb.Handle_vars = flags & Handle_vars_f; @@ -1218,5 +1221,20 @@ void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority) wglb.Write_strings = flags & BackQuote_String_f; /* protect slots for portray */ writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt); + if (flags & New_Line_f) { + if (flags & Fullstop_f) { + wrputc('.', wglb.stream); + wrputc('\n', wglb.stream); + } else { + wrputc('\n', wglb.stream); + } + } else { + if (flags & Fullstop_f) { + wrputc('.', wglb.stream); + wrputc(' ', wglb.stream); + } else { + wrputc(' ', wglb.stream); + } + } restore_from_write(&rwt, &wglb); } diff --git a/C/yap-args.c b/C/yap-args.c index e5a421bb3..89f5bffe3 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -19,12 +19,14 @@ #include "config.h" #include "Yap.h" #include "YapHeap.h" +#if HAVE_UNISTD_H +#include +#endif #if HAVE_STDINT_H #include #endif #include #include -#include "pl-shared.h" #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef HAVE_UNISTD_H #undef HAVE_UNISTD_H @@ -150,7 +152,7 @@ dump_runtime_variables(void) fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR); fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS); fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT); - fprintf(stdout,"YAP_VERSION=%d\n",YAP_NUMERIC_VERSION); + fprintf(stdout,"YAP_VERSION=%s\n",YAP_NUMERIC_VERSION); exit(0); return 1; } @@ -202,8 +204,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) iap->ErrorCause = NULL; iap->QuietMode = FALSE; - GD->cmdline.os_argc = argc; - GD->cmdline.os_argv = argv; while (--argc > 0) { p = *++argv; @@ -548,8 +548,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) iap->SavedState = p; } } - GD->cmdline.appl_argc = argc; - GD->cmdline.appl_argv = argv; //___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode); return BootMode; } diff --git a/C/ypstdio.c b/C/ypstdio.c deleted file mode 100644 index 0a70eb116..000000000 --- a/C/ypstdio.c +++ /dev/null @@ -1,307 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog %W% %G% -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: io.h * -* Last rev: 19/2/88 * -* mods: * -* comments: simple replacement for stdio * -* * -*************************************************************************/ - -#include "Yap.h" - -#ifdef YAP_STDIO - -#include - -#if HAVE_FCNTL_H -#include -#endif -#if HAVE_UNISTD_H -#include -#endif -#if WINDOWS -#include -#endif -#include - -#ifndef O_BINARY -#define O_BINARY 0 -#endif - -YP_FILE yp_iob[YP_MAX_FILES]; - -static void -clear_iob(YP_FILE *f) -{ - f->flags = f->cnt = 0; - f->buflen = 1; - f->ptr = f->base = (char *) &f->buf; - f->close = close; - f->read = read; - f->write = write; -} - -void -init_yp_stdio() -{ - int i; - /* mark all descriptors as free */ - for(i=0; iflags & _YP_IO_READ)||(f->flags & (_YP_IO_ERR|_YP_IO_EOF))) - return -1; - if ((f->cnt = (f->read)(f->fd,f->base,f->buflen)) < 0) { - f->flags |= _YP_IO_ERR; - return -1; - } - if (f->cnt==0) { - f->flags |= _YP_IO_EOF; - return -1; - } - f->ptr = f->base; - return YP_getc(f); -} - - -int -YP_flushbuf(int c,YP_FILE *f) -{ - if(!(f->flags & _YP_IO_WRITE)||(f->flags & _YP_IO_ERR)) return -1; - *(f->ptr++) = c; - { - int cnt = f->ptr-f->base; - int r = (f->write)(f->fd,f->base,cnt); - f->ptr = f->base; - if (r!=cnt) { - f->flags |= _YP_IO_ERR; - return -1; - } - f->ptr = f->base; - f->cnt = f->buflen-1; - } - return c; -} - -int -YP_fflush(YP_FILE *f) -{ - if(!(f->flags & _YP_IO_WRITE)||(f->flags & _YP_IO_ERR)) return -1; - if (f->ptr==f->base) return 0; - { - int cnt = f->ptr-f->base; - int r = (f->write)(f->fd,f->base,cnt); - f->ptr = f->base; - if (r!=cnt) { - f->flags |= _YP_IO_ERR; - return -1; - } - f->ptr = f->base; - f->cnt = f->buflen-1; - } - return 0; -} - -int -YP_fputs(char *s, YP_FILE *f) -{ - int count = 0; - while (*s) { - if (putc(*s++,f)<0) return -1; - ++count; - } - return count; -} - -int -YP_puts(char *s) -{ - return YP_fputs(s,YP_stdout); -} - - -char * -YP_fgets(char *s, int n, YP_FILE *f) -{ - char *p=s; - if (f->flags & _YP_IO_ERR) return 0; - while(--n) { - int ch = YP_getc(f); - if (ch<0) return 0; - *p++ = ch; - if (ch=='\n') break; - } - *p = 0; - return s; -} - -char * -YP_gets(char *s) -{ - char *p=s; - while(1) { - int ch = YP_getchar(); - if (ch<0) return 0; - if (ch=='\n') break; - *p++ = ch; - } - *p = 0; - return s; -} - - -YP_FILE* -YP_fopen(char *path, char *mode) -{ - YP_FILE *f = 0; - int i, fd, flags, ch1, ch2; - for(i=3; ifd = fd; - f->flags = _YP_IO_FILE | (ch1=='r' ? _YP_IO_READ : _YP_IO_WRITE); - f->ptr = f->base; - /* todo: add buffers */ - f->cnt = 0; - f->close = close; - f->read = read; - f->write = write; - return f; -} - -int -YP_fclose(YP_FILE *f) -{ - if (f != &yp_iob[f->check]) return -1; - if (f->flags & _YP_IO_WRITE) { - YP_fflush(f); - } - (f->close)(f->fd); - /* todo: release buffers */ - clear_iob(f); - return 0; -} - - -#define MAXBSIZE 32768 - -int -YP_printf(char *format,...) -{ - va_list ap; - char *buf = (char *) alloca(MAXBSIZE); - int r; - - va_start(ap,format); - vsprintf(buf,format,ap); - r = YP_puts(buf); - - va_end(ap); - - return r; -} - - -int -YP_fprintf(YP_FILE *f, char *format,...) -{ - va_list ap; - char *buf = (char *) alloca(MAXBSIZE); - int r; - - va_start(ap,format); - vsprintf(buf,format,ap); - r = YP_fputs(buf,f); - - va_end(ap); - - return r; -} - -int -YP_fileno(YP_FILE *f) -{ - return f->fd; -} - -int -YP_clearerr(YP_FILE *f) -{ - f->flags &= ~ _YP_IO_ERR | _YP_IO_EOF; - return 0; -} - -int -YP_feof(YP_FILE *f) -{ - return f->flags & _YP_IO_EOF ? 1 : 0; -} - -int -YP_setbuf(YP_FILE *f, char *b) -{ - return 0; -} - -int -YP_fseek(YP_FILE *f, int offset, int whence) -{ - /* todo: implement fseek */ - return 0; -} - -int -YP_ftell(YP_FILE*f) -{ - return 0; -} - -#endif /* YAP_STDIO */ - diff --git a/CMakeLists.txt b/CMakeLists.txt index 1f71d9403..4a609dca6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,17 +4,20 @@ # system core # libraries -cmake_minimum_required(VERSION 2.8) -if (${CMAKE_SYSTEM_NAME} MATCHES "Darwin") - cmake_policy( SET CMP0042 NEW) - cmake_policy( NO_POLICY_SCOPE ) -endif() +cmake_minimum_required(VERSION 3.0) +# where we have most scripts +# set path to additional CMake modules +set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH}) + set(configurations Debug) +if(POLICY CMP0042) +cmake_policy(SET CMP0042 NEW) # Set MACOSX_RPATH=YES by default +endif() +if(POLICY CMP0042) cmake_policy(SET CMP0043 NEW) - -project(YAP C CXX) +endif() set(YAP_FOUND ON) @@ -45,8 +48,73 @@ site_name( YAP_SITE ) message(STATUS "Building YAP version ${YAP_VERSION}") -# set path to additional CMake modules -set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH}) +# +# Optional Components +# +include(CheckIncludeFile) +include(CheckIncludeFileCXX) +INCLUDE (CheckIncludeFiles) +include(CheckLibraryExists) +include(CheckSymbolExists) +include(CheckFunctionExists) +include(CheckIncludeFiles) +include(CheckFunctionExists) +include(CheckPrototypeExists) +include(CheckTypeSize) +include(CheckCXXSourceCompiles) +include(TestBigEndian) +include (CMakeDependentOption) +include (MacroOptionalAddSubdirectory) +include (MacroOptionalFindPackage) +include (MacroLogFeature) +include(GetGitRevisionDescription) + +# Test signal handler return type (mimics AC_TYPE_SIGNAL) +include(TestSignalType) #check if this is really needed as c89 defines this as void + +# Test standard headers (mimics AC_HEADER_STDC) +include(TestSTDC) + +set(bitness 32) +if(CMAKE_SIZEOF_VOID_P EQUAL 8) + set(bitness 64) +endif() + +get_git_head_revision(GIT_HEAD GIT_SHA1) +git_describe(GIT_DESCRIBE) + +if (${CMAKE_SYSTEM_NAME} MATCHES "Darwin") + cmake_policy( SET CMP0042 NEW) + #cmake_policy( NO_POLICY_SCOPE ) +endif() + + +## define system + +include (Sources) + + +add_library(libYap SHARED + ${ENGINE_SOURCES} + ${C_INTERFACE_SOURCES} + ${STATIC_SOURCES} + ${OPTYAP_SOURCES} + ${HEADERS} + $ + $ + ) + + + # Optional libraries that affect compilation + # + include (Config) + +set_target_properties(libYap + PROPERTIES VERSION ${YAP_FULL_VERSION} + SOVERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION} + OUTPUT_NAME Yap + ) + set(CMAKE_TOP_BINARY_DIR ${CMAKE_BINARY_DIR}) set(YAP_PL_SRCDIR ${CMAKE_SOURCE_DIR}/pl) @@ -69,10 +137,10 @@ set(YAP_ROOTDIR ${prefix}) # erootdir -> rootdir # bindir defined above # libdir defined above -set(YAP_LIB_DIR "${dlls}") -set(YAP_SHARE_DIR "${datarootdir}") -set(YAP_BIN_DIR "${bindir}") -set(YAP_INCLUDE_DIR "${includedir}") +set(YAP_LIBDIR "${dlls}") +set(YAP_SHAREDIR "${datarootdir}") +set(YAP_BINDIR "${bindir}") +set(YAP_INCLUDEDIR "${includedir}") set(YAP_ROOTDIR "${prefix}") set(YAP_YAPLIB libYap${CMAKE_SHARED_LIBRARY_SUFFIX}) @@ -83,20 +151,30 @@ string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT ) include_directories (H include os) include_directories (BEFORE ${CMAKE_BINARY_DIR}) -# Optional libraries that affect compilation -# -include (ConfigureChecks) -include (MacroOptionalAddSubdirectory) -include (MacroOptionalFindPackage) -include (MacroLogFeature) +# rpath stuff, hopefully it works + +# use, i.e. don't skip the full RPATH for the build tree +SET(CMAKE_SKIP_BUILD_RPATH FALSE) + +# when building, don't use the install RPATH already +# (but later on when installing) +SET(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) + +SET(CMAKE_INSTALL_RPATH "${dlls}:${libdir}") + +# add the automatically determined parts of the RPATH +# which point to directories outside the build tree to the install RPATH +SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) + + +# the RPATH to be used when installing, but only if it's not a system directory +LIST(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib" isSystemDir) +IF("${isSystemDir}" STREQUAL "-1") + SET(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib") +ENDIF("${isSystemDir}" STREQUAL "-1") + # -# Optional Components -# - -include (CMakeDependentOption) -include (CheckSymbolExists) - set ( YAP_MALLOC_T void *) set ( MIN_STACKSPACE 1024*SIZEOF_INT_P ) set ( MIN_HEAPSPACE 2*1024*SIZEOF_INT_P ) @@ -115,12 +193,13 @@ set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS DEPTH_LIMIT=1;COROU set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS _YAP_NOT_INSTALLED_=1;HAVE_CONFIG_H ) # Compilation model -set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS GNU_SOURCE=1;_XOPEN_SOURCE=700 ) +#set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS _XOPEN_SOURCE=700 ) #add_definitions( -Wall -Wstrict-prototypes -Wmissing-prototypes) # Model Specific -set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:DEBUG=1;LOW_LEVEL_TRACER=1> ) +#set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:DEBUG=1;LOW_LEVEL_TRACER=1> ) +set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS DEBUG=1;LOW_LEVEL_TRACER=1 ) #ensure cells are properly aligned in code set (ALIGN_LONGS 1) @@ -170,12 +249,23 @@ endif (HAVE_GCC) # set (BUILD_SHARED_LIBS ON) -option (YAP_SWI_IO ON) +#option (YAP_SWI_IO ON) -# -# include libtai package as an independent library -# -add_subdirectory (os/libtai) + +macro_optional_find_package (GMP ON) +macro_log_feature (GMP_FOUND "libgmp" + "GNU big integers and rationals" + "http://gmplib.org") +if (GMP_FOUND) + include_directories (${GMP_INCLUDE_DIR}) + + #add_executable(test ${SOURCES}) +# target_link_libraries(libYap ${GMP_LIBRARIES}) + #config.h needs this (TODO: change in code latter) + set (USE_GMP 1) + set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} ) +# set( CMAKE_REQUIRED_LIBRARIES ${GMP_LIBRARIES} ${CMAKE_REQUIRED_LIBRARIES} ) +endif (GMP_FOUND) option (YAP_TABLING "Support tabling" ON) if (YAP_TABLING) @@ -185,7 +275,6 @@ if (YAP_TABLING) #and it is used across several files outside OPTYap add_definitions (-DTABLING=1) include_directories (OPTYap) - add_subdirectory (OPTYap) endif(YAP_TABLING) option (YAP_EAM "enable EAM (Extended Andorra Model)" OFF) @@ -209,256 +298,11 @@ if (YAP_CALL_TRACER) set_directory_properties(PROPERTIES COMPILE_DEFINITIONS_DEBUG LOW_LEVEL_TRACER=1) endif (YAP_CALL_TRACER) +#set( CMAKE_REQUIRED_LIBRARIES ${READLINE_LIBS} ${CMAKE_REQUIRED_LIBRARIES} ) +#target_link_libraries(libYap ${READLINE_LIBS}) + option (YAP_THREADS - "support system threads" OFF) -#TODO: - -# -# Sources Section -# - -set(IOLIB_SOURCES - os/pl-buffer.c - os/pl-codelist.c - os/pl-ctype.c - os/pl-dtoa.c - os/pl-error.c - os/pl-file.c - os/pl-files.c - os/pl-fmt.c - os/pl-glob.c - os/pl-option.c - os/pl-nt.c - os/pl-os.c - os/pl-privitf.c - os/pl-prologflag.c - os/pl-read.c - os/pl-rl.c - os/pl-stream.c - os/pl-string.c - os/pl-table.c - os/pl-tai.c - os/pl-text.c - os/pl-utf8.c - os/pl-write.c - C/pl-yap.c - ) - -if (WIN32) - set(IOLIBS_SOURCES - ${IOLIBS_SOURCES} - os/windows/uxnt.c - ) -endif (WIN32) - -set (ABSMI_SOURCES - C/absmi.c - C/absmi_insts.h - C/fli_absmi_insts.h - C/or_absmi_insts.h - C/control_absmi_insts.h - C/index_absmi_insts.h - C/prim_absmi_insts.h - C/cp_absmi_insts.h - C/lu_absmi_insts.h - C/unify_absmi_insts.h - C/fail_absmi_insts.h - C/meta_absmi_insts.h - ) - -set (ENGINE_SOURCES - ${ABSMI_SOURCES} - C/agc.c - C/adtdefs.c - C/alloc.c - C/amasm.c - C/analyst.c - C/arrays.c - C/arith0.c - C/arith1.c - C/arith2.c - C/atomic.c - C/attvar.c - C/bignum.c - C/bb.c - C/cdmgr.c - C/cmppreds.c - C/compiler.c - C/computils.c - C/corout.c - C/cut_c.c - C/dbase.c - C/dlmalloc.c - C/errors.c - C/eval.c - C/exec.c - C/exo.c - C/exo_udi.c - C/globals.c - C/gmp_support.c - C/gprof.c - C/grow.c - C/heapgc.c - C/index.c - C/init.c - C/inlines.c - C/iopreds.c - C/depth_bound.c - C/mavar.c - C/modules.c - C/other.c - C/parser.c - C/qlyr.c - C/qlyw.c - C/range.c - C/save.c - C/scanner.c - C/signals.c - C/sort.c - C/stdpreds.c - C/sysbits.c - C/text.c - C/threads.c - C/tracer.c - C/unify.c - C/userpreds.c - C/utilpreds.c - C/yap-args.c - C/write.c - C/ypstdio.c - library/dialect/swi/fli/swi.c - library/dialect/swi/fli/blobs.c - C/udi.c - #packages/udi/rtree.c - #packages/udi/rtree_udi.c - - # ${IOLIB_SOURCES} - # MPI_SOURCES - ) - -set(C_INTERFACE_SOURCES - C/load_foreign.c - C/load_dl.c - C/load_dld.c - C/load_dyld.c - C/load_none.c - C/load_aout.c - C/load_aix.c - C/load_dll.c - C/load_shl.c - C/c_interface.c - C/clause_list.c - ) - -SET(OPTYAP_SOURCES - OPTYap/or.memory.c - OPTYap/opt.init.c - OPTYap/opt.preds.c - OPTYap/or.copy_engine.c - OPTYap/or.cow_engine.c - OPTYap/or.sba_engine.c - OPTYap/or.thread_engine.c - OPTYap/or.scheduler.c - OPTYap/or.cut.c - OPTYap/tab.tries.c - OPTYap/tab.completion.c - ) - - - -set(STATIC_SOURCES - #NOT INCLUDED FOR NOW - ) - -set(CONSOLE_SOURCES console/yap.c) - -#MPI STUFF -# library/mpi/mpi.c library/mpi/mpe.c -# library/lammpi/yap_mpi.c library/lammpi/hash.c library/lammpi/prologterms2c.c -# ) - -#WIN STUFF -# SET(PLCONS_SOURCES -# console/LGPL/pl-nt.c -# console/LGPL/pl-ntcon.c -# console/LGPL/pl-ntconsole.c -# console/LGPL/pl-ntmain.c -# ) - -## define system - -add_library(libYap SHARED - ${ENGINE_SOURCES} - ${IOLIB_SOURCES} - ${C_INTERFACE_SOURCES} - ${STATIC_SOURCES} - ${OPTYAP_SOURCES} - $ - ) - -target_link_libraries(libYap - m resolv stdc++ ) - -set_target_properties(libYap - PROPERTIES VERSION ${YAP_FULL_VERSION} - SOVERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION} - OUTPUT_NAME Yap - ) - -#TODO: - -#TODO: - -# -# Arch checks -# -#include(ConfigureChecks) -include (Config) - -macro_optional_find_package (GMP ON) -macro_log_feature (GMP_FOUND "libgmp" - "GNU Multiple Precision" - "http://gmplib.org") -if (GMP_FOUND) - include_directories (${GMP_INCLUDE_DIR}) - target_link_libraries(libYap ${GMP_LIBRARIES}) - #config.h needs this (TODO: change in code latter) - set (USE_GMP 1) - set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} ) - set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) -endif (GMP_FOUND) - -macro_optional_find_package (Readline ON) -macro_log_feature (READLINE_FOUND "libreadline" - "GNU Readline Library (or similar)" - "http://www.gnu.org/software/readline") -if (READLINE_FOUND) - include_directories (${READLINE_INCLUDE_DIR}) - target_link_libraries(libYap ${READLINE_LIBRARIES}) - set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${READLINE_INCLUDE_DIR} ) - set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) - - check_include_file( readline/readline.h HAVE_READLINE_READLINE_H ) - check_function_exists( add_history HAVE_ADD_HISTORY ) - check_function_exists( rl_begin_undo_group HAVE_RL_BEGIN_UNDO_GROUP) - check_function_exists( rl_clear_pending_input HAVE_RL_CLEAR_PENDING_INPUT) - check_function_exists( rl_discard_argument HAVE_RL_DISCARD_ARGUMENT) - check_function_exists( rl_filename_completion_function HAVE_RL_FILENAME_COMPLETION_FUNCTION) - check_function_exists( rl_free_line_state HAVE_RL_FREE_LINE_STATE ) - check_function_exists( rl_insert_close HAVE_RL_INSERT_CLOSE ) - check_function_exists( rl_reset_after_signal HAVE_RL_RESET_AFTER_SIGNAL ) - check_function_exists( rl_set_keyboard_input_timeout HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT ) - check_function_exists( rl_set_prompt HAVE_RL_SET_PROMPT) - check_symbol_exists( rl_catch_signals stdio.h;readline/readline.h HAVE_DECL_RL_CATCH_SIGNALS ) - check_symbol_exists( rl_completion_func_t stdio.h;readline/readline.h HAVE_DECL_RL_COMPLETION_FUNC_T ) - check_symbol_exists( rl_done stdio.h;readline/readline.h HAVE_DECL_RL_DONE ) - check_symbol_exists( rl_hook_func_t stdio.h;readline/readline.h HAVE_DECL_RL_HOOK_FUNC_T ) - check_symbol_exists( rl_event_hook stdio.h;readline/readline.h HAVE_DECL_RL_EVENT_HOOK ) - check_symbol_exists( rl_readline_state stdio.h;readline/readline.h HAVE_DECL_RL_READLINE_STATE ) -endif (READLINE_FOUND) - - -option (YAP_THREADS OFF) +"support system threads" OFF) macro_optional_find_package (Threads ON) macro_log_feature (THREADS_FOUND "Threads Support" "GNU Threads Library (or similar)" @@ -493,23 +337,41 @@ if (YAP_THREADS AND THREADS_FOUND) if (CMAKE_USE_PTHREADS_INIT) target_link_libraries(libYap pthread) set (HAVE_READLINE_READLINE_H 1) - set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${CMAKE_THREAD_LIBS_INIT} ) +# set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${CMAKE_THREAD_LIBS_INIT} ) check_function_exists( pthread_mutexattr_setkind_np HAVE_PTHREAD_MUTEXATTR_SETKIND_NP ) check_function_exists( pthread_mutexattr_settype HAVE_PTHREAD_MUTEXATTR_SETTYPE ) check_function_exists( pthread_setconcurrency HAVE_PTHREAD_SETCONCURRENCY ) endif (CMAKE_USE_PTHREADS_INIT) + add_definitions (-DTHREADS=1) + set (MAX_WORKERS 64) + set (MAX_THREADS 1024) # # Please note that the compiler flag can only be used with the imported # target. Use of both the imported target as well as this switch is highly # recommended for new code. + else() +set (MAX_WORKERS 1) + set (MAX_THREADS 1) endif (YAP_THREADS AND THREADS_FOUND) cmake_dependent_option (YAP_PTHREADLOCKING "use pthread locking primitives for internal locking" ON "NOT YAP_THREADS; NOT THREADS_FOUND" OFF) - add_subdirectory (pl) - add_subdirectory (CXX) +# +# include OS and I/o stuff +# +# convenience libraries +add_subdirectory (os) +add_subdirectory (OPTYap) + +#bootstrap and saved state +add_subdirectory (pl) + +#C++ interface +add_subdirectory (CXX) + +#major libraries ADD_SUBDIRECTORY(library) ADD_SUBDIRECTORY(swi/library) # ADD_SUBDIRECTORY(os) @@ -531,16 +393,12 @@ macro_optional_add_subdirectory(library/lammpi) macro_optional_add_subdirectory (packages/gecode) -macro_optional_add_subdirectory (packages/cuda) - macro_optional_add_subdirectory (packages/myddas) macro_optional_add_subdirectory (packages/real) macro_optional_add_subdirectory (packages/python) -macro_optional_add_subdirectory (packages/raptor) - #add_subdirectory (packages/archive) macro_optional_add_subdirectory (packages/jpl) @@ -549,6 +407,17 @@ macro_optional_add_subdirectory (packages/swig) macro_optional_add_subdirectory (packages/bdd) +macro_optional_add_subdirectory (packages/CLPBN) + +macro_optional_add_subdirectory (packages/CLPBN/horus) + +macro_optional_add_subdirectory (packages/Problog) + +macro_optional_add_subdirectory (packages/raptor) + +#macro_optional_add_subdirectory (packages/cuda) + + #add_subdirectory (packages/prosqlite) #add_subdirectory (packages/zlib) @@ -605,17 +474,6 @@ option(YAP_CONDOR # option (DLCOMPAT # "use dlcompat library for dynamic loading on Mac OS X" OFF) -# find_package(R) -# if (R_FOUND) -# MESSAGE(STATUS "RFOUND ${R_LIBRARIES} ${R_DEFINITIONS} ${R_EXECUTABLE}") -# endif (R_FOUND) -#TODO: check REAL_TARGET REAL#TODO: Switch to feature -# OPTION(CPLINT -# "enable the cplint library using the CUDD library in DIR/lib" OFF) -# OPTION(yap_cv_clpbn_bp -# "enable belief propagation solver in CLPBN." OFF) -# OPTION( - # SHARED PACKAGES with SWI # swi packages have both Makefile.in which we will use and # Makefile.mak, we will use the later to identify this packages @@ -628,17 +486,11 @@ option(YAP_CONDOR #configure_file(packages/Dialect.defs.cmake packages/Dialect.defs) -# -# include subdirectories configuration -## after we have all functionality in -# - -configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake" - "${PROJECT_BINARY_DIR}/config.h" ) -configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake" - "${PROJECT_BINARY_DIR}/YapConfig.h" ) -configure_file ("${PROJECT_SOURCE_DIR}/YapTermConfig.h.cmake" - "${PROJECT_BINARY_DIR}/YapTermConfig.h" ) +target_link_libraries(libYap + ${GMP_LIBRARIES} + ${READLINE_LIBS} + ${CMAKE_DL_LIBS} + ) add_executable (yap-bin ${CONSOLE_SOURCES}) @@ -663,6 +515,20 @@ endif (MPI_C_FOUND) add_custom_target (main ALL DEPENDS ${YAP_STARTUP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) +# +# include subdirectories configuration +## after we have all functionality in +# + +configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake" + "${PROJECT_BINARY_DIR}/config.h" ) +configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake" + "${PROJECT_BINARY_DIR}/YapConfig.h" ) +configure_file ("${PROJECT_SOURCE_DIR}/YapTermConfig.h.cmake" + "${PROJECT_BINARY_DIR}/YapTermConfig.h" ) + configure_file("${PROJECT_SOURCE_DIR}/GitSHA1.c.in" "${PROJECT_BINARY_DIR}/GitSHA1.c" @ONLY) + + install ( TARGETS yap-bin libYap diff --git a/H/Atoms.h b/H/Atoms.h index cedf23aa3..e760daf51 100644 --- a/H/Atoms.h +++ b/H/Atoms.h @@ -94,8 +94,6 @@ typedef struct ExtraAtomEntryStruct # define EndOfPAEntr(P) ( Addr(P) == NIL ) #endif -#define AtomName(at) RepAtom(at)->StrOfAE - /* ********************** Properties **********************************/ @@ -143,4 +141,5 @@ typedef struct FunctorEntryStruct typedef FunctorEntry *Functor; + #endif /* ATOMS_H */ diff --git a/H/absmi.h b/H/absmi.h index 77a0416c4..f56324845 100755 --- a/H/absmi.h +++ b/H/absmi.h @@ -180,7 +180,7 @@ register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */ #ifdef LOW_LEVEL_TRACER #include "tracer.h" #endif -#include "pl-shared.h" + #ifdef DEBUG /********************************************************************** * * @@ -222,7 +222,8 @@ restore_absmi_regs(REGSTORE * old_regs) #else Yap_regp = old_regs; #endif - LOCAL_PL_local_data_p->reg_cache = old_regs; + // not neeeded any more + // LOCAL_PL_local_data_p->reg_cache = old_regs; } #endif /* PUSH_REGS */ diff --git a/H/alloc.h b/H/alloc.h index 88c405e73..fdfe16776 100644 --- a/H/alloc.h +++ b/H/alloc.h @@ -94,7 +94,7 @@ typedef struct FREEB { #define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size] /* Operating system and architecture dependent page size */ -extern int Yap_page_size; +extern size_t Yap_page_size; void Yap_InitHeap(void *); UInt Yap_ExtendWorkSpaceThroughHole(UInt); diff --git a/H/arrays.h b/H/arrays.h index 185ecbcc5..ee172a7e6 100644 --- a/H/arrays.h +++ b/H/arrays.h @@ -18,6 +18,20 @@ static char SccsId[]="%W% %G%"; #endif +/* first, the valid types */ +typedef enum +{ + array_of_ints, + array_of_chars, + array_of_uchars, + array_of_doubles, + array_of_ptrs, + array_of_atoms, + array_of_dbrefs, + array_of_nb_terms, + array_of_terms +} static_array_types; + /* This should never be followed by GC */ typedef struct array_access_struct { Functor array_access_func; /* identifier of array access */ @@ -25,3 +39,9 @@ typedef struct array_access_struct { Term indx; /* index in array, for now keep it as an integer! */ } array_access; + +struct static_array_entry * +Yap_StaticVector( Atom Name, size_t size, static_array_types props ); + +struct static_array_entry * +Yap_StaticArray(Atom na, size_t dim, static_array_types type, CODEADDR start_addr, struct static_array_entry *p); diff --git a/H/eval.h b/H/eval.h index 8f86b8056..c6472c2b7 100644 --- a/H/eval.h +++ b/H/eval.h @@ -410,7 +410,7 @@ Yap_FoundArithError__(USES_REGS1) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) return LOCAL_Error_TYPE; - if (yap_flags[FLOATING_POINT_EXCEPTION_MODE_FLAG]) // test support for exception + if (trueGlobalPrologFlag( ARITHMETIC_EXCEPTIONS_FLAG ) ) // test support for exception return Yap_MathException(); return YAP_NO_ERROR; } diff --git a/H/iopreds.h b/H/iopreds.h deleted file mode 100644 index 6b842d5c7..000000000 --- a/H/iopreds.h +++ /dev/null @@ -1,57 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: iopreds.c * -* Last rev: 5/2/88 * -* mods: * -* comments: Input/Output C implemented predicates * -* * -*************************************************************************/ -#ifdef SCCS -static char SccsId[] = "%W% %G%"; -#endif - -/* - * This file defines main data-structure for stream management, - * - */ - -#if defined(_MSC_VER) || defined(__MINGW32__) - -#include - -#endif - -#include - -#if HAVE_LIBREADLINE - -#if defined(_MSC_VER) || defined(__MINGW32__) - -FILE *rl_instream, *rl_outstream; -#endif - -#endif - -#define MEM_BUF_CODE 0 -#define MEM_BUF_MALLOC 1 - -typedef int (*GetsFunc)(int, UInt, char *); - -#define StdInStream 0 -#define StdOutStream 1 -#define StdErrStream 2 - -#define ALIASES_BLOCK_SIZE 8 - -void Yap_InitStdStreams(void); -Term Yap_StreamPosition(struct io_stream *); -void Yap_InitPlIO(void); - diff --git a/H/yapio.h b/H/yapio.h deleted file mode 100644 index 35c7a13a5..000000000 --- a/H/yapio.h +++ /dev/null @@ -1,323 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog %W% %G% -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2003 * -* * -************************************************************************** -* * -* File: yapio.h * -* Last rev: 22/1/03 * -* mods: * -* comments: Input/Output information * -* * -*************************************************************************/ - - -#ifdef SIMICS -#undef HAVE_LIBREADLINE -#endif - -#include -#include - -#include "SWI-Stream.h" - -#ifndef YAP_STDIO - -#define YP_printf printf -#define YP_putchar putchar -#define YP_getc getc -#define YP_fgetc fgetc -#define YP_getchar getchar -#define YP_fgets fgets -#define YP_clearerr clearerr -#define YP_feof feof -#define YP_ferror ferror -#if defined(_MSC_VER) || defined(__MINGW32__) -#define YP_fileno _fileno -#else -#define YP_fileno fileno -#endif -#define YP_fopen fopen -#define YP_fclose fclose -#define YP_ftell ftell -#define YP_fseek fseek -#define YP_setbuf setbuf -#define YP_fputs fputs -#define YP_ungetc ungetc -#define YP_fdopen fdopen -#define init_yp_stdio() - -#define YP_FILE FILE - -int YP_putc(int, int); - -#else - -#ifdef putc -#undef putc -#undef getc -#undef putchar -#undef getchar -#undef stdin -#undef stdout -#undef stderr -#endif - -#define printf ERR_printf -#define fprintf ERR_fprintf -#define putchar ERR_putchar -#define putc ERR_putc -#define getc ERR_getc -#define fgetc ERR_fgetc -#define getchar ERR_getchar -#define fgets ERR_fgets -#define clearerr ERR_clearerr -#define feof ERR_feof -#define ferror ERR_ferror -#define fileno ERR_fileno -#define fopen ERR_fopen -#define fclose ERR_fclose -#define fflush ERR_fflush - -/* flags for files in IOSTREAM struct */ -#define _YP_IO_WRITE 1 -#define _YP_IO_READ 2 - -#define _YP_IO_ERR 0x04 -#define _YP_IO_EOF 0x08 - -#define _YP_IO_FILE 0x10 -#define _YP_IO_SOCK 0x20 - - -typedef struct IOSTREAM { - int check; - int fd; /* file descriptor */ - int flags; - int cnt; - int buflen; - char buf[2]; - char *ptr; - char *base; - int (*close)(int fd); /* close file */ - int (*read)(int fd, char *b, int n); /* read bytes */ - int (*write)(int fd, char *b, int n);/* write bytes */ -} YP_FILE; - -#define YP_stdin &yp_iob[0] -#define YP_stdout &yp_iob[1] -#define YP_stderr &yp_iob[2] - - - -#define YP_getc(f) (--(f)->cnt < 0 ? YP_fillbuf(f) : *((unsigned char *) ((f)->ptr++))) -#define YP_fgetc(f) YP_fgetc(f) -#define YP_putc(c,f) (--(f)->cnt < 0 ? YP_flushbuf(c,f) : (unsigned char) (*(f)->ptr++ = (char) c)) -#define YP_putchar(cc) YP_putc(cc,YP_stdout) -#define YP_getchar() YP_getc(YP_stdin) - -int YP_fillbuf(YP_FILE *f); -int YP_flushbuf(int c, YP_FILE *f); - -int YP_printf(char *, ...); -int YP_fprintf(YP_FILE *, char *, ...); -char* YP_fgets(char *, int, YP_FILE *); -char* YP_gets(char *); -YP_FILE *YP_fopen(char *, char *); -int YP_fclose(YP_FILE *); -int YP_fileno(YP_FILE *); -int YP_fflush(YP_FILE *); -int YP_feof(YP_FILE *); -int YP_ftell(YP_FILE *); -int YP_fseek(YP_FILE *, int, int); -int YP_clearerr(YP_FILE *); -void init_yp_stdio(void); -int YP_fputs(char *s, YP_FILE *f); -int YP_puts(char *s); -int YP_setbuf(YP_FILE *f, char *buf); - - -#define YP_MAX_FILES 40 - -extern YP_FILE yp_iob[YP_MAX_FILES]; - -#endif /* YAP_STDIO */ - -typedef YP_FILE *YP_File; - - -#ifndef _PL_WRITE_ - -/* Character types for tokenizer and write.c */ - -#define UC 1 /* Upper case */ -#define UL 2 /* Underline */ -#define LC 3 /* Lower case */ -#define NU 4 /* digit */ -#define QT 5 /* single quote */ -#define DC 6 /* double quote */ -#define SY 7 /* Symbol character */ -#define SL 8 /* Solo character */ -#define BK 9 /* Brackets & friends */ -#define BS 10 /* Blank */ -#define EF 11 /* End of File marker */ -#define CC 12 /* comment char % */ - -#define EOFCHAR EOF - -#endif - -/* info on aliases */ -typedef struct AliasDescS { - Atom name; - int alias_stream; -} * AliasDesc; - -/************ SWI compatible support for different encodings ************/ - - -#define MAX_ISO_LATIN1 255 - -/****************** character definition table **************************/ - -#define NUMBER_OF_CHARS 256 -extern char *Yap_chtype; - -#include "inline-only.h" -INLINE_ONLY EXTERN inline int chtype(Int); -int Yap_wide_chtype(Int); - -INLINE_ONLY EXTERN inline int -chtype(Int ch) -{ - if (ch < NUMBER_OF_CHARS) - return Yap_chtype[ch]; - return Yap_wide_chtype(ch); -} - - -/* parser stack, used to be AuxSp, now is ASP */ -#define ParserAuxSp LOCAL_ScannerStack - -/* routines in parser.c */ -VarEntry *Yap_LookupVar(char *); -Term Yap_VarNames(VarEntry *,Term); -Term Yap_Variables(VarEntry *,Term); -Term Yap_Singletons(VarEntry *,Term); - -/* routines in scanner.c */ -TokEntry *Yap_tokenizer(struct io_stream *, int, Term *, void *rd); -void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term); -Term Yap_scan_num(struct io_stream *); -char *Yap_AllocScannerMemory(unsigned int); - -/* routines in iopreds.c */ -FILE *Yap_FileDescriptorFromStream(Term); -Int Yap_FirstLineInParse(void); -int Yap_CheckIOStream(Term, char *); -#if defined(YAPOR) || defined(THREADS) -void Yap_LockStream(struct io_stream *); -void Yap_UnLockStream(struct io_stream *); -#else -#define Yap_LockStream(X) -#define Yap_UnLockStream(X) -#endif -Int Yap_GetStreamFd(int); -void Yap_CloseStreams(int); -void Yap_FlushStreams(void); -void Yap_CloseStream(int); -int Yap_PlGetchar(void); -int Yap_PlGetWchar(void); -int Yap_PlFGetchar(void); -int Yap_GetCharForSIGINT(void); -Int Yap_StreamToFileNo(Term); -Term Yap_OpenStream(FILE *,char *,Term,int); -char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags); -char *Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags); -int Yap_GetFreeStreamD(void); -int Yap_GetFreeStreamDForReading(void); - -Term Yap_WStringToList(wchar_t *); -Term Yap_WStringToListOfAtoms(wchar_t *); -Atom Yap_LookupWideAtom( const wchar_t * ); - -#define YAP_INPUT_STREAM 0x01 -#define YAP_OUTPUT_STREAM 0x02 -#define YAP_APPEND_STREAM 0x04 -#define YAP_PIPE_STREAM 0x08 -#define YAP_TTY_STREAM 0x10 -#define YAP_POPEN_STREAM 0x20 -#define YAP_BINARY_STREAM 0x40 -#define YAP_SEEKABLE_STREAM 0x80 - - -#define Quote_illegal_f 0x01 -#define Ignore_ops_f 0x02 -#define Handle_vars_f 0x04 -#define Use_portray_f 0x08 -#define To_heap_f 0x10 -#define Unfold_cyclics_f 0x20 -#define Use_SWI_Stream_f 0x40 -#define BackQuote_String_f 0x80 -#define AttVar_None_f 0x100 -#define AttVar_Dots_f 0x200 -#define AttVar_Portray_f 0x400 -#define Blob_Portray_f 0x800 - - - -/* grow.c */ -int Yap_growheap_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); -int Yap_growstack_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); -int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); - - - -#ifdef HAVE_ERRNO_H -#include -#else -extern int errno; -#endif - -INLINE_ONLY EXTERN UInt inline HashFunction(unsigned char *); -INLINE_ONLY EXTERN UInt inline WideHashFunction(wchar_t *); - -INLINE_ONLY EXTERN inline UInt -HashFunction(unsigned char *CHP) -{ - /* djb2 */ - UInt hash = 5381; - UInt c; - - while ((c = *CHP++) != '\0') { - /* hash = ((hash << 5) + hash) + c; hash * 33 + c */ - hash = hash * 33 ^ c; - } - return hash; - /* - UInt OUT=0, i = 1; - while(*CHP != '\0') { OUT += (UInt)(*CHP++); } - return OUT; - */ -} - -INLINE_ONLY EXTERN UInt inline -WideHashFunction(wchar_t *CHP) -{ - UInt hash = 5381; - UInt c; - - while ((c = *CHP++) != '\0') { - hash = hash * 33 ^ c; - } - return hash; -} - -#define FAIL_ON_PARSER_ERROR 0 -#define QUIET_ON_PARSER_ERROR 1 -#define CONTINUE_ON_PARSER_ERROR 2 -#define EXCEPTION_ON_PARSER_ERROR 3 diff --git a/Makefile.in b/Makefile.in index 501047122..02630b031 100755 --- a/Makefile.in +++ b/Makefile.in @@ -145,20 +145,10 @@ INTERFACE_HEADERS = \ os/pl-thread.h \ os/SWI-Stream.h -IOLIB_HEADERS=os/pl-buffer.h \ - os/pl-ctype.h \ - H/pl-codelist.h \ - os/pl-dtoa.h \ - os/dtoa.c \ - H/pl-incl.h \ - H/pl-global.h \ - os/pl-option.h \ - os/pl-os.h \ - os/pl-privitf.h \ - os/pl-table.h \ - os/pl-text.h \ - os/pl-utf8.h \ - H/pl-yap.h @WINDOWS@ os/windows/dirent.h os/windows/utf8.h os/windows/utf8.c os/windows/uxnt.h os/windows/popen.c +IOLIB_HEADERS= \ + os/iopreds.h \ + os/fmemopen.c\ + os/yapio.h HEADERS = \ H/Atoms.h \ @@ -175,6 +165,7 @@ HEADERS = \ H/arrays.h \ H/arith2.h \ H/attvar.h \ + H/blobs.h \ H/clause.h \ H/compile.h \ H/corout.h \ @@ -192,7 +183,6 @@ HEADERS = \ H/ilocals.h \ H/index.h \ H/inline-only.h \ - H/iopreds.h \ H/iswiatoms.h \ H/qly.h \ H/rclause.h \ @@ -203,7 +193,6 @@ HEADERS = \ H/threads.h \ H/tracer.h \ H/trim_trail.h \ - H/yapio.h \ H/YapSignals.h \ H/YapText.h \ H/cut_c.h \ @@ -225,37 +214,35 @@ HEADERS = \ JIT/HPP/JIT_Compiler.hpp \ JIT/HPP/jit_predicates.hpp -IOLIB_SOURCES=os/pl-buffer.c os/pl-ctype.c \ - os/pl-codelist.c \ - os/pl-dtoa.c \ - os/pl-error.c \ - os/pl-file.c \ - os/pl-files.c \ - os/pl-fmt.c \ - os/pl-locale.h \ - os/pl-glob.c \ - os/pl-option.c \ - os/pl-os.c \ - os/pl-prologflag.c \ - os/pl-privitf.c \ - os/pl-read.c \ - os/pl-rl.c \ - os/pl-stream.c os/pl-string.c \ - os/pl-table.c \ - os/pl-tai.c \ - os/pl-text.c \ - os/pl-version.c \ - os/pl-write.c \ - C/pl-yap.c @WINDOWS@os/windows/uxnt.c +IOLIB_SOURCES= os/charsio.c \ + os/chartypes.c\ + os/console.c\ + os/files.c\ + os/fmemopen.c\ + os/format.c\ + os/iopreds.c\ + os/mem.c\ + os/pipes.c\ + os/readline.c\ + os/readterm.c\ + os/readutil.c\ + os/sockets.c\ + os/streams.c\ + os/sysbits.c\ + os/writeterm.c\ + os/ypsocks.c\ + os/ypstdio.c + C_SOURCES= \ - $(IOLIB_SOURCES) \ + #$(IOLIB_SOURCES) \ C/absmi.c C/adtdefs.c \ C/agc.c C/alloc.c \ + C/args.c \ C/amasm.c C/analyst.c \ C/arith0.c C/arith1.c C/arith2.c \ C/atomic.c \ - C/arrays.c \ + C/arrays.c \C/blobs.c \ C/attvar.c C/bb.c \ C/bignum.c \ C/c_interface.c C/cdmgr.c C/cmppreds.c \ @@ -266,6 +253,7 @@ C_SOURCES= \ C/eval.c C/exec.c \ C/exo.c \ C/exo_udi.c \ + C/flags.c \ C/globals.c C/gmp_support.c \ C/gprof.c C/grow.c \ C/heapgc.c C/index.c \ @@ -286,6 +274,7 @@ C_SOURCES= \ C/threads.c \ C/tracer.c C/unify.c C/userpreds.c \ C/udi.c \ + C/utf8.c\ C/utilpreds.c C/write.c console/yap.c \ C/yap-args.c \ C/ypstdio.c \ @@ -300,7 +289,7 @@ C_SOURCES= \ OPTYap/tab.tries.c OPTYap/tab.completion.c \ C/cut_c.c \ library/dialect/swi/fli/swi.c \ - library/dialect/swi/fli/blobs.c \ + C/blobs.c \ # library/mpi/mpi.c library/mpi/mpe.c \ # library/lammpi/yap_mpi.c library/lamm1pi/hash.c library/lammpi/prologterms2c.c @@ -374,26 +363,35 @@ SWI_LIB_SOURCES= \ YAPDOCS=docs/yap.tex docs/chr.tex \ docs/clpr.tex docs/swi.tex -IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o \ - pl-file.o pl-files.o pl-fmt.o \ - pl-glob.o pl-locale.o pl-option.o \ - pl-nt.o \ - pl-os.o pl-privitf.o \ - pl-prologflag.o \ - pl-read.o \ - pl-rl.o \ - pl-stream.o pl-string.o pl-table.o \ - pl-tai.o pl-text.o pl-utf8.o \ - pl-version.o pl-write.o \ - pl-yap.o @WINDOWS@ uxnt.o +IOLIB_OBJECTS=\ + os/charsio.o \ + os/chartypes.o\ + os/console.o\ + os/files.o\ + os/fmemopen.o\ + os/format.o\ + os/iopreds.o\ + os/mem.o\ + os/pipes.o\ + os/readline.o\ + os/readterm.o\ + os/readutil.o\ + os/sockets.o\ + os/streams.o\ + os/sysbits.o\ + os/writeterm.o\ + os/ypsocks.o\ + os/ypstdio.o ENGINE_OBJECTS = \ agc.o absmi.o adtdefs.o alloc.o amasm.o analyst.o arrays.o \ + args.o \ arith0.o arith1.o arith2.o atomic.o attvar.o \ bignum.o bb.o \ cdmgr.o cmppreds.o compiler.o computils.o \ corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \ - exec.o exo.o exo_udi.o globals.o gmp_support.o gprof.o grow.o \ + exec.o exo.o exo_udi.o flags.o \ + globals.o gmp_support.o gprof.o grow.o \ heapgc.o index.o init.o inlines.o \ iopreds.o depth_bound.o mavar.o \ modules.o other.o \ @@ -401,9 +399,10 @@ ENGINE_OBJECTS = \ save.o scanner.o signals.o text.o sort.o stdpreds.o \ sysbits.o threads.o tracer.o \ udi.o\ + utf8.o\ unify.o userpreds.o utilpreds.o \ yap-args.o write.o \ - blobs.o swi.o ypstdio.o \ + blobs.o library/dialect/swi/fli/swi.o library/dialect/swi/fli/blobs.o ypstdio.o \ $(IOLIB_OBJECTS) JIT_OBJECTS = \ @@ -428,6 +427,7 @@ MYDDAS_ALL_OBJECTS = \ MYDDAS_OBJECTS = @OBJECTS_MYDDAS@ +# not being compiled. LIBTAI_OBJECTS = \ tai_add.o tai_now.o tai_pack.o \ tai_sub.o tai_unpack.o taia_add.o taia_approx.o \ @@ -458,7 +458,7 @@ STATIC_OBJECTS = \ LIB_OBJECTS = $(ENGINE_OBJECTS) \ $(C_INTERFACE_OBJECTS) $(OR_OBJECTS) \ $(BEAM_OBJECTS) $(STATIC_OBJECTS) \ - $(LIBTAI_OBJECTS) $(JIT_OBJECTS) \ + $(JIT_OBJECTS) \ $(MYDDAS_OBJECTS) OBJECTS = yap.o yapi.o $(LIB_OBJECTS) @@ -474,7 +474,7 @@ all: startup.yss windowsi windowsi: @WINDOWS@ yap-win@EXEC_SUFFIX@ -Makefile: Makefile.in +Makefile: $(srcdir)/Makefile.in H/Yap.h: config.h YapTermConfig.h \ H/YapTags.h \ @@ -502,6 +502,9 @@ udi.o: C/udi.c config.h save.o: C/save.c $(CC) -c $(C_INTERF_FLAGS) -DYAPSTARTUP=\"$(YAPSTARTUP)\" $< -o $@ +library/dialect/swi/fli/%.o: library/dialect/swi/fli/%.c library/dialect/swi/fli/swi.h include/SWI-Prolog.h library/dialect/swi/os/SWI-Stream.h config.h + $(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/library/dialect/swi/fli -I$(srcdir)/library/dialect/swi/os $< -o $@ + %.o: C/%.c config.h $(CC) -c $(CFLAGS) $< -o $@ @@ -526,9 +529,6 @@ yap_random.o: library/random/yap_random.c config.h %.o: library/regex/%.c @NO_BUILTIN_REGEXP@ library/regex/regex2.h library/regex/engine.c config.h $(CC) -c $(CFLAGS) -I$(srcdir)/include -Ilibrary/regex $< -o $@ -%.o: library/dialect/swi/fli/%.c library/dialect/swi/fli/swi.h include/SWI-Prolog.h os/SWI-Stream.h config.h - $(CC) -c $(CFLAGS) -I$(srcdir)/include -Ilibrary/dialect/swi/fli $< -o $@ - %.o: os/%.c config.h $(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -Ios @EXTRA_INCLUDES_FOR_WIN32@ $< -o $@ diff --git a/OPTYap/locks_pthread.h b/OPTYap/locks_pthread.h index 355d125f1..2414dd069 100755 --- a/OPTYap/locks_pthread.h +++ b/OPTYap/locks_pthread.h @@ -15,27 +15,26 @@ ** Atomic locks for PTHREADS ** ************************************************************************/ -#ifndef LOCK_PTHREAD_H +#ifndef LOCK_PTHREAD_H0 #define LOCK_PTHREAD_H 1 #include //#define DEBUG_PE_LOCKS 1 -//#define DEBUG_LOCKS +#define DEBUG_LOCKS 1 #include int Yap_ThreadID( void ); -extern FILE *debugf; +#define debugf stdout -#define INIT_LOCK(LOCK_VAR) pthread_mutex_init(&(LOCK_VAR), NULL) +#define INIT_LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_init(&(LOCK_VAR), NULL) ) #define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR)) #define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR)) #if DEBUG_LOCKS extern int debug_locks; -#define LOCK(LOCK_VAR) (void)(fprintf(debugf,"[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(), \ - __BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) ) +#define LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) ) #define UNLOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: UNLOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_unlock(&(LOCK_VAR)) ) #else #define LOCK(LOCK_VAR) pthread_mutex_lock(&(LOCK_VAR)) diff --git a/OPTYap/opt.macros.h b/OPTYap/opt.macros.h index 9d3b0b9cf..93a415bd7 100644 --- a/OPTYap/opt.macros.h +++ b/OPTYap/opt.macros.h @@ -15,7 +15,7 @@ ** Memory management ** ************************************************************************/ -extern int Yap_page_size; +extern size_t Yap_page_size; #ifdef USE_PAGES_MALLOC #include @@ -513,8 +513,8 @@ extern int Yap_page_size; ** Debug macros ** ************************************************************************/ -#define INFORMATION_MESSAGE(MESSAGE,ARGS...) \ - Sfprintf(Serror, "[ " MESSAGE " ]\n", ##ARGS) +#define INFORMATION_MESSAGE(MESSAGE, ...) \ + fprintf( stderr, "[ " MESSAGE " ]\n", __VA_ARGS__) #ifdef YAPOR #define ERROR_MESSAGE(MESSAGE) \ @@ -551,6 +551,6 @@ extern int Yap_page_size; #define INFO_THREADS_MAIN_THREAD(MESSAGE, ARGS...) \ Sfprintf(Serror, "[ " MESSAGE " ]\n", ##ARGS) #else -#define INFO_THREADS(MESG, ARGS...) -#define INFO_THREADS_MAIN_THREAD(MESSAGE, ARGS...) +#define INFO_THREADS(MESG, ...) +#define INFO_THREADS_MAIN_THREAD(MESSAGE, ...) #endif /* OUTPUT_THREADS_TABLING */ diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 9fc6e820d..51b534656 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -32,6 +32,7 @@ #ifdef TABLING #include "tab.macros.h" #endif /* TABLING */ +#include "iopreds.h" #ifdef TABLING static Int p_freeze_choice_point( USES_REGS1 ); @@ -70,32 +71,32 @@ static inline realtime current_time(void); #endif /* YAPOR */ #ifdef TABLING -static inline struct page_statistics show_statistics_table_entries(IOSTREAM *out); +static inline struct page_statistics show_statistics_table_entries(FILE *out); #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) -static inline struct page_statistics show_statistics_subgoal_entries(IOSTREAM *out); +static inline struct page_statistics show_statistics_subgoal_entries(FILE *out); #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ -static inline struct page_statistics show_statistics_subgoal_frames(IOSTREAM *out); -static inline struct page_statistics show_statistics_dependency_frames(IOSTREAM *out); -static inline struct page_statistics show_statistics_subgoal_trie_nodes(IOSTREAM *out); -static inline struct page_statistics show_statistics_subgoal_trie_hashes(IOSTREAM *out); -static inline struct page_statistics show_statistics_answer_trie_nodes(IOSTREAM *out); -static inline struct page_statistics show_statistics_answer_trie_hashes(IOSTREAM *out); +static inline struct page_statistics show_statistics_subgoal_frames(FILE *out); +static inline struct page_statistics show_statistics_dependency_frames(FILE *out); +static inline struct page_statistics show_statistics_subgoal_trie_nodes(FILE *out); +static inline struct page_statistics show_statistics_subgoal_trie_hashes(FILE *out); +static inline struct page_statistics show_statistics_answer_trie_nodes(FILE *out); +static inline struct page_statistics show_statistics_answer_trie_hashes(FILE *out); #if defined(THREADS_FULL_SHARING) -static inline struct page_statistics show_statistics_answer_ref_nodes(IOSTREAM *out); +static inline struct page_statistics show_statistics_answer_ref_nodes(FILE *out); #endif /* THREADS_FULL_SHARING */ -static inline struct page_statistics show_statistics_global_trie_nodes(IOSTREAM *out); -static inline struct page_statistics show_statistics_global_trie_hashes(IOSTREAM *out); +static inline struct page_statistics show_statistics_global_trie_nodes(FILE *out); +static inline struct page_statistics show_statistics_global_trie_hashes(FILE *out); #endif /* TABLING */ #ifdef YAPOR -static inline struct page_statistics show_statistics_or_frames(IOSTREAM *out); -static inline struct page_statistics show_statistics_query_goal_solution_frames(IOSTREAM *out); -static inline struct page_statistics show_statistics_query_goal_answer_frames(IOSTREAM *out); +static inline struct page_statistics show_statistics_or_frames(FILE *out); +static inline struct page_statistics show_statistics_query_goal_solution_frames(FILE *out); +static inline struct page_statistics show_statistics_query_goal_answer_frames(FILE *out); #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) -static inline struct page_statistics show_statistics_suspension_frames(IOSTREAM *out); +static inline struct page_statistics show_statistics_suspension_frames(FILE *out); #ifdef TABLING_INNER_CUTS -static inline struct page_statistics show_statistics_table_subgoal_solution_frames(IOSTREAM *out); -static inline struct page_statistics show_statistics_table_subgoal_answer_frames(IOSTREAM *out); +static inline struct page_statistics show_statistics_table_subgoal_solution_frames(FILE *out); +static inline struct page_statistics show_statistics_table_subgoal_answer_frames(FILE *out); #endif /* TABLING_INNER_CUTS */ #endif /* YAPOR && TABLING */ @@ -188,7 +189,7 @@ struct page_statistics { #define SHOW_PAGE_STATS(OUT_STREAM, STR_TYPE, _PAGES, STR_NAME) \ { struct page_statistics stats; \ GET_PAGE_STATS(stats, STR_TYPE, _PAGES); \ - Sfprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \ + fprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \ return stats; \ } @@ -434,37 +435,37 @@ static Int p_tabling_mode( USES_REGS1 ) { Int value = IntOfTerm(tvalue); if (value == 1) { /* batched */ SetMode_Batched(TabEnt_flags(tab_ent)); - if (! IsMode_Local(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_Local(LOCAL_TabMode)) { SetMode_Batched(TabEnt_mode(tab_ent)); return(TRUE); } } else if (value == 2) { /* local */ SetMode_Local(TabEnt_flags(tab_ent)); - if (! IsMode_Batched(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_Batched(LOCAL_TabMode)) { SetMode_Local(TabEnt_mode(tab_ent)); return(TRUE); } } else if (value == 3) { /* exec_answers */ SetMode_ExecAnswers(TabEnt_flags(tab_ent)); - if (! IsMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_LoadAnswers(LOCAL_TabMode)) { SetMode_ExecAnswers(TabEnt_mode(tab_ent)); return(TRUE); } } else if (value == 4) { /* load_answers */ SetMode_LoadAnswers(TabEnt_flags(tab_ent)); - if (! IsMode_ExecAnswers(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_ExecAnswers(LOCAL_TabMode)) { SetMode_LoadAnswers(TabEnt_mode(tab_ent)); return(TRUE); } } else if (value == 5) { /* local_trie */ SetMode_LocalTrie(TabEnt_flags(tab_ent)); - if (! IsMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_GlobalTrie(LOCAL_TabMode)) { SetMode_LocalTrie(TabEnt_mode(tab_ent)); return(TRUE); } } else if (value == 6) { /* global_trie */ SetMode_GlobalTrie(TabEnt_flags(tab_ent)); - if (! IsMode_LocalTrie(yap_flags[TABLING_MODE_FLAG])) { + if (! IsMode_LocalTrie(LOCAL_TabMode)) { SetMode_GlobalTrie(TabEnt_mode(tab_ent)); return(TRUE); } @@ -507,36 +508,36 @@ static Int p_abolish_all_tables( USES_REGS1 ) { static Int p_show_tabled_predicates( USES_REGS1 ) { - IOSTREAM *out; + FILE *out; tab_ent_ptr tab_ent; Term t = Deref(ARG1); - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) + if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; tab_ent = GLOBAL_root_tab_ent; - Sfprintf(out, "Tabled predicates\n"); + fprintf(out, "Tabled predicates\n"); if (tab_ent == NULL) - Sfprintf(out, " NONE\n"); + fprintf(out, " NONE\n"); else while(tab_ent) { - Sfprintf(out, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + fprintf(out, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); tab_ent = TabEnt_next(tab_ent); } - PL_release_stream(out); + //PL_release_stream(out); return (TRUE); } static Int p_show_table( USES_REGS1 ) { - IOSTREAM *out; Term mod, t; tab_ent_ptr tab_ent; Term t1 = Deref(ARG1); + FILE *out; - if (IsVarTerm(t1) || !IsAtomTerm(t1)) + if (!IsStreamTerm(t1)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t1)))) + if (!(out = Yap_GetStreamHandle(t1)->file)) return FALSE; mod = Deref(ARG2); t = Deref(ARG3); @@ -545,70 +546,65 @@ static Int p_show_table( USES_REGS1 ) { else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; else { - PL_release_stream(out); return (FALSE); } - show_table(tab_ent, SHOW_MODE_STRUCTURE, out); - PL_release_stream(out); + showTable(tab_ent, SHOW_MODE_STRUCTURE, out); return (TRUE); } static Int p_show_all_tables( USES_REGS1 ) { - IOSTREAM *out; tab_ent_ptr tab_ent; Term t = Deref(ARG1); + FILE *out; - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) + if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; tab_ent = GLOBAL_root_tab_ent; while(tab_ent) { - show_table(tab_ent, SHOW_MODE_STRUCTURE, out); + showTable(tab_ent, SHOW_MODE_STRUCTURE, out); tab_ent = TabEnt_next(tab_ent); } - PL_release_stream(out); return (TRUE); } static Int p_show_global_trie( USES_REGS1 ) { - IOSTREAM *out; Term t = Deref(ARG1); + FILE *out; - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) + if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; - show_global_trie(SHOW_MODE_STRUCTURE, out); - PL_release_stream(out); + showGlobalTrie(SHOW_MODE_STRUCTURE, out); return (TRUE); } static Int p_show_statistics_table( USES_REGS1 ) { - IOSTREAM *out; Term mod, t; tab_ent_ptr tab_ent; Term t1 = Deref(ARG1); + FILE *out; - if (IsVarTerm(t1) || !IsAtomTerm(t1)) + if (!IsStreamTerm(t1)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t1)))) + if (!(out = Yap_GetStreamHandle(t1)->file)) return FALSE; - mod = Deref(ARG2); + mod = Deref(ARG2); t = Deref(ARG3); if (IsAtomTerm(t)) tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; else { - PL_release_stream(out); + //PL_release_stream(out); return (FALSE); } - show_table(tab_ent, SHOW_MODE_STATISTICS, out); - PL_release_stream(out); + showTable(tab_ent, SHOW_MODE_STATISTICS, out); return (TRUE); } @@ -619,15 +615,15 @@ static Int p_show_statistics_tabling( USES_REGS1 ) { #ifdef USE_PAGES_MALLOC long total_pages = 0; #endif /* USE_PAGES_MALLOC */ - IOSTREAM *out; + FILE *out; Term t = Deref(ARG1); - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) + if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; bytes = 0; - Sfprintf(out, "Execution data structures\n"); + fprintf(out, "Execution data structures\n"); stats = show_statistics_table_entries(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) @@ -638,10 +634,10 @@ static Int p_show_statistics_tabling( USES_REGS1 ) { INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_dependency_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Local trie data structures\n"); + fprintf(out, "Local trie data structures\n"); stats = show_statistics_subgoal_trie_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_answer_trie_nodes(out); @@ -654,39 +650,38 @@ static Int p_show_statistics_tabling( USES_REGS1 ) { stats = show_statistics_answer_ref_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); #endif /* THREADS_FULL_SHARING */ - Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Global trie data structures\n"); + fprintf(out, "Global trie data structures\n"); stats = show_statistics_global_trie_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_global_trie_hashes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n", + fprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n", total_bytes, total_pages); - Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc)); #else - Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes); + fprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ - PL_release_stream(out); + //PL_release_stream(out); return (TRUE); } static Int p_show_statistics_global_trie( USES_REGS1 ) { - IOSTREAM *out; Term t = Deref(ARG1); + FILE *out; - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) + if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; - show_global_trie(SHOW_MODE_STATISTICS, out); - PL_release_stream(out); + showGlobalTrie(SHOW_MODE_STATISTICS, out); return (TRUE); } #endif /* TABLING */ @@ -809,34 +804,31 @@ static Int p_show_statistics_or( USES_REGS1 ) { #ifdef USE_PAGES_MALLOC long total_pages = 0; #endif /* USE_PAGES_MALLOC */ - IOSTREAM *out; Term t = Deref(ARG1); - if (IsVarTerm(t) || !IsAtomTerm(t)) + if (!IsStreamTerm(t)) return FALSE; - if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) - return FALSE; - bytes = 0; - Sfprintf(out, "Execution data structures\n"); +\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ bytes = 0; + fprintf(out, "Execution data structures\n"); stats = show_statistics_or_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Cut support data structures\n"); + fprintf(out, "Cut support data structures\n"); stats = show_statistics_query_goal_solution_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_query_goal_answer_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - Sfprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n", + fprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n", total_bytes, total_pages); - Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc)); #else - Sfprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes); + fprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ PL_release_stream(out); return (TRUE); @@ -862,7 +854,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) { #ifdef USE_PAGES_MALLOC long total_pages = 0; #endif /* USE_PAGES_MALLOC */ - IOSTREAM *out; + FILE *out; Term t = Deref(ARG1); if (IsVarTerm(t) || !IsAtomTerm(t)) @@ -870,7 +862,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) { if (!(out = Yap_GetStreamHandle(AtomOfTerm(t)))) return FALSE; bytes = 0; - Sfprintf(out, "Execution data structures\n"); + fprintf(out, "Execution data structures\n"); stats = show_statistics_table_entries(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) @@ -885,10 +877,10 @@ static Int p_show_statistics_opt( USES_REGS1 ) { INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_suspension_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Local trie data structures\n"); + fprintf(out, "Local trie data structures\n"); stats = show_statistics_subgoal_trie_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_answer_trie_nodes(out); @@ -901,18 +893,18 @@ static Int p_show_statistics_opt( USES_REGS1 ) { stats = show_statistics_answer_ref_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); #endif /* THREADS_FULL_SHARING */ - Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Global trie data structures\n"); + fprintf(out, "Global trie data structures\n"); stats = show_statistics_global_trie_nodes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_global_trie_hashes(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); - Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes); total_bytes += bytes; bytes = 0; - Sfprintf(out, "Cut support data structures\n"); + fprintf(out, "Cut support data structures\n"); stats = show_statistics_query_goal_solution_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); stats = show_statistics_query_goal_answer_frames(out); @@ -923,15 +915,15 @@ static Int p_show_statistics_opt( USES_REGS1 ) { stats = show_statistics_table_subgoal_answer_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); #endif /* TABLING_INNER_CUTS */ - Sfprintf(out, " Memory in use (IV): %10ld bytes\n\n", bytes); + fprintf(out, " Memory in use (IV): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n", + fprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n", total_bytes, total_pages); - Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc)); #else - Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes); + fprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ PL_release_stream(out); return (TRUE); @@ -1088,96 +1080,96 @@ static inline realtime current_time(void) { #ifdef TABLING -static inline struct page_statistics show_statistics_table_entries(IOSTREAM *out) { +static inline struct page_statistics show_statistics_table_entries(FILE *out) { SHOW_PAGE_STATS(out, struct table_entry, _pages_tab_ent, "Table entries: "); } #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) -static inline struct page_statistics show_statistics_subgoal_entries(IOSTREAM *out) { +static inline struct page_statistics show_statistics_subgoal_entries(FILE *out) { SHOW_PAGE_STATS(out, struct subgoal_entry, _pages_sg_ent, "Subgoal entries: "); } #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ -static inline struct page_statistics show_statistics_subgoal_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_subgoal_frames(FILE *out) { SHOW_PAGE_STATS(out, struct subgoal_frame, _pages_sg_fr, "Subgoal frames: "); } -static inline struct page_statistics show_statistics_dependency_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_dependency_frames(FILE *out) { SHOW_PAGE_STATS(out, struct dependency_frame, _pages_dep_fr, "Dependency frames: "); } -static inline struct page_statistics show_statistics_subgoal_trie_nodes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_subgoal_trie_nodes(FILE *out) { SHOW_PAGE_STATS(out, struct subgoal_trie_node, _pages_sg_node, "Subgoal trie nodes: "); } -static inline struct page_statistics show_statistics_subgoal_trie_hashes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_subgoal_trie_hashes(FILE *out) { SHOW_PAGE_STATS(out, struct subgoal_trie_hash, _pages_sg_hash, "Subgoal trie hashes: "); } -static inline struct page_statistics show_statistics_answer_trie_nodes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_answer_trie_nodes(FILE *out) { SHOW_PAGE_STATS(out, struct answer_trie_node, _pages_ans_node, "Answer trie nodes: "); } -static inline struct page_statistics show_statistics_answer_trie_hashes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_answer_trie_hashes(FILE *out) { SHOW_PAGE_STATS(out, struct answer_trie_hash, _pages_ans_hash, "Answer trie hashes: "); } #if defined(THREADS_FULL_SHARING) -static inline struct page_statistics show_statistics_answer_ref_nodes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_answer_ref_nodes(FILE *out) { SHOW_PAGE_STATS(out, struct answer_ref_node, _pages_ans_ref_node, "Answer ref nodes: "); } #endif /* THREADS_FULL_SHARING */ -static inline struct page_statistics show_statistics_global_trie_nodes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_global_trie_nodes(FILE *out) { SHOW_PAGE_STATS(out, struct global_trie_node, _pages_gt_node, "Global trie nodes: "); } -static inline struct page_statistics show_statistics_global_trie_hashes(IOSTREAM *out) { +static inline struct page_statistics show_statistics_global_trie_hashes(FILE *out) { SHOW_PAGE_STATS(out, struct global_trie_hash, _pages_gt_hash, "Global trie hashes: "); } #endif /* TABLING */ #ifdef YAPOR -static inline struct page_statistics show_statistics_or_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_or_frames(FILE *out) { SHOW_PAGE_STATS(out, struct or_frame, _pages_or_fr, "Or-frames: "); } -static inline struct page_statistics show_statistics_query_goal_solution_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_query_goal_solution_frames(FILE *out) { SHOW_PAGE_STATS(out, struct query_goal_solution_frame, _pages_qg_sol_fr, "Query goal solution frames: "); } -static inline struct page_statistics show_statistics_query_goal_answer_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_query_goal_answer_frames(FILE *out) { SHOW_PAGE_STATS(out, struct query_goal_answer_frame, _pages_qg_ans_fr, "Query goal answer frames: "); } #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) -static inline struct page_statistics show_statistics_suspension_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_suspension_frames(FILE *out) { SHOW_PAGE_STATS(out, struct suspension_frame, _pages_susp_fr, "Suspension frames: "); } #ifdef TABLING_INNER_CUTS -static inline struct page_statistics show_statistics_table_subgoal_solution_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_table_subgoal_solution_frames(FILE *out) { SHOW_PAGE_STATS(out, struct table_subgoal_solution_frame, _pages_tg_sol_fr, "Table subgoal solution frames:"); } -static inline struct page_statistics show_statistics_table_subgoal_answer_frames(IOSTREAM *out) { +static inline struct page_statistics show_statistics_table_subgoal_answer_frames(FILE *out) { SHOW_PAGE_STATS(out, struct table_subgoal_answer_frame, _pages_tg_ans_fr, "Table subgoal answer frames: "); } #endif /* TABLING_INNER_CUTS */ diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index af7f0a2d8..184709fd0 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -11,10 +11,6 @@ ** ** ************************************************************************/ -#if defined(TABLING) || defined(YAPOR) -#include "SWI-Stream.h" -#endif /* TABLING || YAPOR */ - /************************* @@ -55,8 +51,8 @@ void free_subgoal_trie(sg_node_ptr, int, int); void free_answer_trie(ans_node_ptr, int, int); void free_answer_hash_chain(ans_hash_ptr); void abolish_table(tab_ent_ptr); -void show_table(tab_ent_ptr, int, IOSTREAM *); -void show_global_trie(int, IOSTREAM *); +void showTable(tab_ent_ptr, int, FILE *); +void showGlobalTrie(int, FILE *); #endif /* TABLING */ diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index ada700cd8..8fd311f85 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -478,7 +478,6 @@ typedef enum { #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ - #define new_table_entry(TAB_ENT, PRED_ENTRY, ATOM, ARITY, MODE_ARRAY) \ ALLOC_TABLE_ENTRY(TAB_ENT); \ INIT_LOCK_TAB_ENT(TAB_ENT); \ @@ -490,11 +489,11 @@ typedef enum { SetMode_ExecAnswers(TabEnt_flags(TAB_ENT)); \ SetMode_LocalTrie(TabEnt_flags(TAB_ENT)); \ TabEnt_mode(TAB_ENT) = TabEnt_flags(TAB_ENT); \ - if (IsMode_Local(yap_flags[TABLING_MODE_FLAG])) \ + if (IsMode_Local(LOCAL_TabMode)) \ SetMode_Local(TabEnt_mode(TAB_ENT)); \ - if (IsMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG])) \ + if (IsMode_LoadAnswers(LOCAL_TabMode)) \ SetMode_LoadAnswers(TabEnt_mode(TAB_ENT)); \ - if (IsMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG])) \ + if (IsMode_GlobalTrie(LOCAL_TabMode)) \ SetMode_GlobalTrie(TabEnt_mode(TAB_ENT)); \ TabEnt_init_mode_directed_field(TAB_ENT, MODE_ARRAY); \ TabEnt_init_subgoal_trie_field(TAB_ENT); \ @@ -1237,7 +1236,7 @@ static inline void __restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr U static inline CELL *__expand_auxiliary_stack(CELL *stack USES_REGS) { char *old_top = (char *)LOCAL_TrailTop; - INFORMATION_MESSAGE("Expanding trail in 64 Kbytes"); + INFORMATION_MESSAGE("Expanding trail in " UInt_FORMAT " bytes", K64); if (! Yap_growtrail(K64, TRUE)) { /* TRUE means 'contiguous_only' */ Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); return NULL; diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index f8eaf7b00..c65a1871f 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -78,7 +78,7 @@ static inline void traverse_update_arity(char *, int *, int *); *******************************/ static struct trie_statistics{ - IOSTREAM *out; + FILE *out; int show; long subgoals; long subgoals_incomplete; @@ -144,7 +144,7 @@ static struct trie_statistics{ #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 #define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ if (TrStat_show == SHOW_MODE_STRUCTURE) \ - Sfprintf(TrStat_out, MESG, ##ARGS) + fprintf(TrStat_out, MESG, ##ARGS) #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \ if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \ @@ -1637,7 +1637,7 @@ void abolish_table(tab_ent_ptr tab_ent) { } -void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) { +void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { CACHE_REGS sg_node_ptr sg_node; @@ -1655,40 +1655,40 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) { TrStat_ans_nodes = 0; TrStat_gt_refs = 0; if (show_mode == SHOW_MODE_STATISTICS) - Sfprintf(TrStat_out, "Table statistics for predicate '%s", AtomName(TabEnt_atom(tab_ent))); + fprintf(TrStat_out, "Table statistics for predicate '%s", AtomName(TabEnt_atom(tab_ent))); else /* SHOW_MODE_STRUCTURE */ - Sfprintf(TrStat_out, "Table structure for predicate '%s", AtomName(TabEnt_atom(tab_ent))); + fprintf(TrStat_out, "Table structure for predicate '%s", AtomName(TabEnt_atom(tab_ent))); #ifdef MODE_DIRECTED_TABLING if (TabEnt_mode_directed(tab_ent)) { int i, *mode_directed = TabEnt_mode_directed(tab_ent); - Sfprintf(TrStat_out, "("); + fprintf(TrStat_out, "("); for (i = 0; i < TabEnt_arity(tab_ent); i++) { int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]); if (mode == MODE_DIRECTED_INDEX) { - Sfprintf(TrStat_out, "index"); + fprintf(TrStat_out, "index"); } else if (mode == MODE_DIRECTED_MIN) { - Sfprintf(TrStat_out, "min"); + fprintf(TrStat_out, "min"); } else if (mode == MODE_DIRECTED_MAX) { - Sfprintf(TrStat_out, "max"); + fprintf(TrStat_out, "max"); } else if (mode == MODE_DIRECTED_ALL) { - Sfprintf(TrStat_out, "all"); + fprintf(TrStat_out, "all"); } else if (mode == MODE_DIRECTED_SUM) { - Sfprintf(TrStat_out, "sum"); + fprintf(TrStat_out, "sum"); } else if (mode == MODE_DIRECTED_LAST) { - Sfprintf(TrStat_out, "last"); + fprintf(TrStat_out, "last"); } else if (mode == MODE_DIRECTED_FIRST) { - Sfprintf(TrStat_out, "first"); + fprintf(TrStat_out, "first"); } else Yap_Error(INTERNAL_ERROR, TermNil, "show_table: unknown mode"); if (i != MODE_DIRECTED_GET_ARG(mode_directed[i])) - Sfprintf(TrStat_out, "(ARG%d)", MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1); + fprintf(TrStat_out, "(ARG%d)", MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1); if (i + 1 != TabEnt_arity(tab_ent)) - Sfprintf(TrStat_out, ","); + fprintf(TrStat_out, ","); } - Sfprintf(TrStat_out, ")'\n"); + fprintf(TrStat_out, ")'\n"); } else #endif /* MODE_DIRECTED_TABLING */ - Sfprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent)); + fprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent)); sg_node = get_subgoal_trie(tab_ent); if (sg_node) { if (TrNode_child(sg_node)) { @@ -1726,25 +1726,25 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) { if (TrStat_subgoals == 0) SHOW_TABLE_STRUCTURE(" EMPTY\n"); if (show_mode == SHOW_MODE_STATISTICS) { - Sfprintf(TrStat_out, " Subgoal trie structure\n"); - Sfprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete); - Sfprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes); - Sfprintf(TrStat_out, " Answer trie structure(s)\n"); + fprintf(TrStat_out, " Subgoal trie structure\n"); + fprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete); + fprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes); + fprintf(TrStat_out, " Answer trie structure(s)\n"); #ifdef TABLING_INNER_CUTS - Sfprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned); + fprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned); #else - Sfprintf(TrStat_out, " Answers: %ld\n", TrStat_answers); + fprintf(TrStat_out, " Answers: %ld\n", TrStat_answers); #endif /* TABLING_INNER_CUTS */ - Sfprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true); - Sfprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no); - Sfprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes); - Sfprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs); + fprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true); + fprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no); + fprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes); + fprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs); } return; } -void show_global_trie(int show_mode, IOSTREAM *out) { +void showGlobalTrie(int show_mode, FILE *out) { CACHE_REGS TrStat_out = out; @@ -1753,9 +1753,9 @@ void show_global_trie(int show_mode, IOSTREAM *out) { TrStat_gt_nodes = 1; TrStat_gt_refs = 0; if (show_mode == SHOW_MODE_STATISTICS) - Sfprintf(TrStat_out, "Global trie statistics\n"); + fprintf(TrStat_out, "Global trie statistics\n"); else /* SHOW_MODE_STRUCTURE */ - Sfprintf(TrStat_out, "Global trie structure\n"); + fprintf(TrStat_out, "Global trie structure\n"); if (TrNode_child(GLOBAL_root_gt)) { char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); @@ -1766,9 +1766,9 @@ void show_global_trie(int show_mode, IOSTREAM *out) { } else SHOW_TABLE_STRUCTURE(" EMPTY\n"); if (show_mode == SHOW_MODE_STATISTICS) { - Sfprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms); - Sfprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes); - Sfprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs); + fprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms); + fprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes); + fprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs); } return; } diff --git a/OPTYap/traced_tab.insts.h b/OPTYap/traced_tab.insts.h index 220382f86..59501879f 100644 --- a/OPTYap/traced_tab.insts.h +++ b/OPTYap/traced_tab.insts.h @@ -23,6 +23,7 @@ #define VARS_ENTRY(INDEX) (VARS_ARITY_ENTRY + 1 + vars_arity - (INDEX)) #define SUBS_ENTRY(INDEX) (SUBS_ARITY_ENTRY + 1 + subs_arity - (INDEX)) +#if 0 /************************************************************************ ** clause_with_cut ** ************************************************************************/ @@ -31,7 +32,7 @@ Op(clause_with_cut, e) { printf("clause_with_cut not supported by JIT!!\n"); exit(1); } ENDOp(); - +#endif /************************************************************************ ** table_load_answer ** @@ -157,8 +158,8 @@ PBOp(table_load_answer, Otapl) ** table_answer_resolution_completion ** ************************************************************************/ - BOp(table_answer_resolution_completion, Otapl) #ifdef THREADS_CONSUMER_SHARING + BOp(table_answer_resolution_completion, Otapl) { printf("table_answer_resolution_completion not supported by JIT!!\n"); exit(1); } -#endif /* THREADS_CONSUMER_SHARING */ ENDBOp(); +#endif /* THREADS_CONSUMER_SHARING */ diff --git a/config.h.cmake b/config.h.cmake index 25e9dc075..dcc6bd426 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -19,6 +19,11 @@ #define ALIGN_LONGS 1 #endif +/* size in bits of words. */ +#ifndef BITNESS +#define BITNESS "${bitness}" +#endif + /* if fflush(NULL) clobbers input pipes1 */ #ifndef BROKEN_FFLUSH_NULL #cmakedefine BROKEN_FFLUSH_NULL "${BROKEN_FFLUSH_NULL}" @@ -36,17 +41,17 @@ /* compilation flags */ #ifndef C_CFLAGS -#define C_CFLAGS "${CMAKE_C_CFLAGS}" +#define C_CFLAGS "${CFLAGS_EXPORT} ${CMAKE_C_FLAGS} ${FLAGS} ${LANGUAGE_COMPILE_FLAGS}" #endif /* linking flags */ #ifndef C_LDFLAGS -#define C_LDFLAGS "${CMAKE_SHARED_LINKER_FLAGS}" +#define C_LDFLAGS "${LINK_FLAGS} ${LINK_LIBRARIES}" #endif /* libs for linking with DLLs */ #ifndef C_LIBPLSO -#define C_LIBPLSO "${CMAKE_SHARED_LINKER_FLAGS} -lYap" +#define C_LIBPLSO "${CMAKE_SHARED_LINKER_FLAGS} ${LINK_FLAGS} ${LINK_LIBRARIES}" #endif /* main libs for YAP */ @@ -255,30 +260,6 @@ function. */ #cmakedefine HAVE_CTYPE_H ${HAVE_CTYPE_H} #endif -/* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if -you don't. */ -#ifndef HAVE_DECL_RL_CATCH_SIGNALS_ -#cmakedefine HAVE_DECL_RL_CATCH_SIGNALS ${HAVE_DECL_RL_CATCH_SIGNALS} -#endif - -/* Define to 1 if you have the declaration of `rl_done ', and to 0 if you -don't. */ -#ifndef HAVE_DECL_RL_DONE_ -#cmakedefine HAVE_DECL_RL_DONE_ ${HAVE_DECL_RL_DONE_} -#endif - -/* Define to 1 if you have the declaration of `rl_event_hook', and to 0 if you -don't. */ -#ifndef HAVE_DECL_RL_EVENT_HOOK -#cmakedefine HAVE_DECL_RL_EVENT_HOOK ${HAVE_DECL_RL_EVENT_HOOK} -#endif - -/* Define to 1 if you have the declaration of `rl_readline_state', and to 0 if -you don't. */ -#ifndef HAVE_DECL_RL_READLINE_STATE -#cmakedefine HAVE_DECL_RL_READLINE_STATE ${HAVE_DECL_RL_READLINE_STATE} -#endif - /* Define to 1 if you have the header file. */ #ifndef HAVE_DIRECT_H #cmakedefine HAVE_DIRECT_H ${HAVE_DIRECT_H} @@ -404,6 +385,11 @@ you don't. */ #cmakedefine HAVE_FLSLL ${HAVE_FLSLL} #endif +/* Define to 1 if you have the `fmemopen' function. */ +#ifndef HAVE_FMEMOPEN +#cmakedefine HAVE_FMEMOPEN ${HAVE_FMEMOPEN} +#endif + /* Define to 1 if you have the `fpclass' function. */ #ifndef HAVE_FPCLASS #cmakedefine HAVE_FPCLASS ${HAVE_FPCLASS} @@ -424,6 +410,11 @@ you don't. */ #cmakedefine HAVE_FTRUNCATE ${HAVE_FTRUNCATE} #endif +/* Define to 1 if you have the `funopen' function. */ +#ifndef HAVE_FUNOPEN +#cmakedefine HAVE_FUNOPEN ${HAVE_FUNOPEN} +#endif + /* Old m4 auto-heder generation, not really useful now */ #ifndef HAVE_GCC #cmakedefine HAVE_GCC ${HAVE_GCC} @@ -594,6 +585,11 @@ you don't. */ #cmakedefine HAVE_CRYPT ${HAVE_CRYPT} #endif +/* Define to 1 if you have the header file. */ +#ifndef HAVE_LIBGEN_H +#cmakedefine HAVE_LIBGEN_H ${HAVE_LIBGEN_H} +#endif + /* Define to 1 if you have the `gmp' library (-lgmp). */ #ifndef HAVE_LIBGMP @@ -725,10 +721,6 @@ you don't. */ #define HAVE_LIBRAPTOR2 ${HAVE_LIBRAPTOR2} #endif -/* Define if you have libreadline */ -#ifndef HAVE_LIBREADLINE -#define HAVE_LIBREADLINE ${READLINE_FOUND} -#endif /* Define to 1 if you have the `resolv' library (-lresolv). */ #ifndef HAVE_LIBRESOLV @@ -930,11 +922,17 @@ you don't. */ #cmakedefine HAVE_NULLPTR ${HAVE_NULLPTR} #endif +/* Define to 1 if you have the `open_memstream' function. */ +#ifndef HAVE_OPEN_MEMSTREAM +#cmakedefine HAVE_OPEN_MEMSTREAM ${HAVE_OPEN_MEMSTREAM} +#endif + /* Define to 1 if you have the `opendir' function. */ #ifndef HAVE_OPENDIR #cmakedefine HAVE_OPENDIR ${HAVE_OPENDIR} #endif + /* Define to 1 if you have the header file. */ #cmakedefine HAVE_OPENSSL_RIPEMD_H ${HAVE_OPENSSL_RIPEMD_H} @@ -998,15 +996,6 @@ you don't. */ #cmakedefine HAVE_RAPTOR_H ${HAVE_RAPTOR_H} #endif -/* Define to 1 if you have the header file. */ -#ifndef HAVE_READLINE_HISTORY_H -#cmakedefine HAVE_READLINE_HISTORY_H ${HAVE_READLINE_HISTORY_H} -#endif - -/* Define to 1 if you have the header file. */ -#ifndef HAVE_READLINE_READLINE_H -#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H} -#endif /* Define to 1 if you have the `readlink' function. */ #ifndef HAVE_READLINK @@ -1054,76 +1043,6 @@ signal. */ #cmakedefine HAVE_RINTERFACE_H ${HAVE_RINTERFACE_H} #endif -/* Define to 1 if you have the `rl_begin_undo_group' function. */ -#ifndef HAVE_RL_BEGIN_UNDO_GROUP -#cmakedefine HAVE_RL_BEGIN_UNDO_GROUP ${HAVE_RL_BEGIN_UNDO_GROUP} -#endif - -/* Define to 1 if you have the `rl_clear_pending_input' function. */ -#ifndef HAVE_RL_CLEAR_PENDING_INPUT -#cmakedefine HAVE_RL_CLEAR_PENDING_INPUT ${HAVE_RL_CLEAR_PENDING_INPUT} -#endif - -/* Define to 1 if the system has the type `rl_completion_func_t'). */ -#ifndef HAVE_RL_COMPLETION_FUNC_T -#cmakedefine HAVE_RL_COMPLETION_FUNC_T ${HAVE_RL_COMPLETION_FUNC_T} -#endif - -/* Define to 1 if the system has the type `rl_completion_func_t'. */ -#ifndef HAVE_RL_COMPLETION_FUNC_T -#cmakedefine HAVE_RL_COMPLETION_FUNC_T ${HAVE_RL_COMPLETION_FUNC_T} -#endif - -/* Define to 1 if you have the `rl_completion_matches' function. */ -#ifndef HAVE_RL_COMPLETION_MATCHES -#cmakedefine HAVE_RL_COMPLETION_MATCHES ${HAVE_RL_COMPLETION_MATCHES} -#endif - -/* Define to 1 if you have the `rl_discard_argument' function. */ -#ifndef HAVE_RL_DISCARD_ARGUMENT -#cmakedefine HAVE_RL_DISCARD_ARGUMENT ${HAVE_RL_DISCARD_ARGUMENT} -#endif - -/* Define to 1 if you have the `rl_done' variable. */ -#ifndef HAVE_RL_DONE -#define HAVE_RL_DONE ${HAVE_RL_DONE} -#endif - -/* Define to 1 if you have the `rl_filename_completion_function' function. */ -#ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION -#define HAVE_RL_FILENAME_COMPLETION_FUNCTION ${HAVE_RL_FILENAME_COMPLETION_FUNCTION} -#endif - -/* Define to 1 if you have the `rl_free_line_state' function. */ -#ifndef HAVE_RL_FREE_LINE_STATE -#cmakedefine HAVE_RL_FREE_LINE_STATE ${HAVE_RL_FREE_LINE_STATE} -#endif - -/* Define to 1 if the system has the type `rl_hook_func_t'. */ -#ifndef HAVE_RL_HOOK_FUNC_T -#cmakedefine HAVE_RL_HOOK_FUNC_T ${HAVE_RL_HOOK_FUNC_T} -#endif - -/* Define to 1 if you have the `rl_insert_close' function. */ -#ifndef HAVE_RL_INSERT_CLOSE -#cmakedefine HAVE_RL_INSERT_CLOSE ${HAVE_RL_INSERT_CLOSE} -#endif - -/* Define to 1 if you have the `rl_reset_after_signal' function. */ -#ifndef HAVE_RL_RESET_AFTER_SIGNAL -#cmakedefine HAVE_RL_RESET_AFTER_SIGNAL ${HAVE_RL_RESET_AFTER_SIGNAL} -#endif - -/* Define to 1 if you have the `rl_set_keyboard_input_timeout' function. */ -#ifndef HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT -#cmakedefine HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT ${HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT} -#endif - -/* Define to 1 if you have the `rl_set_prompt' function. */ -#ifndef HAVE_RL_SET_PROMPT -#cmakedefine HAVE_RL_SET_PROMPT ${HAVE_RL_SET_PROMPT} -#endif - /* Define to 1 if you have the header file. */ #ifndef HAVE_R_H #cmakedefine HAVE_R_H ${HAVE_R_H} @@ -1747,8 +1666,18 @@ signal. */ #endif /* Define to the version of this package. */ -#ifndef PACKAGE_VERSION -#define PACKAGE_VERSION "${YAP_VERSION}" +#ifndef YAP_FULL_VERSION +#define YAP_FULL_VERSION "[ YAP ${YAP_FULL_GIT_VERSION} (${CMAKE_SYSTEM}-${YAP_ARCH}): ${YAP_TIMESTAMP}@${YAP_SITE} ]\n" +#endif + +/* Define to the version of this package. */ +#ifndef YAP_GIT_HEAD +#define YAP_GIT_HEAD g_GIT_SHA1 +#endif + +/* Define to the version of this package. */ +#ifndef YAP_NUMERIC_VERSION +#define YAP_NUMERIC_VERSION "${YAP_NUMERIC_VERSION}" #endif /* Define as the return type of signal handlers (`int' or `void'). */ @@ -1838,7 +1767,7 @@ signal. */ /* library search variable */ #ifndef SO_PATH -#cmakedefine SO_PATH "${SO_PATH}" +#define SO_PATH "${dlls}" #endif /* enable condor distributed execution, static compilation */ @@ -1928,42 +1857,15 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ /* architecture */ #ifndef YAP_ARCH -#define YAP_ARCH "${YAP_ARCH}" +#define YAP_ARCH "${YAP_ARCH}" #endif -/* where the yap executable lives */ -#ifndef YAP_BINDIR -#define YAP_BINDIR "${YAP_BINDIR}" -#endif - -/* YAP version string */ -#ifndef YAP_FULL_VERSION -#define YAP_FULL_VERSION "YAP ${YAP_FULL_VERSION}: ${YAP_ARCH}-${CMAKE_SYSTEM}, @${YAP_SITE}, ${YAP_TIMESTAMP}" -#endif - -/* where to look for shared libraries */ -#ifndef YAP_LIBDIR -#define YAP_LIBDIR "${YAP_LIBDIR}" -#endif - -/* numerical version */ -#ifndef YAP_NUMERIC_VERSION -#define YAP_NUMERIC_VERSION ${YAP_NUMERIC_VERSION} -#endif - -/* where to look for Prolog sources */ #ifndef YAP_PL_SRCDIR -#define YAP_PL_SRCDIR "${YAP_PL_SRCDIR}" +#define YAP_PL_SRCDIR "${PROJECT_SOURCE_DIR}/pl}" #endif -/* where YAP lives */ -#ifndef YAP_ROOTDIR -#define YAP_ROOTDIR "${YAP_ROOTDIR}" -#endif - -/* where to look for the Prolog library */ #ifndef YAP_SHAREDIR -#define YAP_SHAREDIR "${YAP_SHAREDIR}" +#define YAP_SHAREDIR "${YAP_SHAREDIR}" #endif /* saved state file */ @@ -1973,17 +1875,22 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ /* date of compilation */ #ifndef YAP_TIMESTAMP -#define YAP_TIMESTAMP "${YAP_TIMESTAMP}" +#define YAP_TIMESTAMP ${YAP_TIMESTAMP} +#endif + +/* yap version as a term */ +#ifndef YAP_TVERSION +#define YAP_TVERSION "yap(${YAP_MAJOR_VERSION},${YAP_MINOR_VERSION},${YAP_PATCH_VERSION},0)" #endif /* what timezone we are in */ #ifndef YAP_VAR_TIMEZONE -#define YAP_VAR_TIMEZONE "${YAP_VAR_TIMEZONE}" +#define YAP_VAR_TIMEZONE ${YAP_VAR_TIMEZONE} #endif -/* yap version */ -#ifndef YAP_VERSION -#define YAP_VERSION "${YAP_VERSION}" +/* yap compiled at */ +#ifndef YAP_COMPILED_AT +#define YAP_COMPILED_AT "${YAP_TIMESTAMP}@${YAP_SITE}" #endif /* name of YAP library */ @@ -1991,6 +1898,21 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ #define YAP_YAPLIB "${YAP_YAPLIB}" #endif +/* name of YAP library */ +#ifndef YAP_BINDIR +#define YAP_BINDIR "${bindir}" +#endif + +/* name of YAP library */ +#ifndef YAP_ROOTDIR +#define YAP_ROOTDIR "${YAP_ROOTDIR}" +#endif + +/* name of YAP library */ +#ifndef YAP_LIBDIR +#define YAP_LIBDIR "${YAP_LIBDIR}" +#endif + /* name of YAP JIT library */ #ifndef YAP_YAPJITLIB #define YAP_YAPJITLIB "${YAP_YAPJITLIB}" @@ -2006,10 +1928,6 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ #cmakedefine _XOPEN_SOURCE_EXTENDED "${_XOPEN_SOURCE_EXTENDED}" #endif -/* compiling for Windows */ -#ifndef __WINDOWS__ -#cmakedefine __WINDOWS__ "${__WINDOWS__}" -#endif /* Define to empty if `const' does not conform to ANSI C. */ #ifndef const @@ -2034,4 +1952,12 @@ calls it, or to nothing if 'inline' is not supported under any name. */ #cmakedefine pid_t "${pid_t}" #endif +#ifndef MAXPATHLEN +#ifdef PATH_MAX +#define MAXPATHLEN PATH_MAX +#else +#define MAXPATHLEN 1024 +#endif +#endif + #endif diff --git a/configure b/configure index e50b1b334..25c3d83a8 100755 --- a/configure +++ b/configure @@ -712,6 +712,7 @@ JITLIBS JITLD JITFLAGS LLVM_CONFIG +MYDDAS_LDFLAGS MYDDAS_LIBS MYDDAS_CPPFLAGS OBJECTS_MYDDAS @@ -4626,7 +4627,8 @@ fi if test "${with_gmp+set}" = set; then : withval=$with_gmp; if test "$withval" = yes; then yap_cv_gmp=yes - GMPDIR=/usr + gmp_in_usr=`echo /usr/lib/gmp*` +GMPDIR=/usr:/usr/lo elif test "$withval" = no; then yap_cv_gmp=no else @@ -7776,7 +7778,7 @@ fi $as_echo "$ac_cv_lib_dl_dlopen" >&6; } if test "x$ac_cv_lib_dl_dlopen" = xyes; then : have_dl=yes - +1 else have_dl=no fi @@ -7814,7 +7816,13 @@ fi fi INSTALL_DLLS="yes" fi - CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall" + if test "$CLANG" = "yes" + then +# CC="$CC -fstrict-aliasing -fno-diagnostics-fixit-info -fno-color-diagnostics -fno-caret-diagnostics -fno-show-column -fsched-interblock -Wall" + CC="$CC -fstrict-aliasing -fsched-interblock -Wall" + else + CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall" + fi DYNYAPLIB=libYap."$YAP_VERSION.$SO" SONAMEFLAG="-Wl,-install_name,$prefix/lib/libYap.$YAP_MAJOR_VERSION.$SO -Wl,-compatibility_version,$YAP_MAJOR_VERSION.$YAP_MINOR_VERSION -Wl,-current_version,$YAP_VERSION" YAPLIB_LD="$CC -dynamiclib" @@ -10576,6 +10584,7 @@ _ACEOF OLD_LIBS="$LIBS" OLD_CPPFLAGS="$CPPFLAGS" MYDDAS_CPPFLAGS="" +MYDDAS_LDFLAGS="" # Check whether --enable-myddas was given. if test "${enable_myddas+set}" = set; then : @@ -10585,7 +10594,8 @@ if test "${enable_myddas+set}" = set; then : yap_cv_myddas=no else yap_cv_myddas=$withval - LDFLAGS="$LDFLAGS -L${yap_cv_myddas}/lib " + LDFLAGS="$LDFLAGS -L${yap_cv_myddas}/lib " + MYDDAS_LDFLAGS+=" -L${yap_cv_myddas}/lib " CPPFLAGS="$CPPFLAGS -I${yap_cv_myddas}/include " MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_myddas}/include " fi @@ -10604,6 +10614,7 @@ if test "${with_mysql+set}" = set; then : else yap_cv_mysql=$withval LDFLAGS="$LDFLAGS -L${yap_cv_mysql}/lib " + MYDDAS_LDFLAGS+=" -L${yap_cv_mysql}/lib " CPPFLAGS="$CPPFLAGS -I${yap_cv_mysql}/include " MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_mysql}/include " fi @@ -10622,6 +10633,7 @@ if test "${with_odbc+set}" = set; then : else yap_cv_odbc=$withval LDFLAGS="$LDFLAGS -L${yap_cv_odbc}/lib " + MYDDAS_LDFLAGS+=" -L${yap_cv_odbc}/lib " CPPFLAGS="$CPPFLAGS -I${yap_cv_odbc}/include " MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_odbc}/include " fi @@ -10640,6 +10652,7 @@ if test "${with_sqlite3+set}" = set; then : else yap_cv_sqlite3=$withval LDFLAGS="$LDFLAGS -L${yap_cv_sqlite3}/lib " + MYDDAS_LDFLAGS+=" -L${yap_cv_sqlite3}/lib " CPPFLAGS="$CPPFLAGS -I${yap_cv_sqlite3}/include " MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_sqlite3}/include " fi @@ -10658,6 +10671,7 @@ if test "${with_postgres+set}" = set; then : else yap_cv_postgres=$withval LDFLAGS="$LDFLAGS -L${yap_cv_postgres}/lib " + MYDDAS_LDFLAGS+=" -L${yap_cv_postgres}/lib " CPPFLAGS="$CPPFLAGS -I${yap_cv_postgres}/include " MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_postgres}/include " fi @@ -11191,7 +11205,9 @@ done fi - MYDDAS_LIBS="$LIBS" +MYDDAS_LDFLAGS="$LDFLAGS" +MYDDAS_LIBS="$LIBS" +MYDDAS_LIBS="$LIBS" LIBS="$OLD_LIBS" CPPFLAGS="$OLD_CPPFLAGS" else @@ -11225,6 +11241,7 @@ fi + # Check whether --enable-jit was given. @@ -14134,7 +14151,7 @@ else JAVA_TEST=Test.java CLASS_TEST=Test.class cat << \EOF > $JAVA_TEST -/* #line 14137 "configure" */ +/* #line 14154 "configure" */ public class Test { } EOF @@ -14310,7 +14327,7 @@ EOF if uudecode$EXEEXT Test.uue; then ac_cv_prog_uudecode_base64=yes else - echo "configure: 14313: uudecode had trouble decoding base 64 file 'Test.uue'" >&5 + echo "configure: 14330: uudecode had trouble decoding base 64 file 'Test.uue'" >&5 echo "configure: failed file was:" >&5 cat Test.uue >&5 ac_cv_prog_uudecode_base64=no @@ -14441,7 +14458,7 @@ else JAVA_TEST=Test.java CLASS_TEST=Test.class cat << \EOF > $JAVA_TEST -/* #line 14444 "configure" */ +/* #line 14461 "configure" */ public class Test { } EOF @@ -14476,7 +14493,7 @@ JAVA_TEST=Test.java CLASS_TEST=Test.class TEST=Test cat << \EOF > $JAVA_TEST -/* [#]line 14479 "configure" */ +/* [#]line 14496 "configure" */ public class Test { public static void main (String args[]) { System.exit (0); diff --git a/configure.in b/configure.in index 831b907c3..90f79ab4f 100755 --- a/configure.in +++ b/configure.in @@ -277,7 +277,8 @@ AC_ARG_WITH(gmp, [ --with-gmp[=DIR] use GNU Multiple Precision in DIR], if test "$withval" = yes; then yap_cv_gmp=yes - GMPDIR=/usr + gmp_in_usr=`echo /usr/lib/gmp*` +GMPDIR=/usr:/usr/lo elif test "$withval" = no; then yap_cv_gmp=no else @@ -1080,7 +1081,7 @@ dnl Linux has both elf and a.out, in this case we found elf then AC_CHECK_LIB(dl,dlopen, have_dl=yes - , +1 , have_dl=no) if test ${have_dl} = yes then @@ -1115,7 +1116,13 @@ dnl Linux has both elf and a.out, in this case we found elf fi INSTALL_DLLS="yes" fi - CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall" + if test "$CLANG" = "yes" + then +# CC="$CC -fstrict-aliasing -fno-diagnostics-fixit-info -fno-color-diagnostics -fno-caret-diagnostics -fno-show-column -fsched-interblock -Wall" + CC="$CC -fstrict-aliasing -fsched-interblock -Wall" + else + CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall" + fi DYNYAPLIB=libYap."$YAP_VERSION.$SO" SONAMEFLAG="-Wl,-install_name,$prefix/lib/libYap.$YAP_MAJOR_VERSION.$SO -Wl,-compatibility_version,$YAP_MAJOR_VERSION.$YAP_MINOR_VERSION -Wl,-current_version,$YAP_VERSION" YAPLIB_LD="$CC -dynamiclib" diff --git a/console/yap.c b/console/yap.c index 604b1f576..86bd313c6 100755 --- a/console/yap.c +++ b/console/yap.c @@ -131,7 +131,7 @@ exec_top_level(int BootMode, YAP_init_args *iap) YAP_Exit(EXIT_SUCCESS); } -FILE *debugf; +//FILE *debugf; #ifdef LIGHT int diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 907daa6b8..148193b0a 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -69,7 +69,6 @@ typedef int _Bool; #define __WINDOWS__ 1 #endif #endif - #ifndef X_API #if (defined(_MSC_VER) || defined(__MINGW32__)) && defined(PL_KERNEL) #define X_API __declspec(dllexport) @@ -79,6 +78,11 @@ typedef int _Bool; #endif +#include "pl-types.h" + + + + /******************************* * EXPORT * *******************************/ @@ -129,47 +133,7 @@ stuff. #endif - /******************************* - * TYPES * - *******************************/ - - -#ifdef __WINDOWS__ -#ifndef INT64_T_DEFINED -#define INT64_T_DEFINED 1 -typedef __int64 int64_t; -typedef unsigned __int64 uint64_t; -#if (_MSC_VER < 1300) && !defined(__MINGW32__) -typedef long intptr_t; -typedef unsigned long uintptr_t; -#endif -#endif -#else -#include /* more portable than stdint.h */ -#endif - -#ifndef PL_HAVE_TERM_T -#define PL_HAVE_TERM_T -typedef intptr_t term_t; -#endif -typedef struct mod_entry *module_t; -typedef struct DB_STRUCT *record_t; -typedef uintptr_t atom_t; -typedef struct pred_entry *predicate_t; -typedef struct open_query_struct *qid_t; -typedef uintptr_t functor_t; -typedef int (*PL_agc_hook_t)(atom_t); -typedef uintptr_t foreign_t; /* return type of foreign functions */ -typedef wchar_t pl_wchar_t; /* wide character support */ -#include /* more portable than stdint.h */ -#if !defined(_MSC_VER) -typedef uintptr_t PL_fid_t; /* opaque foreign context handle */ -#endif -typedef int (*PL_dispatch_hook_t)(int fd); -typedef void *pl_function_t; - -#define fid_t PL_fid_t /* avoid AIX name-clash */ - +#include "pl-types.h" typedef struct _PL_extension { const char *predicate_name; /* Name of the predicate */ short arity; /* Arity of the predicate */ @@ -775,7 +739,7 @@ PL_EXPORT(int) PL_set_prolog_flag(const char *name, int type, ...); /******************************* * BLOBS * *******************************/ - +#ifndef BLOBS_H #define PL_BLOB_MAGIC_B 0x75293a00 /* Magic to validate a blob-type */ #define PL_BLOB_VERSION 1 /* Current version */ #define PL_BLOB_MAGIC (PL_BLOB_MAGIC_B|PL_BLOB_VERSION) @@ -830,7 +794,7 @@ PL_EXPORT(PL_blob_t*) YAP_find_blob_type(YAP_Atom at); PL_EXPORT(int) PL_unregister_blob_type(PL_blob_t *type); PL_EXPORT(int) PL_raise(int sig); - +#endif #if USE_GMP PL_EXPORT(int) PL_get_mpz(term_t t, mpz_t mpz); diff --git a/include/YapDefs.h b/include/YapDefs.h index 5b0e37702..bad305fca 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -18,6 +18,7 @@ #define _YAPDEFS_H 1 +#include #include #include @@ -43,7 +44,7 @@ #else #ifndef true typedef int _Bool; - +v #define bool _Bool; #define false 0 @@ -312,7 +313,7 @@ typedef void (*YAP_halt_hook)(int exit_code, void *closure); typedef YAP_Int YAP_opaque_tag_t; typedef YAP_Bool (*YAP_Opaque_CallOnFail)(void *); -typedef YAP_Bool (*YAP_Opaque_CallOnWrite)(void *, YAP_opaque_tag_t, void *, int); +typedef YAP_Bool (*YAP_Opaque_CallOnWrite)(FILE *, YAP_opaque_tag_t, void *, int); typedef YAP_Int (*YAP_Opaque_CallOnGCMark)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int); typedef YAP_Bool (*YAP_Opaque_CallOnGCRelocate)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int); @@ -334,6 +335,38 @@ typedef enum YAPC_COMPILE_ALL /* compile all predicates */ } yapc_exec_mode; +/** Stream Modes: */ +typedef enum stream_f { + Free_Stream_f = 0x000001, /**< Free YAP Stream */ + Input_Stream_f = 0x000002, /**< Input Stream */ + Output_Stream_f = 0x000004, /**< Output Stream in Truncate Mode */ + Append_Stream_f = 0x000008, /**< Output Stream in Append Mod */ + Eof_Stream_f = 0x000010, /**< Stream found an EOF */ + Null_Stream_f = 0x000020, /**< Stream is /dev/null, or equivant */ + Tty_Stream_f = 0x000040, /**< Stream is a terminal */ + Socket_Stream_f = 0x000080, /**< Socket Stream */ + Binary_Stream_f = 0x000100, /**< Stream is not eof */ + Eof_Error_Stream_f = 0x000200, /**< Stream should generate error on trying to read after EOF */ + Reset_Eof_Stream_f = 0x000400, /**< Stream should be reset on findind an EO (C-D and console.*/ + Past_Eof_Stream_f = 0x000800, /**< Read EOF from stream */ + Push_Eof_Stream_f = 0x001000, /**< keep on sennding EOFs */ + Seekable_Stream_f = 0x002000, /**< we can jump around the stream (std regular files) */ + Promptable_Stream_f = 0x004000, /**< Interactive line-by-line stream */ + Client_Socket_Stream_f= 0x008000, /**< socket in client mode */ + Server_Socket_Stream_f= 0x010000, /**< socket in server mode */ + InMemory_Stream_f = 0x020000, /**< buffer */ + Pipe_Stream_f = 0x040000, /**< FIFO buffer */ + Popen_Stream_f = 0x080000, /**< popen open, pipes mosylyn */ + User_Stream_f = 0x100000, /**< usually user_ipiy */ + HAS_BOM_f = 0x200000, /**< media for streamhas a BOM mar. */ + RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */ + RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */ + DoNotCloseOnAbort_Stream_f= 0x1000000 /**< do not close the stream after an abort event */ +} estream_f; + +typedef uint64_t stream_flags_t; + + /********* encoding ***********************/ typedef enum @@ -355,7 +388,7 @@ typedef enum { YAPC_ENABLE_GC, /* enable or disable garbage collection */ YAPC_ENABLE_AGC /* enable or disable atom garbage collection */ - } yap_flag_t; + } yap_flag_gc_t; typedef enum yap_enum_reset_t { YAP_EXEC_ABSMI = 0, diff --git a/include/YapError.h b/include/YapError.h index 5526ac6a6..ade9963aa 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -88,6 +88,7 @@ typedef enum PERMISSION_ERROR_OUTPUT_STREAM, PERMISSION_ERROR_OUTPUT_TEXT_STREAM, PERMISSION_ERROR_RESIZE_ARRAY, + PERMISSION_ERROR_READ_ONLY_FLAG, PERMISSION_ERROR_REPOSITION_STREAM, PRED_ENTRY_COUNTER_UNDERFLOW, REPRESENTATION_ERROR_CHARACTER, @@ -121,6 +122,7 @@ typedef enum TYPE_ERROR_KEY, TYPE_ERROR_LIST, TYPE_ERROR_NUMBER, + TYPE_ERROR_PARAMETER, TYPE_ERROR_PREDICATE_INDICATOR, TYPE_ERROR_PTR, TYPE_ERROR_REFERENCE, diff --git a/include/YapInterface.h b/include/YapInterface.h index 17942e831..58f65bd65 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -1878,7 +1878,7 @@ extern X_API char *YAP_CompileClause(YAP_Term); extern X_API int YAP_NewExo( YAP_PredEntryPtr ap, size_t data, void *user_di); -extern X_API int YAP_AssertTuples( YAP_PredEntryPtr pred, const YAP_Term *ts, size_t sz); +extern X_API int YAP_AssertTuples( YAP_PredEntryPtr pred, const YAP_Term *ts, size_t offset, size_t sz); /* int YAP_Init(YAP_init_args *) */ extern X_API YAP_Int YAP_Init(YAP_init_args *); @@ -1891,15 +1891,17 @@ extern X_API YAP_Int YAP_FastInit(char saved_state[]); #define IOSTREAM void #endif /* FPL_STREAM_H */ -extern X_API YAP_Term YAP_Read(IOSTREAM *s); +extern X_API YAP_Term YAP_Read(FILE *s); -extern X_API void YAP_Write(YAP_Term t,IOSTREAM *s,int); +extern X_API YAP_Term YAP_ReadFromStream(int s); -extern X_API IOSTREAM * YAP_TermToStream(YAP_Term t); +extern X_API void YAP_Write(YAP_Term t,FILE *s,int); -extern X_API IOSTREAM * YAP_InitConsult(int mode, const char *filename); +extern X_API FILE * YAP_TermToStream(YAP_Term t); -extern X_API void YAP_EndConsult(IOSTREAM *s); +extern X_API int YAP_InitConsult(int mode, const char *filename); + +extern X_API void YAP_EndConsult(int s); #ifndef _PL_STREAM_H // if we don't know what a stream is, just don't assume nothing about the pointer @@ -1973,13 +1975,6 @@ extern X_API void YAP_CloseAllOpenStreams(void); extern X_API void YAP_FlushAllStreams(void); -#define YAP_APPEND_STREAM 0x04 -#define YAP_PIPE_STREAM 0x08 -#define YAP_TTY_STREAM 0x10 -#define YAP_POPEN_STREAM 0x20 -#define YAP_BINARY_STREAM 0x40 -#define YAP_SEEKABLE_STREAM 0x80 - /* YAP_Term *YAP_NewSlots() */ extern X_API YAP_handle_t YAP_NewSlots(int); diff --git a/os/alias.c b/os/alias.c index 7faf27b61..af360bf8c 100644 --- a/os/alias.c +++ b/os/alias.c @@ -8,7 +8,7 @@ * * ************************************************************************** * * -* File: iopreds.c * +* File: alias.c * * Last rev: 5/2/88 * * mods: * * comments: Input/Output C implemented predicates * @@ -402,6 +402,7 @@ Yap_AddAlias (Atom arg, int sno) struct AliasDescS * Yap_InitStandardAliases(void) { + CACHE_REGS /* init standard aliases */ /* alloca alias array */ diff --git a/os/format.c b/os/format.c index df47b58d1..7918b6608 100644 --- a/os/format.c +++ b/os/format.c @@ -791,7 +791,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) } repeats -= GLOBAL_Stream[sno].linepos; repeats = (repeats < 0 ? 0 : repeats); - fill_pads( sno, repeats, &finfo); + fill_pads( sno, repeats, &finfo PASS_REGS); break; case '+': if (osno) { @@ -800,7 +800,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) osno = 0; } repeats = (repeats < 0 ? 0 : repeats); - fill_pads( sno, repeats, &finfo); + fill_pads( sno, repeats, &finfo PASS_REGS); break; case 't': { @@ -914,7 +914,7 @@ format2(Term tin, Term tf, Term tas USES_REGS) (f == FunctorAtom || f == FunctorString || f == FunctorCodes1 || f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) ) { - output_stream = Yap_OpenBufWriteStream(); + output_stream = Yap_OpenBufWriteStream( PASS_REGS1); mem_stream = true; } else { /* needs to change LOCAL_c_output_stream for write */ diff --git a/os/iopreds.c b/os/iopreds.c index a261fe11a..b62a144cf 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -144,6 +144,10 @@ unix_upd_stream_info (StreamDesc * s) #else { int filedes; /* visualc */ + if (!s->file) { + s->name = AtomNil; + return; + } filedes = fileno (s->file); if (isatty (filedes)) { #if HAVE_TTYNAME @@ -1612,8 +1616,9 @@ binary_file(char *file_name) } int - Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) - { +Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) +{ + CACHE_REGS int sno; Atom at; @@ -1628,7 +1633,6 @@ binary_file(char *file_name) } else at = AtomRead; initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at ); - UNLOCK(st->streamlock); return sno; } @@ -1794,8 +1798,6 @@ binary_file(char *file_name) void Yap_InitPlIO (void) { - CACHE_REGS - Int i; Yap_stdin = stdin; diff --git a/os/iopreds.h b/os/iopreds.h index 902973a8c..1932b87a3 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -262,7 +262,7 @@ void Yap_ConsolePipeOps( StreamDesc *st ); void Yap_SocketOps( StreamDesc *st ); void Yap_ConsoleSocketOps( StreamDesc *st ); bool Yap_ReadlineOps( StreamDesc *st ); -int Yap_OpenBufWriteStream(void); +int Yap_OpenBufWriteStream( USES_REGS1); void Yap_ConsoleOps( StreamDesc *s ); void Yap_init_socks(char *host, long interface_port); diff --git a/os/mem.c b/os/mem.c index 93d6018d7..95270d423 100644 --- a/os/mem.c +++ b/os/mem.c @@ -252,7 +252,6 @@ Yap_open_buf_write_stream(char **nbufp, size_t *ncharsp) } nbuf = malloc( nchars ); if(!nbuf) { - UNLOCK(st->streamlock); return -1; } } diff --git a/os/readline.c b/os/readline.c index ea4d1b612..2b1b0862f 100644 --- a/os/readline.c +++ b/os/readline.c @@ -68,28 +68,19 @@ typedef struct scan_atoms { static char * atom_enumerate(const char *prefix, int state) { + CACHE_REGS struct scan_atoms *index; Atom catom; Int i; -#ifdef THREADS - if ( !atomgen_key ) { - pthread_key_create(&atomgen_key, NULL); - state = FALSE; - } -#endif - if ( !state ) { index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms)); i = 0; catom = NIL; } else { -#ifdef O_PLMT - index = (struct scan_atoms *)pthread_getspecific(atomgen_key); -#else - index = LOCAL_search_atoms; -#endif + CACHE_REGS + index = LOCAL_search_atoms; catom = index->atom; i = index->pos; } @@ -111,11 +102,7 @@ atom_enumerate(const char *prefix, int state) if ( strstr( ap->StrOfAE, prefix) == ap->StrOfAE) { index->pos = i; index->atom = ap->NextOfAE; -#ifdef O_PLMT - pthread_setspecific(atomgen_key,index); -#else LOCAL_search_atoms = index; -#endif READ_UNLOCK(ap->ARWLock); return ap->StrOfAE; } @@ -123,11 +110,7 @@ atom_enumerate(const char *prefix, int state) READ_UNLOCK(ap->ARWLock); } } -#ifdef THREADS - pthread_setspecific(atomgen_key,NULL); -#else LOCAL_search_atoms = NULL; -#endif free(index); return NULL; } @@ -255,6 +238,7 @@ InitReadline(void) { static bool getLine( int inp, int out ) { + CACHE_REGS rl_instream = GLOBAL_Stream[inp].file; rl_outstream = GLOBAL_Stream[out].file; const char *myrl_line; @@ -324,7 +308,6 @@ ReadlinePutc (int sno, int ch) static int ReadlineGetc(int sno) { - CACHE_REGS StreamDesc *s = &GLOBAL_Stream[sno]; int ch; bool fetch = (s->u.irl.buf == NULL); diff --git a/os/readterm.c b/os/readterm.c index 0ca1ff4f0..1bc188dd6 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -875,8 +875,7 @@ static Int nofileerrors( USES_REGS1 ) static Int style_checker( USES_REGS1 ) { Term t = Deref( ARG1 ); - CACHE_REGS - + if (IsVarTerm(t)) { Term t = TermNil; if ( getYapFlag( MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) { @@ -922,10 +921,10 @@ static Int style_checker( USES_REGS1 ) Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings) { + CACHE_REGS Term bvar = MkVarTerm(), ctl; yhandle_t sl; - CACHE_REGS if (bindings) { ctl = Yap_MkApplTerm( Yap_MkFunctor(AtomVariableNames,1),1,&bvar); sl = Yap_InitSlot( bvar ); @@ -941,7 +940,7 @@ Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bind Yap_CloseStream(stream); if (bindings) { *bindings = Yap_GetFromSlot( sl ); - Yap_RecoverSlots( sl, 1 ); + Yap_RecoverSlots( sl, 1 PASS_REGS); } return rval; } @@ -951,7 +950,6 @@ Yap_ReadFromAtom(Atom a, Term opts) { Term rval; int sno; - CACHE_REGS if (IsWideAtom( a )) { wchar_t *ws = a->WStrOfAE; size_t len = wcslen(ws); @@ -972,7 +970,6 @@ readFromBuffer(const char *s, Term opts) { Term rval; int sno; - CACHE_REGS sno = Yap_open_buf_read_stream((char *)s, utf8_strlen1(s), ENC_ISO_UTF8, MEM_BUF_USER); rval = Yap_read_term(sno, opts, 3); diff --git a/os/streams.c b/os/streams.c index 3c45cbb21..98a21819b 100644 --- a/os/streams.c +++ b/os/streams.c @@ -451,6 +451,7 @@ SetBuffering ( int sno, Atom at ) if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IONBF, 0) < 0) return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set disable buffering"); } else { + CACHE_REGS LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; LOCAL_ErrorMessage = "in set_stream/2:buffer"; return false; @@ -725,7 +726,7 @@ do_set_stream (int sno, Term opts USES_REGS) break; case SET_STREAM_CLOSE_ON_ABORT: rc = rc && - SetCloseOnAbort ( sno, (args[SET_STREAM_CLOSE_ON_ABORT].tvalue == TermTrue) PASS_REGS); + SetCloseOnAbort ( sno, (args[SET_STREAM_CLOSE_ON_ABORT].tvalue == TermTrue)); break; case SET_STREAM_ENCODING: GLOBAL_Stream[sno]. encoding = enc_id(AtomOfTerm(args[SET_STREAM_ENCODING].tvalue)->StrOfAE); diff --git a/packages/ProbLog/simplecudd/LICENSE b/packages/ProbLog/simplecudd/LICENSE deleted file mode 100644 index 2501ec7e9..000000000 --- a/packages/ProbLog/simplecudd/LICENSE +++ /dev/null @@ -1,182 +0,0 @@ -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. diff --git a/packages/ProbLog/simplecudd/Makefile.in b/packages/ProbLog/simplecudd/Makefile.in deleted file mode 100755 index 5602084b2..000000000 --- a/packages/ProbLog/simplecudd/Makefile.in +++ /dev/null @@ -1,68 +0,0 @@ -# -# default base directory for YAP installation -# (EROOT for architecture-dependent files) -# -prefix = @prefix@ -exec_prefix = @exec_prefix@ -ROOTDIR = $(prefix) -EROOTDIR = @exec_prefix@ -abs_top_builddir = @abs_top_builddir@ -# -# where the binary should be -# -BINDIR = $(EROOTDIR)/bin -# -# where YAP should look for libraries -# -LIBDIR=@libdir@ -YAPLIBDIR=@libdir@/Yap -# -# where YAP should look for architecture-independent Prolog libraries -# -SHAREDIR=$(ROOTDIR)/share -# -# -CC=@CC@ -# -# -# You shouldn't need to change what follows. -# -INSTALL=@INSTALL@ -INSTALL_DATA=@INSTALL_DATA@ -INSTALL_PROGRAM=@INSTALL_PROGRAM@ -SHELL=/bin/sh -RANLIB=@RANLIB@ -srcdir=@srcdir@ -SO=@SO@ -#4.1VPATH=@srcdir@:@srcdir@/OPTYap -CWD=$(PWD) -# - -DYNAMIC = -CFLAGS = @CFLAGS@ -INCLUDE = -I@abs_top_builddir@ @CUDD_CPPFLAGS@ -LINKFLAGS = -lm -LINKLIBS = @CUDD_LIBS@ - -default: problogbdd - -problogbdd: problogbdd.o simplecudd.o general.o problogmath.o - @echo Making problogbdd... - @echo Copyright Katholieke Universiteit Leuven 2008 - @echo Authors: T. Mantadelis, A. Kimmig, B. Gutmann, I. Thon, G. Van den Broeck - $(CC) problogbdd.o simplecudd.o general.o problogmath.o $(LINKLIBS) $(LINKFLAGS) -o problogbdd - -%.o : $(srcdir)/%.c - $(CC) $(CFLAGS) $(INCLUDE) $(DYNAMIC) -c $< - -clean: - rm -f *.o problogbdd - -install: default - $(INSTALL_PROGRAM) problogbdd $(DESTDIR)$(BINDIR) - -install-examples: - -distclean: clean - rm -f Makefile - diff --git a/packages/ProbLog/simplecudd/general.c b/packages/ProbLog/simplecudd/general.c deleted file mode 100644 index b34b7dd5b..000000000 --- a/packages/ProbLog/simplecudd/general.c +++ /dev/null @@ -1,298 +0,0 @@ -/******************************************************************************\ -* * -* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) * -* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) * -* * -* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 * -* * -* Author: Theofrastos Mantadelis * -* File: general.c * -* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ * -* $Revision:: 4880 $ * -* * -******************************************************************************** -* * -* 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. * -* * -* The End * -* * -\******************************************************************************/ - - -#include "general.h" - -/* Number Handling */ - -int getRealNumber(char *c, double *number) { - char *unparsed_string; - errno = 0; - *number = strtod(c, &unparsed_string); - return !(errno == ERANGE || unparsed_string == c || *unparsed_string != '\0'); -} - -int getIntNumber(char *c, int *number) { - char *unparsed_string; - errno = 0; - long int numberl = strtol(c, &unparsed_string, 10); - *number = (int) numberl; - return !(errno == ERANGE || unparsed_string == c || *unparsed_string != '\0' || numberl > INT_MAX || numberl < INT_MIN); -} - -inline int getPosNumber(char *c, int *number) { - return (getIntNumber(c, number) && *number >= 0); -} - -int IsRealNumber(char *c) { - int i, l; - l = strlen(c); - if (l <= 0) return 0; - if (l == 1) return IsNumberDigit(c[0]); - for(i = 1; i < strlen(c); i++) { - if (c[i] == '.') return IsPosNumber(&c[i + 1]); - if (!IsNumberDigit(c[i])) return 0; - } - return (IsNumberDigit(c[0]) || IsSignDigit(c[0])); -} - -int IsPosNumber(const char *c) { - int i, l; - l = strlen(c); - if (l <= 0) return 0; - for(i = 0; i < strlen(c); i++) { - if (!IsNumberDigit(c[i])) return 0; - } - return 1; -} - -int IsNumber(const char *c) { - int i, l; - l = strlen(c); - if (l <= 0) return 0; - if (l == 1) return IsNumberDigit(c[0]); - for(i = 1; i < strlen(c); i++) { - if (!IsNumberDigit(c[i])) return 0; - } - return (IsNumberDigit(c[0]) || IsSignDigit(c[0])); -} - -/* File Handling */ - -char * freadstr(FILE *fd, const char *separators) { - char *str; - int buf, icur = 0, max = 10; - str = (char *) malloc(sizeof(char) * max); - str[0] = '\0'; - do { - if ((buf = fgetc(fd)) != EOF) { - if (icur == (max - 1)) { - max = max * 2; - str = (char *) realloc(str, sizeof(char) * max); - } - if (!CharIn((char) buf, separators)) { - str[icur] = (char) buf; - icur++; - str[icur] = '\0'; - } - } - } while(!CharIn(buf, separators) && !feof(fd)); - return str; -} - -int CharIn(const char c, const char *in) { - int i; - for (i = 0; i < strlen(in); i++) - if (c == in[i]) return 1; - return 0; -} - -/* string handling */ - -int patternmatch(char *pattern, char *thestr) { - int i, j = -1, pl = strlen(pattern), sl = strlen(thestr); - for(i = 0; i < pl; i++) { - if (pattern[i] == '*') { - do { - i++; - if (i == pl) return 1; - } while(pattern[i] == '*'); - do { - j++; - if (j >= sl) return 0; - if ((thestr[j] == pattern[i]) && patternmatch(pattern + i, thestr + j)) return 1; - } while(1); - } else { - j++; - if (j >= sl) return 0; - if (pattern[i] != thestr[j]) return 0; - } - } - return (pl == sl); -} diff --git a/packages/ProbLog/simplecudd/general.h b/packages/ProbLog/simplecudd/general.h deleted file mode 100644 index 4b22bef5d..000000000 --- a/packages/ProbLog/simplecudd/general.h +++ /dev/null @@ -1,209 +0,0 @@ -/******************************************************************************\ -* * -* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) * -* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) * -* * -* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 * -* * -* Author: Theofrastos Mantadelis * -* File: general.h * -* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ * -* $Revision:: 4880 $ * -* * -******************************************************************************** -* * -* 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. * -* * -* The End * -* * -\******************************************************************************/ - - -#include -#include -#include -#include -#include - -#define IsNumberDigit(c) ('0' <= c && c <= '9') -#define IsSignDigit(c) (c == '+' || c == '-') -#define isOperator(x) (x == '+' || x == '*' || x == '#' || x == '=') -#define freadline(fd) freadstr(fd, "\n"); - -int getRealNumber(char *c, double *number); -int getIntNumber(char *c, int *number); -inline int getPosNumber(char *c, int *number); -int IsRealNumber(char *c); -int IsPosNumber(const char *c); -int IsNumber(const char *c); -char * freadstr(FILE *fd, const char *separators); -int CharIn(const char c, const char *in); -int patternmatch(char *pattern, char *thestr); diff --git a/packages/ProbLog/simplecudd/problogbdd.c b/packages/ProbLog/simplecudd/problogbdd.c deleted file mode 100644 index 13613b914..000000000 --- a/packages/ProbLog/simplecudd/problogbdd.c +++ /dev/null @@ -1,1980 +0,0 @@ -/******************************************************************************\ -* * -* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) * -* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) * -* * -* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 * -* * -* Author: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann * -* File: problogbdd.c * -* $Date:: 2010-10-06 18:06:08 +0200 (Wed, 06 Oct 2010) $ * -* $Revision:: 4883 $ * -* * -******************************************************************************** -* * -* 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. * -* * -* The End * -* * -\******************************************************************************/ - -//#include -//#include -#include "simplecudd.h" -#include "problogmath.h" -#include -#include - -#define VERSION "2.0.1" - - -#ifndef max - #define max( a, b ) ( ((a) > (b)) ? (a) : (b) ) -#endif - -// INFINITY macro does not work on trantor (64-bit linux of some kind) -const double my_infinity = 1.0/0.0; - -typedef struct _parameters { - int loadfile; - int savedfile; - int exportfile; - int inputfile; - int debug; - int errorcnt; - int *error; - int method; - int queryid; - int timeout; - double sigmoid_slope; - int online; - int maxbufsize; - char *ppid; - int orderfile; - int utilfile; - int independent_forest; - int local_search; - int dynreorder; - int staticorder; -} parameters; - -typedef struct _gradientpair { - double probability; - double gradient; -} gradientpair; - -typedef struct _extmanager { - DdManager *manager; - DdNode *t, *f; - hisqueue *his; - namedvars varmap; -} extmanager; - -typedef struct _bdd_mgr { - extmanager extmanager; - DdNode *root; -} bdd_mgr; - - -int argtype(const char *arg); -void printhelp(int argc, char **arg); -parameters loadparam(int argc, char **arg); -parameters params; - -void handler(int num); -void pidhandler(int num); -void termhandler(int num); - -void myexpand(extmanager MyManager, DdNode *Current); -double CalcProbability(extmanager MyManager, DdNode *Current); -double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current); -gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern, int type); -int patterncalculated(char *pattern, extmanager MyManager, int loc); -char * extractpattern(char *thestr); - -// added by GUY -double* read_util_file(char * filename); -int forestSize(DdNode **forest); -int compare_util_adds(const void* A, const void* B); -void exact_strategy_search(extmanager* MyManager, DdNode **forest, double* utilities); -DdNode* buildADDfromBDD(extmanager* MyManager, DdNode *Current, DdManager* addmgr); -void ReInitAndUnrefHistory(hisqueue *HisQueue, int varcnt, DdManager* mgr); -char* GetAddNodeVarNameDisp(namedvars varmap, DdNode *node); -int extractstrategy(extmanager* MyManager, DdManager * add_mgr, DdNode *Current, DdNode *max_node); -DdNode * setLowerBound(DdManager * dd, DdNode * f, double lowerBound); -DdNode * setLowerBoundRecur(DdManager * dd, DdNode * f, double lowerBound); -void local_strategy_search(extmanager* MyManager, DdNode **forest, double* utilities); -void local_strategy_search_independent(bdd_mgr* bdd_mgrs, double* utilities, int nb_bdds, namedvars globalvars); -double expected_value(extmanager* MyManager, DdNode **forest, double* utilities); -void print_strategy(namedvars varmap); -void newManager(extmanager* MyManager,bddfileheader fileheader, int nbManagers); -bdd_mgr* generateIndependentBDDForest(bddfileheader fileheader); -int LoadVariableDataForForest(namedvars varmap, char *filename); -int printTime(void); - -int main(int argc, char **arg) { - extmanager MyManager; - DdNode *bdd, **forest, *bakbdd; - bddfileheader fileheader; - int i, ivarcnt, code, curbdd; - gradientpair tvalue; - double probability = -1.0; - char *varpattern; - bdd_mgr* bdd_mgrs; - varpattern = NULL; - code = -1; - params = loadparam(argc, arg); - - //Initializin to NULL to be safe? - bdd = NULL; - bakbdd = NULL; - forest = NULL; - bdd_mgrs = NULL; - - if (params.errorcnt > 0) { - printhelp(argc, arg); - for (i = 0; i < params.errorcnt; i++) { - fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]); - } - return -1; - } - - if (params.online == 0 && params.loadfile == -1) { - printhelp(argc, arg); - fprintf(stderr, "Error: you must specify a loading file.\n"); - return -1; - } - - if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l' && arg[params.method][0] != 's') { - printhelp(argc, arg); - fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [s]earch for strategy, [o]nline.\n"); - return -1; - } - - if (params.method != 0 && (arg[params.method][0] == 'g' || arg[params.method][0] == 'p' || arg[params.method][0] == 'l') && params.inputfile == -1) { - printhelp(argc, arg); - fprintf(stderr, "Error: an input file is necessary for probability, gradient or line search calculation methods.\n"); - return -1; - } - - if (params.debug) DEBUGON; - RAPIDLOADON; - SETMAXBUFSIZE(params.maxbufsize); - - signal(SIGINT, termhandler); -#ifndef __MINGW32__ - if (params.ppid != NULL) { - signal(SIGALRM, pidhandler); - alarm(5); - } else { - signal(SIGALRM, handler); - alarm(params.timeout); - } -#endif - - if (params.online) { - if (params.dynreorder == 1) - MyManager.manager = simpleBDDinit(0); - else - MyManager.manager = simpleBDDinitNoReOrder(0); - MyManager.t = HIGH(MyManager.manager); - MyManager.f = LOW(MyManager.manager); - MyManager.varmap = InitNamedVars(1, 0); - bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap); - bakbdd = bdd; - ivarcnt = GetVarCount(MyManager.manager); - } else if(params.independent_forest>0){ - // the flag to create a forest of independent bdds is set - fileheader = ReadFileHeader(arg[params.loadfile]); - if (_debug) fprintf(stderr,"Generating forest of independent BDDs.\n"); - bdd_mgrs = generateIndependentBDDForest(fileheader); - ivarcnt = fileheader.varcnt; - MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - } else{ - fileheader = ReadFileHeader(arg[params.loadfile]); - switch(fileheader.filetype) { - case BDDFILE_SCRIPT: - if (params.dynreorder == 1) - MyManager.manager = simpleBDDinit(fileheader.varcnt); - else - MyManager.manager = simpleBDDinitNoReOrder(fileheader.varcnt); - MyManager.t = HIGH(MyManager.manager); - MyManager.f = LOW(MyManager.manager); - MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - if (params.staticorder > 0) { - char **Order = GetVariableOrder(arg[params.staticorder], MyManager.varmap.varcnt); - for (i = 0; i < MyManager.varmap.varcnt; i++) - if (Order[i] != NULL) AddNamedVarAt(MyManager.varmap, Order[i], i); - } - if (fileheader.version > 1) { - forest = FileGenerateBDDForest(MyManager.manager, MyManager.varmap, fileheader); - bdd = forest[0]; - bakbdd = bdd; - } else { - forest = NULL; - bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader); - bakbdd = bdd; - } - ivarcnt = fileheader.varcnt; - break; - case BDDFILE_NODEDUMP: - if (params.dynreorder == 1) - MyManager.manager = simpleBDDinit(fileheader.varcnt); - else - MyManager.manager = simpleBDDinitNoReOrder(fileheader.varcnt); - MyManager.t = HIGH(MyManager.manager); - MyManager.f = LOW(MyManager.manager); - MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile); - ivarcnt = fileheader.varcnt; - break; - default: - fprintf(stderr, "Error: not a valid file format to load.\n"); - return -1; - break; - } - } - - - alarm(0); - - // problem specifics - - if (params.method == 0 || arg[params.method][0] != 's') { - if (bdd != NULL || bdd_mgrs != NULL) { - ivarcnt = RepairVarcnt(&MyManager.varmap); - code = 0; - if (params.inputfile != -1) { - if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1; - if (!all_loaded(MyManager.varmap, 1)) return -1; - } - // impose a predifined order good for debugging - // can be used with a partial number of variables to impose ordering at beggining of BDD - if (params.orderfile != -1) { - ImposeOrder(MyManager.manager, MyManager.varmap, GetVariableOrder(arg[params.orderfile], MyManager.varmap.varcnt)); - } - curbdd = 0; - do { - MyManager.his = InitHistory(ivarcnt); - if (params.method != 0) { - switch(arg[params.method][0]) { - case 'g': - for (i = 0; i < MyManager.varmap.varcnt; i++) { - if (MyManager.varmap.vars[i] != NULL) { - - // check whether this is a continues fact - if (MyManager.varmap.dynvalue[i] == NULL) { // nope, regular fact - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 0); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } - ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); - } - } else { // it is! let's do the Hybrid Problog Magic - // first for mu - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 1); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,mu,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,mu,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } - } - ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); - - // then for sigma - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 2); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,sigma,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,sigma,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } - } - ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); - } - - } else { - fprintf(stderr, "Error: no variable name given for parameter.\n"); - } - } - if (probability < 0.0) { - // no nodes, so we have to calculate probability ourself - tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL, 0); - probability = tvalue.probability; - } - printf("query_probability(%s,%e).\n", arg[params.queryid], probability); - break; - case 'l': - tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL, 0); - probability = tvalue.probability; - printf("query_probability(%s,%e).\n", arg[params.queryid], probability); - break; - case 'p': - printf("probability(%e).\n", CalcProbability(MyManager, bdd)); - break; - case 'o': - onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd); - break; - default: - myexpand(MyManager, bdd); - break; - } - } else { - myexpand(MyManager, bdd); - } - if (forest != NULL) { - curbdd++; - bdd = forest[curbdd]; - } else { - bdd = NULL; - } - // Guy: I removed it, why is it here? - // ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - } while(bdd != NULL); - - bdd = bakbdd; - if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]); - if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]); - } - }else{ - // param "s" is set - // do strategy search on the forest - code = 0; - if(params.independent_forest>0){ - //the forest consists of independent bdds - LoadVariableDataForForest(MyManager.varmap,arg[params.inputfile]); - if(bdd_mgrs[0].root == NULL){ - fprintf(stderr, "Error: No BDDs were generated.\n"); - return -1; - } - if (_debug) fprintf(stderr,"Initializing histories.\n"); - if(params.local_search>0){ - if (_debug) fprintf(stderr,"Independent local search.\n"); - local_strategy_search_independent(bdd_mgrs, read_util_file(arg[params.utilfile]), fileheader.intercnt, MyManager.varmap); - }else{ - if (_debug) fprintf(stderr,"Independent exact search.\n"); - fprintf(stderr, "Error: independent exact search not supported yet.\n"); - return -1; - } - }else{ - ivarcnt = RepairVarcnt(&MyManager.varmap); - //the forest is a bdd with multiple entry points - if (params.inputfile != -1) { - if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1; - if (!all_loaded(MyManager.varmap, 1)) return -1; - } - // impose a predifined order good for debugging - // can be used with a partial number of variables to impose ordering at beggining of BDD - if (params.orderfile != -1) { - ImposeOrder(MyManager.manager, MyManager.varmap, GetVariableOrder(arg[params.orderfile], MyManager.varmap.varcnt)); - } - MyManager.his = InitHistory(ivarcnt); - if (_debug) fprintf(stderr,"Initialized shared history with %i variables.\n", ivarcnt); - if(params.local_search>0){ - if (_debug) fprintf(stderr,"Local search.\n"); - local_strategy_search(&MyManager, forest, read_util_file(arg[params.utilfile])); - }else{ - if (_debug) fprintf(stderr,"Exact search.\n"); - exact_strategy_search(&MyManager, forest, read_util_file(arg[params.utilfile])); - } - free(MyManager.his); - } - print_strategy(MyManager.varmap); - } - if (_debug) fprintf(stderr,"Cleaning up.\n"); - if(params.independent_forest>0){ - // TODO clean up memory - the existing code gives an invalid pointer problem - }else{ - if (MyManager.manager != NULL) { - KillBDD(MyManager.manager); - free(MyManager.varmap.dvalue); - free(MyManager.varmap.ivalue); - if (MyManager.varmap.dynvalue != NULL) { - for(i = 0; i < MyManager.varmap.varcnt; i++) - if (MyManager.varmap.dynvalue[i] != NULL) { - free(MyManager.varmap.dynvalue[i]); - } - free(MyManager.varmap.dynvalue); - } - for (i = 0; i < MyManager.varmap.varcnt; i++) - free(MyManager.varmap.vars[i]); - free(MyManager.varmap.vars); - } - } - if (params.error != NULL) free(params.error); - - return code; - -} - -////////////////// -// Added by Guy // -////////////////// - -double* read_util_file(char *filename){ - FILE* file; - double line; - int nb_lines; - double *utils; - int i=0; - if ((file = fopen(filename, "r")) == NULL) { - perror(filename); - return NULL; - } - // Read file - fscanf(file, "%i\n", &nb_lines); - utils = (double *) malloc(sizeof(double)*nb_lines); - //utils = new double[nb_lines]; - while (!feof(file)) { - fscanf(file, "%lf\n", &line); - //fprintf(stderr,"read %g.\n", line); - if(i>nb_lines) { - fprintf(stderr,"The number of lines field of %i does not match the number of lines in the file.\n",nb_lines); - fclose(file); - exit(1); - } - utils[i++] = line; - } - fclose(file); - if(i!=nb_lines) { - fprintf(stderr,"The number of lines field of %i does not match the number of lines in the file %i.\n",nb_lines,i); - fclose(file); - exit(1); - } - if (params.debug) for(i=0;iutil_spread < ((const util_add*) B)->util_spread) return 1; - else if (((const util_add*) A)->util_spread > ((const util_add*) B)->util_spread) return -1; - else return 0; -} - -void exact_strategy_search(extmanager* MyManager, DdNode **forest, double* utilities){ - DdManager* add_mgr; - DdNode *sum, *temp, *add_ps, *constant; - DdNode *max_node; - FILE *outfile; //output file pointer for .dot file - int i; - char filename[128]; - char** names; - int n = forestSize(forest); - double utility_to_go = 0.000001; - util_add * util_adds = (util_add *) malloc(sizeof(util_add)*n); - - names = NULL; - if (params.debug) { - fprintf(stderr, "init add\n"); - } - if (params.dynreorder == 1) { - add_mgr = simpleBDDinit(MyManager->varmap.varcnt); - }else{ - add_mgr = simpleBDDinitNoReOrder(MyManager->varmap.varcnt); - } - if (params.debug){ - fprintf(stderr, "end init add\n"); - } - - if (params.debug) { - names= malloc(sizeof(char*)*MyManager->varmap.varcnt); - for(i = MyManager->varmap.varstart ;i < MyManager->varmap.varcnt; i++){ - names[i- MyManager->varmap.varstart] = MyManager->varmap.vars[i]; - } - } - - for(i=n-1;i>=0;i--){ - if (params.debug) { - // write BDD file - snprintf(filename, sizeof(filename), "bdd-total.dot"); - outfile = fopen(filename,"w"); - Cudd_DumpDot(MyManager->manager, n, forest, names, NULL, outfile); - fclose(outfile); - - temp = Cudd_BddToAdd(MyManager->manager,forest[i]); - Cudd_Ref(temp); - snprintf(filename, sizeof(filename), "bdd-%i.dot", i+1); - outfile = fopen(filename,"w"); - Cudd_DumpDot(MyManager->manager, 1, &temp,names, NULL, outfile); - fclose(outfile); - Cudd_RecursiveDeref(MyManager->manager,temp); - } - - // create ADD for Ps - add_ps = buildADDfromBDD(MyManager,forest[i],add_mgr); - Cudd_Ref(add_ps); - if (params.debug) fprintf(stderr, "built add_ps\n"); - ReInitAndUnrefHistory(MyManager->his, MyManager->varmap.varcnt,add_mgr); - - Cudd_RecursiveDeref(MyManager->manager,forest[i]); - - if (params.debug) { - // write ADD-Ps file - snprintf(filename, sizeof(filename), "add-ps-%i.dot", i+1); - outfile = fopen(filename,"w"); - Cudd_DumpDot(add_mgr, 1, &add_ps, names, NULL, outfile); - fclose(outfile); - } - //if (1 || _debug) fprintf(stderr,"best terminal of add_ps after %i now %g.\n", i,cuddV(Cudd_addFindMax(add_mgr,add_ps))); - //create ADD for u - constant = Cudd_addConst(add_mgr,utilities[i]); - Cudd_Ref(constant); - util_adds[i].root = Cudd_addApply(add_mgr,Cudd_addTimes,add_ps,constant); - Cudd_Ref(util_adds[i].root); - Cudd_RecursiveDeref(add_mgr,constant); - Cudd_RecursiveDeref(add_mgr,add_ps); - //add_ps can only be dereferenced when the history is cleared or when referenced twice. - - if (params.debug) { - // write ADD-U file - snprintf(filename, sizeof(filename), "add-u-%i.dot", i+1); - outfile = fopen(filename,"w"); - Cudd_DumpDot(add_mgr, 1, &util_adds[i].root, names, NULL, outfile); - fclose(outfile); - } - - // compute the maximum achievable utility to set useless terminals to -inf - max_node = Cudd_addFindMax(add_mgr,util_adds[i].root); - util_adds[i].util_spread = cuddV(max_node); - max_node = Cudd_addFindMin(add_mgr,util_adds[i].root); - util_adds[i].util_spread += -cuddV(max_node); - utility_to_go += util_adds[i].util_spread; - - //if (1 || _debug) fprintf(stderr,"best terminal of util_add after %i now %g.\n", i,cuddV(Cudd_addFindMax(add_mgr,util_adds[i].root))); - } - - qsort(util_adds, (size_t)n, sizeof(util_add), compare_util_adds); - - sum = Cudd_addConst(add_mgr,0); - Cudd_Ref(sum); - for(i=0;ihis, MyManager->varmap.varcnt); - extractstrategy(MyManager, add_mgr, sum, max_node); - Cudd_RecursiveDeref(add_mgr,sum); - -} - -DdNode* buildADDfromBDD(extmanager* MyManager, DdNode *Current, DdManager* addmgr) { - // the created adds are not dereferenced - // must be done based on the dynamic programming table - DdNode *h, *l; - hisnode *Found; - char *curnode; - double fact_prob; - int isDecision; - DdNode *lowvalue, *highvalue, *thisvalue; - DdNode *lowAdd, *highAdd; - DdNode* var; - DdNode *posprob, *negprob; - - curnode = NULL; - - //if (_debug && Cudd_DebugCheck(addmgr)!=0) exit(-1); - - if (_debug) { - fprintf(stderr, "(%p) ", Current); - curnode = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, Current); - fprintf(stderr, " aka %s\n", curnode); - } - - // base cases - if (Current == MyManager->t){ - thisvalue = Cudd_ReadOne(addmgr); - Cudd_Ref(thisvalue); - //if(_debug && Cudd_DebugCheck(addmgr)!=0) exit(-1); - return thisvalue; - } - if (Current == MyManager->f){ - thisvalue = Cudd_ReadZero(addmgr); - Cudd_Ref(thisvalue); - //if(_debug && Cudd_DebugCheck(addmgr)!=0) exit(-1); - return thisvalue; - } - - //node is in cache - if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) != NULL){ - if (_debug) fprintf(stderr, "found node %p (%s) in history\n", Current,curnode); - return (DdNode*)(Found->dynvalue); - } - - //inductive case - l = LowNodeOf(MyManager->manager, Current); - if (_debug) fprintf(stderr, "l(%s)->%p", curnode,l); - lowvalue = buildADDfromBDD(MyManager,l,addmgr); - - h = HighNodeOf(MyManager->manager, Current); - if (_debug) fprintf(stderr, "h(%s)->%p", curnode,h); - highvalue = buildADDfromBDD(MyManager,h,addmgr); - - //if(params.debug && Cudd_DebugCheck(addmgr)!=0) exit(-1); - - isDecision = MyManager->varmap.ivalue[GetIndex(Current) - MyManager->varmap.varstart]; - if(isDecision){ - //decision - if (_debug) fprintf(stderr,"%p (%s) is a decision\n",Current,curnode); - var = Cudd_addIthVar(addmgr,(int)GetIndex(Current)); - Cudd_Ref(var); - thisvalue=Cudd_addIte(addmgr,var,highvalue,lowvalue); - Cudd_Ref(thisvalue); - Cudd_RecursiveDeref(addmgr,var); - } else { - //probabilistic node - if (_debug) fprintf(stderr,"%p (%s) is a probabilistic fact",Current,curnode); - fact_prob = MyManager->varmap.dvalue[GetIndex(Current) - MyManager->varmap.varstart]; - if (_debug) fprintf(stderr, " with probability %lf \n", fact_prob); - posprob = Cudd_addConst(addmgr,fact_prob); - Cudd_Ref(posprob); - highAdd=Cudd_addApply(addmgr,Cudd_addTimes,posprob,highvalue); - Cudd_Ref(highAdd); - Cudd_RecursiveDeref(addmgr,posprob); - - negprob=Cudd_addConst(addmgr,1-fact_prob); - Cudd_Ref(negprob); - lowAdd= Cudd_addApply(addmgr,Cudd_addTimes,negprob,lowvalue); - Cudd_Ref(lowAdd); - Cudd_RecursiveDeref(addmgr,negprob); - - thisvalue = Cudd_addApply(addmgr,Cudd_addPlus,highAdd,lowAdd); - Cudd_Ref(thisvalue); - - Cudd_RecursiveDeref(addmgr,lowAdd); - Cudd_RecursiveDeref(addmgr,highAdd); - } - AddNode(MyManager->his, MyManager->varmap.varstart, Current, 0, 0, thisvalue); - return thisvalue; -} - - -void ReInitAndUnrefHistory(hisqueue *HisQueue, int varcnt, DdManager* mgr) { - int i, j; - for (i = 0; i < varcnt; i++) { - if (HisQueue[i].thenode != NULL) { - for (j = 0; j < HisQueue[i].cnt; j++){ - if(HisQueue[i].thenode[j].ivalue != 0){ - //if (_debug) fprintf(stderr,"At (%i,%i), unreffing node %i",i,j,HisQueue[i].thenode[j].ivalue); - Cudd_RecursiveDeref(mgr,(DdNode*)(HisQueue[i].thenode[j].dynvalue)); - } - } - free(HisQueue[i].thenode); - HisQueue[i].thenode = NULL; - } - HisQueue[i].cnt = 0; - } -} - -char* GetAddNodeVarNameDisp(namedvars varmap, DdNode *node) { - unsigned int index; - char *buffer = malloc(sizeof(char)*128); - if (Cudd_IsConstant(node)) { - snprintf(buffer, 128, "%lf", cuddV(node)); - return buffer; - } - if (NULL == node) return "(null)"; - index = GetIndex(node); - return varmap.vars[index - varmap.varstart]; -} - -int extractstrategy(extmanager* MyManager, DdManager * add_mgr, DdNode *Current, DdNode *max_node) { - char *curnode; - int result; - hisnode *Found; - - if (params.debug) { - fprintf(stderr, "handling node %p", Current); - curnode = GetAddNodeVarNameDisp(MyManager->varmap, Current); - fprintf(stderr, " aka %s\n", curnode); - } - - if(max_node == Current) return 1; - else if (Cudd_IsConstant(Current)) return 0; - else{ - if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) != NULL) { - return Found->ivalue; - } - if(extractstrategy(MyManager,add_mgr,LowNodeOf(add_mgr, Current),max_node)){ - // set strategy to 0 - MyManager->varmap.dvalue[GetIndex(Current) - MyManager->varmap.varstart] = 0; - result = 1; - }else if(extractstrategy(MyManager,add_mgr,HighNodeOf(add_mgr, Current),max_node)){ - // set strategy to 1 - MyManager->varmap.dvalue[GetIndex(Current) - MyManager->varmap.varstart] = 1; - result = 1; - }else result = 0; - AddNode(MyManager->his, MyManager->varmap.varstart, Current, 0, result, NULL); - return result; - } -} - -DdNode * setLowerBound(DdManager * dd, DdNode * f, double lowerBound) { - DdNode *res; - do { - res = setLowerBoundRecur(dd,f,lowerBound); - } while (dd->reordered == 1); - return(res); -} - -DdNode * setLowerBoundRecur(DdManager * dd, DdNode * f, double lowerBound) { - DdNode *res, *fv, *fvn, *T, *E; - DD_CTFP1 cacheOp; - - statLine(dd); - if (cuddIsConstant(f)) { - if(cuddV(f)index,T,E); - if (res == NULL) { - Cudd_RecursiveDeref(dd,T); - Cudd_RecursiveDeref(dd,E); - return(NULL); - } - cuddDeref(T); - cuddDeref(E); - - /* Store result. */ - cuddCacheInsert1(dd,cacheOp,f,res); - return(res); -} - -// TODO extmanager* or extmanager ??????? -// Is copying the varmap not too inefficient? -void local_strategy_search(extmanager* MyManager, DdNode **forest, double* utilities){ - double tempev; - int i; - int j = 0; - int changed = 1; - double bestev = expected_value(MyManager, forest, utilities); - if (_debug) fprintf(stderr,"Initial strategy has reward %g.\n", bestev); - while(changed){ - j++; - if (_debug) fprintf(stderr,"starting iteration %i.\n", j); - changed = 0; - for(i = 0; i < MyManager->varmap.varcnt; i++){ - if (MyManager->varmap.ivalue[i] == 1) { - //it's a decision, flip it' - MyManager->varmap.dvalue[i] = 1-MyManager->varmap.dvalue[i]; - tempev = expected_value(MyManager, forest, utilities); - if(tempev > bestev){ - if (_debug) fprintf(stderr,"found new best strategy (%g > %g).\n", tempev, bestev); - bestev = tempev; - changed = 1; - }else{ - if (_debug) fprintf(stderr,"keeping old strategy (%g < %g).\n", tempev, bestev); - MyManager->varmap.dvalue[i] = 1-MyManager->varmap.dvalue[i]; - } - } - } - } - if (_debug) fprintf(stderr,"expected_value(%g).\n", bestev); - printf("expected_value(%g).\n", bestev); -} - -typedef struct _decision{ - int var; - int nb_rel_bdds; - int alloc_rel_bdds; - int* rel_bdds; - int* rel_bdds_var; -} decision; - -void local_strategy_search_independent(bdd_mgr* bdd_mgrs, double* utilities, int nb_bdds, namedvars globalvars){ - int i, j, index; - int changed; - double* bdd_ev = malloc(sizeof(double)*nb_bdds); - double* bdd_ev_temp = malloc(sizeof(double)*nb_bdds); - double difference; - double new_strategy; - int nb_dec_vars = 0; - decision* decs = (decision*) malloc(sizeof(decision)*globalvars.varcnt); - decision* decision; - - // Initialize all BDDs and compute their utility - if (_debug) fprintf(stderr,"Initializing BDDs and computing the starting utility\n"); - for(i=0;ivar = i; - decision->nb_rel_bdds = 0; - decision->alloc_rel_bdds = 8; - decision->rel_bdds = (int*) malloc(sizeof(int)*8); - decision->rel_bdds_var = (int*)malloc(sizeof(int)*8); - for(j=0;j=0){ - if (_debug) fprintf(stderr," %i", j); - bdd_mgrs[j].extmanager.varmap.dvalue[index] = globalvars.dvalue[i]; - if(decision->nb_rel_bdds == decision->alloc_rel_bdds){ - // increase array size - decision->alloc_rel_bdds = 2*decision->alloc_rel_bdds; - decision->rel_bdds = (int*) realloc(decision->rel_bdds,sizeof(int)*decision->alloc_rel_bdds); - decision->rel_bdds_var = (int*) realloc(decision->rel_bdds_var,sizeof(int)*decision->alloc_rel_bdds); - } - decision->rel_bdds[decision->nb_rel_bdds] = j; - decision->rel_bdds_var[decision->nb_rel_bdds] = index; - decision->nb_rel_bdds++; - } - } - }else{ - if (_debug) fprintf(stderr," is not a decision, affecting bdds"); - for(j=0;j=0){ - if (_debug) fprintf(stderr," %i", j); - bdd_mgrs[j].extmanager.varmap.dvalue[index] = globalvars.dvalue[i]; - } - } - } - if (_debug) fprintf(stderr,".\n"); - } - - if (_debug) fprintf(stderr,"Starting Search\n"); - if (_debug) fprintf(stderr,"There are %i decisions.\n",nb_dec_vars); - do{ - changed = 0; - if (_debug) fprintf(stderr,"New Iteration\n"); - for(i=0;i0){ - // it's an improvement - globalvars.dvalue[decs[i].var] = new_strategy; - changed = 1; - for(j=0;jhis, MyManager->varmap.varcnt); - //printf("final sum is %e.\n", sum); - return sum; -} - -void print_strategy(namedvars varmap){ - int i; - for(i = 0; i < varmap.varcnt; i++){ - if (varmap.ivalue[i] == 1) { - // it's a decision, print it - // if it contains an '_', it must be quoted, - // otherwise don't quote because it must parsed as an integer in prolog - if(strchr(varmap.vars[i]+1,'_')==NULL){ - if (_debug) fprintf(stderr,"strategy(%s,%g).\n",varmap.vars[i]+1, varmap.dvalue[i]); - printf("strategy(%s,%g).\n",varmap.vars[i]+1, varmap.dvalue[i]); - }else{ - if (_debug) fprintf(stderr,"strategy('%s',%g).\n",varmap.vars[i]+1, varmap.dvalue[i]); - printf("strategy('%s',%g).\n",varmap.vars[i]+1, varmap.dvalue[i]); - } - } - } -} - -// new manager for bdd forest needs very low memory requirements! -l -void newManager(extmanager* MyManager, bddfileheader fileheader, int nbManagers){ -// MyManager->manager; - if (_debug) fprintf(stderr,"Creating new BDD manager.\n\n"); - if (_debug) fprintf(stderr,"Setting BDD manager memory consumption to %i.\n", max(1024,(512*1024*1024)/nbManagers)); - MyManager->manager = Cudd_Init((unsigned int)fileheader.varcnt, 0, - (unsigned int)max(32,CUDD_UNIQUE_SLOTS/nbManagers), - (unsigned int)max(512,CUDD_CACHE_SLOTS/nbManagers), - (unsigned int)max(5000,(1024*1024*1024)/nbManagers)); - Cudd_AutodynEnable(MyManager->manager, CUDD_REORDER_GROUP_SIFT); - //Cudd_SetMaxCacheHard(MyManager->manager, 1024*1024*1024); - //Cudd_SetLooseUpTo(MyManager->manager, 1024*1024*512); - if (_debug) Cudd_EnableReorderingReporting(MyManager->manager); - MyManager->t = HIGH(MyManager->manager); - MyManager->f = LOW(MyManager->manager); - MyManager->varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - if (_debug) Cudd_PrintInfo(MyManager->manager,stderr); - MyManager->his = InitHistory(fileheader.varcnt); -} - - -int printTime(void){ - struct tm *current; - time_t now; - time(&now); - current = localtime(&now); - fprintf(stderr, "%i:%i:%i: ", current->tm_hour, current->tm_min, current->tm_sec); - return 1; -} - -bdd_mgr* generateIndependentBDDForest(bddfileheader fileheader) { - int icomment, maxlinesize, icur, iline, curinter, iequal; - DdNode *Line; - bdd_mgr * bdd_mgrs; - char buf, *inputline, *filename, *subl; - bddfileheader interfileheader; - subl = NULL; // This addition might hide a real bug GUY you need to check your free(subl) instructions - // Initialization of intermediate steps - //Guy: +1 to delimit array???? - bdd_mgrs = (bdd_mgr *) malloc(sizeof(bdd_mgr) * (fileheader.intercnt+1)); - for (icur = 0; icur < fileheader.intercnt+1; icur++) { - bdd_mgrs[icur].extmanager.manager = NULL; - bdd_mgrs[icur].root = NULL; - } - // Read file data - interfileheader.inputfile = NULL; - filename = NULL; // For nested files - iequal = 0; // Flag for encountered = sign - icur = 0; // Pointer for inputline buffer location - iline = 5; // Current file line (first after header) - icomment = 0; // Flag for comments - maxlinesize = 80; // inputline starting buffer size - inputline = (char *) malloc(sizeof(char) * maxlinesize); - while(!feof(fileheader.inputfile)) { - fread(&buf, 1, 1, fileheader.inputfile); - if (buf == ';' || buf == '%' || buf == '$') icomment = 1; - if (buf == '\n') { - if (icomment) icomment = 0; - if (iequal > 1) { - fprintf(stderr, "Error at line: %i. Line contains more than 1 equal(=) signs.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } else iequal = 0; - if (icur > 0) { - inputline[icur] = '\0'; - if (inputline[0] != 'L') { - fprintf(stderr, "Error at line: %i. Intermediate results should start with L.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - curinter = getInterBDD(inputline); - if (curinter == -1) { - if (fileheader.version < 2) { - if (inputline[0] == 'L' && IsPosNumber(inputline + 1)) { - curinter = atoi(inputline + 1) - 1; - if (curinter > -1 && curinter < fileheader.intercnt && bdd_mgrs[curinter].extmanager.manager != NULL) { - if (_debug) fprintf(stderr, "Returned: %s\n", inputline); - fclose(fileheader.inputfile); - free(inputline); - //changed: just return every intermediate BDD - return bdd_mgrs; - } else { - fprintf(stderr, "Error at line: %i. Return result asked doesn't exist.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - } else { - fprintf(stderr, "Error at line: %i. Invalid intermediate result format.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - } else { - // Support for forest - maxlinesize = 10; - iline = -1; - for (subl = strtok(inputline, ","); subl != NULL; subl = strtok(NULL, ",")) { - if (subl[0] == 'L' && IsPosNumber(subl + 1)) { - curinter = atoi(subl + 1) - 1; - if (curinter > -1 && curinter < fileheader.intercnt && bdd_mgrs[curinter].extmanager.manager != NULL) { - iline++; - if (iline >= (maxlinesize - 1)) { - maxlinesize *= 2; - } - } else { - fprintf(stderr, "Error at line: %i. Return result asked(%s) doesn't exist.\n", iline, subl); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - free(subl); - return NULL; - } - } else { - fprintf(stderr, "Error at line: %i. Invalid intermediate result format.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - free(subl); - return NULL; - } - } - if (_debug) fprintf(stderr, "Returned: %s\n", inputline); - fclose(fileheader.inputfile); - free(inputline); - free(subl); - iline++; - //changed: just return every intermediate BDD - return bdd_mgrs; - } - } else if (curinter > -1 && curinter < fileheader.intercnt && bdd_mgrs[curinter].extmanager.manager == NULL) { - if (_debug) fprintf(stderr, "%i %s\n", curinter, inputline); - if (_debug) printTime(); - if (_debug) fprintf(stderr, "At line %i reading %s\n", (curinter+1), inputline); - filename = getFileName(inputline); - if (filename == NULL) { - fprintf(stderr, "Error at line: %i. A forest of independent BDDs cannot have formulas.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - free(subl); - return NULL; - } else { - interfileheader = ReadFileHeader(filename); - if (interfileheader.inputfile == NULL) { - //Line = simpleBDDload(manager, &varmap, filename); - Line = NULL; - } else { - newManager(&(bdd_mgrs[curinter].extmanager),interfileheader,fileheader.intercnt); - Line = FileGenerateBDD(bdd_mgrs[curinter].extmanager.manager, bdd_mgrs[curinter].extmanager.varmap, interfileheader); -// for(i = 0; imanager); - if (_debug) Cudd_PrintInfo(bdd_mgrs[curinter].extmanager.manager,stderr); - } - if (Line == NULL) fprintf(stderr, "Error at line: %i. Error in nested BDD file: %s.\n", iline, filename); - free(filename); - filename = NULL; - interfileheader.inputfile = NULL; - } - if (Line == NULL) { - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - bdd_mgrs[curinter].root = Line; - icur = 0; - } else if (curinter > -1 && curinter < fileheader.intercnt && bdd_mgrs[curinter].extmanager.manager != NULL) { - fprintf(stderr, "Error at line: %i. Intermediate results can't be overwritten.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } else { - fprintf(stderr, "Error at line: %i. Intermediate result asked doesn't exist.\n", iline); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - } - iline++; - } else if (buf != ' ' && buf != '\t' && !icomment) { - if (buf == '=') iequal++; - inputline[icur] = buf; - icur += 1; - if (icur == _maxbufsize) { - fprintf(stderr, "Error: Maximum buffer size(%i) exceeded.\n", _maxbufsize); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; - } - while (icur > maxlinesize - 1) { - maxlinesize *= 2; - inputline = (char *) realloc(inputline, sizeof(char) * maxlinesize); - } - } - } - fprintf(stderr, "Error, file either doesn't end with a blank line or no return result was asked.\n"); - fclose(fileheader.inputfile); - free(bdd_mgrs); - free(inputline); - return NULL; -} - - -int LoadVariableDataForForest(namedvars varmap, char *filename) { - FILE *data; - char *dataread, buf, *varname, *dynvalue; - double dvalue = 0.0; - int icur = 0, maxbufsize = 10, hasvar = 0, index = 0, idat = 0, ivalue = 0; - dynvalue = NULL; - varname = NULL; - if ((data = fopen(filename, "r")) == NULL) { - perror(filename); - return -1; - } - dataread = (char *) malloc(sizeof(char) * maxbufsize); - while(!feof(data)) { - fread(&buf, 1, 1, data); - if ((buf == '\n') && icur == 0) { - // ignore empty lines - } else if (buf == '\n') { - dataread[icur] = '\0'; - icur = 0; - buf = ' '; - if (dataread[0] == '@') { - if (hasvar) { - AddNamedVarAt(varmap,varname,index); - varmap.loaded[index] = 1; - varmap.dvalue[index] = dvalue; - varmap.ivalue[index] = ivalue; - if (varmap.dynvalue[index] != NULL) { - free(varmap.dynvalue[index]); - varmap.dynvalue[index] = NULL; - } - if (dynvalue != NULL) { - varmap.dynvalue[index] = (void *) malloc(sizeof(char) * (strlen(dynvalue) + 1)); - strcpy(varmap.dynvalue[index], dynvalue); - free(dynvalue); - dynvalue = NULL; - } - index++; - dvalue = 0.0; - ivalue = 0; - free(varname); - } - varname = (char *) malloc(sizeof(char) * strlen(dataread)); - strcpy(varname, dataread + 1); - hasvar = 1; - idat = 0; - } else { - if (hasvar >= 0) { - switch(idat) { - case 0: - if (!getRealNumber(dataread, &dvalue)) { - fprintf(stderr, "Error at file: %s. Variable: %s can't have non real value: %s.\n", filename, varname, dataread); - fclose(data); - free(varname); - free(dataread); - return -2; - } - idat++; - break; - case 1: - if (!getIntNumber(dataread, &ivalue)) { - fprintf(stderr, "Error at file: %s. Variable: %s can't have non integer value: %s.\n", filename, varname, dataread); - fclose(data); - free(varname); - free(dataread); - return -2; - } - idat++; - break; - case 2: - dynvalue = malloc(sizeof(char) * (strlen(dataread) + 1)); - strcpy(dynvalue, dataread); - break; - } - } - } - } else { - dataread[icur] = buf; - icur++; - if (icur == _maxbufsize) { - fprintf(stderr, "Error: Maximum buffer size(%i) exceeded.\n", _maxbufsize); - fclose(data); - free(varname); - free(dataread); - return -2; - } - while (icur > maxbufsize - 1) { - maxbufsize *= 2; - dataread = (char *) realloc(dataread, sizeof(char) * maxbufsize); - } - } - } - if (hasvar) { - AddNamedVarAt(varmap,varname,index); - varmap.loaded[index] = 1; - varmap.dvalue[index] = dvalue; - varmap.ivalue[index] = ivalue; - if (varmap.dynvalue[index] != NULL) { - free(varmap.dynvalue[index]); - varmap.dynvalue[index] = NULL; - } - if (dynvalue != NULL) { - varmap.dynvalue[index] = (void *) malloc(sizeof(char) * (strlen(dynvalue) + 1)); - strcpy(varmap.dynvalue[index], dynvalue); - free(dynvalue); - } - index++; - free(varname); - } - fclose(data); - free(dataread); - return 0; -} - -/////////////////////// -// Stop Added by Guy // -/////////////////////// - -/* Shell Parameters handling */ - -int argtype(const char *arg) { - if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0; - if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2; - if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3; - if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4; - if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5; - if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6; - if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7; - if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8; - if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9; - if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10; - if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11; - if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12; - if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13; - if (strcmp(arg, "-ord") == 0 || strcmp(arg, "--order") == 0) return 14; - if (strcmp(arg, "-u") == 0 || strcmp(arg, "--utilities") == 0) return 15; - if (strcmp(arg, "-if") == 0 || strcmp(arg, "--independent") == 0) return 16; - if (strcmp(arg, "-lo") == 0 || strcmp(arg, "--local") == 0) return 17; - if (strcmp(arg, "-dreorder") == 0 || strcmp(arg, "--disable-reorder") == 0) return 18; - if (strcmp(arg, "-sord") == 0 || strcmp(arg, "--static-order") == 0) return 19; - return -1; -} - -void printhelp(int argc, char **arg) { - fprintf(stderr, "\n\nProbLogBDD Tool Version: %s\n\n", VERSION); - fprintf(stderr, "SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html)\n"); - fprintf(stderr, "SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be)\n"); - fprintf(stderr, "Copyright Katholieke Universiteit Leuven 2008\n"); - fprintf(stderr, "Authors: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann\n"); - fprintf(stderr, "This package falls under the: Artistic License 2.0\n"); - fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]); - fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n"); - fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n"); - fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n"); - fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n"); - fprintf(stderr, "Optional parameters:\n"); - fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n"); - fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n"); - fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [l]ine search, [o]nline\n"); - fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]); - fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n"); - fprintf(stderr, "\t-if \t\t->\tbuild a forest of -independent- BDDs where each BDD is in a different manager. \n"); - fprintf(stderr, "\t-u [filename]\t->\tfilename where a list of utilities can be found. \n"); - fprintf(stderr, "\t-lo \t\t->\t do local strategy search. \n"); - fprintf(stderr, "Extra parameters:\n"); - fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n"); - fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check\n"); - fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n"); - fprintf(stderr, "\t-ord [filename]\t->\tUse the [filename] to define a specific final BDD variable order\n"); - fprintf(stderr, "\t-dreorder\t->\tDiseable BDD dynamic variable ordering\n"); - fprintf(stderr, "\t-sord [filename]\t->\tDefine a static ordering within [filename]\n"); - fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n"); - fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n"); - fprintf(stderr, "Extra notes:\nSupports a forest of BDDs in one shared BDD.\nSelected computational methods will be applied to each BDD seperately.\nFile operations will be applied only to the first BDD.\n"); - fprintf(stderr, "\nExample: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]); -} - -parameters loadparam(int argc, char **arg) { - int i; - parameters params; - params.loadfile = -1; - params.savedfile = -1; - params.exportfile = -1; - params.method = 0; - params.inputfile = -1; - params.debug = 0; - params.errorcnt = 0; - params.queryid = 0; - params.timeout = 0; - params.sigmoid_slope = 1.0; - params.online = 0; - params.maxbufsize = 0; - params.ppid = NULL; - params.orderfile = -1; - params.utilfile = -1; - params.independent_forest = -1; - params.local_search = -1; - params.error = (int *) malloc(argc * sizeof(int)); - params.dynreorder = 1; - params.staticorder = -1; - for (i = 1; i < argc; i++) { - switch(argtype(arg[i])) { - case 0: - if (argc > i + 1) { - i++; - params.loadfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 2: - if (argc > i + 1) { - i++; - params.exportfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 3: - if (argc > i + 1) { - i++; - params.method = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 4: - if (argc > i + 1) { - i++; - params.inputfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 5: - printhelp(argc, arg); - break; - case 6: - params.debug = 1; - break; - case 7: - if (argc > i + 1) { - i++; - params.queryid = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 8: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.timeout = atoi(arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 9: - if (argc > i + 1) { - i++; - params.savedfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 10: - if ((argc > i + 1) && (getRealNumber(arg[i + 1], & params.sigmoid_slope))) { - i++; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 11: - params.online = 1; - break; - case 12: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.maxbufsize = atoi(arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 13: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1)); - strcpy(params.ppid, arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 14: - if (argc > i + 1) { - i++; - params.orderfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 15: - if (argc > i + 1) { - i++; - params.utilfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 16: - params.independent_forest = i; - break; - case 17: - params.local_search = i; - break; - case 18: - params.dynreorder = -1; - break; - case 19: - if (argc > i + 1) { - i++; - params.staticorder = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - default: - params.error[params.errorcnt] = i; - params.errorcnt++; - break; - } - } - return params; -} - -/* Error Handlers */ - -void handler(int num) { - fprintf(stderr, "Error: Timeout %i exceeded.\n", params.timeout); - exit(-1); -} - -void pidhandler(int num) { - char *s; - if (params.timeout > 0) { - params.timeout -= 5; - if (params.timeout <= 0) { - fprintf(stderr, "Error: Timeout exceeded.\n"); - exit(-1); - } - } - s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid))); - strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null"); - if (system(s) != 0) exit(4); -#ifndef __MINGW32__ - signal(SIGALRM, pidhandler); -#endif - alarm(5); - free(s); -} - -void termhandler(int num) { - exit(3); -} - -/* Debugging traverse function */ - -void myexpand(extmanager MyManager, DdNode *Current) { - DdNode *h, *l; - hisnode *Found; - char *curnode; - curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); - printf("%s\n", curnode); - if ((Current != MyManager.t) && (Current != MyManager.f) && - ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) { - l = LowNodeOf(MyManager.manager, Current); - h = HighNodeOf(MyManager.manager, Current); - printf("l(%s)->", curnode); - myexpand(MyManager, l); - printf("h(%s)->", curnode); - myexpand(MyManager, h); - AddNode(MyManager.his, MyManager.varmap.varstart, Current, 0.0, 0, NULL); - } -} - -/* Angelicas Algorithm */ - -double CalcProbability(extmanager MyManager, DdNode *Current) { - DdNode *h, *l; - hisnode *Found; - char *curnode, *dynvalue; - double lvalue, hvalue, tvalue; - density_integral dynvalue_parsed; - - dynvalue_parsed.low = 0.0; - dynvalue_parsed.high = 0.0; - dynvalue_parsed.mu = 0.0; - dynvalue_parsed.log_sigma = 0.0; - - curnode = NULL; - - if (params.debug) { - curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); - fprintf(stderr, "%s\n", curnode); - } - - // base cases: 0 and 1 terminal - if (Current == MyManager.t) return 1.0; - if (Current == MyManager.f) return 0.0; - - // case: node is in cache - if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) { - return Found->dvalue; - } - - // case: node is not in cache - l = LowNodeOf(MyManager.manager, Current); - h = HighNodeOf(MyManager.manager, Current); - if (params.debug) fprintf(stderr, "l(%s)->", curnode); - lvalue = CalcProbability(MyManager, l); - if (params.debug) fprintf(stderr, "h(%s)->", curnode); - hvalue = CalcProbability(MyManager, h); - - dynvalue = (char*) MyManager.varmap.dynvalue[GetIndex(Current) - MyManager.varmap.varstart]; - if (dynvalue == NULL) { - // no dynvalue, node is regular probabilistic fact - tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart]; - } else { - // there is a dynvalue, node is continuous fact - curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); - dynvalue_parsed = parse_density_integral_string(dynvalue, curnode); - if (params.debug) fprintf(stderr, " cont low=%f high=%f mu=%f sigma=%f\n->", dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu,exp(dynvalue_parsed.log_sigma) ); - tvalue = cumulative_normal(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))/ - (1-cumulative_normal_upper(dynvalue_parsed.low, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))); - } - - tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue); - AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL); - return tvalue; -} - - -/* Bernds Algorithm */ -// type=0 regular probabilistic fact -// type=1 derive gradient for mu -// type=2 derive gradient for sigma -gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern, int type) { - DdNode *h, *l; - hisnode *Found; - char *curnode, *dynvalue; - gradientpair lowvalue, highvalue, tvalue; - double this_probability = 0.0; - double this_gradient = 0.0; - double continuous_denominator = 0.0, continuous_numerator = 0.0; - double *gradient; - density_integral dynvalue_parsed; - - dynvalue_parsed.low = 0.0; - dynvalue_parsed.high = 0.0; - dynvalue_parsed.mu = 0.0; - dynvalue_parsed.log_sigma = 0.0; - - curnode = NULL; - if (params.debug) { - curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); - fprintf(stderr, "%s\n", curnode); - } - // base cases - if (Current == MyManager.t) { - tvalue.probability = 1.0; - tvalue.gradient = 0.0; - return tvalue; - } - if (Current == MyManager.f) { - tvalue.probability = 0.0; - tvalue.gradient = 0.0; - return tvalue; - } - //node is in cache - if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) { - tvalue.probability = Found->dvalue; - tvalue.gradient = *((double *) Found->dynvalue); - return tvalue; - } - - //inductive case - l = LowNodeOf(MyManager.manager, Current); - h = HighNodeOf(MyManager.manager, Current); - if (params.debug) fprintf(stderr, "l(%s)->", curnode); - lowvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern,type); - if (params.debug) fprintf(stderr, "h(%s)->", curnode); - highvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern,type); - dynvalue = (char*) MyManager.varmap.dynvalue[GetIndex(Current) - MyManager.varmap.varstart]; - if (dynvalue == NULL) { // no dynvalue, it's a regular probabilistic fact - this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope); - } else { // there is a dynvalue, it's a continuous fact! let's do the hybrid ProbLog magic here - curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); - dynvalue_parsed = parse_density_integral_string(dynvalue, curnode); - continuous_denominator = 1-cumulative_normal_upper(dynvalue_parsed.low, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma)); - continuous_numerator = cumulative_normal(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma)); - this_probability= continuous_numerator/continuous_denominator; - } - - tvalue.probability = this_probability * highvalue.probability + (1 - this_probability) * lowvalue.probability; - tvalue.gradient = this_probability * highvalue.gradient + (1 - this_probability) * lowvalue.gradient; - - - // is this node, the one we want to calculcate the gradient for? - - if ((GetIndex(Current) == TargetVar) || - ((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) { - - if (type == 0) { - // current node is normal probabilistic fact - this_gradient = this_probability * (1 - this_probability) * params.sigmoid_slope; - } else if (type == 1) { - // it's a continues fact and we need d/dmu - this_gradient = (cumulative_normal_dmu(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))*continuous_denominator+ - continuous_numerator*cumulative_normal_upper_dmu(dynvalue_parsed.low, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))) / - (continuous_denominator*continuous_denominator); - } else if (type == 2) { - // it's a continues fact and we need d/dsigma - - - this_gradient = exp(dynvalue_parsed.log_sigma)* - - (cumulative_normal_dsigma(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))*continuous_denominator + - continuous_numerator*cumulative_normal_upper_dsigma(dynvalue_parsed.low, dynvalue_parsed.mu, exp(dynvalue_parsed.log_sigma))) / - (continuous_denominator*continuous_denominator); - } - - tvalue.gradient += (highvalue.probability - lowvalue.probability) * this_gradient; - } - - - gradient = (double *) malloc(sizeof(double)); - *gradient = tvalue.gradient; - AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient); - return tvalue; -} - -char * extractpattern(char *thestr) { - char *p; - int i = 0, sl = strlen(thestr); - while((thestr[i] != '_') && (i < sl)) i++; - if (i == sl) return NULL; - i++; - p = (char *) malloc(sizeof(char) * (i + 2)); - strncpy(p, thestr, i); - p[i] = '*'; - p[i + 1] = '\0'; - return p; -} - -int patterncalculated(char *pattern, extmanager MyManager, int loc) { - int i; - if (pattern == NULL) return 0; - for (i = loc - 1; i > -1; i--) - if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1; - return 0; -} diff --git a/packages/ProbLog/simplecudd/problogmath.c b/packages/ProbLog/simplecudd/problogmath.c deleted file mode 100644 index bc06f5ba9..000000000 --- a/packages/ProbLog/simplecudd/problogmath.c +++ /dev/null @@ -1,347 +0,0 @@ -/******************************************************************************\ -* * -* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) * -* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) * -* * -* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 * -* * -* Author: Bernd Gutmann * -* File: problogmath.c * -* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ * -* $Revision:: 5159 $ * -* * -******************************************************************************** -* * -* 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. * -* * -* The End * -* * -\******************************************************************************/ - -#include "problogmath.h" -#include "general.h" - -double sigmoid(double x, double slope) { - return 1.0 / (1.0 + exp(-x * slope)); -} - -// This function calculates the accumulated density of the normal distribution -// For details see G. Marsaglia, Evaluating the Normal Distribution, Journal of Statistical Software, 2004:11(4). -double Phi(double x) { - double s=x; - double t=0.0; - double b=x; - double q=x*x; - double i=1; - - // if the value is too small or too big, return - // 0/1 to avoid long computations - if (x < -10.0) { - return 0.0; - } - - if (x > 10.0) { - return 1.0; - } - - // t is the value from last iteration - // s is the value from the current iteration - // iterate until they are equal - while(fabs(s-t) >= DBL_MIN) { - t=s; - i+=2; - b*=q/i; - s+=b; - } - - return 0.5+s*exp(-0.5*q-0.91893853320467274178); -} - -// integrates the normal distribution over [low,high] -double cumulative_normal(double low, double high, double mu, double sigma) { - return Phi((high-mu)/sigma) - Phi((low-mu)/sigma); -} - -// integrates the normal distribution over [-oo,high] -double cumulative_normal_upper(double high, double mu, double sigma) { - return Phi((high-mu)/sigma); -} - - -// evaluates the density of the normal distribution -double normal(double x, double mu,double sigma) { - double inner=(x-mu)/sigma; - double denom=sigma*sqrt(2*3.14159265358979323846); - return exp(-inner*inner/2)/denom; -} - -double cumulative_normal_dmu(double low, double high,double mu,double sigma) { - return normal(low,mu,sigma) - normal(high,mu,sigma); -} - -double cumulative_normal_upper_dmu(double high,double mu,double sigma) { - return - normal(high,mu,sigma); -} - - -double cumulative_normal_dsigma(double low, double high,double mu,double sigma) { - return (((mu-high)*normal(high,mu,sigma) - (mu-low)*normal(low,mu,sigma))/sigma); -} - -double cumulative_normal_upper_dsigma(double high,double mu,double sigma) { - return (mu-high)*normal(high,mu,sigma); -} - - -// this function parses two strings "$a;$b" and "???_???l$ch$d" where $a-$d are (real) numbers -// it is used to parse in the parameters of continues variables from the input file -density_integral parse_density_integral_string(char *input, char *variablename) { - density_integral result; - double sigma; - int i; - char garbage[64], s1[64],s2[64],s3[64],s4[64]; - - if(sscanf(input, "%64[^;];%64[^;]", s1,s2) != 2) { - fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "The string should contain 2 fields seperated by ; characters.\n"); - exit(EXIT_FAILURE); - } - - if (!getRealNumber(s1, &result.mu)) { - fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "%s is not a number\n",s1); - exit(EXIT_FAILURE); - } - - if (!getRealNumber(s2, &sigma) || sigma<=0.0) { - fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "%s is not a number\n",s2); - exit(EXIT_FAILURE); - } - result.log_sigma=log(sigma); - -/* if (result.sigma<=0) { */ -/* fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string",input); */ -/* fprintf(stderr, "The value for sigma has to be larger than 0.\n"); */ - -/* exit(EXIT_FAILURE); */ -/* } */ - - if (sscanf(variablename,"%64[^lh]l%64[^lh]h%64[^lh]",garbage,s3,s4) != 3) { - fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",variablename); - fprintf(stderr, "The string should contain 2 fields seperated by ; characters.\n"); - exit(EXIT_FAILURE); - } - - // replace the d by . in s1 and s2 - for(i=0; s3[i]!='\0' ; i++) { - if (s3[i]=='d') { - s3[i]='.'; - } - if (s3[i]=='m') { - s3[i]='-'; - } - } - for(i=0; s4[i]!='\0' ; i++) { - if (s4[i]=='d') { - s4[i]='.'; - } - if (s4[i]=='m') { - s4[i]='-'; - } - } - - if (!getRealNumber(s3, &result.low)) { - fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "%s is not a number\n",s1); - exit(EXIT_FAILURE); - } - - if (!getRealNumber(s4, &result.high)) { - fprintf(stderr, "Error ar parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "%s is not a number\n",s1); - exit(EXIT_FAILURE); - } - - - if (result.low>result.high) { - fprintf(stderr, "Error ar parsing the string %s in the function parse_density_integral_string\n",input); - fprintf(stderr, "The value for low has to be larger than then value for high.\n"); - fprintf(stderr, " was [%f, %f]\n",result.low, result.high); - fprintf(stderr, " input %s \n",input); - fprintf(stderr, " variablename %s \n",variablename); - - exit(EXIT_FAILURE); - } - - - return result; -} diff --git a/packages/ProbLog/simplecudd/problogmath.h b/packages/ProbLog/simplecudd/problogmath.h deleted file mode 100644 index 2b56d41a4..000000000 --- a/packages/ProbLog/simplecudd/problogmath.h +++ /dev/null @@ -1,217 +0,0 @@ -/******************************************************************************\ -* * -* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) * -* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) * -* * -* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 * -* * -* Author: Bernd Gutmann * -* File: problogmath.h * -* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ * -* $Revision:: 5159 $ * -* * -******************************************************************************** -* * -* 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. * -* * -* The End * -* * -\******************************************************************************/ - -#include -#include -#include -#include -#include - -typedef struct _density_integral { - double low; - double high; - double mu; - double log_sigma; -} density_integral; - - - -double sigmoid(double x, double slope); -double Phi(double x); - -double cumulative_normal(double low, double high, double sigma, double mu); -double cumulative_normal_dmu(double low, double high,double mu,double sigma); -double cumulative_normal_dsigma(double low, double high,double mu,double sigma); - -double cumulative_normal_upper(double high, double mu, double sigma); -double cumulative_normal_upper_dsigma(double high,double mu,double sigma); -double cumulative_normal_upper_dmu(double high,double mu,double sigma); - -double normal(double x, double mu,double sigma); - -density_integral parse_density_integral_string(char *input, char *variablename); diff --git a/packages/ProbLog/simplecudd_lfi/iqueue.h b/packages/ProbLog/simplecudd_lfi/iqueue.h deleted file mode 100644 index abee025ce..000000000 --- a/packages/ProbLog/simplecudd_lfi/iqueue.h +++ /dev/null @@ -1,66 +0,0 @@ -/****************************************************************** -** -** IQUEUE.H: -** -** ADT Queue Iterator Implementation -** -** This file is part of Apt Abstract Data Types (ADT) -** Copyright (c) 1991 -- Apt Technologies -** All rights reserved -** -******************************************************************/ - -#ifndef IQUEUE_H -#define IQUEUE_H - -/* ---------- Headers */ - -#include "pqueue.h" - -/* ---------- Types */ - -typedef struct _QueueIterator { - int position; - Queue queue; - QueueItem currentItem, previousItem; -} _QueueIterator, *QueueIterator; - -/* ---------- Exported Function Prototypes */ - -#ifdef __ANSI_C__ -QueueIterator QueueIteratorNew(Queue,int); -void QueueIteratorDispose(QueueIterator); - -int QueueIteratorAtTop(QueueIterator); -int QueueIteratorAtBottom(QueueIterator); -int QueueIteratorAtPosition(QueueIterator,int); - -int QueueIteratorPosition(QueueIterator); -void *QueueIteratorCurrentData(QueueIterator); -void *QueueIteratorPreviousData(QueueIterator); - -void QueueIteratorAdvance(QueueIterator); -void QueueIteratorBackup(QueueIterator); -void QueueIteratorAbsoluteSeek(QueueIterator,int); -void QueueIteratorRelativeSeek(QueueIterator,int); - -#else -QueueIterator QueueIteratorNew(); -void QueueIteratorDispose(); - -int QueueIteratorAtTop(); -int QueueIteratorAtBottom(); -int QueueIteratorAtPosition(); - -int QueueIteratorPosition(); -void *QueueIteratorCurrentData(); -void *QueueIteratorPreviousData(); - -void QueueIteratorAdvance(); -void QueueIteratorBackup(); -void QueueIteratorAbsoluteSeek(); -void QueueIteratorRelativeSeek(); - -#endif /* __ANSI_C__ */ - -#endif /* QUEUE_H */ diff --git a/packages/cuda/CMakeLists.txt b/packages/cuda/CMakeLists.txt index 5b51c5f00..570b5cd7b 100644 --- a/packages/cuda/CMakeLists.txt +++ b/packages/cuda/CMakeLists.txt @@ -3,7 +3,7 @@ macro_optional_find_package (CUDA ON) macro_log_feature (CUDA_FOUND "CUDA" "CUDA GGPU Programming " - "http://www.r.org" FALSE) + "http://www.nvidia.com/object/cuda_home_new.html" FALSE) if (CUDA_FOUND) # CUDA_VERSION_MAJOR -- The major version of cuda as reported by nvcc. @@ -50,6 +50,51 @@ if (CUDA_FOUND) # CUDA_nvcuvid_LIBRARY -- CUDA Video Decoder library. # Only available for CUDA version 3.2+. # Windows only. + # + macro_optional_find_package (FindThrust ON) + + set (CUDA_SOURCES + lista.cu + memory.cu + cuda.c + ) + + set (PL_SOURCES + cuda.yap + ) + + cuda_add_library (libcuda SHARED ${CUDA_SOURCES}) + + target_link_libraries(libcuda libYap + ${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} ${CUDA_nppc_LIBRARY} +stdc++ ) + +if( THRUST_INCLUDE_DIR ) + list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR ) + include_directories( ${THRUST_INCLUDE_DIR} ) +endif( THRUST_INCLUDE_DIR ) + + set(CUDA_ATTACH_VS_BUILD_RULE_TO_CUDA_FILE ON) + + #set(BUILD_SHARED_LIBS OFF) + + set(CUDA_SEPARABLE_COMPILATION ON) + + #list(APPEND CUDA_NVCC_FLAGS -arch=sm_20) + + set_target_properties (libcuda PROPERTIES PREFIX "") + + include_directories (${CUDA_INCLUDE_DIRS} + ${CMAKE_CURRENT_SOURCE_DIR} + ) + + install(TARGETS libcuda + LIBRARY DESTINATION ${dlls} + ) + + install(FILES ${PL_SOURCES} + DESTINATION ${libpl} + ) endif (CUDA_FOUND) diff --git a/packages/cuda/Makefile.in b/packages/cuda/Makefile.in index e119516f9..cad3e06d9 100644 --- a/packages/cuda/Makefile.in +++ b/packages/cuda/Makefile.in @@ -39,7 +39,7 @@ SO=@SO@ CWD=$(PWD) # -BDD_PROLOG= \ +CUDA_PROLOG= \ $(srcdir)/cuda.yap OBJS=cuda.o memory.o lista.o @@ -64,7 +64,7 @@ memory.o: $(srcdir)/memory.cu $(srcdir)/pred.h install: all install-examples mkdir -p $(DESTDIR)$(SHAREDIR) - for h in $(BDD_PROLOG); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done + for h in $(CUDA_PROLOG); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR) install-examples: diff --git a/packages/jpl b/packages/jpl index 9b7278278..8b043d9f8 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit 9b727827845bf5cf309b831c7372715b07412931 +Subproject commit 8b043d9f8261e701723d7e75391dcb99937206d5 diff --git a/packages/raptor b/packages/raptor index b36fdac22..8dbcba9ff 160000 --- a/packages/raptor +++ b/packages/raptor @@ -1 +1 @@ -Subproject commit b36fdac2281b7eef141095375d81456410dbcd2f +Subproject commit 8dbcba9ff8f87abba5db6e65aaeaad7ad1b383f2 diff --git a/packages/real b/packages/real index 09c8bd21f..e0e072ad7 160000 --- a/packages/real +++ b/packages/real @@ -1 +1 @@ -Subproject commit 09c8bd21fbbf611ef1164b59b645af2c5ff6c307 +Subproject commit e0e072ad7fbe7558e69197135cc657a02365224a diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index b24d299c5..db9122bd3 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -53,21 +53,21 @@ set(PL_SOURCES yio.yap ) -add_custom_target (${YAP_STARTUP} ALL DEPENDS ${PL_SOURCES} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) +add_custom_target (${YAP_STARTUP} ALL SOURCES ${PL_SOURCES} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) # create a startup.yss on the top directory. add_custom_command (TARGET ${YAP_STARTUP} COMMAND yap-bin -b ${CMAKE_SOURCE_DIR}/pl/boot.yap -L ${CMAKE_SOURCE_DIR}/pl/init.yap -z qend_program VERBATIM WORKING_DIRECTORY ${CMAKE_TOP_BINARY_DIR} - DEPENDS yap-bin + DEPENDS yap-bin ${PL_SOURCES} + USES_TERMINAL ) install (FILES ${PL_SOURCES} DESTINATION ${libpl}/boot ) - + install (FILES ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} DESTINATION ${dlls} ) - diff --git a/pl/absf.yap b/pl/absf.yap index 77f6cb4e1..9e27a3d3e 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -21,7 +21,6 @@ variables and registry information to search for files. **/ - :- system_module( absolute_file_name, [absolute_file_name/2, absolute_file_name/3, add_to_path/1, @@ -138,16 +137,23 @@ absolute_file_name(File0,File) :- '$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !, '$do_error'(instantiation_error, G). '$absolute_file_name'(File,Opts,TrueFileName, G) :- + current_prolog_flag( fileerrors, PreviousFileErrors ), '$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G), + ( FErrors = fail -> + set_prolog_flag( fileerrors, false ) + ; + set_prolog_flag( fileerrors, true ) + ), /* our own local findall */ nb:nb_queue(Ref), ( - '$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G), + '$find_in_path'(File,opts(Extensions,RelTo,Type,Access,Errors,Expand,Debug),TrueFileName,G), nb:nb_queue_enqueue(Ref, TrueFileName), fail ; nb:nb_queue_close(Ref, FileNames, []) - ), + ), + set_prolog_flag( fileerrors, PreviousFileErrors ), '$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G). '$absolute_file_names'(_Solutions, [], error, _, File, G) :- !, @@ -159,7 +165,13 @@ absolute_file_name(File0,File) :- '$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !, '$do_error'(instantiation_error, G). -'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !. +'$process_fn_opts'([],[],_,txt,none,OnError,first,false,false,_) :- !, + current_prolog_flag(fileerrors, Flag), + ( OnError == error ; + OnError == fail ; + Flag == true, OnError = error ; + Flag == false, OnError = fail ; + OnError = error ), !. '$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !, '$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G), '$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G). @@ -282,14 +294,14 @@ absolute_file_name(File0,File) :- '$to_list_of_atoms'(Bs, L2, LF). '$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :- - '$swi_current_prolog_flag'(file_name_variables, OldF), - '$swi_set_prolog_flag'(file_name_variables, Expand), + current_prolog_flag(file_name_variables, OldF), + set_prolog_flag(file_name_variables, Expand), ( '$absolute_file_name'(File,ExpFile) -> - '$swi_set_prolog_flag'(file_name_variables, OldF) + set_prolog_flag(file_name_variables, OldF) ; - '$swi_set_prolog_flag'(file_name_variables, OldF), + set_prolog_flag(file_name_variables, OldF), fail ), ( @@ -314,14 +326,14 @@ absolute_file_name(File0,File) :- '$add_type_extensions'(Type, File, F0), '$check_file'(F0, Type, Access, F). +% always verify if a directory +'$check_file'(F, directory, _, F) :- + !, + exists_directory(F). '$check_file'(F, _Type, none, F) :- !. -'$check_file'(F0, Type, Access, F0) :- +'$check_file'(F0, _Type, Access, F0) :- access_file(F0, Access), - (Type == directory -> - exists_directory(F0) - ; - \+ exists_directory(F0) % if it has a type cannot be a directory. - ). + \+ exists_directory(F0). % if it has a type cannot be a directory.. '$add_extensions'([Ext|_],File,F) :- '$mk_sure_true_ext'(Ext,NExt), @@ -363,7 +375,7 @@ absolute_file_name(File0,File) :- '$split_by_sep'(Start, Next, Dirs, Dir) :- - '$swi_current_prolog_flag'(windows, true), + current_prolog_flag(windows, true), '$split_by_sep'(Start, Next, Dirs, ';', Dir), !. '$split_by_sep'(Start, Next, Dirs, Dir) :- '$split_by_sep'(Start, Next, Dirs, ':', Dir). @@ -501,9 +513,7 @@ remove_from_path(New) :- '$check_path'(New,Path), This directory is initialized by a rule that calls the system predicate system_library/1. */ - :- multifile user:library_directory/1. - :- dynamic user:library_directory/1. %% user:library_directory( ?Dir ) @@ -513,13 +523,13 @@ remove_from_path(New) :- '$check_path'(New,Path), % 1. honor YAPSHAREDIR user:library_directory( Dir ) :- getenv( 'YAPSHAREDIR', Dir0), - absolute_file_name( Dir0, [file_type(directory), expand(true)], Dir ). + absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ). %% 2. honor user-library user:library_directory( Dir ) :- - absolute_file_name( '~/share/Yap', [file_type(directory), expand(true)], Dir ). + absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ). %% 3. honor current directory user:library_directory( Dir ) :- - absolute_file_name( '.', [file_type(directory), expand(true)], Dir ). + absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ). %% 4. honor default location. user:library_directory( Dir ) :- system_library( Dir ). @@ -537,6 +547,7 @@ user:library_directory( Dir ) :- :- dynamic user:commons_directory/1. + user:commons_directory( Path ):- system_commons( Path ). @@ -638,7 +649,6 @@ file_search_path(path, C) :- :- multifile user:file_search_path/2. :- dynamic user:file_search_path/2. - user:file_search_path(library, Dir) :- user:library_directory(Dir). user:file_search_path(commons, Dir) :- @@ -661,4 +671,5 @@ user:file_search_path(path, C) :- lists:member(C, B) ). -%%@} \ No newline at end of file +%%@} + diff --git a/pl/qly.yap b/pl/qly.yap index 6d2e6b734..e79b841c2 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -1,4 +1,3 @@ - /************************************************************************* * * * YAP Prolog * @@ -80,7 +79,7 @@ qsave_program(File) :- '$save_program_status'([], qsave_program(File)), open(File, write, S, [type(binary)]), '$qsave_program'(S), - close(S). + close(S). /** @pred qsave_program(+ _F_, Opts) @@ -105,7 +104,7 @@ qsave_program(File, Opts) :- open(File, write, S, [type(binary)]), '$qsave_program'(S), % make sure we're not going to bootstrap from this file. - close(S). + close(S). /** @pred save_program(+ _F_, : _G_) @@ -114,7 +113,7 @@ Saves an image of the current state of the YAP database in file trying goal _G_. **/ save_program(_File, Goal) :- - recorda('$restore_goal', Goal ,_R), + recorda('$restore_goal', Goal ,_R), fail. save_program(File, _Goal) :- qsave_program(File). @@ -130,7 +129,7 @@ qend_program :- halt(0). '$save_program_status'(Flags, G) :- - findall(F:V,'$x_yap_flag'(F,V),L), + findall(F-V, '$x_yap_flag'(F,V),L), recordz('$program_state',L,_), '$cvt_qsave_flags'(Flags, G), fail. @@ -156,7 +155,7 @@ qend_program :- var(Flag), !, '$do_error'(instantiation_error,G). '$cvt_qsave_flag'(local(B), G, _) :- !, - ( number(B) -> + ( number(B) -> ( B > 0 -> recordz('$restore_flag',local(B),_) ; B =:= 0 -> true ; @@ -165,7 +164,7 @@ qend_program :- '$do_error'(type_error(integer,B),G) ). '$cvt_qsave_flag'(global(B), G, _) :- !, - ( number(B) -> + ( number(B) -> ( B > 0 -> recordz('$restore_flag',global(B),_) ; B =:= 0 -> true ; @@ -174,7 +173,7 @@ qend_program :- '$do_error'(type_error(integer,B),G) ). '$cvt_qsave_flag'(stack(B), G, _) :- !, - ( number(B) -> + ( number(B) -> ( B > 0 -> recordz('$restore_flag',stack(B),_) ; B =:= 0 -> true ; @@ -183,7 +182,7 @@ qend_program :- '$do_error'(type_error(integer,B),G) ). '$cvt_qsave_flag'(trail(B), G, _) :- !, - ( number(B) -> + ( number(B) -> ( B > 0 -> recordz('$restore_flag',trail(B),_) ; B =:= 0 -> true ; @@ -192,7 +191,7 @@ qend_program :- '$do_error'(type_error(integer,B),G) ). '$cvt_qsave_flag'(goal(B), G, M) :- !, - ( callable(B) -> + ( callable(B) -> strip_module(M:B, M1, G1), recordz('$restore_flag',goal(M1:G1),_) ; @@ -200,7 +199,7 @@ qend_program :- '$do_error'(type_error(callable,G1),G) ). '$cvt_qsave_flag'(toplevel(B), G, M) :- !, - ( callable(B) -> + ( callable(B) -> strip_module(M:B, M1, G1), recordz('$restore_flag',toplevel(M1:G1),_) ; @@ -208,7 +207,7 @@ qend_program :- '$do_error'(type_error(callable,G1),G) ). '$cvt_qsave_flag'(init_file(B), G, M) :- !, - ( atom(B) -> + ( atom(B) -> recordz('$restore_flag', init_file(M:B), _) ; '$do_error'(type_error(atom,B),G) @@ -222,31 +221,23 @@ qend_program :- '$do_error'(domain_error(qsave_program,Opt), G). % there is some ordering between flags. -'$x_yap_flag'(goal, _Goal). -'$x_yap_flag'(language, _V). -'$x_yap_flag'(M:unknown, V) :- +'$x_yap_flag'(language, V) :- + yap_flag(language, V). +'$x_yap_flag'(M:P, V) :- current_module(M), - yap_flag(M:unknown, V). + yap_flag(M:P, V). '$x_yap_flag'(X, V) :- + prolog_flag_property(X, [access(read_write)]), + atom(X), yap_flag(X, V), X \= gc_margin, % different machines will have different needs, X \= argv, X \= os_argv, X \= language, - X \= max_threads, - X \= max_workers, - X \= readline, - X \= timezone, - X \= tty_control, - X \= undefined, - X \= user_input, - X \= user_output, - X \= user_error, - X \= version, - X \= version_data. + X \= encoding. '$init_state' :- - recorded('$program_state', _, _), !, + recorded('$program_state', P, _), !, '$do_init_state'. '$init_state'. @@ -257,7 +248,7 @@ qend_program :- '$do_init_state' :- recorded('$program_state',L,R), erase(R), - lists:member(F:V,L), + lists:member(F-V,L), catch(yap_flag(F,V),_,fail), fail. '$do_init_state' :- @@ -294,7 +285,7 @@ qend_program :- fail. % this should be done before -l kicks in. '$init_from_saved_state_and_args' :- - '$access_yap_flags'(16,0), + current_prolog_flag(fast_boot, false), ( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ), ( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ), ( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ), @@ -332,7 +323,7 @@ qend_program :- set_value('$extend_file_search_path',[]), '$extend_file_search_path'(P). '$init_path_extensions'. - + % then we can execute the programs. '$startup_goals' :- recorded('$startup_goal',G,_), @@ -391,30 +382,30 @@ qsave_file(F0) :- ensure_loaded( F0 ), absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]), absolute_file_name( F0, State, [expand(true),file_type(qly)]), - '$qsave_file_'(File, State). + '$qsave_file_'(File, State). /** @pred qsave_file(+ _File_, +_State_) -Saves an image of all the information compiled by the system from file _F_ to _State_. +Saves an image of all the information compiled by the system from file _F_ to _State_. This includes modules and predicates eventually including multi-predicates. **/ qsave_file(F0, State) :- ensure_loaded( F0 ), absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]), - '$qsave_file_'(File, State). + '$qsave_file_'(File, State). -'$qsave_file_'(File, UserF, _State) :- +'$qsave_file_'(File, UserF, _State) :- ( File == user_input -> Age = 0 ; time_file64(File, Age) ), '$current_module'(M), assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ), '$set_owner_file'( '$file_property'( _ ), user, File ), fail. -'$qsave_file_'(File, UserF, _State) :- +'$qsave_file_'(File, UserF, _State) :- recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _), assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ), '$set_owner_file'( '$file_property'( _ ), user, File ), fail. -'$qsave_file_'(File, _UserF, _State) :- +'$qsave_file_'(File, _UserF, _State) :- recorded('$directive',directive( File, M:G, Mode, VL, Pos ), _), assert(user:'$file_property'( directive( M:G, Mode, VL, Pos ) ) ), '$set_owner_file'('$file_property'( _ ), user, File ), @@ -433,7 +424,7 @@ qsave_file(F0, State) :- open(State, write, S, [type(binary)]), '$qsave_file_preds'(S, File), close(S) - ), + ), abolish(user:'$file_property'/1). '$fetch_multi_files_file'(File, Multi_Files) :- @@ -441,16 +432,16 @@ qsave_file(F0, State) :- '$fetch_multi_file_file'(FileName, (M:G :- Body)) :- recorded('$multifile_defs','$defined'(FileName,Name,Arity,M), _), - functor(G, Name, Arity ), + functor(G, Name, Arity ), clause(M:G, Body, ClauseRef), clause_property(ClauseRef, file(FileName) ). /** @pred qsave_module(+ _Module_, +_State_) -Saves an image of all the information compiled by the systemm on module _F_ to _State_. +Saves an image of all the information compiled by the systemm on module _F_ to _State_. **/ -qsave_module(Mod, OF) :- +qsave_module(Mod, OF) :- recorded('$module', '$module'(_F,Mod,Source,Exps,L), _), '$fetch_parents_module'(Mod, Parents), '$fetch_imports_module'(Mod, Imps), @@ -501,7 +492,7 @@ available it tries reconsulting the source file. */ qload_module(Mod) :- - ( '$swi_current_prolog_flag'(verbose_load, false) + ( current_prolog_flag(verbose_load, false) -> Verbosity = silent ; @@ -529,7 +520,7 @@ qload_module(Mod) :- '$qload_module'(S , Mod, File, SourceModule) ; Type == file -> - '$qload_file'(S, File) + '$qload_file'(S, File) ). '$qload_module'(Mod, File, SourceModule) :- open(File, read, S, [type(binary)]), @@ -538,7 +529,7 @@ qload_module(Mod) :- '$qload_module'(S , Mod, File, SourceModule) ; Type == file -> - '$qload_file'(S, File) + '$qload_file'(S, File) ), close(S). @@ -685,7 +676,7 @@ qload_module(Mod) :- '$do_foreign'('$swi_foreign'(_,_), _More). '$init_foreigns'([], _Handle, _NewHandle). -'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :- +'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :- !, call_shared_object_function( NewHandle, Function), '$init_foreigns'(More, Handle, NewHandle). @@ -699,7 +690,7 @@ Restores a previously saved state of YAP contaianing a qly file _F_. */ qload_file( F0 ) :- - ( '$swi_current_prolog_flag'(verbose_load, false) + ( current_prolog_flag(verbose_load, false) -> Verbosity = silent ; @@ -708,9 +699,9 @@ qload_file( F0 ) :- StartMsg = loading_module, EndMsg = module_loaded, '$current_module'( SourceModule ), - H0 is heapused, + H0 is heapused, '$cputime'(T0,_), - ( is_stream( F0 ) + ( is_stream( F0 ) -> stream_property(F0, file_name(File) ), File = FilePl, @@ -732,7 +723,7 @@ qload_file( F0 ) :- '$lf_option'(last_opt, LastOpt), functor( TOpts, opt, LastOpt ), '$lf_default_opts'(1, LastOpt, TOpts), - '$qload_file'(S, SourceModule, File, FilePl, F0, all, TOpts) + '$qload_file'(S, SourceModule, File, FilePl, F0, all, TOpts) ), close(S), working_directory( _, OldD), @@ -779,5 +770,3 @@ qload_file( F0 ) :- fail. '$process_directives'( _FilePl ) :- abolish(user:'$file_property'/1). - - diff --git a/pl/strict_iso.yap b/pl/strict_iso.yap index 4652a558d..df0235b71 100644 --- a/pl/strict_iso.yap +++ b/pl/strict_iso.yap @@ -22,13 +22,13 @@ '$iso_check_a_goal'(G2,(G1->G2),G0). '$iso_check_goal'(!,_) :- !. '$iso_check_goal'((G1|G2),G0) :- - '$access_yap_flags'(9,1), !, + current_prolog_flag(language, iso), !, '$do_error'(domain_error(builtin_procedure,(G1|G2)), call(G0)). '$iso_check_goal'((G1|G2),G0) :- !, '$iso_check_a_goal'(G1,(G1|G2),G0), '$iso_check_a_goal'(G2,(G1|G2),G0). '$iso_check_goal'(G,G0) :- - '$access_yap_flags'(9,1), + current_prolog_flag(language, iso), '$system_predicate'(G,0), ( '$iso_builtin'(G) @@ -58,11 +58,11 @@ '$iso_check_a_goal'(G2,E,G0). '$iso_check_a_goal'(!,_,_) :- !. '$iso_check_a_goal'((_|_),E,G0) :- - '$access_yap_flags'(9,1), !, + current_prolog_flag(language, iso), !, '$do_error'(domain_error(builtin_procedure,E), call(G0)). '$iso_check_a_goal'((_|_),_,_) :- !. '$iso_check_a_goal'(G,_,G0) :- - '$access_yap_flags'(9,1), + current_prolog_flag(language, iso), '$system_predicate'(G,0), ( '$iso_builtin'(G) diff --git a/pl/tabling.yap b/pl/tabling.yap index 614ad8c37..d3157d30e 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -291,10 +291,10 @@ table(Pred) :- '$undefined'(PredFunctor,Mod), !, '$c_table'(Mod,PredFunctor,PredModeList). '$set_table'(Mod,PredFunctor,_PredModeList) :- - '$flags'(PredFunctor,Mod,Flags,Flags), + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), Flags /\ 0x00000040 =:= 0x00000040, !. '$set_table'(Mod,PredFunctor,PredModeList) :- - '$flags'(PredFunctor,Mod,Flags,Flags), + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), Flags /\ 0x1991F8C0 =:= 0, '$c_table'(Mod,PredFunctor,PredModeList), !. '$set_table'(Mod,PredFunctor,_PredModeList) :- @@ -346,7 +346,7 @@ is_tabled(Pred) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), - '$flags'(PredFunctor,Mod,Flags,Flags), !, + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !, Flags /\ 0x000040 =\= 0. '$do_is_tabled'(Mod,Pred) :- '$do_pi_error'(type_error(callable,Pred),is_tabled(Mod:Pred)). @@ -377,7 +377,7 @@ tabling_mode(Pred,Options) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), - '$flags'(PredFunctor,Mod,Flags,Flags), !, + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !, ( Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options) ; @@ -438,7 +438,7 @@ abolish_table(Pred) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), - '$flags'(PredFunctor,Mod,Flags,Flags), !, + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !, ( Flags /\ 0x000040 =\= 0, !, '$c_abolish_table'(Mod,PredFunctor) ; @@ -478,7 +478,7 @@ show_table(Stream,Pred) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), - '$flags'(PredFunctor,Mod,Flags,Flags), !, + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !, ( Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Stream,Mod,PredFunctor) ; @@ -518,7 +518,7 @@ table_statistics(Stream,Pred) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), - '$flags'(PredFunctor,Mod,Flags,Flags), !, + '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !, ( Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Stream,Mod,PredFunctor) ; diff --git a/pl/threads.yap b/pl/threads.yap index 14c789dd5..9ee2e7414 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -1368,7 +1368,7 @@ thread_local(X) :- '$thread_local2'(A/N, Mod) :- integer(N), atom(A), !, functor(T,A,N), - (Mod \= idb -> '$flags'(T,Mod,F,F) ; true), + (Mod \= idb -> '$predicate_flags'(T,Mod,F,F) ; true), ( '$install_thread_local'(T,Mod) -> true ; F /\ 0x08002000 =\= 0 -> '$do_error'(permission_error(modify,dynamic_procedure,A/N),thread_local(Mod:A/N)) ; '$do_error'(permission_error(modify,static_procedure,A/N),thread_local(Mod:A/N)) diff --git a/pl/undefined.yap b/pl/undefined.yap index 53f16f400..42b4670c7 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -105,16 +105,16 @@ followed by the failure of that call. */ :- multifile user:unknown_predicate_handler/3. -'$handle_error'(0x0080,Goal,Mod) :- +'$handle_error'(error,Goal,Mod) :- functor(Goal,Name,Arity), '$program_continuation'(PMod,PName,PAr), '$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)). -'$handle_error'(0x0040,Goal,Mod) :- +'$handle_error'(warning,Goal,Mod) :- functor(Goal,Name,Arity), '$program_continuation'(PMod,PName,PAr), print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))), fail. -'$handle_error'(0x0020,_Goal,_Mod) :- +'$handle_error'(fail,_Goal,_Mod) :- fail. '$complete_goal'(M, G, CurG, CurMod, NG) :- diff --git a/pl/yio.yap b/pl/yio.yap index 26049cc50..db5752c32 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -67,67 +67,6 @@ setting and clearing this flag are given under 7.7. /* stream predicates */ -/* check whether a list of options is valid */ -'$check_io_opts'(V,G) :- var(V), !, - '$do_error'(instantiation_error,G). -'$check_io_opts'([],_) :- !. -'$check_io_opts'([H|_],G) :- var(H), !, - '$do_error'(instantiation_error,G). -'$check_io_opts'([Opt|T],G) :- !, - '$check_opt'(G,Opt,G), - '$check_io_opts'(T,G). -'$check_io_opts'(T,G) :- - '$do_error'(type_error(list,T),G). - -'$check_opt'(read_term(_,_),Opt,G) :- - '$check_opt_read'(Opt, G). -'$check_opt'(stream_property(_,_),Opt,G) :- - '$check_opt_sp'(Opt, G). - -'$check_opt_read'(variables(_), _) :- !. -'$check_opt_read'(variable_names(_), _) :- !. -'$check_opt_read'(singletons(_), _) :- !. -'$check_opt_read'(syntax_errors(T), G) :- !, - '$check_read_syntax_errors_arg'(T, G). -'$check_opt_read'(term_position(_), _) :- !. -'$check_opt_read'(term_position(_), _) :- !. -'$check_opt_read'(comments(_), _) :- !. -'$check_opt_read'(module(_), _) :- !. -'$check_opt_read'(A, G) :- - '$do_error'(domain_error(read_option,A),G). - -'$check_opt_sp'(file_name(_), _) :- !. -'$check_opt_sp'(mode(_), _) :- !. -'$check_opt_sp'(input, _) :- !. -'$check_opt_sp'(output, _) :- !. -'$check_opt_sp'(alias(_), _) :- !. -'$check_opt_sp'(position(_), _) :- !. -'$check_opt_sp'(end_of_stream(_), _) :- !. -'$check_opt_sp'(eof_action(_), _) :- !. -'$check_opt_sp'(reposition(_), _) :- !. -'$check_opt_sp'(type(_), _) :- !. -'$check_opt_sp'(bom(_), _) :- !. -'$check_opt_sp'(encoding(_), _) :- !. -'$check_opt_sp'(representation_errors(_), _) :- !. -'$check_opt_sp'(A, G) :- - '$do_error'(domain_error(stream_property,A),G). - -'$check_read_syntax_errors_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_read_syntax_errors_arg'(dec10,_) :- !. -'$check_read_syntax_errors_arg'(fail,_) :- !. -'$check_read_syntax_errors_arg'(error,_) :- !. -'$check_read_syntax_errors_arg'(quiet,_) :- !. -'$check_read_syntax_errors_arg'(X,G) :- - '$do_error'(domain_error(read_option,syntax_errors(X)),G). - -'$check_boolean'(X, _, _, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_boolean'(true,_,_,_) :- !. -'$check_boolean'(false,_,_,_) :- !. -'$check_boolean'(_X, B, T, G) :- - '$do_error'(domain_error(B,T),G). - /** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface @ingroup InputOutput @{ @@ -143,15 +82,6 @@ Call socket/4 with _TYPE_ bound to `SOCK_STREAM'` and */ -socket(Domain, Sock) :- - ( - '$undefined'(ip_socket(_,_),yap_sockets) - -> - load_files(library(sockets), [silent(true),if(not_loaded)]) - ; - true - ), - yap_sockets:ip_socket(Domain, Sock). /** @pred socket(+ _DOMAIN_,+ _TYPE_,+ _PROTOCOL_,- _SOCKET_) @@ -170,16 +100,6 @@ supported: `SOCK_STREAM'` and `SOCK_DGRAM'` (untested in 6.3). */ -socket(Domain, Type, Protocol, Sock) :- - ( - '$undefined'(ip_socket(_,_),yap_sockets) - -> - load_files(library(sockets), [silent(true),if(not_loaded)]) - ; - true - ), - yap_sockets:ip_socket(Domain, Type, Protocol, Sock). - /** @pred socket_connect(+ _SOCKET_, + _PORT_, - _STREAM_) @@ -196,58 +116,18 @@ connect to socket at file _FILENAME_. + 'AF_INET'(+ _HOST_,+ _PORT_) Connect to socket at host _HOST_ and port _PORT_. - +*/ -*/ -socket_connect(Sock, Host, Read) :- - ( - '$undefined'(ip_socket(_,_),yap_sockets) - -> - load_files(library(sockets), [silent(true),if(not_loaded)]) - ; - true - ), - yap_sockets:tcp_connect(Sock, Host:Read). - /** @pred open_pipe_streams(Read, Write) Autoload old pipe access interface */ -open_pipe_streams(Read, Write) :- - ( - '$undefined'(pipe(_,_),unix) - -> - load_files(library(unix), [silent(true),if(not_loaded)]) - ; - true - ), - unix:pipe(Read, Write), - yap_flag(encoding, X), - set_stream(Read, encoding(X) ), - set_stream(Write, encoding(X) ). - %! @} -/** @pred fileerrors -Switches on the file_errors flag so that in certain error conditions -Input/Output predicates will produce an appropriated message and abort. - - */ -fileerrors :- '$swi_set_prolog_flag'(fileerrors, true). - -/** @pred nofileerrors - -Switches off the file_errors flag, so that the predicates see/1, -tell/1, open/3 and close/1 just fail, instead of producing -an error message and aborting whenever the specified file cannot be -opened or closed. - -*/ -nofileerrors :- '$swi_set_prolog_flag'(fileerrors, false). /** @pred exists(+ _F_) @@ -262,28 +142,6 @@ exists(F) :- /* Term IO */ -/** @pred read(- _T_) is iso - -Reads the next term from the current input stream, and unifies it with - _T_. The term must be followed by a dot (`.`) and any blank-character -as previously defined. The syntax of the term must match the current -declarations for operators (see op). If the end-of-stream is reached, - _T_ is unified with the atom `end_of_file`. Further reads from of -the same stream may cause an error failure (see open/3). - -*/ -read(T) :- - read_term(T, []). - -/** @pred read(+ _S_,- _T_) is iso - -Reads term _T_ from the stream _S_ instead of from the current input -stream. - - -*/ -read(Stream,T) :- - read_term(Stream, T, []). %! @} @@ -475,6 +333,7 @@ current_char_conversion(X,Y) :- '$fetch_char_conversion'(List,X,Y). + /** @pred current_stream( _F_, _M_, _S_) @@ -489,6 +348,7 @@ with _S_. */ current_stream(File, Mode, Stream) :- + stream_property(Stream, mode(Mode)), '$stream_name'(Stream, File). @@ -560,16 +420,7 @@ stream_position_data(Prop, Term, Value) :- '$stream_position_field'(byte_count, 4). -'$default_expand'(Expand) :- - get_value('$open_expands_filename',Expand). - -'$set_default_expand'(true) :- !, - set_value('$open_expands_filename',true). -'$set_default_expand'(false) :- !, - set_value('$open_expands_filename',false). -'$set_default_expand'(V) :- !, - '$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,V)). - + %! @} diff --git a/swi/library/CMakeLists.txt b/swi/library/CMakeLists.txt index 5aee758bc..666b68a4f 100644 --- a/swi/library/CMakeLists.txt +++ b/swi/library/CMakeLists.txt @@ -23,7 +23,6 @@ set (LIBRARY_PL pure_input.pl quasi_quotations.pl quintus.pl - readutil.pl record.pl settings.pl shlib.pl diff --git a/swi/library/readutil.pl b/swi/library/readutil.pl deleted file mode 100644 index d617c8261..000000000 --- a/swi/library/readutil.pl +++ /dev/null @@ -1,272 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(read_util, - [ read_line_to_codes/2, % +Fd, -Codes (without trailing \n) - read_line_to_codes/3, % +Fd, -Codes, ?Tail - read_stream_to_codes/2, % +Fd, -Codes - read_stream_to_codes/3, % +Fd, -Codes, ?Tail - read_line_to_string/2, % +Fd, -Codes (without trailing \n) - read_stream_to_string/2, % +Fd, -Codes, ?Tail - read_file_to_codes/3, % +File, -Codes, +Options - read_file_to_string/3, % +File, -Codes, +Options - read_file_to_terms/3 % +File, -Terms, +Options - ]). -:- use_module(library(shlib)). -:- use_module(library(lists), [select/3]). -:- use_module(library(error)). - -/** Read utilities -@ingroup swi - -This library provides some commonly used reading predicates. As these -predicates have proven to be time-critical in some applications we moved -them to C. For compatibility as well as to reduce system dependency, we -link the foreign code at runtime and fallback to the Prolog -implementation if the shared object cannot be found. -*/ - -:- volatile - read_line_to_codes/2, - read_line_to_codes/3, - read_stream_to_codes/2, - read_stream_to_codes/3, - read_line_to_string/2, - read_stream_to_string/2, - read_stream_to_string/3. - -link_foreign :- - catch(load_foreign_library(foreign(readutil)), _, fail), !. -link_foreign :- - assertz((read_line_to_codes(Stream, Line) :- - pl_read_line_to_codes(Stream, Line))), - assertz((read_line_to_codes(Stream, Line, Tail) :- - pl_read_line_to_codes(Stream, Line, Tail))), - assertz((read_stream_to_codes(Stream, Content) :- - pl_read_stream_to_codes(Stream, Content))), - assertz((read_stream_to_codes(Stream, Content, Tail) :- - pl_read_stream_to_codes(Stream, Content, Tail))), - compile_predicates([ read_line_to_codes/2, - read_line_to_codes/3, - read_stream_to_codes/2, - read_stream_to_codes/3 - ]), - assertz((read_line_to_string(Stream, Line) :- - pl_read_line_to_string(Stream, Line))), - assertz((read_line_to_string(Stream, Line, Tail) :- - pl_read_line_to_string(Stream, Line, Tail))), - assertz((read_stream_to_string(Stream, Content) :- - pl_read_stream_to_string(Stream, Content))), - assertz((read_stream_to_string(Stream, Content, Tail) :- - pl_read_stream_to_string(Stream, Content, Tail))), - compile_predicates([ read_line_to_string/2, - read_stream_to_string/2 - ]). - -:- initialization(link_foreign, now). - - - /******************************* - * LINES * - *******************************/ - -%% read_line_to_codes(+In:stream, -Line:codes) is det. -% -% Read a line of input from In into a list of character codes. -% Trailing newline and or return are deleted. Upon reaching -% end-of-file Line is unified to the atom =end_of_file=. - -pl_read_line_to_string(Fd, String) :- - get_code(Fd, C0), - ( C0 == -1 - -> String = end_of_file - ; read_1line_to_codes(C0, Fd, Codes0) - ), - string_codes( String, Codes0 ). - -pl_read_line_to_codes(Fd, Codes) :- - get_code(Fd, C0), - ( C0 == -1 - -> Codes = end_of_file - ; read_1line_to_codes(C0, Fd, Codes0) - ), - Codes = Codes0. - -read_1line_to_codes(-1, _, []) :- !. -read_1line_to_codes(10, _, []) :- !. -read_1line_to_codes(13, Fd, L) :- !, - get_code(Fd, C2), - read_1line_to_codes(C2, Fd, L). -read_1line_to_codes(C, Fd, [C|T]) :- - get_code(Fd, C2), - read_1line_to_codes(C2, Fd, T). - -%% read_line_to_codes(+Fd, -Line, ?Tail) is det. -% -% Read a line of input as a difference list. This should be used -% to read multiple lines efficiently. On reaching end-of-file, -% Tail is bound to the empty list. - -pl_read_line_to_codes(Fd, Codes, Tail) :- - get_code(Fd, C0), - read_line_to_codes(C0, Fd, Codes0, Tail), - Codes = Codes0. - -read_line_to_codes(-1, _, Tail, Tail) :- !, - Tail = []. -read_line_to_codes(10, _, [10|Tail], Tail) :- !. -read_line_to_codes(C, Fd, [C|T], Tail) :- - get_code(Fd, C2), - read_line_to_codes(C2, Fd, T, Tail). - - - /******************************* - * STREAM (ENTIRE INPUT) * - *******************************/ - -%% read_stream_to_codes(+Stream, -Codes) is det. -%% read_stream_to_codes(+Stream, -Codes, ?Tail) is det. -% -% Read input from Stream to a list of character codes. The version -% read_stream_to_codes/3 creates a difference-list. - -pl_read_stream_to_string(Fd, String) :- - pl_read_stream_to_codes(Fd, Codes, []), - string_codes( String, Codes ). - -pl_read_stream_to_codes(Fd, Codes) :- - pl_read_stream_to_codes(Fd, Codes, []). -pl_read_stream_to_codes(Fd, Codes, Tail) :- - get_code(Fd, C0), - read_stream_to_codes(C0, Fd, Codes0, Tail), - Codes = Codes0. - -read_stream_to_codes(-1, _, Tail, Tail) :- !. -read_stream_to_codes(C, Fd, [C|T], Tail) :- - get_code(Fd, C2), - read_stream_to_codes(C2, Fd, T, Tail). - - -%% read_stream_to_terms(+Stream, -Terms, ?Tail, +Options) is det. - -read_stream_to_terms(Fd, Terms, Tail, Options) :- - read_term(Fd, C0, Options), - read_stream_to_terms(C0, Fd, Terms0, Tail, Options), - Terms = Terms0. - -read_stream_to_terms(end_of_file, _, Tail, Tail, _) :- !. -read_stream_to_terms(C, Fd, [C|T], Tail, Options) :- - read_term(Fd, C2, Options), - read_stream_to_terms(C2, Fd, T, Tail, Options). - - - /******************************* - * FILE (ENTIRE INPUT) * - *******************************/ - -%% read_file_to_codes(+Spec, -Codes, +Options) is det. -% -% Read the file Spec into a list of Codes. Options is split into -% options for absolute_file_name/3 and open/4. - -read_file_to_codes(Spec, Codes, Options) :- - must_be(proper_list, Options), - ( select(tail(Tail), Options, Options1) - -> true - ; Tail = [], - Options1 = Options - ), - split_options(Options1, file_option, FileOptions, OpenOptions), - absolute_file_name(Spec, - [ access(read) - | FileOptions - ], - Path), - open(Path, read, Fd, OpenOptions), - call_cleanup(read_stream_to_codes(Fd, Codes0, Tail), - close(Fd)), - Codes = Codes0. - - -%% read_file_to_terms(+Spec, -Terms, +Options) is det. -% -% Read the file Spec into a list of terms. Options is split over -% absolute_file_name/3, open/4 and read_term/3. - -read_file_to_terms(Spec, Terms, Options) :- - must_be(proper_list, Options), - ( select(tail(Tail), Options, Options1) - -> true - ; Tail = [], - Options1 = Options - ), - split_options(Options1, file_option, FileOptions, Options2), - split_options(Options2, read_option, ReadOptions, OpenOptions), - absolute_file_name(Spec, - [ access(read) - | FileOptions - ], - Path), - open(Path, read, Fd, OpenOptions), - call_cleanup(read_stream_to_terms(Fd, Terms0, Tail, ReadOptions), - close(Fd)), - Terms = Terms0. - -split_options([], _, [], []). -split_options([H|T], G, File, Open) :- - ( call(G, H) - -> File = [H|FT], - OT = Open - ; Open = [H|OT], - FT = File - ), - split_options(T, G, FT, OT). - - -read_option(module(_)). -read_option(syntax_errors(_)). -read_option(character_escapes(_)). -read_option(double_quotes(_)). -read_option(backquoted_string(_)). - -file_option(extensions(_)). -file_option(file_type(_)). -file_option(file_errors(_)). -file_option(relative_to(_)). -file_option(expand(_)). - - /******************************* - * XREF * - *******************************/ - -:- multifile prolog:meta_goal/2. -:- dynamic prolog:meta_goal/2. -prolog:meta_goal(split_options(_,G,_,_), [G+1]).