From 65f1cb9741618f2f9f939e76feb4a107310b8ab1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 10 Apr 2016 06:21:17 -0700 Subject: [PATCH] win64 support: encodings --- .gitignore | 2 +- C/absmi.c | 2 +- C/arrays.c | 3 +- C/c_interface.c | 17 +- C/control_absmi_insts.h | 2 +- C/flags.c | 9 +- C/parser.c | 112 +- C/scanner.c | 6 +- C/text.c | 39 +- CMakeLists.txt | 6 +- CXX/yapi.cpp | 15 +- CXX/yapi.hh | 10 +- CXX/yapt.hh | 2 +- H/TermExt.h | 5 +- H/YapFlags.h | 3 +- H/YapHandles.h | 2 +- H/YapText.h | 5 +- H/Yapproto.h | 4 +- H/Yatom.h | 73 +- H/amidefs.h | 2 +- H/amiops.h | 2 +- OPTYap/tab.tries.insts.h | 362 ++--- cmake/FindGMP.cmake | 13 +- config.h.cmake | 2 +- include/YapInterface.h | 1 - library/dialect/swi/fli/swi.c | 2 +- library/system/sys.c | 2301 ++++++++++++++--------------- os/CMakeLists.txt | 220 +-- os/chartypes.c | 13 +- os/console.c | 6 +- os/files.c | 4 +- os/iopreds.c | 23 +- os/iopreds.h | 6 +- os/readline.c | 2 +- os/readterm.c | 17 +- os/streams.c | 10 +- os/sysbits.c | 47 +- os/sysbits.h | 3 + os/writeterm.c | 2 +- os/yapio.h | 350 ++--- os/ypsocks.c | 1 + packages/CLPBN/horus/LiftedKc.cpp | 2 +- packages/CLPBN/horus/Util.h | 1 + packages/myddas/pl/CMakeLists.txt | 26 +- 44 files changed, 1846 insertions(+), 1889 deletions(-) diff --git a/.gitignore b/.gitignore index 3480505bd..46042e493 100644 --- a/.gitignore +++ b/.gitignore @@ -141,7 +141,7 @@ Build xcode Threads droid -mxe +mxe msys2 caret codelite diff --git a/C/absmi.c b/C/absmi.c index f1dbf03eb..b4fe32fa2 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -192,7 +192,7 @@ static int check_alarm_fail_int(int CONT USES_REGS) { static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp, arity_t nargs USES_REGS) { - if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap(PASS_REGS1) || + if (Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1) || Yap_get_signal(YAP_STOVF_SIGNAL)) { S = (CELL *)pe; if (!Yap_locked_gc(nargs, env, cp)) { diff --git a/C/arrays.c b/C/arrays.c index 9e15ad6d5..cf8385f26 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -742,8 +742,7 @@ CreateStaticArray(AtomEntry *ae, size_t dim, static_array_types type, CODEADDR s p->ArrayType = type; p->TypeOfAE = STATIC_ARRAY; if (start_addr == NULL) { - Int i; - + size_t i; AllocateStaticArraySpace(p, type, NULL, dim PASS_REGS); if (p->ValueOfVE.ints == NULL) { WRITE_UNLOCK(p->ArRWLock); diff --git a/C/c_interface.c b/C/c_interface.c index 7cc32b0fc..d4bbdf742 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2012,6 +2012,7 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { CACHE_REGS FILE *f; int sno; + char full[FILENAME_MAX] BACKUP_MACHINE_REGS(); if (mode == YAP_BOOT_MODE) { @@ -2019,15 +2020,16 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { } bool consulted = (mode == YAP_CONSULT_MODE); Yap_init_consult(consulted, filename); - const char *full = Yap_AbsoluteFile(filename, true); - if (!full) + const char *fl = Yap_AbsoluteFile(filename, full, true); + if (!fl) return -1; - f = fopen(full, "r"); + f = fopen(fl, "r"); if (!f) return -1; - else if (full != filename && full != LOCAL_FileNameBuf && - full != LOCAL_FileNameBuf2) - free((char *)full); + else if (fl != filename && fl != full && + fl != LOCAL_FileNameBuf && + fl != LOCAL_FileNameBuf2) + free(fl); sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f); *osnop = Yap_CheckAlias(AtomLoopStream); if (!Yap_AddAlias(AtomLoopStream, sno)) { @@ -2036,14 +2038,15 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { } GLOBAL_Stream[sno].name = Yap_LookupAtom(filename); GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(filename)); + GLOBAL_Stream[sno].encoding = ENC_ISO_LATIN1; RECOVER_MACHINE_REGS(); UNLOCK(GLOBAL_Stream[sno].streamlock); return sno; } X_API FILE *YAP_TermToStream(Term t) { - FILE *s; BACKUP_MACHINE_REGS(); + FILE *s; if (IsVarTerm(t) || !IsAtomTerm(t)) return NULL; diff --git a/C/control_absmi_insts.h b/C/control_absmi_insts.h index c34c02127..ba532782d 100644 --- a/C/control_absmi_insts.h +++ b/C/control_absmi_insts.h @@ -12,7 +12,7 @@ Op(cut, s); #ifdef COROUTINING CACHE_Y_AS_ENV(YREG); - check_stack(NoStackCut, HR); + check_stack(NoStackCut, HR); ENDCACHE_Y_AS_ENV(); do_cut: #endif diff --git a/C/flags.c b/C/flags.c index 5f1ef9c0a..765004a60 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1254,8 +1254,9 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, if (bootstrap) { return false; } - CACHE_REGS - t0 = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, GLOBAL_MaxPriority, + CACHE_REGS + encoding_t encoding = ENC_ISO_UTF8; + t0 = Yap_StringToTerm(s, strlen(s) + 1, &encoding, GLOBAL_MaxPriority, NULL); if (!t0) return false; @@ -1541,7 +1542,7 @@ void Yap_InitFlags(bool bootstrap) { } GLOBAL_flagCount++; f++; - } + } LOCAL_flagCount = 0; int nflags = sizeof(local_flags_setup) / sizeof(flag_info); if (bootstrap) @@ -1552,7 +1553,7 @@ void Yap_InitFlags(bool bootstrap) { bool itf = setInitialValue(bootstrap, f->def, f->init, LOCAL_Flags + LOCAL_flagCount); // Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1, - // LOCAL_encoding, GLOBAL_MaxPriority, &tp); + // EBC_ISO_UTF8, GLOBAL_MaxPriority, &tp); if (itf) { initFlag(f, LOCAL_flagCount, false); } diff --git a/C/parser.c b/C/parser.c index e777bf57b..368c38ad9 100755 --- a/C/parser.c +++ b/C/parser.c @@ -163,12 +163,12 @@ dot with single quotes. typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF; static void GNextToken(CACHE_TYPE1); -static void checkfor(wchar_t, JMPBUFF * CACHE_TYPE); -static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, Term CACHE_TYPE); -static Term ParseList(JMPBUFF *, Term CACHE_TYPE); -static Term ParseTerm(int, JMPBUFF *, Term CACHE_TYPE); +static void checkfor(wchar_t, JMPBUFF *, encoding_t CACHE_TYPE); +static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE); +static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE); +static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE); -const char *Yap_tokRep(TokEntry *tokptr); +const char *Yap_tokRep(TokEntry *tokptr, encoding_t enc); static void syntax_msg(const char *msg, ...) { CACHE_REGS @@ -367,7 +367,7 @@ Term Yap_Variables(VarEntry *p, Term l) { return Variables(p, l PASS_REGS); } -static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term cmod USES_REGS) { +static int IsPrefixOp(Atom op, int *pptr, int *rpptr, encoding_t enc, Term cmod USES_REGS) { int p; OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, cmod PASS_REGS); @@ -391,10 +391,10 @@ static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term cmod USES_REGS) { int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) { CACHE_REGS - return IsPrefixOp(op, pptr, rpptr, CurrentModule PASS_REGS); + return IsPrefixOp(op, pptr, rpptr, LOCAL_encoding, CurrentModule PASS_REGS); } -static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term cmod USES_REGS) { +static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, encoding_t enc, Term cmod USES_REGS) { int p; OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS); @@ -420,10 +420,10 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term cmod USES_ int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) { CACHE_REGS - return IsInfixOp(op, pptr, lpptr, rpptr, CurrentModule PASS_REGS); + return IsInfixOp(op, pptr, lpptr, rpptr, CurrentModule, LOCAL_encoding PASS_REGS); } -static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term cmod USES_REGS) { +static int IsPosfixOp(Atom op, int *pptr, int *lpptr, encoding_t enc, Term cmod USES_REGS) { int p; OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, cmod PASS_REGS); @@ -447,7 +447,7 @@ static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term cmod USES_REGS) { int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) { CACHE_REGS - return IsPosfixOp(op, pptr, lpptr, CurrentModule PASS_REGS); + return IsPosfixOp(op, pptr, lpptr, CurrentModule, LOCAL_encoding PASS_REGS); } inline static void GNextToken(USES_REGS1) { @@ -459,11 +459,11 @@ inline static void GNextToken(USES_REGS1) { LOCAL_tokptr = LOCAL_tokptr->TokNext; } -inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) { +inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_REGS) { if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != (Term)c) { char s[1024]; - strncpy(s, Yap_tokRep(LOCAL_tokptr), 1023); + strncpy(s, Yap_tokRep(LOCAL_tokptr, enc), 1023); syntax_msg("line %d: expected to find \'%c\', found %s", LOCAL_tokptr->TokPos, c, s); FAIL; } @@ -472,7 +472,7 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) { #ifdef O_QUASIQUOTATIONS -static int is_quasi_quotation_syntax(Term goal, Atom *pat, Term cmod) { +static int is_quasi_quotation_syntax(Term goal, Atom *pat, encoding_t enc, Term cmod) { CACHE_REGS Term m = cmod, t; Atom at; @@ -525,7 +525,7 @@ static int get_quasi_quotation(term_t t, unsigned char **here, #endif /*O_QUASIQUOTATIONS*/ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, - Term arg1, Term cmod USES_REGS) { + Term arg1, encoding_t enc, Term cmod USES_REGS) { int nargs = 0; Term *p, t; Functor func; @@ -562,7 +562,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos); FAIL; } - *tp++ = Unsigned(ParseTerm(999, FailBuff, cmod PASS_REGS)); + *tp++ = Unsigned(ParseTerm(999, FailBuff, enc,cmod PASS_REGS)); ParserAuxSp = (char *)tp; ++nargs; if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)) @@ -601,7 +601,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, return TermNil; } /* check for possible overflow against local stack */ - checkfor(close, FailBuff PASS_REGS); + checkfor(close, FailBuff, enc PASS_REGS); return t; } @@ -617,14 +617,14 @@ static Term MakeAccessor(Term t, Functor f USES_REGS) { return Yap_MkApplTerm(f, 2, tf); } -static Term ParseList(JMPBUFF *FailBuff, Term cmod USES_REGS) { +static Term ParseList(JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) { Term o; CELL *to_store; o = AbsPair(HR); loop: to_store = HR; HR += 2; - to_store[0] = ParseTerm(999, FailBuff, cmod PASS_REGS); + to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS); if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (((int)LOCAL_tokptr->TokInfo) == ',') { NextToken; @@ -641,19 +641,19 @@ loop: } } else if (((int)LOCAL_tokptr->TokInfo) == '|') { NextToken; - to_store[1] = ParseTerm(999, FailBuff, cmod PASS_REGS); + to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS); } else { to_store[1] = MkAtomTerm(AtomNil); } } else { syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",LOCAL_tokptr->TokPos, - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } return (o); } -static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { +static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) { /* parse term with priority prio */ Volatile Term t; Volatile Functor func; @@ -686,7 +686,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { } if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || Unsigned(LOCAL_tokptr->TokInfo) != 'l') && - IsPrefixOp((Atom)t, &opprio, &oprprio, cmod PASS_REGS)) { + IsPrefixOp((Atom)t, &opprio, &oprprio, enc, cmod PASS_REGS)) { if (LOCAL_tokptr->Tok == Name_tok) { Atom at = (Atom)LOCAL_tokptr->TokInfo; #ifndef _MSC_VER @@ -721,7 +721,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos); FAIL; } - t = ParseTerm(oprprio, FailBuff, cmod PASS_REGS); + t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS); t = Yap_MkApplTerm(func, 1, &t); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -733,7 +733,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { } if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) && Unsigned(LOCAL_tokptr->TokInfo) == 'l') - t = ParseArgs((Atom)t, ')', FailBuff, 0L, cmod PASS_REGS); + t = ParseArgs((Atom)t, ')', FailBuff, 0L, enc, cmod PASS_REGS); else t = MkAtomTerm((Atom)t); break; @@ -749,7 +749,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { // we may be operating under a syntax error yap_error_number oerr = LOCAL_Error_TYPE; LOCAL_Error_TYPE = YAP_NO_ERROR; - t = Yap_CharsToTDQ(p, cmod, LOCAL_encoding PASS_REGS); + t = Yap_CharsToTDQ(p, cmod, enc PASS_REGS); if (!t) { syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo); FAIL; @@ -813,7 +813,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { break; case Error_tok: - syntax_msg("line %d: found ill-formed \"%s\"",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr)); + syntax_msg("line %d: found ill-formed \"%s\"",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); FAIL; case Ponctuation_tok: @@ -822,8 +822,8 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { case '(': case 'l': /* non solo ( */ NextToken; - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, cmod PASS_REGS); - checkfor(')', FailBuff PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS); + checkfor(')', FailBuff, enc PASS_REGS); break; case '[': NextToken; @@ -833,8 +833,8 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { NextToken; break; } - t = ParseList(FailBuff, cmod PASS_REGS); - checkfor(']', FailBuff PASS_REGS); + t = ParseList(FailBuff, enc, cmod PASS_REGS); + checkfor(']', FailBuff, enc PASS_REGS); break; case '{': NextToken; @@ -844,17 +844,17 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { NextToken; break; } - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, cmod PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS); t = Yap_MkApplTerm(FunctorBraces, 1, &t); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos); FAIL; } - checkfor('}', FailBuff PASS_REGS); + checkfor('}', FailBuff, enc PASS_REGS); break; default: - syntax_msg("line %d: unexpected ponctuation signal %s",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr)); + syntax_msg("line %d: unexpected ponctuation signal %s",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } break; @@ -896,15 +896,15 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { } NextToken; - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, cmod PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS); if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { syntax_msg("expected to find quasi quotes, got \"%s\"", , - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } if (!(is_quasi_quotation_syntax(t, &at))) { syntax_msg("bad quasi quotation syntax, at \"%s\"", - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } /* Arg 2: the content */ @@ -914,7 +914,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)), &qq->text, qq->text + strlen((const char *)qq->text))) { syntax_msg("could not get quasi quotation, at \"%s\"", - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } if (positions) { @@ -926,7 +926,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { qq->mid.charno + 2, /* end of | token */ PL_INTPTR, qqend - 2)) /* end minus "|}" */ syntax_msg("failed to unify quasi quotation, at \"%s\"", - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } @@ -937,7 +937,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { !PL_unify_list(LOCAL_qq_tail, to, LOCAL_qq_tail) || !PL_unify(to, Yap_InitSlot(tn))) { syntax_msg("failed to unify quasi quotation, at \"%s\"", - Yap_tokRep(LOCAL_tokptr)); + Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } } @@ -945,7 +945,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { NextToken; break; default: - syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr)); + syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } @@ -954,7 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { if (LOCAL_tokptr->Tok == Ord(Name_tok) && Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); - if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) && + if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* try parsing as infix operator */ Volatile int oldprio = curprio; @@ -967,7 +967,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { { Term args[2]; args[0] = t; - args[1] = ParseTerm(oprprio, FailBuff, cmod PASS_REGS); + args[1] = ParseTerm(oprprio, FailBuff,enc, cmod PASS_REGS); t = Yap_MkApplTerm(func, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -979,7 +979,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { opinfo = save_opinfo; continue;, opinfo = save_opinfo; curprio = oldprio;) } - if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) && opprio <= prio && + if (IsPosfixOp(opinfo, &opprio, &oplprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* parse as posfix operator */ Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1); @@ -1005,7 +1005,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { Volatile Term args[2]; NextToken; args[0] = t; - args[1] = ParseTerm(1000, FailBuff, cmod PASS_REGS); + args[1] = ParseTerm(1000, FailBuff, enc, cmod PASS_REGS); t = Yap_MkApplTerm(FunctorComma, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -1015,12 +1015,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { curprio = 1000; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && - IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, cmod PASS_REGS) && + IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { Volatile Term args[2]; NextToken; args[0] = t; - args[1] = ParseTerm(oprprio, FailBuff, cmod PASS_REGS); + args[1] = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS); t = Yap_MkApplTerm(FunctorVBar, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -1030,31 +1030,31 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' && - IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, cmod PASS_REGS) && + IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, cmod PASS_REGS); + t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, enc, cmod PASS_REGS); curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' && IsPosfixOp(AtomEmptySquareBrackets, &opprio, - &oplprio, cmod PASS_REGS) && + &oplprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, cmod PASS_REGS); + t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, enc, cmod PASS_REGS); t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS); curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' && IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, - &oplprio, cmod PASS_REGS) && + &oplprio, enc, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, cmod PASS_REGS); + t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, enc, cmod PASS_REGS); t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); curprio = opprio; continue; } } if (LOCAL_tokptr->Tok <= Ord(WString_tok)) { - syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr)); + syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); FAIL; } break; @@ -1062,7 +1062,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term cmod USES_REGS) { return t; } -Term Yap_Parse(UInt prio, Term cmod) { +Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { CACHE_REGS Volatile Term t; JMPBUFF FailBuff; @@ -1070,7 +1070,7 @@ Term Yap_Parse(UInt prio, Term cmod) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) { - t = ParseTerm(prio, &FailBuff, cmod PASS_REGS); + t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS); #if DEBUG if (GLOBAL_Option['p' - 'a' + 1]) { Yap_DebugPutc(stderr, '['); diff --git a/C/scanner.c b/C/scanner.c index 17e60ba46..6b7565464 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1226,7 +1226,7 @@ Term Yap_scan_num(StreamDesc *inp) { return l; \ } -const char *Yap_tokRep(TokEntry *tokptr) { +const char *Yap_tokRep(TokEntry *tokptr, encoding_t encoding) { CACHE_REGS Term info = tokptr->TokInfo; char *b, *buf = LOCAL_FileNameBuf2; @@ -1242,7 +1242,7 @@ const char *Yap_tokRep(TokEntry *tokptr) { } return RepAtom((Atom)info)->StrOfAE; case Number_tok: - if ((b = Yap_TermToString(info, buf, sze, &length, &LOCAL_encoding, + if ((b = Yap_TermToString(info, buf, sze, &length, &encoding, flags)) != buf) { return NULL; } @@ -2054,7 +2054,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } #if DEBUG if (GLOBAL_Option[2]) - fprintf(stderr, "[Token %d %s]", Ord(kind), Yap_tokRep(t)); + fprintf(stderr, "[Token %d %s]", Ord(kind), Yap_tokRep(t, inp_stream->encoding)); #endif if (LOCAL_ErrorMessage) { /* insert an error token to inform the system of what happened */ diff --git a/C/text.c b/C/text.c index ff98cc573..ee5b9cc98 100644 --- a/C/text.c +++ b/C/text.c @@ -1442,18 +1442,26 @@ er. * @return the buffer, or NULL in case of failure. If so, Yap_Error may be called. */ const char * -Yap_TextTermToText(Term t, char *buf, size_t len) -{ CACHE_REGS - seq_tv_t inp, out; - encoding_t enc = LOCAL_encoding; - - inp.val.t = t; - if (IsAtomTerm(t)) - inp.type = YAP_STRING_ATOM; - else if (IsStringTerm(t)) - inp.type = YAP_STRING_STRING; - else if (IsPairTerm(t) ) - inp.type = (YAP_STRING_CODES|YAP_STRING_ATOMS); +Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) +{ + CACHE_REGS + seq_tv_t inp, out; + + inp.val.t = t; + if (IsAtomTerm(t)) { + inp.type = YAP_STRING_ATOM; + if (IsWideAtom(AtomOfTerm(t))) + inp.enc = ENC_WCHAR; + else + inp.enc = ENC_ISO_LATIN1; + } + else if (IsStringTerm(t)) { + inp.type = YAP_STRING_STRING; + inp.enc = ENC_ISO_UTF8; +} +else if (IsPairTerm(t)) { + inp.type = (YAP_STRING_CODES | YAP_STRING_ATOMS); + } else { Yap_Error(TYPE_ERROR_TEXT, t, NULL); return false; @@ -1479,15 +1487,14 @@ Yap_TextTermToText(Term t, char *buf, size_t len) * * @return the term */ -Term Yap_MkTextTerm(const char *s, - Term tguide ) { +Term Yap_MkTextTerm(const char *s, encoding_t enc, Term tguide ) { CACHE_REGS if (IsAtomTerm(tguide)) return MkAtomTerm(Yap_LookupAtom(s)); if (IsStringTerm(tguide)) return MkStringTerm(s); if (IsPairTerm(tguide) && IsAtomTerm(HeadOfTerm(tguide))) { - return Yap_CharsToListOfAtoms( s, LOCAL_encoding PASS_REGS ); + return Yap_CharsToListOfAtoms( s, enc PASS_REGS ); } - return Yap_CharsToListOfCodes( s, LOCAL_encoding PASS_REGS ); + return Yap_CharsToListOfCodes( s, enc PASS_REGS ); } diff --git a/CMakeLists.txt b/CMakeLists.txt index d716a2a71..34660239e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -175,7 +175,7 @@ ENDIF (NOT MSVC) set_target_properties(libYap PROPERTIES VERSION ${YAP_FULL_VERSION} SOVERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION} - OUTPUT_NAME Yap + OUTPUT_NAME libYap ) @@ -442,8 +442,10 @@ add_subDIRECTORY (os) #bootstrap and saved state add_subDIRECTORY (pl) +IF (NOT MSVC) #C++ interface add_subDIRECTORY (CXX) +ENDIF(NOT MSVC) ADD_SUBDIRECTORY(library) ADD_SUBDIRECTORY(swi/library) @@ -471,6 +473,7 @@ add_subDIRECTORY (packages/ProbLog) add_subDIRECTORY (packages/swi-minisat2) +IF (NOT MSVC) OPTION (WITH_CLPBN " Enable the CLPBN and PFL probabilistic languages" ON) OPTION (WITH_CPLINT " Enable the cplint probabilistic language" ON) @@ -484,6 +487,7 @@ ENDIF() IF (WITH_CPLINT) add_subDIRECTORY (packages/cplint) ENDIF() +ENDIF(NOT MSVC) add_subDIRECTORY (packages/raptor) diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index afac9af11..a1d769317 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -8,13 +8,13 @@ extern "C" { #include "YapInterface.h" #include "blobs.h" -char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, +X_API char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encodingp, int flags); -void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); -void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, +X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); +X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); -void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, +X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity); } @@ -595,7 +595,12 @@ YAPEngine::YAPEngine(char *savedState, size_t stackSize, size_t trailSize, init_args.YapPrologBootFile = bootFile; init_args.YapPrologGoal = goal; init_args.YapPrologTopLevelGoal = topLevel; - init_args.HaltAfterConsult = script; + init_args.HaltAfter + + + + + = script; init_args.FastBoot = fastBoot; yerror = YAPError(); delYAPCallback(); diff --git a/CXX/yapi.hh b/CXX/yapi.hh index dfcf69eae..86ffca0f3 100644 --- a/CXX/yapi.hh +++ b/CXX/yapi.hh @@ -61,22 +61,22 @@ extern "C" { #endif #if _MSC_VER || defined(__MINGW32__) -#include +//#include #endif // taken from yap_structs.h #include "iopreds.h" -extern void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); +X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); /* void UserCPredicateWithArgs(const char *name, int *fn(), unsigned int arity) */ -extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); +X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); /* void UserBackCPredicate(const char *name, int *init(), int *cont(), int arity, int extra) */ -extern void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity); + X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity); -extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p); +X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p); } diff --git a/CXX/yapt.hh b/CXX/yapt.hh index 2512b7eed..07f551e0d 100644 --- a/CXX/yapt.hh +++ b/CXX/yapt.hh @@ -3,7 +3,7 @@ class YAPAtomTerm; -extern "C" Term YAP_ReadBuffer(const char *s, Term *tp); +extern "C" Term X_API YAP_ReadBuffer(const char *s, Term *tp); /** * @brief Generic Prolog Term diff --git a/H/TermExt.h b/H/TermExt.h index 32385df7b..be4378f33 100755 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -338,10 +338,7 @@ INLINE_ONLY inline EXTERN int IsStringTerm(Term t) { #include #if defined(__cplusplus) -#define OCXX __cplusplus -#undef __cplusplus -#include -#define __cplusplus OCXX +#include #elif !defined(__GMP_H__) #include #endif diff --git a/H/YapFlags.h b/H/YapFlags.h index 7c349cdfa..2d637f5c8 100644 --- a/H/YapFlags.h +++ b/H/YapFlags.h @@ -345,7 +345,8 @@ static inline Term getBackQuotesFlag(void) { return GLOBAL_Flags[BACKQUOTED_STRING_FLAG].at; } -static inline int indexingMode(void) { return GLOBAL_Flags[INDEX_FLAG].at; } +static inline Term +indexingMode(void) { return GLOBAL_Flags[INDEX_FLAG].at; } static inline const char *floatFormat(void) { return RepAtom(AtomOfTerm(GLOBAL_Flags[FLOAT_FORMAT_FLAG].at))->rep.uStrOfAE; diff --git a/H/YapHandles.h b/H/YapHandles.h index 5f27560a6..47b9af43a 100755 --- a/H/YapHandles.h +++ b/H/YapHandles.h @@ -192,7 +192,7 @@ INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) { (inc + LOCAL_NHandles) * sizeof(CELL)); LOCAL_NHandles += inc; if (!LOCAL_HandleBase) { - unsigned long int kneeds = ((inc + LOCAL_NHandles) * sizeof(CELL)) / 1024; + size_t kneeds = ((inc + LOCAL_NHandles) * sizeof(CELL)) / 1024; Yap_Error( SYSTEM_ERROR_INTERNAL, 0 /* TermNil */, "Out of memory for the term handles (term_t) aka slots, l needed", diff --git a/H/YapText.h b/H/YapText.h index 5ddace8d6..a4fb70db0 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -269,7 +269,7 @@ inline static int cmpn_utf8(const utf8proc_uint8_t *pt1, #define LEAD_OFFSET ((uint32_t)0xD800 - (uint32_t)(0x10000 >> 10)) #define SURROGATE_OFFSET ( (uint32_t)0x10000 - (uint32_t)(0xD800 << 10) - (uint32_t)0xDC00 ) -const char *Yap_tokRep(TokEntry *tokptr); +const char *Yap_tokRep(TokEntry *tokptr, encoding_t enc); // standard strings @@ -1433,3 +1433,6 @@ static inline Term Yap_SubtractTailString(Term t1, Term th USES_REGS) { } #endif // ≈YAP_TEXT_H + +const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc); +Term Yap_MkTextTerm(const char *s, encoding_t e, Term tguide); diff --git a/H/Yapproto.h b/H/Yapproto.h index a4bf23888..4946bc04d 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -423,12 +423,10 @@ double Yap_random(void); char *Yap_RegistryGetString(char *); void Yap_WinError(char *); #endif -const char *Yap_TextTermToText(Term t, char *buf, size_t len); -Term Yap_MkTextTerm(const char *s, Term tguide ); typedef enum { YAP_STD, YAP_SAVED_STATE, YAP_OBJ, YAP_PL, YAP_QLY } file_type_t; -const char *Yap_AbsoluteFile(const char *spec, bool ok); +const char *Yap_AbsoluteFile(const char *spec, char *obuf, bool ok); const char *Yap_AbsoluteFileInBuffer(const char *spec, char *outp, size_t sz, bool ok); const char *Yap_findFile(const char *isource, const char *idef, const char *root, char *result, bool access, file_type_t ftype, diff --git a/H/Yatom.h b/H/Yatom.h index b3dbb59c8..443ce3f40 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -237,22 +237,22 @@ INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p) { #define WideAtomProperty ((PropFlags)0xfff8) -INLINE_ONLY inline EXTERN PropFlags IsWideAtomProperty(int); +INLINE_ONLY inline EXTERN bool IsWideAtomProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsWideAtomProperty(int flags) { - return (PropFlags)((flags == WideAtomProperty)); +INLINE_ONLY inline EXTERN bool IsWideAtomProperty(PropFlags flags) { + return (flags == WideAtomProperty); } -INLINE_ONLY inline EXTERN int IsWideAtom(Atom); +INLINE_ONLY inline EXTERN bool IsWideAtom(Atom); -INLINE_ONLY inline EXTERN int IsWideAtom(Atom at) { - return RepAtom(at)->PropsOfAE && +INLINE_ONLY inline EXTERN bool IsWideAtom(Atom at) { + return RepAtom(at)->PropsOfAE != NIL && IsWideAtomProperty(RepWideAtomProp(RepAtom(at)->PropsOfAE)->KindOfPE); } /* Module property */ typedef struct mod_entry { - Prop NextOfPE; /* used to chain properties */ + Prop NextOfPE; /** chain of atom properties */ PropFlags KindOfPE; /* kind of property */ struct pred_entry *PredForME; /* index in module table */ Atom AtomOfME; /* module's name */ @@ -296,10 +296,10 @@ INLINE_ONLY inline EXTERN Prop AbsModProp(ModEntry *p) { return (Prop)(p); } #define ModProperty ((PropFlags)0xfffa) -INLINE_ONLY inline EXTERN PropFlags IsModProperty(int); +INLINE_ONLY inline EXTERN bool IsModProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsModProperty(int flags) { - return (PropFlags)((flags == ModProperty)); +INLINE_ONLY inline EXTERN bool IsModProperty(int flags) { + return flags == ModProperty; } /* Flags on module. Most of these flags are copied to the read context @@ -369,10 +369,10 @@ INLINE_ONLY inline EXTERN Prop AbsOpProp(OpEntry *p) { return (Prop)(p); } #endif #define OpProperty ((PropFlags)0xffff) -INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int); +INLINE_ONLY inline EXTERN bool IsOpProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int flags) { - return (PropFlags)((flags == OpProperty)); +INLINE_ONLY inline EXTERN bool IsOpProperty(PropFlags flags) { + return flags == OpProperty; } typedef enum { INFIX_OP = 0, POSFIX_OP = 1, PREFIX_OP = 2 } op_type; @@ -1025,10 +1025,10 @@ static inline TranslationEntry *Yap_GetTranslationProp(Atom at, arity_t arity) { return p; } -INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty(int); +INLINE_ONLY inline EXTERN bool IsTranslationProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty(int flags) { - return (PropFlags)((flags == TranslationProperty)); +INLINE_ONLY inline EXTERN bool IsTranslationProperty(PropFlags flags) { + return flags == TranslationProperty; } /*** handle named mutexes */ @@ -1087,9 +1087,9 @@ static inline void *Yap_GetMutexFromProp(Atom at) { return p->Mutex; } -INLINE_ONLY inline EXTERN PropFlags IsMutexProperty(int); +INLINE_ONLY inline EXTERN bool IsMutexProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsMutexProperty(int flags) { +INLINE_ONLY inline EXTERN bool IsMutexProperty(PropFlags flags) { return (PropFlags)((flags == MutexProperty)); } @@ -1205,16 +1205,16 @@ INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry *p) { #endif #define ArrayProperty ((PropFlags)0xfff7) -INLINE_ONLY inline EXTERN int ArrayIsDynamic(ArrayEntry *); +INLINE_ONLY inline EXTERN bool ArrayIsDynamic(ArrayEntry *); -INLINE_ONLY inline EXTERN int ArrayIsDynamic(ArrayEntry *are) { - return (int)(((are)->TypeOfAE & DYNAMIC_ARRAY)); +INLINE_ONLY inline EXTERN bool ArrayIsDynamic(ArrayEntry *are) { + return ((are)->TypeOfAE & DYNAMIC_ARRAY) != 0; } -INLINE_ONLY inline EXTERN PropFlags IsArrayProperty(int); +INLINE_ONLY inline EXTERN bool IsArrayProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsArrayProperty(int flags) { - return (PropFlags)((flags == ArrayProperty)); +INLINE_ONLY inline EXTERN bool IsArrayProperty(PropFlags flags) { + return flags == ArrayProperty; } /* SWI Blob property */ @@ -1256,23 +1256,23 @@ INLINE_ONLY inline EXTERN Prop AbsBlobProp(YAP_BlobPropEntry *p) { #define BlobProperty ((PropFlags)0xfffe) -INLINE_ONLY inline EXTERN PropFlags IsBlobProperty(int); +INLINE_ONLY inline EXTERN bool IsBlobProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsBlobProperty(int flags) { - return (PropFlags)((flags == BlobProperty)); +INLINE_ONLY inline EXTERN bool IsBlobProperty(PropFlags flags) { + return flags == BlobProperty; } -INLINE_ONLY inline EXTERN int IsBlob(Atom); +INLINE_ONLY inline EXTERN bool IsBlob(Atom); -INLINE_ONLY inline EXTERN int IsBlob(Atom at) { - return RepAtom(at)->PropsOfAE && +INLINE_ONLY inline EXTERN bool IsBlob(Atom at) { + return RepAtom(at)->PropsOfAE != NIL && IsBlobProperty(RepBlobProp(RepAtom(at)->PropsOfAE)->KindOfPE); } -INLINE_ONLY inline EXTERN PropFlags IsValProperty(int); +INLINE_ONLY inline EXTERN bool IsValProperty(PropFlags); -INLINE_ONLY inline EXTERN PropFlags IsValProperty(int flags) { - return (PropFlags)((flags == ValProperty)); +INLINE_ONLY inline EXTERN bool IsValProperty(PropFlags flags) { + return flags == ValProperty; } /* flag property entry structure */ @@ -1318,10 +1318,11 @@ INLINE_ONLY inline EXTERN Prop AbsFlagProp(FlagEntry *p) { return (Prop)(p); } #endif #define FlagProperty ((PropFlags)0xfff9) -INLINE_ONLY inline EXTERN PropFlags IsFlagProperty(int); +INLINE_ONLY inline EXTERN bool IsFlagProperty(PropFlags); + +INLINE_ONLY inline EXTERN bool IsFlagProperty(PropFlags flags) { + return flags == FlagProperty; -INLINE_ONLY inline EXTERN PropFlags IsFlagProperty(int flags) { - return (PropFlags)((flags == FlagProperty)); } /* Proto types */ diff --git a/H/amidefs.h b/H/amidefs.h index c7ab91d16..e7ef7e159 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -1036,7 +1036,7 @@ CELL *ENV_Parent(CELL *env) } static inline -UInt ENV_Size(yamop *cp) +Int ENV_Size(yamop *cp) { return (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NULL,Osbpp)))->y_u.Osbpp.s); } diff --git a/H/amiops.h b/H/amiops.h index 9269524aa..465aab56a 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -294,7 +294,7 @@ extern void Yap_WakeUp(CELL *v); #define Bind_NonAtt(A,D) { *(A) = (D); TRAIL(A,D); } #define Bind_Global_NonAtt(A,D) { *(A) = (D); TRAIL_GLOBAL(A,D); } #define Bind_and_Trail(A,D) { *(A) = (D); DO_TRAIL(A, D); } -#define Bind(A,D) YapBind(A,D) +// #define Bind(A,D) YapBind(A,D) conflicts with Windows headers #define MaBind(VP,D) { MATRAIL((VP),*(VP),(D)); *(VP) = (D); } diff --git a/OPTYap/tab.tries.insts.h b/OPTYap/tab.tries.insts.h index 6cef8eeea..55ae5df44 100644 --- a/OPTYap/tab.tries.insts.h +++ b/OPTYap/tab.tries.insts.h @@ -75,7 +75,7 @@ GONext() #define copy_aux_stack() \ - { int size = 3 + heap_arity + subs_arity + vars_arity; \ + { arity_t size = 3 + heap_arity + subs_arity + vars_arity; \ TOP_STACK -= size; \ memcpy(TOP_STACK, aux_stack, size * sizeof(CELL *)); \ aux_stack = TOP_STACK; \ @@ -251,7 +251,7 @@ TOP_STACK[HEAP_ARITY_ENTRY] = func_arity; \ } \ *HR = (CELL) func; \ - { int i; \ + { arity_t i; \ for (i = 1; i <= func_arity; i++) \ TOP_STACK[HEAP_ENTRY(i)] = (CELL) (HR + i); \ } \ @@ -273,7 +273,7 @@ Bind_Global(HR, AbsAppl(HR + 2)); \ HR += 2; \ *HR = (CELL) func; \ - { int i; \ + { arity_t i; \ for (i = 1; i <= func_arity; i++) \ TOP_STACK[HEAP_ENTRY(i)] = (CELL) (HR + i); \ } \ @@ -288,7 +288,7 @@ #define aux_stack_var_instr() \ if (heap_arity) { \ - int i; \ + arity_t i; \ CELL var = aux_stack[HEAP_ENTRY(1)]; \ RESET_VARIABLE(var); \ TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity - 1; \ @@ -309,7 +309,7 @@ #define aux_stack_var_in_pair_instr() \ if (heap_arity) { \ - int i; \ + arity_t i; \ Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(HR)); \ TOP_STACK = &aux_stack[-1]; \ TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity; \ @@ -411,9 +411,9 @@ PBOp(trie_do_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; aux_stack_var_instr(); ENDPBOp(); @@ -422,9 +422,9 @@ PBOp(trie_trust_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_var_instr(); @@ -434,9 +434,9 @@ PBOp(trie_try_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_var_instr(); @@ -446,9 +446,9 @@ PBOp(trie_retry_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_var_instr(); @@ -459,9 +459,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; aux_stack_var_in_pair_instr(); #else @@ -474,9 +474,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_var_in_pair_instr(); @@ -490,9 +490,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_var_in_pair_instr(); @@ -506,9 +506,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_var_in_pair_instr(); @@ -521,10 +521,10 @@ PBOp(trie_do_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); aux_stack_val_instr(); ENDPBOp(); @@ -533,10 +533,10 @@ PBOp(trie_trust_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); pop_trie_node(); aux_stack_val_instr(); @@ -546,10 +546,10 @@ PBOp(trie_try_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); store_trie_node(TrNode_next(node)); aux_stack_val_instr(); @@ -559,10 +559,10 @@ PBOp(trie_retry_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); restore_trie_node(TrNode_next(node)); aux_stack_val_instr(); @@ -573,10 +573,10 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); aux_stack_val_in_pair_instr(); #else @@ -589,10 +589,10 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); pop_trie_node(); aux_stack_val_in_pair_instr(); @@ -606,10 +606,10 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); store_trie_node(TrNode_next(node)); aux_stack_val_in_pair_instr(); @@ -623,10 +623,10 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - int var_index = VarIndexOfTableTerm(TrNode_entry(node)); + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + int var_index = VarIndexOfTableTerm(TrNode_entry(node)); restore_trie_node(TrNode_next(node)); aux_stack_val_in_pair_instr(); @@ -639,9 +639,9 @@ PBOp(trie_do_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = TrNode_entry(node); aux_stack_term_instr(); @@ -651,9 +651,9 @@ PBOp(trie_trust_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = TrNode_entry(node); pop_trie_node(); @@ -664,9 +664,9 @@ PBOp(trie_try_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = TrNode_entry(node); store_trie_node(TrNode_next(node)); @@ -677,9 +677,9 @@ PBOp(trie_retry_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = TrNode_entry(node); restore_trie_node(TrNode_next(node)); @@ -691,9 +691,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; aux_stack_term_in_pair_instr(); #else @@ -706,9 +706,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_term_in_pair_instr(); @@ -722,9 +722,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_term_in_pair_instr(); @@ -738,9 +738,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_term_in_pair_instr(); @@ -760,9 +760,9 @@ PBOp(trie_trust_null, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_null_instr(); @@ -772,9 +772,9 @@ PBOp(trie_try_null, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_null_instr(); @@ -784,9 +784,9 @@ PBOp(trie_retry_null, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_null_instr(); @@ -797,9 +797,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; aux_stack_new_pair_instr(); #else @@ -812,9 +812,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_new_pair_instr(); @@ -828,9 +828,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_new_pair_instr(); @@ -844,9 +844,9 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_new_pair_instr(); @@ -859,9 +859,9 @@ PBOp(trie_do_pair, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; aux_stack_pair_instr(); ENDPBOp(); @@ -870,9 +870,9 @@ PBOp(trie_trust_pair, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_pair_instr(); @@ -882,9 +882,9 @@ PBOp(trie_try_pair, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_pair_instr(); @@ -894,9 +894,9 @@ PBOp(trie_retry_pair, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_pair_instr(); @@ -906,11 +906,11 @@ PBOp(trie_do_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); aux_stack_appl_instr(); ENDPBOp(); @@ -919,11 +919,11 @@ PBOp(trie_trust_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); pop_trie_node(); aux_stack_appl_instr(); @@ -933,11 +933,11 @@ PBOp(trie_try_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); store_trie_node(TrNode_next(node)); aux_stack_appl_instr(); @@ -947,11 +947,11 @@ PBOp(trie_retry_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); restore_trie_node(TrNode_next(node)); aux_stack_appl_instr(); @@ -962,11 +962,11 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); aux_stack_appl_in_pair_instr(); #else @@ -979,11 +979,11 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); pop_trie_node(); aux_stack_appl_in_pair_instr(); @@ -997,11 +997,11 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); store_trie_node(TrNode_next(node)); aux_stack_appl_in_pair_instr(); @@ -1015,11 +1015,11 @@ #ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); - int func_arity = ArityOfFunctor(func); + arity_t func_arity = ArityOfFunctor(func); restore_trie_node(TrNode_next(node)); aux_stack_appl_in_pair_instr(); @@ -1032,7 +1032,7 @@ PBOp(trie_do_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; aux_stack_extension_instr(); ENDPBOp(); @@ -1041,9 +1041,9 @@ PBOp(trie_trust_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); aux_stack_extension_instr(); @@ -1053,9 +1053,9 @@ PBOp(trie_try_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); aux_stack_extension_instr(); @@ -1065,9 +1065,9 @@ PBOp(trie_retry_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); aux_stack_extension_instr(); @@ -1077,9 +1077,9 @@ PBOp(trie_do_double, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; volatile union { Float dbl; Term ts[SIZEOF_DOUBLE/SIZEOF_INT_P]; @@ -1120,9 +1120,9 @@ PBOp(trie_do_longint, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = MkLongIntTerm(aux_stack[HEAP_ENTRY(1)]); heap_arity -= 2; @@ -1150,9 +1150,9 @@ PBOp(trie_do_bigint, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Term t = AbsAppl((CELL*)aux_stack[HEAP_ENTRY(1)]); heap_arity -= 2; @@ -1181,9 +1181,9 @@ PBOp(trie_do_gterm, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = 0; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = 0; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); next_instruction(subs_arity - 1 , node); @@ -1193,9 +1193,9 @@ PBOp(trie_trust_gterm, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = 0; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = 0; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); @@ -1206,9 +1206,9 @@ PBOp(trie_try_gterm, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = TOP_STACK; - int heap_arity = 0; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = 0; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); @@ -1219,9 +1219,9 @@ PBOp(trie_retry_gterm, e) register ans_node_ptr node = (ans_node_ptr) PREG; register CELL *aux_stack = (CELL *) (B + 1); - int heap_arity = 0; - int vars_arity = aux_stack[VARS_ARITY_ENTRY]; - int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + arity_t heap_arity = 0; + arity_t vars_arity = aux_stack[VARS_ARITY_ENTRY]; + arity_t subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); diff --git a/cmake/FindGMP.cmake b/cmake/FindGMP.cmake index 7f2afb0a2..6ccc5c2bd 100644 --- a/cmake/FindGMP.cmake +++ b/cmake/FindGMP.cmake @@ -63,16 +63,7 @@ else(MSVC) get_filename_component(GMP_LIBRARIES_DIR "${GMP_LIBRARIES}" PATH CACHE) -if (WIN32) - -find_library(GMP_LIBRARY_DLL NAMES gmp - PATHS - ${GMP_LIBRARIES_DIR}/../bin - ${GMP_LIBRARIES_DIR} - ) -endif(WIN32) - -find_file(GMP_INCLUDE_DIRS +find_path(GMP_INCLUDE_DIRS NAMES gmp.h PATHS ${GMP_LIBRARIES_DIR}/../include @@ -85,7 +76,7 @@ endif(MSVC) # handle the QUIET and REQUIRED arguments and set GMP_FOUND to TRUE if # all listed variables are true include(FindPackageHandleStandardArgs) -if(WIN32) +if(MSVC) find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_LIBRARIES_DIR GMP_LIBRARY_DLL GMP_INCLUDE_DIRS) mark_as_advanced(GMP_LIBRARY_DLL) else() diff --git a/config.h.cmake b/config.h.cmake index 16237b3c8..fbb5eba06 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -1996,7 +1996,7 @@ calls it, or to nothing if 'inline' is not supported under any name. */ #endif #ifndef MAXPATHLEN -#ifdef PATH_MAX +#if defined(PATH_MAX) #define MAXPATHLEN PATH_MAX #else #define MAXPATHLEN 1024 diff --git a/include/YapInterface.h b/include/YapInterface.h index fe178f1bf..5f7b51600 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -1798,7 +1798,6 @@ extern X_API void *YAP_ExtraSpaceCut(void); extern X_API YAP_Bool YAP_Unify(YAP_Term t1, YAP_Term t2); -/* void UserCPredicate(const char *name, int *fn(), int arity) */ extern X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index cca4edc26..92e74c6f9 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -3174,7 +3174,7 @@ atom_generator(const char *prefix, char **hit, int state) CACHE_REGS struct scan_atoms *index; Atom catom; - Int i; + UInt i; if ( !state ) { index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms)); diff --git a/library/system/sys.c b/library/system/sys.c index a4446bae4..403820bb9 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -1,1187 +1,1114 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* $Id: sys.c,v 1.36 2008-07-11 17:02:09 vsc Exp $ * -* mods: $Log: not supported by cvs2svn $ -* mods: Revision 1.35 2008/05/23 13:16:13 vsc -* mods: fix sys.c for win32 -* mods: -* mods: Revision 1.34 2008/05/22 23:25:21 vsc -* mods: add tmp_file/2 -* mods: -* mods: Revision 1.33 2007/10/05 18:24:30 vsc -* mods: fix garbage collector and fix LeaveGoal -* mods: -* mods: Revision 1.32 2007/05/07 12:11:39 vsc -* mods: fix mktime fix -* mods: -* mods: Revision 1.31 2007/05/07 11:21:29 vsc -* mods: mktime needs to know if daylight time savings are on -* mods: (obs from Bernd Gutmann). -* mods: -* mods: Revision 1.30 2007/05/02 11:16:43 vsc -* mods: small fixes to sys.c -* mods: -* mods: Revision 1.29 2006/10/10 14:08:17 vsc -* mods: small fixes on threaded implementation. -* mods: -* mods: Revision 1.28 2006/05/25 16:28:28 vsc -* mods: include thread_sleep functionality. -* mods: -* mods: Revision 1.27 2006/05/17 18:38:11 vsc -* mods: make system library use true file name -* mods: -* mods: Revision 1.26 2006/04/25 03:23:40 vsc -* mods: fix ! in debugger (execute_clause) -* mods: improve system/1 and execute/1 -* mods: -* mods: Revision 1.25 2006/01/17 14:10:42 vsc -* mods: YENV may be an HW register (breaks some tabling code) -* mods: All YAAM instructions are now brackedted, so Op introduced an { and EndOp introduces an }. This is because Ricardo assumes that. -* mods: Fix attvars when COROUTING is undefined. -* mods: -* mods: Revision 1.24 2006/01/08 23:01:48 vsc -* mods: *** empty log message *** -* mods: -* mods: Revision 1.23 2005/10/21 16:09:03 vsc -* mods: SWI compatible module only operators -* mods: -* mods: Revision 1.22 2005/03/10 18:04:01 rslopes -* mods: update YAP_Error arguments -* mods: to be able to compile on Windows... -* mods: -* mods: Revision 1.21 2004/08/11 16:14:54 vsc -* mods: whole lot of fixes: -* mods: - memory leak in indexing -* mods: - memory management in WIN32 now supports holes -* mods: - extend Yap interface, more support for SWI-Interface -* mods: - new predicate mktime in system -* mods: - buffer console I/O in WIN32 -* mods: -* mods: Revision 1.20 2004/07/23 19:02:09 vsc -* mods: misc fixes -* mods: -* mods: Revision 1.19 2004/07/23 03:37:17 vsc -* mods: fix heap overflow in YAP_LookupAtom -* mods: -* mods: Revision 1.18 2004/01/26 12:51:33 vsc -* mods: should be datime/1 not date/1 -* mods: -* mods: Revision 1.17 2004/01/26 12:41:06 vsc -* mods: bug fixes -* mods: -* mods: Revision 1.16 2003/01/27 15:55:40 vsc -* mods: use CVS Id -* mods: -* mods: Revision 1.15 2003/01/27 15:54:10 vsc -* mods: fix header -* mods: * -* comments: regular expression interpreter * -* * -*************************************************************************/ - -#include "config.h" -#include "YapInterface.h" -#include "crypto/md5.h" -#include -#if HAVE_UNISTD_H -#include -#endif -#include -#if HAVE_TIME_H -#include -#endif -#if HAVE_SYS_TYPES_H -#include -#endif -#if HAVE_SYS_STAT_H -#include -#endif -#if HAVE_FCNTL_H -#include -#endif -#if HAVE_MATH_H -#include -#endif -#if HAVE_UNISTD_H -#include -#endif -#if HAVE_ERRNO_H -#include -#endif -#if HAVE_STRING_H -#include -#endif -#if HAVE_SIGNAL_H -#include -#endif -#if HAVE_SYS_WAIT_H -#include -#endif -#if HAVE_DIRENT_H -#include -#endif -#if HAVE_DIRECT_H -#include -#endif -#if defined(__MINGW32__) || _MSC_VER -#include -#include -#endif -#ifdef __MINGW32__ -#ifdef HAVE_ENVIRON -#undef HAVE_ENVIRON -#endif -#endif -#if __ANDROID__ -#include -#include -#include -#endif - -void init_sys(void); - -#if defined(__MINGW32__) || _MSC_VER -static YAP_Term -WinError(void) -{ - char msg[256]; - /* Error, we could not read time */ - FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, - NULL, GetLastError(), - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256, - NULL); - return(YAP_MkAtomTerm(YAP_LookupAtom(msg))); -} -#endif - -/* Return time in a structure */ -static YAP_Bool -sysmktime(void) -{ - -#if defined(__MINGW32__) || _MSC_VER - SYSTEMTIME stime, stime0; - FILETIME ftime, ftime0; - - stime.wYear = YAP_IntOfTerm(YAP_ARG1); - stime.wMonth = YAP_IntOfTerm(YAP_ARG2); - stime.wDay = YAP_IntOfTerm(YAP_ARG3); - stime.wHour = YAP_IntOfTerm(YAP_ARG4); - stime.wMinute = YAP_IntOfTerm(YAP_ARG5); - stime.wSecond = YAP_IntOfTerm(YAP_ARG6); - stime.wMilliseconds = 0; - stime0.wYear = 1970; - stime0.wMonth = 1; - stime0.wDay = 1; - stime0.wHour = 12; - stime0.wMinute = 0; - stime0.wSecond = 0; - stime0.wMilliseconds = 0; - if (!SystemTimeToFileTime(&stime,&ftime)) { - return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); - } - if (!SystemTimeToFileTime(&stime0,&ftime0)) { - return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); - } -#if __GNUC__ - { - unsigned long long f1 = (((unsigned long long)ftime.dwHighDateTime)<<32)+(unsigned long long)ftime.dwLowDateTime; - unsigned long long f0 = (((unsigned long long)ftime0.dwHighDateTime)<<32)+(unsigned long long)ftime0.dwLowDateTime; - return YAP_Unify(YAP_ARG7,YAP_MkIntTerm((long int)((f1-f0)/10000000))); - } -#else - return FALSE; -#endif -#else -#ifdef HAVE_MKTIME - struct tm loc; - time_t tim; - - loc.tm_year = YAP_IntOfTerm(YAP_ARG1)-1900; - loc.tm_mon = YAP_IntOfTerm(YAP_ARG2)-1; - loc.tm_mday = YAP_IntOfTerm(YAP_ARG3); - loc.tm_hour = YAP_IntOfTerm(YAP_ARG4); - loc.tm_min = YAP_IntOfTerm(YAP_ARG5); - loc.tm_sec = YAP_IntOfTerm(YAP_ARG6); - loc.tm_isdst = -1; - - if ((tim = mktime(&loc)) == (time_t)-1) { - return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); - } - return YAP_Unify(YAP_ARG7,YAP_MkIntTerm(tim)); -#else - oops -#endif /* HAVE_MKTIME */ -#endif /* WINDOWS */ -} - -/* Return time in a structure */ -static YAP_Bool -datime(void) -{ - YAP_Term tf, out[6]; -#if defined(__MINGW32__) || _MSC_VER - SYSTEMTIME stime; - GetLocalTime(&stime); - out[0] = YAP_MkIntTerm(stime.wYear); - out[1] = YAP_MkIntTerm(stime.wMonth); - out[2] = YAP_MkIntTerm(stime.wDay); - out[3] = YAP_MkIntTerm(stime.wHour); - out[4] = YAP_MkIntTerm(stime.wMinute); - out[5] = YAP_MkIntTerm(stime.wSecond); -#elif HAVE_TIME - time_t tp; - - if ((tp = time(NULL)) == -1) { - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); - } -#ifdef HAVE_LOCALTIME - { - struct tm *loc = localtime(&tp); - if (loc == NULL) { - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); - } - out[0] = YAP_MkIntTerm(1900+loc->tm_year); - out[1] = YAP_MkIntTerm(1+loc->tm_mon); - out[2] = YAP_MkIntTerm(loc->tm_mday); - out[3] = YAP_MkIntTerm(loc->tm_hour); - out[4] = YAP_MkIntTerm(loc->tm_min); - out[5] = YAP_MkIntTerm(loc->tm_sec); - } -#else - oops -#endif /* HAVE_LOCALTIME */ -#else - oops -#endif /* HAVE_TIME */ - tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out); - return YAP_Unify(YAP_ARG1, tf); -} - -#define BUF_SIZE 1024 - -/* Return a list of files for a directory */ -static YAP_Bool -list_directory(void) -{ - YAP_Term tf = YAP_MkAtomTerm(YAP_LookupAtom("[]")); - long sl = YAP_InitSlot(tf); - - char *buf = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); -#if defined(__MINGW32__) || _MSC_VER - struct _finddata_t c_file; - char bs[BUF_SIZE]; - long hFile; - - bs[0] = '\0'; -#if HAVE_STRNCPY - strncpy(bs, buf, BUF_SIZE); -#else - strcpy(bs, buf); -#endif -#if HAVE_STRNCAT - strncat(bs, "/*", BUF_SIZE); -#else - strcat(bs, "/*"); -#endif - if ((hFile = _findfirst(bs, &c_file)) == -1L) { - return(YAP_Unify(YAP_ARG2,tf)); - } - YAP_PutInSlot(sl, YAP_MkPairTerm(YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)), YAP_GetFromSlot(sl))); - while (_findnext( hFile, &c_file) == 0) { - YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)); - YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); - } - _findclose( hFile ); -#else -#if __ANDROID__ - { - extern AAssetManager *Yap_assetManager; - const char *dirName = buf+strlen("/assets/"); - AAssetManager* mgr = Yap_assetManager; - AAssetDir *de; - const char* dp; - - if ((de = AAssetManager_openDir(mgr, dirName)) == NULL) { - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } - while (( dp = AAssetDir_getNextFileName(de))) { - YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp)); - YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); - } - AAssetDir_close(de); - } -#endif -#if HAVE_OPENDIR - { - DIR *de; - struct dirent *dp; - - if ((de = opendir(buf)) == NULL) { - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } - while ((dp = readdir(de))) { - YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp->d_name)); - YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); - } - closedir(de); - } -#endif /* HAVE_OPENDIR */ -#endif - tf = YAP_GetFromSlot(sl); - return YAP_Unify(YAP_ARG2, tf); -} - -static YAP_Bool -p_unlink(void) -{ - char *fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); -#if defined(__MINGW32__) || _MSC_VER - if (_unlink(fd) == -1) -#else - if (unlink(fd) == -1) -#endif - { - /* return an error number */ - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); - } - return(TRUE); -} - -static YAP_Bool -p_rmdir(void) -{ - char *fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); -#if defined(__MINGW32__) || _MSC_VER - if (_rmdir(fd) == -1) { -#else - if (rmdir(fd) == -1) { -#endif - /* return an error number */ - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); - } - return(TRUE); -} - -static YAP_Bool -rename_file(void) -{ - char *s1 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); - char *s2 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); -#if HAVE_RENAME - if (rename(s1, s2) == -1) { - /* return an error number */ - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } -#endif - return(TRUE); -} - -static YAP_Bool -dir_separator(void) -{ - return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/")))); -} - -static YAP_Bool -file_property(void) -{ - const char *fd; -#if HAVE_LSTAT - struct stat buf; - - fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); - if (lstat(fd, &buf) == -1) { - /* return an error number */ - return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); - } - if (S_ISREG(buf.st_mode)) { - if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))) && - YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) - return(FALSE); - } else if (S_ISDIR(buf.st_mode)) { - if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))) && - YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) - return(FALSE); - } else if (S_ISFIFO(buf.st_mode)) { - if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("fifo"))) && - YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) - return(FALSE); - } else if (S_ISLNK(buf.st_mode)) { - if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("symlink")))) - return(FALSE); -#if HAVE_READLINK - { - char tmp[256]; - int n; - if ((n = readlink(fd,tmp,256)) == -1) { - return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); - } - tmp[n] = '\0'; - if(!YAP_Unify(YAP_ARG6,YAP_MkAtomTerm(YAP_LookupAtom(tmp)))) { - return(FALSE); - } - } -#else - if (!YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))) - return(FALSE); -#endif - } else if (S_ISSOCK(buf.st_mode)) { - if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("socket"))) && - YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) - return(FALSE); - } else { - if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))) && - YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) - return(FALSE); - } -#elif defined(__MINGW32__) || _MSC_VER - /* for some weird reason _stat did not work with mingw32 */ - struct _stat buf; - - fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); - if (_stat(fd, &buf) != 0) { - /* return an error number */ - return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); - } - if (buf.st_mode & S_IFREG) { - if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular")))) - return(FALSE); - } else if (buf.st_mode & S_IFDIR) { - if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory")))) - return(FALSE); - } else { - if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown")))) - return(FALSE); - } -#endif - return ( - YAP_Unify(YAP_ARG3, YAP_MkIntTerm(buf.st_size)) && - YAP_Unify(YAP_ARG4, YAP_MkIntTerm(buf.st_mtime)) && - YAP_Unify(YAP_ARG5, YAP_MkIntTerm(buf.st_mode)) - ); -} - -/* temporary files */ - -static YAP_Bool -p_mktemp(void) -{ -#if HAVE_MKSTEMP || HAVE_MKTEMP || defined(__MINGW32__) || _MSC_VER - char *s, tmp[BUF_SIZE]; - s = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); -#if HAVE_STRNCPY - strncpy(tmp, s, BUF_SIZE); -#else - strcpy(tmp, s); -#endif -#if defined(__MINGW32__) || _MSC_VER - if ((s = _mktemp(tmp)) == NULL) { - /* return an error number */ - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } - return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s)))); -#elif HAVE_MKSTEMP - strcpy(tmp, "/tmp/YAP_tmpXXXXXXXX"); - if(mkstemp(tmp) == -1) { - /* return an error number */ - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } - return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(tmp))); -#else - if ((s = mktemp(tmp)) == NULL) { - /* return an error number */ - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } - return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s))); -#endif -#else - return FALSE; -#endif - return(TRUE); -} - -static YAP_Bool -p_tmpnam(void) -{ -#if HAVE_MKSTEMP - char s[21]; - strcpy(s, "/tmp/YAP_tmpXXXXXXXX"); - if(mkstemp(s) == -1) - return FALSE; - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); -#elif HAVE_MKTEMP - char *s; - if (!(s = mktemp("/tmp/YAP_tmpXXXXXXXX"))) - return FALSE; - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); -#elif HAVE_TMPNAM - char buf[L_tmpnam], *s; - if (!(s = tmpnam(buf))) - return FALSE; - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); -#else - return FALSE; -#endif -} - -static YAP_Bool -p_tmpdir(void) -{ -#if defined(__MINGW32__) || _MSC_VER - char buf[512]; - DWORD out = GetTempPath(512, buf); - if (!out) { - return(YAP_Unify(YAP_ARG2, WinError())); - } - if (out > 511) { - char *nbuf = malloc(out+1); - if (!nbuf) - return YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("no malloc memory"))); - out = GetTempPath(512, nbuf); - if (!out) { - return YAP_Unify(YAP_ARG2, WinError()); - } - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(nbuf))); - } - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(buf))); -#else - char *s; - if ((s = getenv("TMPDIR"))) - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); -#ifdef P_tmpdir - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(P_tmpdir))); -#endif - return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/tmp"))); -#endif -} - -/* return YAP's environment */ -static YAP_Bool -p_environ(void) -{ -#if HAVE_ENVIRON && 0 -#if HAVE__NSGETENVIRON - char ** ptr = _NSGetEnviron(); -#elif defined(__MINGW32__) || _MSC_VER - extern char **_environ; - char ** ptr = _environ; -#else - extern char **environ; - char ** ptr = environ; -#endif - YAP_Term t1 = YAP_ARG1; - long int i; - - i = YAP_IntOfTerm(t1); - if (ptr[i] == NULL) - return(FALSE); - else { - YAP_Term t = YAP_BufferToString(ptr[i]); - return(YAP_Unify(t, YAP_ARG2)); - } -#else - YAP_Error(0, 0L, "environ not available in this configuration" ); - return(FALSE); -#endif -} - -#if defined(__MINGW32__) || _MSC_VER -static HANDLE -get_handle(YAP_Term ti, DWORD fd) -{ - if (YAP_IsAtomTerm(ti)) { - HANDLE out; - SECURITY_ATTRIBUTES satt; - - satt.nLength = sizeof(satt); - satt.lpSecurityDescriptor = NULL; - satt.bInheritHandle = TRUE; - out = CreateFile("NUL", - GENERIC_READ|GENERIC_WRITE, - FILE_SHARE_READ|FILE_SHARE_WRITE, - &satt, - OPEN_EXISTING, - 0, - NULL); - return(out); - } else { - if (YAP_IsIntTerm(ti)) { - return(GetStdHandle(fd)); - } else - return((HANDLE)YAP_StreamToFileNo(ti)); - } -} - -static void -close_handle(YAP_Term ti, HANDLE h) -{ - if (YAP_IsAtomTerm(ti)) { - CloseHandle(h); - } -} - -#endif - -/* execute a command as a detached process */ -static YAP_Bool -execute_command(void) -{ - YAP_Term ti = YAP_ARG2, to = YAP_ARG3, te = YAP_ARG4; - int res; - YAP_Term AtomNull = YAP_MkAtomTerm(YAP_LookupAtom("null")); - -#if defined(__MINGW32__) || _MSC_VER - HANDLE inpf, outf, errf; - DWORD CreationFlags = 0; - STARTUPINFO StartupInfo; - PROCESS_INFORMATION ProcessInformation; - inpf = get_handle(ti, STD_INPUT_HANDLE); - if (inpf == INVALID_HANDLE_VALUE) { - return(YAP_Unify(YAP_ARG6, WinError())); - } - outf = get_handle(to, STD_OUTPUT_HANDLE); - if (outf == INVALID_HANDLE_VALUE) { - close_handle(ti, inpf); - return(YAP_Unify(YAP_ARG6, WinError())); - } - errf = get_handle(te, STD_OUTPUT_HANDLE); - if (errf == INVALID_HANDLE_VALUE) { - close_handle(ti, inpf); - close_handle(to, outf); - return(YAP_Unify(YAP_ARG6, WinError())); - } - if (!YAP_IsIntTerm(ti) && !YAP_IsIntTerm(to) && !YAP_IsIntTerm(te)) { - /* we do not keep a current stream */ - CreationFlags = DETACHED_PROCESS; - } - StartupInfo.cb = sizeof(STARTUPINFO); - StartupInfo.lpReserved = NULL; - StartupInfo.lpDesktop = NULL; /* inherit */ - StartupInfo.lpTitle = NULL; /* we do not create a new console window */ - StartupInfo.dwFlags = STARTF_USESTDHANDLES; - StartupInfo.cbReserved2 = 0; - StartupInfo.lpReserved2 = NULL; - StartupInfo.hStdInput = inpf; - StartupInfo.hStdOutput = outf; - StartupInfo.hStdError = errf; - /* got stdin, stdout and error as I like it */ - if (CreateProcess(NULL, - (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), - NULL, - NULL, - TRUE, - CreationFlags, - NULL, - NULL, - &StartupInfo, - &ProcessInformation) == FALSE) { - close_handle(ti, inpf); - close_handle(to, outf); - close_handle(te, errf); - return(YAP_Unify(YAP_ARG6, WinError())); - } - close_handle(ti, inpf); - close_handle(to, outf); - close_handle(te, errf); - res = ProcessInformation.dwProcessId; - return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); -#else /* UNIX CODE */ - int inpf, outf, errf; - /* process input first */ - if (ti == AtomNull) { - inpf = open("/dev/null", O_RDONLY); - } else { - int sd; - if (YAP_IsIntTerm(ti)) - sd = YAP_IntOfTerm(ti); - else - sd = YAP_StreamToFileNo(ti); - if (sd == 0) - inpf = 0; - else - inpf = dup(sd); - } - if (inpf < 0) { - /* return an error number */ - return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); - } - /* then output stream */ - if (to == AtomNull) { - outf = open("/dev/zero", O_WRONLY); - } else { - int sd; - if (YAP_IsIntTerm(to)) - sd = YAP_IntOfTerm(to); - else - sd = YAP_StreamToFileNo(to); - if (sd == 1) - outf = 1; - else - outf = dup(sd); - } - if (outf < 0) { - /* return an error number */ - if (inpf != 0) close(inpf); - return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); - } - /* then error stream */ - if (te == AtomNull) { - errf = open("/dev/zero", O_WRONLY); - } else { - int sd; - if (YAP_IsIntTerm(te)) - sd = YAP_IntOfTerm(te); - else - sd = YAP_StreamToFileNo(te); - if (sd == 2) - errf = 2; - else - errf = dup(sd); - } - if (errf < 0) { - /* return an error number */ - if (inpf != 0) close(inpf); - if (outf != 1) close(outf); - return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); - } - YAP_FlushAllStreams(); - /* we are now ready to fork */ - if ((res = fork()) < 0) { - /* close streams we don't need */ - if (inpf != 0) close(inpf); - if (outf != 1) close(outf); - if (errf != 2) close(errf); - /* return an error number */ - return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); - } else if (res == 0) { - char *argv[4]; - - /* child */ - /* close current streams, but not std streams */ - YAP_CloseAllOpenStreams(); - if (inpf != 0) { - close(0); - if (dup(inpf) != 0) - exit(1); - close(inpf); - } - if (outf != 1) { - close(1); - if (dup(outf) != 1) - exit(1); - close(outf); - } - if (errf != 2) { - close(2); - if (dup(errf) != 2) - exit(2); - close(errf); - } - argv[0] = "sh"; - argv[1] = "-c"; - argv[2] = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); - argv[3] = NULL; - execv("/bin/sh", argv); - exit(127); - /* we have the streams where we want them, just want to execute now */ - } else { - if (inpf != 0) close(inpf); - if (outf != 1) close(outf); - if (errf != 2) close(errf); - return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); - } -#endif /* UNIX code */ -} - -/* execute a command as a detached process */ -static YAP_Bool -do_system(void) -{ - char *command = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); -#if HAVE_SYSTEM - int sys = system(command); - if (sys < 0) { - return YAP_Unify(YAP_ARG3,YAP_MkIntTerm(errno)); - } - return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys)); -#else - YAP_Error(0,0L,"system not available in this configuration, trying %s", command); - return FALSE; -#endif -} - - - -/* execute a command as a detached process */ -static YAP_Bool -do_shell(void) -{ -#if defined(__MINGW32__) || _MSC_VER - YAP_Error(0,0L,"system not available in this configuration"); - return(FALSE); -#elif HAVE_SYSTEM - char *buf = YAP_AllocSpaceFromYap(BUF_SIZE); - int sys; - - if (buf == NULL) { - YAP_Error(0,0L,"No Temporary Space for Shell"); - return(FALSE); - } -#if HAVE_STRNCPY - strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), BUF_SIZE); - strncpy(buf, " ", BUF_SIZE); - strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), BUF_SIZE); - strncpy(buf, " ", BUF_SIZE); - strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), BUF_SIZE); -#else - strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1))); - strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2))); - strcpy(buf, " "); - strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3))); -#endif - sys = system(buf); - YAP_FreeSpaceFromYap(buf); - if (sys < 0) { - return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); - } - return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)); -#else - char *cptr[4]; - int t; - int sys; - - cptr[0]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); - cptr[1]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); - cptr[2]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)); - cptr[3]= NULL; - t = fork(); - if (t < 0) { - return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); - } else if (t == 0) { - t = execvp(cptr[0],cptr); - return t; - } else { - t = wait(&sys); - if (t < 0) { - return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); - } - } - return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)); -#endif -} - -/* execute a command as a detached process */ -static YAP_Bool -plwait(void) -{ - long int pid = YAP_IntOfTerm(YAP_ARG1); -#if defined(__MINGW32__) || _MSC_VER - HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid); - DWORD ExitCode; - if (proc == NULL) { - return(YAP_Unify(YAP_ARG3, WinError())); - } - if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) { - return(YAP_Unify(YAP_ARG3, WinError())); - } - if (GetExitCodeProcess(proc, &ExitCode) == 0) { - return(YAP_Unify(YAP_ARG4, WinError())); - } - CloseHandle(proc); - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(ExitCode))); -#else - do { - int status; - - /* check for interruptions */ - if (waitpid(pid, &status, 0) == -1) { - if (errno) { - if (errno == EINTR) { - continue; - } - return YAP_Unify( YAP_ARG3, YAP_MkIntTerm(errno)); - } - } - if (WIFEXITED( status ) ) { - return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(WEXITSTATUS(status)) ); - } else if (WIFSIGNALED( status )) { - return YAP_Unify(YAP_ARG3, YAP_MkAtomTerm(YAP_LookupAtom("signal")) ) && - YAP_Unify(YAP_ARG4, YAP_MkIntTerm( WTERMSIG(status)) ); - } else /* WIFSTOPPED(status) */ { - return YAP_Unify(YAP_ARG3, YAP_MkAtomTerm(YAP_LookupAtom("stopped")) ) && - YAP_Unify(YAP_ARG4, YAP_MkIntTerm( WSTOPSIG(status) ) ); - } - } while(TRUE); -#endif -} - -static YAP_Bool -p_sleep(void) -{ - YAP_Term ts = YAP_ARG1; -#if defined(__MINGW32__) || _MSC_VER - { - unsigned long int secs = 0, usecs = 0, msecs, out; - if (YAP_IsIntTerm(ts)) { - secs = YAP_IntOfTerm(ts); - } else if (YAP_IsFloatTerm(ts)) { - double tfl = YAP_FloatOfTerm(ts); - if (tfl > 1.0) - secs = tfl; - else - usecs = tfl*1000000; - } - msecs = secs*1000 + usecs/1000; - Sleep(msecs); - /* no errors possible */ - out = 0; - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); - } -#elif HAVE_NANOSLEEP - { - struct timespec req; - int out; - - if (YAP_IsFloatTerm(ts)) { - double tfl = YAP_FloatOfTerm(ts); - - req.tv_nsec = (tfl-floor(tfl))*1000000000; - req.tv_sec = rint(tfl); - } else { - req.tv_nsec = 0; - req.tv_sec = YAP_IntOfTerm(ts); - } - out = nanosleep(&req, NULL); - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); - } -#elif HAVE_USLEEP - { - useconds_t usecs; - if (YAP_IsFloatTerm(ts)) { - double tfl = YAP_FloatOfTerm(ts); - - usecs = rint(tfl*1000000); - } else { - usecs = YAP_IntOfTerm(ts)*1000000; - } - out = usleep(usecs); - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); - } -#elif HAVE_SLEEP - { - unsigned int secs, out; - if (YAP_IsFloatTerm(ts)) { - secs = rint(YAP_FloatOfTerm(ts)); - } else { - secs = YAP_IntOfTerm(ts); - } - out = sleep(secs); - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); - } -#else - YAP_Error(0,0L,"sleep not available in this configuration"); - return FALSE: -#endif -} - -/* host info */ - -static YAP_Bool -host_name(void) -{ -#if defined(__MINGW32__) || _MSC_VER - char name[MAX_COMPUTERNAME_LENGTH+1]; - DWORD nSize = MAX_COMPUTERNAME_LENGTH+1; - if (GetComputerName(name, &nSize) == 0) { - return(YAP_Unify(YAP_ARG2, WinError())); - } -#else -#if HAVE_GETHOSTNAME - char name[256]; - if (gethostname(name, 256) == -1) { - /* return an error number */ - return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); - } -#endif -#endif /* defined(__MINGW32__) || _MSC_VER */ - return(YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name)))); -} - -static YAP_Bool -host_id(void) -{ -#if HAVE_GETHOSTID - return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid()))); -#else - return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0))); -#endif -} - -static YAP_Bool -pid(void) -{ -#if defined(__MINGW32__) || _MSC_VER - return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid()))); -#else - return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid()))); -#endif -} - -static YAP_Bool -win(void) -{ -#if defined(__MINGW32__) || _MSC_VER - return(TRUE); -#else - return(FALSE); -#endif -} - -static YAP_Bool -p_kill(void) -{ -#if defined(__MINGW32__) || _MSC_VER - /* Windows does not support cross-process signals, so we shall do the - SICStus thing and assume that a signal to a process will - always kill it */ - HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, YAP_IntOfTerm(YAP_ARG1)); - if (proc == NULL) { - return(YAP_Unify(YAP_ARG3, WinError())); - } - if (TerminateProcess(proc, -1) == 0) { - return(YAP_Unify(YAP_ARG3, WinError())); - } - CloseHandle(proc); -#else - if (kill(YAP_IntOfTerm(YAP_ARG1), YAP_IntOfTerm(YAP_ARG2)) < 0) { - /* return an error number */ - return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); - } -#endif /* defined(__MINGW32__) || _MSC_VER */ - return(TRUE); -} - -#if HAVE_OPENSSL_RIPEMD_H - #include -#endif - -/** md5( +Text, -Key, -Remaining keyq - * encode text using OpenSSL - * - * arg Text is a List of ASCII codes - * arg2 and 3: difference list with the character codes for the - * digest. - * - * @return whether ARG1's md5 unifies with the difference liat. - */ - static YAP_Bool - md5(void) - { - unsigned char buf[64]; - md5_state_t pms; - const char *s; - size_t len = -1; - - if ( ! (s = YAP_StringToBuffer( YAP_ARG1 , NULL, len )) || - s[0] == 0) - return false; - - md5_init( & pms ); - md5_append( & pms, (const unsigned char *)s, strlen(s)); - md5_finish( & pms, buf ); - //free((void *)s); - YAP_Term t = YAP_ARG3; - int i = 16; - while (i > 0) - { - int top, bop; - i--; - top = buf[i]>>4; - if (top > 9) - top = (top-10)+'a'; - else - top = top+'0'; - bop = buf[i] & 15; - if (bop > 9) - bop = (bop-10)+'a'; - else - bop = bop+'0'; - t = YAP_MkPairTerm(YAP_MkIntTerm(top), - YAP_MkPairTerm( YAP_MkIntTerm( bop ), t )); - } - return YAP_Unify( YAP_ARG2,t ); - } - -static YAP_Bool -error_message(void) -{ -#if HAVE_STRERROR - return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(strerror(YAP_IntOfTerm(YAP_ARG1))))); -#else - return YAP_Unify(YAP_ARG2,YAP_ARG1); -#endif -} - void -init_sys(void) -{ -#if HAVE_MKTIME - tzset(); -#endif - YAP_UserCPredicate("datime", datime, 2); - YAP_UserCPredicate("mktime", sysmktime, 8); - YAP_UserCPredicate("list_directory", list_directory, 3); - YAP_UserCPredicate("file_property", file_property, 7); - YAP_UserCPredicate("unlink", p_unlink, 2); - YAP_UserCPredicate("rmdir", p_rmdir, 2); - YAP_UserCPredicate("dir_separator", dir_separator, 1); - YAP_UserCPredicate("p_environ", p_environ, 2); - YAP_UserCPredicate("exec_command", execute_command, 6); - YAP_UserCPredicate("do_shell", do_shell, 5); - YAP_UserCPredicate("do_system", do_system, 3); - YAP_UserCPredicate("plwait", plwait, 4); - YAP_UserCPredicate("host_name", host_name, 2); - YAP_UserCPredicate("host_id", host_id, 2); - YAP_UserCPredicate("pid", pid, 2); - YAP_UserCPredicate("kill", p_kill, 3); - YAP_UserCPredicate("mktemp", p_mktemp, 3); - YAP_UserCPredicate("tmpnam", p_tmpnam, 2); - YAP_UserCPredicate("tmpdir", p_tmpdir, 2); - YAP_UserCPredicate("rename_file", rename_file, 3); - YAP_UserCPredicate("sleep", p_sleep, 2); - YAP_UserCPredicate("error_message", error_message, 2); - YAP_UserCPredicate("win", win, 0); - YAP_UserCPredicate("md5", md5, 3); -} - -#ifdef _WIN32 - -#include - -int WINAPI win_sys(HANDLE, DWORD, LPVOID); - -int WINAPI win_sys(HANDLE hinst, DWORD reason, LPVOID reserved) -{ - switch (reason) - { - case DLL_PROCESS_ATTACH: - break; - case DLL_PROCESS_DETACH: - break; - case DLL_THREAD_ATTACH: - break; - case DLL_THREAD_DETACH: - break; - } - return 1; -} -#endif - +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * + * +* comments: regular expression interpreter * +* * +*************************************************************************/ + +#include "config.h" +#include "YapInterface.h" +#include "crypto/md5.h" +#include +#if HAVE_UNISTD_H +#include +#endif +#include +#if HAVE_TIME_H +#include +#endif +#if HAVE_SYS_TYPES_H +#include +#endif +#if HAVE_SYS_STAT_H +#include +#endif +#if HAVE_FCNTL_H +#include +#endif +#if HAVE_MATH_H +#include +#endif +#if HAVE_UNISTD_H +#include +#endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_STRING_H +#include +#endif +#if HAVE_SIGNAL_H +#include +#endif +#if HAVE_SYS_WAIT_H +#include +#endif +#if HAVE_DIRENT_H +#include +#endif +#if HAVE_DIRECT_H +#include +#endif +#if defined(__MINGW32__) || _MSC_VER +#include +#include +#include +#endif +#ifdef __MINGW32__ +#ifdef HAVE_ENVIRON +#undef HAVE_ENVIRON +#endif +#endif +#if __ANDROID__ +#include +#include +#include +#endif + +void init_sys(void); + +#if defined(__MINGW32__) || _MSC_VER +static YAP_Term +WinError(void) +{ + char msg[256]; + /* Error, we could not read time */ + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256, + NULL); + return(YAP_MkAtomTerm(YAP_LookupAtom(msg))); +} +#endif + +/* Return time in a structure */ +static YAP_Bool +sysmktime(void) +{ + +#if defined(__MINGW32__) || _MSC_VER + SYSTEMTIME stime, stime0; + FILETIME ftime, ftime0; + + stime.wYear = YAP_IntOfTerm(YAP_ARG1); + stime.wMonth = YAP_IntOfTerm(YAP_ARG2); + stime.wDay = YAP_IntOfTerm(YAP_ARG3); + stime.wHour = YAP_IntOfTerm(YAP_ARG4); + stime.wMinute = YAP_IntOfTerm(YAP_ARG5); + stime.wSecond = YAP_IntOfTerm(YAP_ARG6); + stime.wMilliseconds = 0; + stime0.wYear = 1970; + stime0.wMonth = 1; + stime0.wDay = 1; + stime0.wHour = 12; + stime0.wMinute = 0; + stime0.wSecond = 0; + stime0.wMilliseconds = 0; + if (!SystemTimeToFileTime(&stime,&ftime)) { + return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); + } + if (!SystemTimeToFileTime(&stime0,&ftime0)) { + return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); + } +#if __GNUC__ + { + unsigned long long f1 = (((unsigned long long)ftime.dwHighDateTime)<<32)+(unsigned long long)ftime.dwLowDateTime; + unsigned long long f0 = (((unsigned long long)ftime0.dwHighDateTime)<<32)+(unsigned long long)ftime0.dwLowDateTime; + return YAP_Unify(YAP_ARG7,YAP_MkIntTerm((long int)((f1-f0)/10000000))); + } +#else + return FALSE; +#endif +#else +#ifdef HAVE_MKTIME + struct tm loc; + time_t tim; + + loc.tm_year = YAP_IntOfTerm(YAP_ARG1)-1900; + loc.tm_mon = YAP_IntOfTerm(YAP_ARG2)-1; + loc.tm_mday = YAP_IntOfTerm(YAP_ARG3); + loc.tm_hour = YAP_IntOfTerm(YAP_ARG4); + loc.tm_min = YAP_IntOfTerm(YAP_ARG5); + loc.tm_sec = YAP_IntOfTerm(YAP_ARG6); + loc.tm_isdst = -1; + + if ((tim = mktime(&loc)) == (time_t)-1) { + return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); + } + return YAP_Unify(YAP_ARG7,YAP_MkIntTerm(tim)); +#else + oops +#endif /* HAVE_MKTIME */ +#endif /* WINDOWS */ +} + +/* Return time in a structure */ +static YAP_Bool +datime(void) +{ + YAP_Term tf, out[6]; +#if defined(__MINGW32__) || _MSC_VER + SYSTEMTIME stime; + GetLocalTime(&stime); + out[0] = YAP_MkIntTerm(stime.wYear); + out[1] = YAP_MkIntTerm(stime.wMonth); + out[2] = YAP_MkIntTerm(stime.wDay); + out[3] = YAP_MkIntTerm(stime.wHour); + out[4] = YAP_MkIntTerm(stime.wMinute); + out[5] = YAP_MkIntTerm(stime.wSecond); +#elif HAVE_TIME + time_t tp; + + if ((tp = time(NULL)) == -1) { + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); + } +#ifdef HAVE_LOCALTIME + { + struct tm *loc = localtime(&tp); + if (loc == NULL) { + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); + } + out[0] = YAP_MkIntTerm(1900+loc->tm_year); + out[1] = YAP_MkIntTerm(1+loc->tm_mon); + out[2] = YAP_MkIntTerm(loc->tm_mday); + out[3] = YAP_MkIntTerm(loc->tm_hour); + out[4] = YAP_MkIntTerm(loc->tm_min); + out[5] = YAP_MkIntTerm(loc->tm_sec); + } +#else + oops +#endif /* HAVE_LOCALTIME */ +#else + oops +#endif /* HAVE_TIME */ + tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out); + return YAP_Unify(YAP_ARG1, tf); +} + +#define BUF_SIZE 1024 + +/* Return a list of files for a directory */ +static YAP_Bool +list_directory(void) +{ + YAP_Term tf = YAP_MkAtomTerm(YAP_LookupAtom("[]")); + long sl = YAP_InitSlot(tf); + + char *buf = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); +#if defined(__MINGW32__) || _MSC_VER + struct _finddata_t c_file; + char bs[BUF_SIZE]; + long hFile; + + bs[0] = '\0'; +#if HAVE_STRNCPY + strncpy(bs, buf, BUF_SIZE); +#else + strcpy(bs, buf); +#endif +#if HAVE_STRNCAT + strncat(bs, "/*", BUF_SIZE); +#else + strcat(bs, "/*"); +#endif + if ((hFile = _findfirst(bs, &c_file)) == -1L) { + return(YAP_Unify(YAP_ARG2,tf)); + } + YAP_PutInSlot(sl, YAP_MkPairTerm(YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)), YAP_GetFromSlot(sl))); + while (_findnext( hFile, &c_file) == 0) { + YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)); + YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); + } + _findclose( hFile ); +#else +#if __ANDROID__ + { + extern AAssetManager *Yap_assetManager; + const char *dirName = buf+strlen("/assets/"); + AAssetManager* mgr = Yap_assetManager; + AAssetDir *de; + const char* dp; + + if ((de = AAssetManager_openDir(mgr, dirName)) == NULL) { + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } + while (( dp = AAssetDir_getNextFileName(de))) { + YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp)); + YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); + } + AAssetDir_close(de); + } +#endif +#if HAVE_OPENDIR + { + DIR *de; + struct dirent *dp; + + if ((de = opendir(buf)) == NULL) { + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } + while ((dp = readdir(de))) { + YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp->d_name)); + YAP_PutInSlot(sl,YAP_MkPairTerm(ti, YAP_GetFromSlot(sl))); + } + closedir(de); + } +#endif /* HAVE_OPENDIR */ +#endif + tf = YAP_GetFromSlot(sl); + return YAP_Unify(YAP_ARG2, tf); +} + +static YAP_Bool +p_unlink(void) +{ + char *fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); +#if defined(__MINGW32__) || _MSC_VER + if (_unlink(fd) == -1) +#else + if (unlink(fd) == -1) +#endif + { + /* return an error number */ + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); + } + return(TRUE); +} + +static YAP_Bool +p_rmdir(void) +{ + char *fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); +#if defined(__MINGW32__) || _MSC_VER + if (_rmdir(fd) == -1) { +#else + if (rmdir(fd) == -1) { +#endif + /* return an error number */ + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); + } + return(TRUE); +} + +static YAP_Bool +rename_file(void) +{ + char *s1 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + char *s2 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); +#if HAVE_RENAME + if (rename(s1, s2) == -1) { + /* return an error number */ + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } +#endif + return(TRUE); +} + +static YAP_Bool +dir_separator(void) +{ + return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/")))); +} + +static YAP_Bool +file_property(void) +{ + const char *fd; +#if HAVE_LSTAT + struct stat buf; + + fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + if (lstat(fd, &buf) == -1) { + /* return an error number */ + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); + } + if (S_ISREG(buf.st_mode)) { + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) + return(FALSE); + } else if (S_ISDIR(buf.st_mode)) { + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) + return(FALSE); + } else if (S_ISFIFO(buf.st_mode)) { + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("fifo"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) + return(FALSE); + } else if (S_ISLNK(buf.st_mode)) { + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("symlink")))) + return(FALSE); +#if HAVE_READLINK + { + char tmp[256]; + int n; + if ((n = readlink(fd,tmp,256)) == -1) { + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); + } + tmp[n] = '\0'; + if(!YAP_Unify(YAP_ARG6,YAP_MkAtomTerm(YAP_LookupAtom(tmp)))) { + return(FALSE); + } + } +#else + if (!YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))) + return(FALSE); +#endif + } else if (S_ISSOCK(buf.st_mode)) { + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("socket"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) + return(FALSE); + } else { + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) + return(FALSE); + } +#elif defined(__MINGW32__) || _MSC_VER + /* for some weird reason _stat did not work with mingw32 */ + struct _stat buf; + + fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + if (_stat(fd, &buf) != 0) { + /* return an error number */ + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); + } + if (buf.st_mode & S_IFREG) { + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular")))) + return(FALSE); + } else if (buf.st_mode & S_IFDIR) { + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory")))) + return(FALSE); + } else { + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown")))) + return(FALSE); + } +#endif + return ( + YAP_Unify(YAP_ARG3, YAP_MkIntTerm(buf.st_size)) && + YAP_Unify(YAP_ARG4, YAP_MkIntTerm(buf.st_mtime)) && + YAP_Unify(YAP_ARG5, YAP_MkIntTerm(buf.st_mode)) + ); +} + +/* temporary files */ + +static YAP_Bool +p_mktemp(void) +{ +#if HAVE_MKSTEMP || HAVE_MKTEMP || defined(__MINGW32__) || _MSC_VER + char *s, tmp[BUF_SIZE]; + s = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); +#if HAVE_STRNCPY + strncpy(tmp, s, BUF_SIZE); +#else + strcpy(tmp, s); +#endif +#if defined(__MINGW32__) || _MSC_VER + if ((s = _mktemp(tmp)) == NULL) { + /* return an error number */ + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } + return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s)))); +#elif HAVE_MKSTEMP + strcpy(tmp, "/tmp/YAP_tmpXXXXXXXX"); + if(mkstemp(tmp) == -1) { + /* return an error number */ + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } + return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(tmp))); +#else + if ((s = mktemp(tmp)) == NULL) { + /* return an error number */ + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } + return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#endif +#else + return FALSE; +#endif + return(TRUE); +} + +static YAP_Bool +p_tmpnam(void) +{ +#if HAVE_MKSTEMP + char s[21]; + strcpy(s, "/tmp/YAP_tmpXXXXXXXX"); + if(mkstemp(s) == -1) + return FALSE; + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#elif HAVE_MKTEMP + char *s; + if (!(s = mktemp("/tmp/YAP_tmpXXXXXXXX"))) + return FALSE; + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#elif HAVE_TMPNAM + char buf[L_tmpnam], *s; + if (!(s = tmpnam(buf))) + return FALSE; + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#else + return FALSE; +#endif +} + +static YAP_Bool +p_tmpdir(void) +{ +#if defined(__MINGW32__) || _MSC_VER + char buf[512]; + DWORD out = GetTempPath(512, buf); + if (!out) { + return(YAP_Unify(YAP_ARG2, WinError())); + } + if (out > 511) { + char *nbuf = malloc(out+1); + if (!nbuf) + return YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("no malloc memory"))); + out = GetTempPath(512, nbuf); + if (!out) { + return YAP_Unify(YAP_ARG2, WinError()); + } + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(nbuf))); + } + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(buf))); +#else + char *s; + if ((s = getenv("TMPDIR"))) + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#ifdef P_tmpdir + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(P_tmpdir))); +#endif + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/tmp"))); +#endif +} + +/* return YAP's environment */ +static YAP_Bool +p_environ(void) +{ +#if HAVE_ENVIRON && 0 +#if HAVE__NSGETENVIRON + char ** ptr = _NSGetEnviron(); +#elif defined(__MINGW32__) || _MSC_VER + extern char **_environ; + char ** ptr = _environ; +#else + extern char **environ; + char ** ptr = environ; +#endif + YAP_Term t1 = YAP_ARG1; + long int i; + + i = YAP_IntOfTerm(t1); + if (ptr[i] == NULL) + return(FALSE); + else { + YAP_Term t = YAP_BufferToString(ptr[i]); + return(YAP_Unify(t, YAP_ARG2)); + } +#else + YAP_Error(0, 0L, "environ not available in this configuration" ); + return(FALSE); +#endif +} + +#if defined(__MINGW32__) || _MSC_VER +static HANDLE +get_handle(YAP_Term ti, DWORD fd) +{ + if (YAP_IsAtomTerm(ti)) { + HANDLE out; + SECURITY_ATTRIBUTES satt; + + satt.nLength = sizeof(satt); + satt.lpSecurityDescriptor = NULL; + satt.bInheritHandle = TRUE; + out = CreateFile("NUL", + GENERIC_READ|GENERIC_WRITE, + FILE_SHARE_READ|FILE_SHARE_WRITE, + &satt, + OPEN_EXISTING, + 0, + NULL); + return(out); + } else { + if (YAP_IsIntTerm(ti)) { + return(GetStdHandle(fd)); + } else + return((HANDLE)YAP_StreamToFileNo(ti)); + } +} + +static void +close_handle(YAP_Term ti, HANDLE h) +{ + if (YAP_IsAtomTerm(ti)) { + CloseHandle(h); + } +} + +#endif + +/* execute a command as a detached process */ +static YAP_Bool +execute_command(void) +{ + YAP_Term ti = YAP_ARG2, to = YAP_ARG3, te = YAP_ARG4; + int res; + YAP_Term AtomNull = YAP_MkAtomTerm(YAP_LookupAtom("null")); + +#if defined(__MINGW32__) || _MSC_VER + HANDLE inpf, outf, errf; + DWORD CreationFlags = 0; + STARTUPINFO StartupInfo; + PROCESS_INFORMATION ProcessInformation; + inpf = get_handle(ti, STD_INPUT_HANDLE); + if (inpf == INVALID_HANDLE_VALUE) { + return(YAP_Unify(YAP_ARG6, WinError())); + } + outf = get_handle(to, STD_OUTPUT_HANDLE); + if (outf == INVALID_HANDLE_VALUE) { + close_handle(ti, inpf); + return(YAP_Unify(YAP_ARG6, WinError())); + } + errf = get_handle(te, STD_OUTPUT_HANDLE); + if (errf == INVALID_HANDLE_VALUE) { + close_handle(ti, inpf); + close_handle(to, outf); + return(YAP_Unify(YAP_ARG6, WinError())); + } + if (!YAP_IsIntTerm(ti) && !YAP_IsIntTerm(to) && !YAP_IsIntTerm(te)) { + /* we do not keep a current stream */ + CreationFlags = DETACHED_PROCESS; + } + StartupInfo.cb = sizeof(STARTUPINFO); + StartupInfo.lpReserved = NULL; + StartupInfo.lpDesktop = NULL; /* inherit */ + StartupInfo.lpTitle = NULL; /* we do not create a new console window */ + StartupInfo.dwFlags = STARTF_USESTDHANDLES; + StartupInfo.cbReserved2 = 0; + StartupInfo.lpReserved2 = NULL; + StartupInfo.hStdInput = inpf; + StartupInfo.hStdOutput = outf; + StartupInfo.hStdError = errf; + /* got stdin, stdout and error as I like it */ + if (CreateProcess(NULL, + (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), + NULL, + NULL, + TRUE, + CreationFlags, + NULL, + NULL, + &StartupInfo, + &ProcessInformation) == FALSE) { + close_handle(ti, inpf); + close_handle(to, outf); + close_handle(te, errf); + return(YAP_Unify(YAP_ARG6, WinError())); + } + close_handle(ti, inpf); + close_handle(to, outf); + close_handle(te, errf); + res = ProcessInformation.dwProcessId; + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); +#else /* UNIX CODE */ + int inpf, outf, errf; + /* process input first */ + if (ti == AtomNull) { + inpf = open("/dev/null", O_RDONLY); + } else { + int sd; + if (YAP_IsIntTerm(ti)) + sd = YAP_IntOfTerm(ti); + else + sd = YAP_StreamToFileNo(ti); + if (sd == 0) + inpf = 0; + else + inpf = dup(sd); + } + if (inpf < 0) { + /* return an error number */ + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); + } + /* then output stream */ + if (to == AtomNull) { + outf = open("/dev/zero", O_WRONLY); + } else { + int sd; + if (YAP_IsIntTerm(to)) + sd = YAP_IntOfTerm(to); + else + sd = YAP_StreamToFileNo(to); + if (sd == 1) + outf = 1; + else + outf = dup(sd); + } + if (outf < 0) { + /* return an error number */ + if (inpf != 0) close(inpf); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); + } + /* then error stream */ + if (te == AtomNull) { + errf = open("/dev/zero", O_WRONLY); + } else { + int sd; + if (YAP_IsIntTerm(te)) + sd = YAP_IntOfTerm(te); + else + sd = YAP_StreamToFileNo(te); + if (sd == 2) + errf = 2; + else + errf = dup(sd); + } + if (errf < 0) { + /* return an error number */ + if (inpf != 0) close(inpf); + if (outf != 1) close(outf); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); + } + YAP_FlushAllStreams(); + /* we are now ready to fork */ + if ((res = fork()) < 0) { + /* close streams we don't need */ + if (inpf != 0) close(inpf); + if (outf != 1) close(outf); + if (errf != 2) close(errf); + /* return an error number */ + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); + } else if (res == 0) { + char *argv[4]; + + /* child */ + /* close current streams, but not std streams */ + YAP_CloseAllOpenStreams(); + if (inpf != 0) { + close(0); + if (dup(inpf) != 0) + exit(1); + close(inpf); + } + if (outf != 1) { + close(1); + if (dup(outf) != 1) + exit(1); + close(outf); + } + if (errf != 2) { + close(2); + if (dup(errf) != 2) + exit(2); + close(errf); + } + argv[0] = "sh"; + argv[1] = "-c"; + argv[2] = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + argv[3] = NULL; + execv("/bin/sh", argv); + exit(127); + /* we have the streams where we want them, just want to execute now */ + } else { + if (inpf != 0) close(inpf); + if (outf != 1) close(outf); + if (errf != 2) close(errf); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); + } +#endif /* UNIX code */ +} + +/* execute a command as a detached process */ +static YAP_Bool +do_system(void) +{ + char *command = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); +#if HAVE_SYSTEM + int sys = system(command); + if (sys < 0) { + return YAP_Unify(YAP_ARG3,YAP_MkIntTerm(errno)); + } + return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys)); +#else + YAP_Error(0,0L,"system not available in this configuration, trying %s", command); + return FALSE; +#endif +} + + + +/* execute a command as a detached process */ +static YAP_Bool +do_shell(void) +{ +#if defined(__MINGW32__) || _MSC_VER + YAP_Error(0,0L,"system not available in this configuration"); + return(FALSE); +#elif HAVE_SYSTEM + char *buf = YAP_AllocSpaceFromYap(BUF_SIZE); + int sys; + + if (buf == NULL) { + YAP_Error(0,0L,"No Temporary Space for Shell"); + return(FALSE); + } +#if HAVE_STRNCPY + strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), BUF_SIZE); + strncpy(buf, " ", BUF_SIZE); + strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), BUF_SIZE); + strncpy(buf, " ", BUF_SIZE); + strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), BUF_SIZE); +#else + strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1))); + strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2))); + strcpy(buf, " "); + strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3))); +#endif + sys = system(buf); + YAP_FreeSpaceFromYap(buf); + if (sys < 0) { + return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); + } + return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)); +#else + char *cptr[4]; + int t; + int sys; + + cptr[0]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + cptr[1]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); + cptr[2]= (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)); + cptr[3]= NULL; + t = fork(); + if (t < 0) { + return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); + } else if (t == 0) { + t = execvp(cptr[0],cptr); + return t; + } else { + t = wait(&sys); + if (t < 0) { + return YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)); + } + } + return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)); +#endif +} + +/* execute a command as a detached process */ +static YAP_Bool +plwait(void) +{ + long int pid = YAP_IntOfTerm(YAP_ARG1); +#if defined(__MINGW32__) || _MSC_VER + HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid); + DWORD ExitCode; + if (proc == NULL) { + return(YAP_Unify(YAP_ARG3, WinError())); + } + if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) { + return(YAP_Unify(YAP_ARG3, WinError())); + } + if (GetExitCodeProcess(proc, &ExitCode) == 0) { + return(YAP_Unify(YAP_ARG4, WinError())); + } + CloseHandle(proc); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(ExitCode))); +#else + do { + int status; + + /* check for interruptions */ + if (waitpid(pid, &status, 0) == -1) { + if (errno) { + if (errno == EINTR) { + continue; + } + return YAP_Unify( YAP_ARG3, YAP_MkIntTerm(errno)); + } + } + if (WIFEXITED( status ) ) { + return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(WEXITSTATUS(status)) ); + } else if (WIFSIGNALED( status )) { + return YAP_Unify(YAP_ARG3, YAP_MkAtomTerm(YAP_LookupAtom("signal")) ) && + YAP_Unify(YAP_ARG4, YAP_MkIntTerm( WTERMSIG(status)) ); + } else /* WIFSTOPPED(status) */ { + return YAP_Unify(YAP_ARG3, YAP_MkAtomTerm(YAP_LookupAtom("stopped")) ) && + YAP_Unify(YAP_ARG4, YAP_MkIntTerm( WSTOPSIG(status) ) ); + } + } while(TRUE); +#endif +} + +static YAP_Bool +p_sleep(void) +{ + YAP_Term ts = YAP_ARG1; +#if defined(__MINGW32__) || _MSC_VER + { + unsigned long int secs = 0, usecs = 0, msecs, out; + if (YAP_IsIntTerm(ts)) { + secs = YAP_IntOfTerm(ts); + } else if (YAP_IsFloatTerm(ts)) { + double tfl = YAP_FloatOfTerm(ts); + if (tfl > 1.0) + secs = tfl; + else + usecs = tfl*1000000; + } + msecs = secs*1000 + usecs/1000; + Sleep(msecs); + /* no errors possible */ + out = 0; + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); + } +#elif HAVE_NANOSLEEP + { + struct timespec req; + int out; + + if (YAP_IsFloatTerm(ts)) { + double tfl = YAP_FloatOfTerm(ts); + + req.tv_nsec = (tfl-floor(tfl))*1000000000; + req.tv_sec = rint(tfl); + } else { + req.tv_nsec = 0; + req.tv_sec = YAP_IntOfTerm(ts); + } + out = nanosleep(&req, NULL); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); + } +#elif HAVE_USLEEP + { + useconds_t usecs; + if (YAP_IsFloatTerm(ts)) { + double tfl = YAP_FloatOfTerm(ts); + + usecs = rint(tfl*1000000); + } else { + usecs = YAP_IntOfTerm(ts)*1000000; + } + out = usleep(usecs); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); + } +#elif HAVE_SLEEP + { + unsigned int secs, out; + if (YAP_IsFloatTerm(ts)) { + secs = rint(YAP_FloatOfTerm(ts)); + } else { + secs = YAP_IntOfTerm(ts); + } + out = sleep(secs); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); + } +#else + YAP_Error(0,0L,"sleep not available in this configuration"); + return FALSE: +#endif +} + +/* host info */ + +static YAP_Bool +host_name(void) +{ +#if defined(__MINGW32__) || _MSC_VER + char name[MAX_COMPUTERNAME_LENGTH+1]; + DWORD nSize = MAX_COMPUTERNAME_LENGTH+1; + if (GetComputerName(name, &nSize) == 0) { + return(YAP_Unify(YAP_ARG2, WinError())); + } +#else +#if HAVE_GETHOSTNAME + char name[256]; + if (gethostname(name, 256) == -1) { + /* return an error number */ + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); + } +#endif +#endif /* defined(__MINGW32__) || _MSC_VER */ + return(YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name)))); +} + +static YAP_Bool +host_id(void) +{ +#if HAVE_GETHOSTID + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid()))); +#else + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0))); +#endif +} + +static YAP_Bool +pid(void) +{ +#if defined(__MINGW32__) || _MSC_VER + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid()))); +#else + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid()))); +#endif +} + +static YAP_Bool +win(void) +{ +#if defined(__MINGW32__) || _MSC_VER + return(TRUE); +#else + return(FALSE); +#endif +} + +static YAP_Bool +p_kill(void) +{ +#if defined(__MINGW32__) || _MSC_VER + /* Windows does not support cross-process signals, so we shall do the + SICStus thing and assume that a signal to a process will + always kill it */ + HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, YAP_IntOfTerm(YAP_ARG1)); + if (proc == NULL) { + return(YAP_Unify(YAP_ARG3, WinError())); + } + if (TerminateProcess(proc, -1) == 0) { + return(YAP_Unify(YAP_ARG3, WinError())); + } + CloseHandle(proc); +#else + if (kill(YAP_IntOfTerm(YAP_ARG1), YAP_IntOfTerm(YAP_ARG2)) < 0) { + /* return an error number */ + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); + } +#endif /* defined(__MINGW32__) || _MSC_VER */ + return(TRUE); +} + +#if HAVE_OPENSSL_RIPEMD_H + #include +#endif + +/** md5( +Text, -Key, -Remaining keyq + * encode text using OpenSSL + * + * arg Text is a List of ASCII codes + * arg2 and 3: difference list with the character codes for the + * digest. + * + * @return whether ARG1's md5 unifies with the difference liat. + */ + static YAP_Bool + md5(void) + { + unsigned char buf[64]; + md5_state_t pms; + const char *s; + size_t len = -1; + + if ( ! (s = YAP_StringToBuffer( YAP_ARG1 , NULL, len )) || + s[0] == 0) + return false; + + md5_init( & pms ); + md5_append( & pms, (const unsigned char *)s, strlen(s)); + md5_finish( & pms, buf ); + //free((void *)s); + YAP_Term t = YAP_ARG3; + int i = 16; + while (i > 0) + { + int top, bop; + i--; + top = buf[i]>>4; + if (top > 9) + top = (top-10)+'a'; + else + top = top+'0'; + bop = buf[i] & 15; + if (bop > 9) + bop = (bop-10)+'a'; + else + bop = bop+'0'; + t = YAP_MkPairTerm(YAP_MkIntTerm(top), + YAP_MkPairTerm( YAP_MkIntTerm( bop ), t )); + } + return YAP_Unify( YAP_ARG2,t ); + } + +static YAP_Bool +error_message(void) +{ +#if HAVE_STRERROR + return YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(strerror(YAP_IntOfTerm(YAP_ARG1))))); +#else + return YAP_Unify(YAP_ARG2,YAP_ARG1); +#endif +} + void +init_sys(void) +{ +#if HAVE_MKTIME + tzset(); +#endif + YAP_UserCPredicate("datime", datime, 2); + YAP_UserCPredicate("mktime", sysmktime, 8); + YAP_UserCPredicate("list_directory", list_directory, 3); + YAP_UserCPredicate("file_property", file_property, 7); + YAP_UserCPredicate("unlink", p_unlink, 2); + YAP_UserCPredicate("rmdir", p_rmdir, 2); + YAP_UserCPredicate("dir_separator", dir_separator, 1); + YAP_UserCPredicate("p_environ", p_environ, 2); + YAP_UserCPredicate("exec_command", execute_command, 6); + YAP_UserCPredicate("do_shell", do_shell, 5); + YAP_UserCPredicate("do_system", do_system, 3); + YAP_UserCPredicate("plwait", plwait, 4); + YAP_UserCPredicate("host_name", host_name, 2); + YAP_UserCPredicate("host_id", host_id, 2); + YAP_UserCPredicate("pid", pid, 2); + YAP_UserCPredicate("kill", p_kill, 3); + YAP_UserCPredicate("mktemp", p_mktemp, 3); + YAP_UserCPredicate("tmpnam", p_tmpnam, 2); + YAP_UserCPredicate("tmpdir", p_tmpdir, 2); + YAP_UserCPredicate("rename_file", rename_file, 3); + YAP_UserCPredicate("sleep", p_sleep, 2); + YAP_UserCPredicate("error_message", error_message, 2); + YAP_UserCPredicate("win", win, 0); + YAP_UserCPredicate("md5", md5, 3); +} + +#ifdef _WIN32 + +#include + +int WINAPI win_sys(HANDLE, DWORD, LPVOID); + +int WINAPI win_sys(HANDLE hinst, DWORD reason, LPVOID reserved) +{ + switch (reason) + { + case DLL_PROCESS_ATTACH: + break; + case DLL_PROCESS_DETACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_THREAD_DETACH: + break; + } + return 1; +} +#endif + diff --git a/os/CMakeLists.txt b/os/CMakeLists.txt index db549a2d3..4a33ab1ac 100644 --- a/os/CMakeLists.txt +++ b/os/CMakeLists.txt @@ -1,110 +1,110 @@ - -set (YAPOS_SOURCES - alias.c - charsio.c - chartypes.c - console.c - files.c - fmemopen.c - format.c - iopreds.c - mem.c - open_memstream.c - pipes.c - readline.c - random.c - readterm.c - readutil.c - sig.c - sockets.c - streams.c - sysbits.c - time.c - writeterm.c - ypsocks.c - ypstdio.c - ) - -set (YAPOS_HEADERS - encoding.h - iopreds.h - fmemopen.h - yapio.h - sysbits.h - ) - - -include_directories (../H ../include ../OPTYap . ${GMP_INCLUDE_DIR} ${PROJECT_BINARY_DIR}) - - option (READLINE "GNU readline console" ON) - - if (READLINE) - macro_optional_find_package (Readline ON) - macro_log_feature (READLINE_FOUND "libreadline" - "Readline line editing library" - "http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html") - - if (READLINE_FOUND) - # - Find the readline library - # This module defines - # READLINE_INCLUDE_DIR, path to readline/readline.h, etc. - # READLINE_LIBRARIES, the libraries required to use READLINE. - # READLINE_FOUND, If false, do not try to use READLINE. - # also defined, but not for general use are - # READLINE_readline_LIBRARY, where to find the READLINE library. - # READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] - - include_directories (BEFORE ${READLINE_INCLUDE_DIR}) - - set(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) - set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) - check_library_exists( readline readline "" HAVE_LIBREADLINE ) - - check_include_files( "stdio.h;readline/readline.h" HAVE_READLINE_READLINE_H ) - check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H ) - if (HAVE_READLINE_READLINE_H) - SET ( USE_READLINE ON ) - 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_variable_exists( rl_catch_signals "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_variable_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_variable_exists( rl_readline_state stdio.h;readline/readline.h HAVE_DECL_RL_READLINE_STATE ) - endif() -endif (READLINE_FOUND) - -endif (READLINE) - -set (POSITION_INDEPENDENT_CODE TRUE) - -add_library (libYAPOs OBJECT - ${YAPOS_SOURCES} - ) - -set_target_properties(libYAPOs - PROPERTIES - - # RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION} - # SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION} - POSITION_INDEPENDENT_CODE TRUE - OUTPUT_NAME YAPOs - depends dheap - ) - -configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake" - "${PROJECT_BINARY_DIR}/os/YapIOConfig.h" ) - - set( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE) - - -#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) + +set (YAPOS_SOURCES + alias.c + charsio.c + chartypes.c + console.c + files.c + fmemopen.c + format.c + iopreds.c + mem.c + open_memstream.c + pipes.c + readline.c + random.c + readterm.c + readutil.c + sig.c + sockets.c + streams.c + sysbits.c + time.c + writeterm.c + ypsocks.c + ypstdio.c + ) + +set (YAPOS_HEADERS + encoding.h + iopreds.h + fmemopen.h + yapio.h + sysbits.h + ) + + +include_directories (../H ../include ../OPTYap . ${GMP_INCLUDE_DIR} ${PROJECT_BINARY_DIR}) + + option (READLINE "GNU readline console" ON) + + if (READLINE) + macro_optional_find_package (Readline ON) + macro_log_feature (READLINE_FOUND "libreadline" + "Readline line editing library" + "http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html") + + if (READLINE_FOUND) + # - Find the readline library + # This module defines + # READLINE_INCLUDE_DIR, path to readline/readline.h, etc. + # READLINE_LIBRARIES, the libraries required to use READLINE. + # READLINE_FOUND, If false, do not try to use READLINE. + # also defined, but not for general use are + # READLINE_readline_LIBRARY, where to find the READLINE library. + # READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] + + include_directories (BEFORE ${READLINE_INCLUDE_DIR}) + + set(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) + set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) + check_library_exists( readline readline "" HAVE_LIBREADLINE ) + + check_include_files( "stdio.h;readline/readline.h" HAVE_READLINE_READLINE_H ) + check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H ) + if (HAVE_READLINE_READLINE_H) + SET ( USE_READLINE ON ) + 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_variable_exists( rl_catch_signals "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_variable_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_variable_exists( rl_readline_state stdio.h;readline/readline.h HAVE_DECL_RL_READLINE_STATE ) + endif() +endif (READLINE_FOUND) + +endif (READLINE) + +set (POSITION_INDEPENDENT_CODE TRUE) + +add_library (libYAPOs OBJECT + ${YAPOS_SOURCES} + ) + +set_target_properties(libYAPOs + PROPERTIES + + # RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION} + # SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION} + POSITION_INDEPENDENT_CODE TRUE + OUTPUT_NAME YAPOs + depends dheap + ) + +configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake" + "${PROJECT_BINARY_DIR}/os/YapIOConfig.h" ) + + set( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE) + + +#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) diff --git a/os/chartypes.c b/os/chartypes.c index c46847a68..3d8140bf1 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -118,7 +118,7 @@ static enc_map_t ematches[] = { {"CP-1252", ENC_ISO_LATIN1}, {"C", ENC_ISO_ASCII}, #ifdef _WIN32 - {NULL, ENC_UTF16_LE} + {NULL, ENC_ISO_ASCII} #else {NULL, ENC_ISO_UTF8} #endif @@ -127,16 +127,11 @@ static enc_map_t ematches[] = { static encoding_t enc_os_default( encoding_t rc)\ { // by default, return UTF-8 - // except in _WIN32 - // note that we match the C locale to UTF8/16, as all Unix maachines will work on UNICODE. + // note that we match the C locale to UTF8/16, as all Unix machines will work on UNICODE. + // WIN32 we will rely on BOM if (rc == ENC_ISO_ASCII) { -#ifdef _WIN32 - return ENC_UTF16_BE; -#else - return ENC_ISO_UTF8; -#endif - } + return ENC_ISO_UTF8; } return rc; } diff --git a/os/console.c b/os/console.c index a70ef0729..122794277 100644 --- a/os/console.c +++ b/os/console.c @@ -79,11 +79,10 @@ static Int is_same_tty2(USES_REGS1) { /* 'prompt(Atom) */ return out; } -void Yap_ConsoleOps(StreamDesc *s, bool recursive) { - if (!recursive) - Yap_DefaultStreamOps(s); +void Yap_ConsoleOps(StreamDesc *s) { /* the putc routine only has to check it is putting out a newline */ s->stream_putc = ConsolePutc; + s->stream_getc = ConsoleGetc; #if USE_READLINE /* if a tty have a special routine to call readline */ if ((s->status & Readline_Stream_f) && trueGlobalPrologFlag(READLINE_FLAG)) { @@ -91,7 +90,6 @@ void Yap_ConsoleOps(StreamDesc *s, bool recursive) { return; } #endif - s->stream_getc = ConsoleGetc; } /* static */ diff --git a/os/files.c b/os/files.c index 07b7ba480..1d665c1f5 100644 --- a/os/files.c +++ b/os/files.c @@ -62,7 +62,7 @@ loop: return false; } char *pts = strrchr(f, '/'); -#if WIN32_ssss +#if WIN32_ char *pts1 = strrchr(f, '\\'); if (pts11 > pts) pts = pts1; @@ -467,7 +467,7 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */ Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2"); return FALSE; } - const char *buf = Yap_TextTermToText(t, NULL, 0); + const char *buf = Yap_TextTermToText(t, NULL, 0, LOCAL_encoding); if (buf) { return Yap_IsAbsolutePath(buf); } else { diff --git a/os/iopreds.c b/os/iopreds.c index 58d13bec3..0986c2cbd 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -260,12 +260,17 @@ void Yap_DefaultStreamOps(StreamDesc *st) { st->stream_putc = FilePutc; st->stream_getc = PlGetc; if (st->status & (Promptable_Stream_f)) { - st->stream_wgetc = get_wchar; - Yap_ConsoleOps(st, false); - } else if (st->encoding == LOCAL_encoding) { - st->stream_wgetc = get_wchar_from_file; - } else - st->stream_wgetc = get_wchar_from_FILE; + Yap_ConsoleOps(st); + } +#ifndef _WIN32 + else if (st->file != NULL) { + if (st->encoding == LOCAL_encoding) { + st->stream_wgetc = get_wchar_from_file; + } + else + st->stream_wgetc = get_wchar_from_FILE; + } +#endif if (GLOBAL_CharConversionTable != NULL) st->stream_wgetc_for_read = ISOWGetc; else @@ -275,7 +280,7 @@ void Yap_DefaultStreamOps(StreamDesc *st) { } else if (st->status & InMemory_Stream_f) { Yap_MemOps(st); } else if (st->status & Tty_Stream_f) { - Yap_ConsoleOps(st, false); + Yap_ConsoleOps(st); } else { unix_upd_stream_info(st); } @@ -1129,6 +1134,7 @@ do_open(Term file_name, Term t2, StreamDesc *st; bool avoid_bom = false, needs_bom = false; const char *fname; + char fbuf[FILENAME_MAX]; stream_flags_t flags; FILE *fd; const char *s_encoding; @@ -1217,7 +1223,7 @@ do_open(Term file_name, Term t2, : false) || trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); // expand file name? - fname = Yap_AbsoluteFile(fname, ok); + fname = Yap_AbsoluteFile(fname, fbuf, ok); if (fname) { st->name = Yap_LookupAtom(fname); } else { @@ -1270,6 +1276,7 @@ do_open(Term file_name, Term t2, if ((fd = fopen(fname, io_mode)) == NULL || (!(flags & Binary_Stream_f) && binary_file(fname))) { strncpy(LOCAL_FileNameBuf, fname, MAXPATHLEN); + if (fname != fbuf && fname != LOCAL_FileNameBuf && fname != LOCAL_FileNameBuf2) free((void *)fname); fname = LOCAL_FileNameBuf; UNLOCK(st->streamlock); diff --git a/os/iopreds.h b/os/iopreds.h index edb427060..a86d23c26 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -152,7 +152,7 @@ typedef struct read_data_t { } read_data, *ReadData; Term Yap_read_term(int inp_stream, Term opts, int nargs); -Term Yap_Parse(UInt prio, Term cmod); +Term Yap_Parse(UInt prio, encoding_t enc, Term cmod); void init_read_data(ReadData _PL_rd, struct stream_desc *s); @@ -274,7 +274,7 @@ static inline StreamDesc *Yap_GetStreamHandle(Term t) { void Yap_InitStdStreams(void); Term Yap_StreamPosition(int); -static inline int GetCurInpPos(StreamDesc *inp_stream) { +static inline Int GetCurInpPos(StreamDesc *inp_stream) { return (inp_stream->linecount); } @@ -302,7 +302,7 @@ void Yap_SocketOps(StreamDesc *st); void Yap_ConsoleSocketOps(StreamDesc *st); bool Yap_ReadlineOps(StreamDesc *st); int Yap_OpenBufWriteStream(USES_REGS1); -void Yap_ConsoleOps(StreamDesc *s, bool recursive); +void Yap_ConsoleOps(StreamDesc *s); void Yap_InitRandomPreds(void); void Yap_InitSignalPreds(void); diff --git a/os/readline.c b/os/readline.c index f599fe64c..b9dae080c 100644 --- a/os/readline.c +++ b/os/readline.c @@ -205,7 +205,7 @@ bool Yap_InitReadline(Term enable) { #endif rl_outstream = stderr; using_history(); - const char *s = Yap_AbsoluteFile("~/.YAP.history", true); + const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true); if (!read_history(s)) { FILE *f = fopen(s, "w"); if (f) { diff --git a/os/readterm.c b/os/readterm.c index 665874d3c..32adba580 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -68,7 +68,7 @@ static char SccsId[] = "%W% %G%"; #endif #ifdef _WIN32 #if HAVE_IO_H -/* Windows */ +/* priows */ #include #endif #endif @@ -802,8 +802,9 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { return YAP_PARSING; } if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { - char *out = malloc(strlen("Empty clause" + 1)); - strcpy(out, "Empty clause"); + size_t len = strlen("Empty clause"); + char *out = malloc(len + 1); + strncpy(out, "Empty clause",len); LOCAL_ErrorMessage = out; LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_Term = TermEof; @@ -885,10 +886,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { CACHE_REGS TokEntry *tokstart = LOCAL_tokptr; - encoding_t e = LOCAL_encoding; - LOCAL_encoding = fe->enc; - fe->t = Yap_Parse(re->prio, fe->cmod); - LOCAL_encoding = e; + fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); fe->toklast = LOCAL_tokptr; LOCAL_tokptr = tokstart; TR = (tr_fr_ptr)tokstart; @@ -1260,14 +1258,17 @@ static Int style_checker(USES_REGS1) { return TRUE; } -Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, +X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings) { CACHE_REGS Term bvar = MkVarTerm(), ctl; yhandle_t sl; if (bindings) { + Term enc = MkAtomTerm(Yap_LookupAtom(enc_name(*encp))); + Term encc = Yap_MkApplTerm(Yap_MkFunctor(AtomEncoding, 1), 1, &enc); ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar); + ctl = MkPairTerm(ctl, MkPairTerm(encc, TermNil)); sl = Yap_PushHandle(bvar); } else { ctl = TermNil; diff --git a/os/streams.c b/os/streams.c index 0ee3e5ae0..162b30e85 100644 --- a/os/streams.c +++ b/os/streams.c @@ -248,11 +248,11 @@ has_reposition(int sno, } char *Yap_guessFileName(FILE* file, int sno, char *nameb, size_t max) { - if (!nameb) { - nameb = malloc(max(256, max)); - } - if (!file) { - strcpy(nameb, "memory buffer"); + if (!nameb) { + nameb = malloc(max(256, max)); + } + if (!file) { + strcpy(nameb, "memory buffer"); return nameb; } int f = fileno(file); diff --git a/os/sysbits.c b/os/sysbits.c index 42b7b753e..16d5ba4a3 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -428,7 +428,8 @@ static char *PrologPath(const char *Y, char *X) { return (char *)Y; } static bool ChDir(const char *path) { bool rc = false; - const char *qpath = Yap_AbsoluteFile(path, true); + char qp[FILENAME_MAX + 1]; + const char *qpath = Yap_AbsoluteFile(path, qp, true); #ifdef __ANDROID__ if (GLOBAL_AssetsWD) { @@ -462,6 +463,8 @@ static bool ChDir(const char *path) { #else rc = (chdir(qpath) == 0); #endif + if (qpath != qp && qpath != LOCAL_FileNameBuf && + qpath != LOCAL_FileNameBuf2) free((char *)qpath); return rc; } @@ -494,8 +497,9 @@ const char *DirName(const char *X) { } #endif -static const char *myrealpath(const char *path) { - char *out = LOCAL_FileNameBuf; +static const char *myrealpath(const char *path, char *out) { + if (!out) + out = LOCAL_FileNameBuf; #if _WIN32 || defined(__MINGW32__) DWORD retval = 0; @@ -576,18 +580,22 @@ static const char *expandVars(const char *spec, char *u) { * * @return tmp, or NULL, in malloced memory */ -const char *Yap_AbsoluteFile(const char *spec, bool ok) { +const char *Yap_AbsoluteFile(const char *spec, char *rc0, bool ok) { const char *p; - const char *rc; - rc = PlExpandVars(spec, NULL, NULL); + char *rc; + rc = PlExpandVars(spec, NULL, rc0); if (!rc) rc = spec; - if ((p = myrealpath(rc))) { - return p; + if ((p = myrealpath(rc, rc0))) { + if (rc != rc0 && rc != spec && rc != p) + freeBuffer(rc); + return p; } else { + if (rc != rc0 && rc != spec) + freeBuffer(rc); return NULL; } - freeBuffer(rc); + } /** @@ -614,7 +622,7 @@ const char *Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, rc = spec; } - if ((p = myrealpath(rc))) { + if ((p = myrealpath(rc, NULL))) { if (!out) { out = LOCAL_FileNameBuf; sz = YAP_FILENAME_MAX - 1; @@ -802,7 +810,7 @@ static Int prolog_realpath(USES_REGS1) { } else { return false; } - const char *rc = myrealpath(cmd); + const char *rc = myrealpath(cmd, NULL); if (!rc) { PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno)); return false; @@ -950,14 +958,14 @@ static Int absolute_file_system_path(USES_REGS1) { const char *fp; bool rc; char s[MAXPATHLEN + 1]; - const char *text = Yap_TextTermToText(t, s, MAXPATHLEN); + const char *text = Yap_TextTermToText(t, s, MAXPATHLEN, LOCAL_encoding); if (text == NULL) { return false; } - if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, true))) + if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true))) return false; - rc = Yap_unify(Yap_MkTextTerm(fp, t), ARG2); + rc = Yap_unify(Yap_MkTextTerm(fp, LOCAL_encoding, t), ARG2); if (fp != s) freeBuffer((void *)fp); return rc; @@ -1410,13 +1418,13 @@ static Int p_expand_file_name(USES_REGS1) { Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound"); return FALSE; } - text = Yap_TextTermToText(t, NULL, 0); + text = Yap_TextTermToText(t, NULL, 0, LOCAL_encoding); if (!text) return false; if (!(text2 = PlExpandVars(text, NULL, NULL))) return false; freeBuffer(text); - bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, t)); + bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, LOCAL_encoding, t)); freeBuffer(text2); return rc; } @@ -1993,12 +2001,13 @@ static wchar_t *WideStringFromAtom(Atom KeyAt USES_REGS) { k = (wchar_t *)Yap_AllocCodeSpace(sz); while (k == NULL) { - if (!Yap_growheap(FALSE, sz, NULL)) { + if (!Yap_growheap(false, sz, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, MkIntegerTerm(sz), "generating key in win_registry_get_value/3"); - return FALSE; + return false; } - } + k = (wchar_t *)Yap_AllocCodeSpace(sz); + } kptr = k; while ((*kptr++ = *chp++)) ; diff --git a/os/sysbits.h b/os/sysbits.h index fef730622..8e52a2358 100644 --- a/os/sysbits.h +++ b/os/sysbits.h @@ -13,6 +13,8 @@ * */ +#include "config.h" + #if _WIN32 || defined(__MINGW32__) #if !defined(MINGW_HAS_SECURE_API) #define MINGW_HAS_SECURE_API 1 @@ -24,6 +26,7 @@ #include "YapHeap.h" #include "yapio.h" #include "eval.h" +#include "YapText.h" #if _WIN32 || defined(__MINGW32__) #include /* Windows */ diff --git a/os/writeterm.c b/os/writeterm.c index ee5bbd13f..9a78db4b6 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -170,7 +170,7 @@ bind_variable_names(Term t USES_REGS) t2 = ArgOfTerm(2, tl); tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t1); if (IsVarTerm(t2)) { - Bind(VarOfTerm(t2), tv); + YapBind(VarOfTerm(t2), tv); } t = TailOfTerm(t); } diff --git a/os/yapio.h b/os/yapio.h index 148df70bd..d4004ffe1 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -1,175 +1,175 @@ -/************************************************************************* -* * -* 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 * -* * -*************************************************************************/ - -#ifndef YAPIO_H - -#define YAPIO_H 1 - -#ifdef SIMICS -#undef HAVE_LIBREADLINE -#endif - -#include -#include - -#include "os/YapIOConfig.h" -#include - -#ifndef _PL_WRITE_ - -#define EOFCHAR EOF - -#endif - -/* info on aliases */ -typedef struct AliasDescS { - Atom name; - int alias_stream; -} * AliasDesc; - -#define MAX_ISO_LATIN1 255 - -/* parser stack, used to be AuxSp, now is ASP */ -#define ParserAuxSp LOCAL_ScannerStack - -/* routines in parser.c */ -VarEntry *Yap_LookupVar(const char *); -Term Yap_VarNames(VarEntry *, Term); -Term Yap_Variables(VarEntry *, Term); -Term Yap_Singletons(VarEntry *, Term); - -/* routines in scanner.c */ -TokEntry *Yap_tokenizer(struct stream_desc *, bool, Term *d); -void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *); -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(void *); -void Yap_UnLockStream(void *); -#else -#define Yap_LockStream(X) -#define Yap_UnLockStream(X) -#endif -Int Yap_GetStreamFd(int); -void Yap_CloseStreams(int); -void Yap_FlushStreams(void); -void Yap_ReleaseStream(int); -void Yap_CloseStream(int); -int Yap_PlGetchar(void); -int Yap_PlGetWchar(void); -int Yap_PlFGetchar(void); -int Yap_GetCharForSIGINT(void); -Int Yap_StreamToFileNo(Term); -int Yap_OpenStream(FILE *, char *, Term, int); -char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, - encoding_t *encoding, int flags); -char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, - encoding_t *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 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 -#define No_Escapes_f 0x1000 -#define No_Brace_Terms_f 0x2000 -#define Fullstop_f 0x4000 -#define New_Line_f 0x8000 - -/* 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 **); - -bool Yap_IsAbsolutePath(const char *p); -Atom Yap_TemporaryFile(const char *prefix, int *fd); -const char *Yap_AbsoluteFile(const char *spec, bool expand); - -typedef enum mem_buf_source { - MEM_BUF_CODE = 1, - MEM_BUF_MALLOC = 2, - MEM_BUF_USER = 4 -} memBufSource; - -char *Yap_MemStreamBuf(int sno); - -extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, - int prio, Term *bindings_p); -extern Term Yap_StringToNumberTerm(char *s, encoding_t *encp); -int Yap_FormatFloat(Float f, char **s, size_t sz); -int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, - memBufSource src); -int Yap_open_buf_write_stream(char *nbuf, size_t nchars, encoding_t *encp, - memBufSource src); -Term Yap_ReadFromAtom(Atom a, Term opts); -FILE *Yap_GetInputStream(Term t, const char *m); -FILE *Yap_GetOutputStream(Term t, const char *m); -char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max); -void Yap_plwrite(Term t, struct stream_desc *mywrite, int max_depth, int flags, - int priority); - -int Yap_CheckSocketStream(Term stream, const char *error); -void Yap_init_socks(char *host, long interface_port); - -#ifdef HAVE_ERRNO_H -#include -#else -extern int errno; -#endif - -uint64_t HashFunction(const unsigned char *); -uint64_t WideHashFunction(wchar_t *); - -INLINE_ONLY inline EXTERN Term MkCharTerm(Int c); - -/** - * MkCharTerm: convert a character into a single atom. - * - * @param c the character code - * - * @return the term. - */ -INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) { - wchar_t cs[2]; - if (c < 0) - return TermEof; - cs[0] = c; - cs[1] = '\0'; - return MkAtomTerm(Yap_LookupMaybeWideAtom(cs)); -} - -/// UT when yap started -uint64_t Yap_StartOfWTimes; - -#endif +/************************************************************************* +* * +* 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 * +* * +*************************************************************************/ + +#ifndef YAPIO_H + +#define YAPIO_H 1 + +#ifdef SIMICS +#undef HAVE_LIBREADLINE +#endif + +#include +#include + +#include "os/YapIOConfig.h" +#include + +#ifndef _PL_WRITE_ + +#define EOFCHAR EOF + +#endif + +/* info on aliases */ +typedef struct AliasDescS { + Atom name; + int alias_stream; +} * AliasDesc; + +#define MAX_ISO_LATIN1 255 + +/* parser stack, used to be AuxSp, now is ASP */ +#define ParserAuxSp LOCAL_ScannerStack + +/* routines in parser.c */ +VarEntry *Yap_LookupVar(const char *); +Term Yap_VarNames(VarEntry *, Term); +Term Yap_Variables(VarEntry *, Term); +Term Yap_Singletons(VarEntry *, Term); + +/* routines in scanner.c */ +TokEntry *Yap_tokenizer(struct stream_desc *, bool, Term *d); +void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *); +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(void *); +void Yap_UnLockStream(void *); +#else +#define Yap_LockStream(X) +#define Yap_UnLockStream(X) +#endif +Int Yap_GetStreamFd(int); +void Yap_CloseStreams(int); +void Yap_FlushStreams(void); +void Yap_ReleaseStream(int); +void Yap_CloseStream(int); +int Yap_PlGetchar(void); +int Yap_PlGetWchar(void); +int Yap_PlFGetchar(void); +int Yap_GetCharForSIGINT(void); +Int Yap_StreamToFileNo(Term); +int Yap_OpenStream(FILE *, char *, Term, int); +char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, + encoding_t *encoding, int flags); +char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, + encoding_t *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 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 +#define No_Escapes_f 0x1000 +#define No_Brace_Terms_f 0x2000 +#define Fullstop_f 0x4000 +#define New_Line_f 0x8000 + +/* 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 **); + +bool Yap_IsAbsolutePath(const char *p); +Atom Yap_TemporaryFile(const char *prefix, int *fd); +const char *Yap_AbsoluteFile(const char *spec, char *obuf, bool expand); + +typedef enum mem_buf_source { + MEM_BUF_CODE = 1, + MEM_BUF_MALLOC = 2, + MEM_BUF_USER = 4 +} memBufSource; + +char *Yap_MemStreamBuf(int sno); + +extern X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, + int prio, Term *bindings_p); +extern Term Yap_StringToNumberTerm(char *s, encoding_t *encp); +int Yap_FormatFloat(Float f, char **s, size_t sz); +int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, + memBufSource src); +int Yap_open_buf_write_stream(char *nbuf, size_t nchars, encoding_t *encp, + memBufSource src); +Term Yap_ReadFromAtom(Atom a, Term opts); +FILE *Yap_GetInputStream(Term t, const char *m); +FILE *Yap_GetOutputStream(Term t, const char *m); +char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max); +void Yap_plwrite(Term t, struct stream_desc *mywrite, int max_depth, int flags, + int priority); + +int Yap_CheckSocketStream(Term stream, const char *error); +void Yap_init_socks(char *host, long interface_port); + +#ifdef HAVE_ERRNO_H +#include +#else +extern int errno; +#endif + +uint64_t HashFunction(const unsigned char *); +uint64_t WideHashFunction(wchar_t *); + +INLINE_ONLY inline EXTERN Term MkCharTerm(Int c); + +/** + * MkCharTerm: convert a character into a single atom. + * + * @param c the character code + * + * @return the term. + */ +INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) { + wchar_t cs[2]; + if (c < 0) + return TermEof; + cs[0] = c; + cs[1] = '\0'; + return MkAtomTerm(Yap_LookupMaybeWideAtom(cs)); +} + +/// UT when yap started +uint64_t Yap_StartOfWTimes; + +#endif diff --git a/os/ypsocks.c b/os/ypsocks.c index 045e9bce1..f49ac7169 100755 --- a/os/ypsocks.c +++ b/os/ypsocks.c @@ -1237,6 +1237,7 @@ static Int p_hostname_address(USES_REGS1) { Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "hostname_address/2 (gethostbyname)"); #endif + return false; } memcpy((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length); out = MkAtomTerm(Yap_LookupAtom(inet_ntoa(adr))); diff --git a/packages/CLPBN/horus/LiftedKc.cpp b/packages/CLPBN/horus/LiftedKc.cpp index 68e28273b..e1aa79557 100644 --- a/packages/CLPBN/horus/LiftedKc.cpp +++ b/packages/CLPBN/horus/LiftedKc.cpp @@ -406,7 +406,7 @@ LeafNode::weight() const // ancester that is not set. This can only // happen when calculating the weights // for the edge labels in graphviz - return 0.0 / 0.0; + return nan(NULL); } } double weight = clause_->literals()[0].isPositive() diff --git a/packages/CLPBN/horus/Util.h b/packages/CLPBN/horus/Util.h index d8ec621f1..5318a1d2f 100644 --- a/packages/CLPBN/horus/Util.h +++ b/packages/CLPBN/horus/Util.h @@ -13,6 +13,7 @@ #include #include #include +#include #include "Horus.h" diff --git a/packages/myddas/pl/CMakeLists.txt b/packages/myddas/pl/CMakeLists.txt index ac51da1a0..3f016f1c9 100644 --- a/packages/myddas/pl/CMakeLists.txt +++ b/packages/myddas/pl/CMakeLists.txt @@ -11,29 +11,35 @@ set( MYDDAS_YPP myddas_prolog2sql_optimizer.ypp ) set (MYDDAS_YAP "") + function(cpp_compile output filename) - set(header_extension "yap") get_filename_component(base ${filename} NAME_WE) set(base_abs ${CMAKE_CURRENT_BINARY_DIR}/${base}) set(outfile ${base_abs}.yap) set(${output} ${${output}} ${outfile} PARENT_SCOPE) - #message("outfile=${outfile}: ${CMAKE_C_COMPILER} -E -Xpreprocessor P ${CMAKE_CURRENT_SOURCE_DIR}/${filename}\n") - add_custom_command( - OUTPUT ${outfile} +IF(MSVC) + add_custom_command( + OUTPUT ${outfile} + COMMAND ${CMAKE_C_COMPILER} ${MYDDAS_FLAGS} /EP /P ${outfile} ${CMAKE_CURRENT_SOURCE_DIR}/${filename} +DEPENDS "${CMAKE_CURRENT_SOURCE_DIR}/${filename}") + else() + add_custom_command( + OUTPUT ${outfile} COMMAND ${CMAKE_C_COMPILER} ${MYDDAS_FLAGS} -x c -E -P -w ${CMAKE_CURRENT_SOURCE_DIR}/${filename} -o ${outfile} DEPENDS "${CMAKE_CURRENT_SOURCE_DIR}/${filename}") -set_source_files_properties(${outfile} PROPERTIES GENERATED TRUE) +ENDIF(MSVC) + set_source_files_properties(${outfile} PROPERTIES GENERATED TRUE) endfunction() + +Add_custom_target (plmyddas ALL DEPENDS ${MYDDAS_YPP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) + foreach(file ${MYDDAS_YPP}) - message("infile=${file}\n") - cpp_compile( MYDDAS_YAP ${file}) + cpp_compile( MYDDAS_YAP ${file}) #message("outfiles=${MYDDAS_YAP}\n") endforeach() -Add_custom_target (plmyddas ALL DEPENDS ${MYDDAS_YPP} ${MYDDAS_YAP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) - install(FILES ${MYDDAS_YAP} DESTINATION ${libpl} -) +)