diff --git a/C/atoms.c b/C/atoms.c index 24732d688..fd4d71b93 100644 --- a/C/atoms.c +++ b/C/atoms.c @@ -30,6 +30,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "eval.h" #include "yapio.h" +#include "pl-shared.h" #ifdef TABLING #include "tab.macros.h" #endif /* TABLING */ @@ -656,8 +657,9 @@ p_atom_chars( USES_REGS1 ) return(FALSE); } { + LD_FROM_REGS /* ISO Prolog Mode */ - int has_atoms = yap_flags[STRICT_ISO_FLAG]; + int has_atoms = truePrologFlag(PLFLAG_ISO); int has_ints = FALSE; while (t != TermNil) { @@ -1308,7 +1310,8 @@ p_atom_length( USES_REGS1 ) } return Yap_unify(ARG2, MkIntegerTerm(len)); } else if (!IsAtomTerm(t1)) { - if (!yap_flags[STRICT_ISO_FLAG]) { + LD_FROM_REGS + if (!truePrologFlag(PLFLAG_ISO)) { char *String; if (IsIntegerTerm(t1)) { @@ -1547,7 +1550,8 @@ p_number_chars( USES_REGS1 ) s = String; { /* ISO code */ - int has_atoms = yap_flags[STRICT_ISO_FLAG]; + LD_FROM_REGS + int has_atoms = truePrologFlag(PLFLAG_ISO); int has_ints = FALSE; while (t != TermNil) { diff --git a/C/init.c b/C/init.c index fa9cc0df2..961668846 100755 --- a/C/init.c +++ b/C/init.c @@ -169,7 +169,8 @@ OpDec(int p, char *type, Atom a, Term m) WRITE_UNLOCK(ae->ARWLock); } if (i <= 3) { - if (yap_flags[STRICT_ISO_FLAG] && + GET_LD + if (truePrologFlag(PLFLAG_ISO) && info->Posfix != 0) /* there is a posfix operator */ { /* ISO dictates */ WRITE_UNLOCK(info->OpRWLock); @@ -178,7 +179,8 @@ OpDec(int p, char *type, Atom a, Term m) } info->Infix = p; } else if (i <= 5) { - if (yap_flags[STRICT_ISO_FLAG] && + GET_LD + if (truePrologFlag(PLFLAG_ISO) && info->Infix != 0) /* there is an infix operator */ { /* ISO dictates */ WRITE_UNLOCK(info->OpRWLock); @@ -902,7 +904,6 @@ InitFlags(void) /* note that Yap_heap_regs must be set first */ yap_flags[LANGUAGE_MODE_FLAG] = 0; - yap_flags[STRICT_ISO_FLAG] = FALSE; yap_flags[SOURCE_MODE_FLAG] = FALSE; yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; /* we do not garantee safe assert in parallel mode */ @@ -995,8 +996,6 @@ InitLogDBErasedMarker(void) INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker); } -#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1] - static void InitSWIAtoms(void) { diff --git a/C/pl-yap.c b/C/pl-yap.c index cb4d2cecb..f2dffaac9 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -1034,6 +1034,28 @@ PL_dispatch(int fd, int wait) return TRUE; } +/* SWI: int PL_get_arg(int index, term_t t, term_t a) + YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/ +X_API int _PL_get_arg__LD(int index, term_t ts, term_t a ARG_LD) +{ + REGS_FROM_LD + YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); + if ( !YAP_IsApplTerm(t) ) { + if (YAP_IsPairTerm(t)) { + if (index == 1){ + Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS); + return 1; + } else if (index == 2) { + Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS); + return 1; + } + } + return 0; + } + Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS); + return 1; +} + /* SWI: int PL_get_atom(term_t t, YAP_Atom *a) YAP: YAP_Atom YAP_AtomOfTerm(Term) */ int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD) @@ -1046,6 +1068,13 @@ int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD) return 1; } +X_API int PL_put_atom__LD(term_t t, atom_t a ARG_LD) +{ + REGS_FROM_LD + Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a)) PASS_REGS); + return TRUE; +} + void PL_put_term__LD(term_t d, term_t s ARG_LD) { REGS_FROM_LD diff --git a/C/scanner.c b/C/scanner.c index dac2ea073..7bb9687d0 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -232,12 +232,11 @@ extern double atof(const char *); static Term float_send(char *s, int sign) { - CACHE_REGS + GET_LD Float f = (Float)atof(s); #if HAVE_FINITE - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + if (truePrologFlag(PLFLAG_ISO)) { /* iso */ if (!finite(f)) { - CACHE_REGS LOCAL_ErrorMessage = "Float overflow while scanning"; return(MkEvalFl(0.0)); } @@ -279,6 +278,7 @@ send_error_message(char s[]) static wchar_t read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream) { + GET_LD int ch; /* escape sequence */ @@ -359,7 +359,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream) case '`': return '`'; case '^': - if (FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) { + if (truePrologFlag(PLFLAG_ISO)) { return send_error_message("invalid escape sequence"); } else { ch = getchrq(inp_stream); @@ -458,7 +458,7 @@ num_send_error_message(char s[]) static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, int sign) { - CACHE_REGS + GET_LD char *sp = s; int ch = *chp; Int val = 0L, base = ch - '0'; @@ -574,7 +574,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in ch = getchr(inp_stream); } if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) { - if (yap_flags[STRICT_ISO_FLAG] && (ch == 'e' || ch == 'E')) { + if (truePrologFlag(PLFLAG_ISO) && (ch == 'e' || ch == 'E')) { return num_send_error_message("Float format not allowed in ISO mode"); } if (ch == '.') { @@ -796,7 +796,7 @@ ch_to_wide(char *base, char *charp) TokEntry * Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp) { - CACHE_REGS + GET_LD TokEntry *t, *l, *p; enum TokenKinds kind; int solo_flag = TRUE; @@ -1076,7 +1076,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp) LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; break; } - if (ch == 10 && FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) { + if (ch == 10 && truePrologFlag(PLFLAG_ISO)) { /* in ISO a new line terminates a string */ LOCAL_ErrorMessage = "layout character \n inside quotes"; break; diff --git a/C/stdpreds.c b/C/stdpreds.c index 392e70dba..b9fbe30ac 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -273,6 +273,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "eval.h" #include "yapio.h" +#include "pl-shared.h" #ifdef TABLING #include "tab.macros.h" #endif /* TABLING */ @@ -330,6 +331,7 @@ static Int p_runtime( USES_REGS1 ); static Int p_walltime( USES_REGS1 ); static Int p_access_yap_flags( USES_REGS1 ); static Int p_set_yap_flags( USES_REGS1 ); +static Int p_break( USES_REGS1 ); #ifdef BEAM Int use_eam( USES_REGS1 ); @@ -1659,11 +1661,6 @@ p_set_yap_flags( USES_REGS1 ) } yap_flags[LANGUAGE_MODE_FLAG] = value; break; - case STRICT_ISO_FLAG: - if (value != 0 && value != 1) - return(FALSE); - yap_flags[STRICT_ISO_FLAG] = value; - break; case SOURCE_MODE_FLAG: if (value != 0 && value != 1) return(FALSE); @@ -1837,13 +1834,17 @@ p_loop( USES_REGS1 ) { static Int -p_max_tagged_integer( USES_REGS1 ) { - return Yap_unify(ARG1, MkIntTerm(MAX_ABS_INT-((CELL)1))); -} - -static Int -p_min_tagged_integer( USES_REGS1 ) { - return Yap_unify(ARG1, MkIntTerm(-MAX_ABS_INT)); +p_break( USES_REGS1 ) { + Atom at = AtomOfTerm(Deref( ARG1 )); + if (at == AtomTrue) { + LOCAL_PL_local_data_p->break_level++; + return TRUE; + } + if (at == AtomFalse) { + LOCAL_PL_local_data_p->break_level--; + return TRUE; + } + return FALSE; } void @@ -1922,8 +1923,7 @@ Yap_InitCPreds(void) Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag); Yap_InitCPred("$p_system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag); Yap_InitCPred("abort", 0, p_abort, SyncPredFlag); - Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag); - Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag); + Yap_InitCPred("$break", 1, p_break, SafePredFlag); #ifdef BEAM Yap_InitCPred("@", 0, eager_split, SafePredFlag); Yap_InitCPred(":", 0, force_wait, SafePredFlag); diff --git a/H/Yap.h b/H/Yap.h index b5d4b72f0..8212df502 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -343,7 +343,6 @@ typedef pthread_rwlock_t rwlock_t; typedef enum { LANGUAGE_MODE_FLAG = 8, - STRICT_ISO_FLAG = 9, SOURCE_MODE_FLAG = 11, WRITE_QUOTED_STRING_FLAG = 13, ALLOW_ASSERTING_STATIC_FLAG = 14, diff --git a/H/eval.h b/H/eval.h index 46d1bcb45..04531ab15 100644 --- a/H/eval.h +++ b/H/eval.h @@ -42,6 +42,9 @@ #define Int_MIN (-Int_MAX-(CELL)1) #endif +#define PLMAXTAGGEDINT (MAX_ABS_INT-((CELL)1)) +#define PLMINTAGGEDINT (-MAX_ABS_INT) + #define PLMAXINT Int_MAX #define PLMININT Int_MIN diff --git a/H/pl-basic.h b/H/pl-basic.h index 6b5fa7c0e..7ff45093e 100644 --- a/H/pl-basic.h +++ b/H/pl-basic.h @@ -111,6 +111,8 @@ typedef void *pl_function_t; #define IGNORE_LD #define REGS_FROM_LD +#define LD_FROM_CACHE + #else #define LOCAL_LD (__PL_ld) @@ -126,6 +128,7 @@ typedef void *pl_function_t; #define IGNORE_LD (void)__PL_ld; #define REGS_FROM_LD struct regstore_t *regcache = __PL_ld->reg_cache; +#define LD_FROM_REGS struct PL_local_data *__PL_ld = LOCAL_PL_local_data_p; #endif diff --git a/H/pl-incl.h b/H/pl-incl.h index a1dc2f454..a1b0b0757 100755 --- a/H/pl-incl.h +++ b/H/pl-incl.h @@ -173,6 +173,7 @@ typedef enum #endif #if __YAP_PROLOG__ #include "pl-yap.h" + #if _WIN32 #define __WINDOWS__ 1 #else @@ -533,8 +534,6 @@ extern int _PL_unify_atomic(term_t t, PL_atomic_t a); extern int _PL_unify_string(term_t t, word w); -#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z) - extern IOSTREAM ** /* provide access to Suser_input, */ _PL_streams(void); /* Suser_output and Suser_error */ @@ -781,12 +780,14 @@ COMMON(int) f_is_prolog_atom_start(wint_t c); COMMON(int) f_is_prolog_identifier_continue(wint_t c); COMMON(int) f_is_prolog_symbol(wint_t c); +COMMON(int) _PL_get_arg__LD(int index, term_t t, term_t a ARG_LD); COMMON(int) PL_get_atom__LD(term_t t1, atom_t *a ARG_LD); COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD); COMMON(int) PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD); COMMON(int) PL_is_variable__LD(term_t t ARG_LD); COMMON(term_t) PL_new_term_ref__LD(ARG1_LD); +COMMON(int) PL_put_atom__LD(term_t t, atom_t a ARG_LD); COMMON(void) PL_put_term__LD(term_t t1, term_t t2 ARG_LD); COMMON(int) PL_unify__LD(term_t t1, term_t t2 ARG_LD); COMMON(int) PL_unify_atom__LD(term_t t, atom_t a ARG_LD); diff --git a/H/pl-shared.h b/H/pl-shared.h index 1d76ef025..225640589 100644 --- a/H/pl-shared.h +++ b/H/pl-shared.h @@ -147,5 +147,8 @@ getUnknownModule(module_t m); COMMON(int) debugmode(debug_type new, debug_type *old); COMMON(int) tracemode(debug_type new, debug_type *old); +COMMON(void) Yap_setCurrentSourceLocation(IOSTREAM **s); + +#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1] #endif /* PL_SHARED_INCLUDE */ diff --git a/H/pl-yap.h b/H/pl-yap.h index e96208662..1aa013a36 100644 --- a/H/pl-yap.h +++ b/H/pl-yap.h @@ -193,10 +193,13 @@ charCode(Term w) #define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD) #define PL_is_variable(t) PL_is_variable__LD(t PASS_LD) #define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1) +#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD) #define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD) #define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD) #define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD) +#define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD); + #endif /* __YAP_PROLOG__ */ unsigned int getUnknownModule(module_t m); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 204a688b5..fe69bfa53 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -207,28 +207,6 @@ X_API int PL_get_arg(int index, term_t ts, term_t a) return 1; } -/* SWI: int PL_get_arg(int index, term_t t, term_t a) - YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/ -X_API int _PL_get_arg(int index, term_t ts, term_t a) -{ - CACHE_REGS - YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); - if ( !YAP_IsApplTerm(t) ) { - if (YAP_IsPairTerm(t)) { - if (index == 1){ - Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS); - return 1; - } else if (index == 2) { - Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS); - return 1; - } - } - return 0; - } - Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS); - return 1; -} - /* SWI: int PL_get_atom(term_t t, YAP_Atom *a) YAP: YAP_Atom YAP_AtomOfTerm(Term) */ X_API int PL_get_atom(term_t ts, atom_t *a) diff --git a/os/pl-prologflag.c b/os/pl-prologflag.c index 43ffe59cd..5271cc2c6 100644 --- a/os/pl-prologflag.c +++ b/os/pl-prologflag.c @@ -1174,13 +1174,8 @@ initPrologFlags(void) setPrologFlag("max_integer", FT_INT64|FF_READONLY, PLMAXINT); setPrologFlag("min_integer", FT_INT64|FF_READONLY, PLMININT); #endif -#ifndef __YAP_PROLOG__ setPrologFlag("max_tagged_integer", FT_INTEGER|FF_READONLY, PLMAXTAGGEDINT); setPrologFlag("min_tagged_integer", FT_INTEGER|FF_READONLY, PLMINTAGGEDINT); -#else - setPrologFlag("max_tagged_integer", FT_INTEGER|FF_READONLY, Int_MAX); - setPrologFlag("min_tagged_integer", FT_INTEGER|FF_READONLY, Int_MIN); -#endif #ifdef O_GMP setPrologFlag("bounded", FT_BOOL|FF_READONLY, FALSE, 0); #ifdef __GNU_MP__ diff --git a/pl/boot.yap b/pl/boot.yap index 28dcbe40d..1c3053108 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -93,7 +93,7 @@ true :- true. '$init_globals' :- '$init_consult', - nb_setval('$break',0), + % '$swi_set_prolog_flag'(break_level, 0), % '$set_read_error_handler'(error), let the user do that nb_setval('$system_mode',off), nb_setval('$chr_toplevel_show_store',false). @@ -189,7 +189,7 @@ true :- true. '$clean_up_dead_clauses', fail. '$enter_top_level' :- - '$nb_getval'('$break',BreakLevel,fail), + '$swi_current_prolog_flag'(break_level, BreakLevel), '$swi_current_prolog_flag'(debug, DBON), ( '$nb_getval'('$trace', on, fail) @@ -208,8 +208,8 @@ true :- true. get_value('$top_level_goal',GA), GA \= [], !, set_value('$top_level_goal',[]), '$run_atom_goal'(GA), - '$nb_getval'('$break',BreakLevel,fail), - ( BreakLevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ). + '$swi_current_prolog_flag'(break_level, BreakLevel), + ( Breaklevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ). '$enter_top_level' :- '$run_toplevel_hooks', prompt1(' ?- '), @@ -219,7 +219,7 @@ true :- true. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), '$command'(Command,Varnames,_Pos,top), - '$nb_getval'('$break',BreakLevel,fail), + '$swi_current_prolog_flag'(break_level, BreakLevel), ( BreakLevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ). @@ -559,7 +559,7 @@ true :- true. flush_output, fail. '$present_answer'((?-), Answ) :- - '$nb_getval'('$break',BL,fail), + '$swi_current_prolog_flag'(break_level, BL ), ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; true ), ( recorded('$print_options','$toplevel'(Opts),_) -> @@ -1221,7 +1221,7 @@ catch_ball(Ball, V) :- catch_ball(C, C). '$run_toplevel_hooks' :- - '$nb_getval'('$break', 0, fail), + '$swi_current_prolog_flag'(break_level, 0 ), recorded('$toplevel_hooks',H,_), H \= fail, !, ( call(user:H1) -> true ; true). diff --git a/pl/control.yap b/pl/control.yap index d429959b7..9d4ca15e1 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -273,12 +273,12 @@ break :- nb_getval('$debug_run',Run), '$swi_current_prolog_flag'(debug, Debug), '$swi_set_prolog_flag'(debug, false), - nb_getval('$break',BL), NBL is BL+1, + '$break'( true ), nb_getval('$spy_gn',SPY_GN), b_getval('$spy_glist',GList), b_setval('$spy_glist',[]), - nb_setval('$break',NBL), current_output(OutStream), current_input(InpStream), + '$swi_current_prolog_flag'(break_level, NBL ), format(user_error, '% Break (level ~w)~n', [NBL]), '$do_live', !, @@ -291,7 +291,7 @@ break :- nb_setval('$debug_jump',Jump), nb_setval('$debug_run',Run), nb_setval('$trace',Trace), - nb_setval('$break',BL), + '$break'( false ), nb_setval('$system_mode',SystemMode). diff --git a/pl/flags.yap b/pl/flags.yap index 5812f3492..153ed21ad 100755 --- a/pl/flags.yap +++ b/pl/flags.yap @@ -506,12 +506,10 @@ yap_flag(max_threads,X) :- '$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)). '$yap_system_flag'(agc_margin). -'$yap_system_flag'(answer_format). '$yap_system_flag'(chr_toplevel_show_store). '$yap_system_flag'(debugger_print_options). '$yap_system_flag'(discontiguous_warnings). '$yap_system_flag'(dollar_as_lower_case). -'$yap_system_flag'(double_quotes). % V = fast ; % '$yap_system_flag'(file_name_variables). % '$yap_system_flag'(fileerrors ).