From 4c264a968a5ed390e94fed6e6b52eff5cd7bf7dc Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 4 Dec 2003 18:13:04 +0000 Subject: [PATCH] new scheme for flags. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@949 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/cdmgr.c | 4 ++-- C/init.c | 2 +- C/stdpreds.c | 8 ++++---- m4/Yatom.h.m4 | 52 +++++++++++++++++++++++------------------------ pl/boot.yap | 4 ++-- pl/checker.yap | 2 +- pl/consult.yap | 2 +- pl/debug.yap | 2 +- pl/directives.yap | 5 ----- pl/init.yap | 1 + pl/tabling.yap | 14 +++++-------- pl/yapor.yap | 8 ++++---- 12 files changed, 48 insertions(+), 56 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index ca2d2bf55..c2fe619e5 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1092,7 +1092,7 @@ addclause(Term t, yamop *cp, int mode, int mod) } } if (compile_mode) - p->PredFlags = p->PredFlags | CompiledPredFlag | FastPredFlag; + p->PredFlags = p->PredFlags | CompiledPredFlag; else p->PredFlags = p->PredFlags | CompiledPredFlag; } @@ -1813,7 +1813,7 @@ p_new_multifile(void) pe->PredFlags |= MultiFileFlag; if (!(pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { /* static */ - pe->PredFlags |= SourcePredFlag; + pe->PredFlags |= (SourcePredFlag|CompiledPredFlag); } WRITE_UNLOCK(pe->PRWLock); return (TRUE); diff --git a/C/init.c b/C/init.c index e8b324305..ac44f6683 100644 --- a/C/init.c +++ b/C/init.c @@ -777,7 +777,7 @@ InitCodes(void) heap_regs->update_mode = UPDATE_MODE_LOGICAL; heap_regs->consultbase = heap_regs->consultsp = heap_regs->consultlow + heap_regs->consultcapacity; - heap_regs->compiler_compile_mode = 1; + heap_regs->compiler_compile_mode = 0; /* fast will be for native code */ heap_regs->maxdepth = 0; heap_regs->maxlist = 0; diff --git a/C/stdpreds.c b/C/stdpreds.c index 813f726da..395b113cf 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1957,7 +1957,7 @@ p_flags(void) if (EndOfPAEntr(pe)) return (FALSE); WRITE_LOCK(pe->PRWLock); - if (!Yap_unify_constant(ARG3, MkIntTerm(pe->PredFlags))) { + if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) { WRITE_UNLOCK(pe->PRWLock); return(FALSE); } @@ -1965,7 +1965,7 @@ p_flags(void) if (IsVarTerm(ARG4)) { WRITE_UNLOCK(pe->PRWLock); return (TRUE); - } else if (!IsIntTerm(ARG4)) { + } else if (!IsIntegerTerm(ARG4)) { union arith_ret v; if (Yap_Eval(ARG4, &v) == long_int_e) { @@ -1976,8 +1976,8 @@ p_flags(void) return(FALSE); } } else - newFl = IntOfTerm(ARG4); - pe->PredFlags = (SMALLUNSGN) newFl; + newFl = IntegerOfTerm(ARG4); + pe->PredFlags = (CELL)newFl; WRITE_UNLOCK(pe->PRWLock); return (TRUE); } diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 0cc9163c4..b24df1b80 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -162,36 +162,36 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) ) CodeOfPred holds the address of the correspondent C-function. */ typedef enum { - InUsePredFlag = 0x4000000L, /* count calls to pred */ - CountPredFlag = 0x2000000L, /* count calls to pred */ - HiddenPredFlag = 0x1000000L, /* invisible predicate */ - CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */ - SourcePredFlag = 0x400000L, /* static predicate with source declaration */ - MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */ - SyncPredFlag = 0x100000L, /* has to synch before it can execute*/ - UserCPredFlag = 0x080000L, /* CPred defined by the user */ - NumberDBPredFlag = 0x080000L, /* entry for a number key */ - AtomDBPredFlag = 0x040000L, /* entry for an atom key */ - MultiFileFlag = 0x040000L, /* is multi-file */ - FastPredFlag = 0x020000L, /* is "compiled" */ - TestPredFlag = 0x010000L, /* is a test (optim. comit) */ - AsmPredFlag = 0x008000L, /* inline */ - StandardPredFlag= 0x004000L, /* system predicate */ - DynamicPredFlag= 0x002000L, /* dynamic predicate */ - CPredFlag = 0x001000L, /* written in C */ - SafePredFlag = 0x000800L, /* does not alter arguments */ - CompiledPredFlag= 0x000400L, /* is static */ - IndexedPredFlag= 0x000200L, /* has indexing code */ - SpiedPredFlag = 0x000100L, /* is a spy point */ - BinaryTestPredFlag=0x000080L, /* test predicate. */ + MultiFileFlag = 0x20000000L, /* is multi-file */ + UserCPredFlag = 0x10000000L, /* CPred defined by the user */ + LogUpdatePredFlag= 0x08000000L, /* dynamic predicate with log. upd. sem.*/ + InUsePredFlag = 0x04000000L, /* count calls to pred */ + CountPredFlag = 0x02000000L, /* count calls to pred */ + HiddenPredFlag = 0x01000000L, /* invisible predicate */ + CArgsPredFlag = 0x00800000L, /* SWI-like C-interface pred. */ + SourcePredFlag = 0x00400000L, /* static predicate with source declaration */ + MetaPredFlag = 0x00200000L, /* predicate subject to a meta declaration */ + SyncPredFlag = 0x00100000L, /* has to synch before it can execute*/ + NumberDBPredFlag = 0x00080000L, /* entry for a number key */ + AtomDBPredFlag = 0x00040000L, /* entry for an atom key */ + FastPredFlag = 0x00020000L, /* native code */ + TestPredFlag = 0x00010000L, /* is a test (optim. comit) */ + AsmPredFlag = 0x00008000L, /* inline */ + StandardPredFlag= 0x00004000L, /* system predicate */ + DynamicPredFlag= 0x00002000L, /* dynamic predicate */ + CPredFlag = 0x00001000L, /* written in C */ + SafePredFlag = 0x00000800L, /* does not alter arguments */ + CompiledPredFlag= 0x00000400L, /* is static */ + IndexedPredFlag= 0x00000200L, /* has indexing code */ + SpiedPredFlag = 0x00000100L, /* is a spy point */ + BinaryTestPredFlag=0x00000080L, /* test predicate. */ #ifdef TABLING - TabledPredFlag = 0x000040L, /* is tabled */ + TabledPredFlag = 0x00000040L, /* is tabled */ #endif /* TABLING */ #ifdef YAPOR - SequentialPredFlag=0x000020L, /* may not create par. choice points!*/ + SequentialPredFlag=0x00000020L, /* may not create par. choice points!*/ #endif /* YAPOR */ - ProfiledPredFlag = 0x000010L, /* pred is being profiled */ - LogUpdatePredFlag= 0x000008L /* dynamic predicate with log. upd. sem.*/ + ProfiledPredFlag = 0x00000010L /* pred is being profiled */ } pred_flag; /* profile data */ diff --git a/pl/boot.yap b/pl/boot.yap index 8aeec618b..7b41d6a50 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -364,9 +364,9 @@ repeat :- '$repeat'. '$$compile'(G, G0, L, Mod) :- '$head_and_body'(G,H,_), '$flags'(H, Mod, Fl, Fl), - ( Fl /\ 16'000008 =\= 0 -> '$compile'(G,L,G0,Mod) + ( Fl /\ 0x08000000 =\= 0 -> '$compile'(G,L,G0,Mod) ; - Fl /\ 16'002000 =\= 0 -> '$assertz_dynamic'(L,G,G0,Mod) ; + Fl /\ 0x00002000 =\= 0 -> '$assertz_dynamic'(L,G,G0,Mod) ; '$$compile_stat'(G,G0,L,H, Mod) ). % process a clause for a static predicate diff --git a/pl/checker.yap b/pl/checker.yap index 1de23a805..fc1cfa73d 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -232,7 +232,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$check_multifile_pred'(Hd, M, Fl) :- % so this is not a multi-file predicate any longer. functor(Hd,Na,Ar), - NFl is \(16'040000 ) /\ Fl, + NFl is \(0x20000000) /\ Fl, '$flags'(Hd,M,Fl,NFl), '$warn_mfile'(Na,Ar). diff --git a/pl/consult.yap b/pl/consult.yap index 39208f938..2c7cf2c1e 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -169,7 +169,7 @@ reconsult(Fs) :- ( '$find_in_path'(X,Y,reconsult(X)), '$open'(Y,'$csult',Stream,0) -> ( '$access_yap_flags'(15, 0) -> true ; '$skip_unix_comments'(Stream) ), - '$reconsult'(X,Stream), '$close'(Stream) + '$current_module'(M), '$reconsult'(X,M,Stream), '$close'(Stream) ; '$output_error_message'(permission_error(input,stream,X),reconsult(X)) ), diff --git a/pl/debug.yap b/pl/debug.yap index da14f5740..a0824d470 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -396,7 +396,7 @@ debugging :- '$execute0'(G, M). '$spycall'(G, M, InControl) :- '$flags'(G,M,F,F), - F /\ 16'402008 =\= 0, !, % dynamic procedure, logical semantics, or source + F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source % use the interpreter '$clause'(G, M, Cl), CP is '$last_choice_pt', diff --git a/pl/directives.yap b/pl/directives.yap index f513b1983..68169af7f 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -105,11 +105,6 @@ '$exec_directives'(G, Mode, M) :- '$exec_directive'(G, Mode, M). -'$uncutable'(A/N, Mod) :- - functor(T,A,N),'$flags'(T,Mod,F,F), - NF is F \/ 16'2, - '$flags'(T, Mod, F, NF). - yap_flag(V,Out) :- var(V), !, '$show_yap_flag_opts'(V,Out). diff --git a/pl/init.yap b/pl/init.yap index 0c1db05fc..c0391ad45 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -158,3 +158,4 @@ library_directory(D) :- :- get_value(system_library_directory,D), assert(library_directory(D)). + diff --git a/pl/tabling.yap b/pl/tabling.yap index 7ef396827..a279581be 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -32,13 +32,9 @@ table(X) :- '$table'(A/N, M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), ( - X is F /\ 8'170000, X =:= 0, !, '$do_table'(T, M) + X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T, M) ; - write(user_error, '[ Error: '), - write(user_error, M:A/N), - write(user_error, ' cannot be declared as table ]'), - nl(user_error), - fail + '$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N)) ). '$table'(X, _) :- write(user_error, '[ Error: '), write(user_error, X), @@ -61,7 +57,7 @@ abolish_trie(X) :- '$abolish_trie'(A/N, M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), ( - X is F /\ 8'000100, X =\= 0, !, '$do_abolish_trie'(T,M) + X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M) ; write(user_error, '[ Error: '), write(user_error, M:A/N), @@ -88,7 +84,7 @@ show_trie(X) :- '$show_trie'(A/N, M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), ( - X is F /\ 8'000100, X =\= 0, !, '$show_trie'(T,M,_) + X is F /\ 0x000040, X =\= 0, !, '$show_trie'(T,M,_) ; write(user_error, '[ Error: '), write(user_error, M:A/N), @@ -116,7 +112,7 @@ resume_trie(X) :- '$resume_trie'(A/N,M) :- atom(A), integer(N), !, functor(T,A,N), '$flags'(T,M,F,F), ( - X is F /\ 8'000100, X =\= 0, !, '$resume_trie'(T,M) + X is F /\ 0x000040, X =\= 0, !, '$resume_trie'(T,M) ; write(user_error, '[ Error: '), write(user_error, A/N), diff --git a/pl/yapor.yap b/pl/yapor.yap index 9bcc8d1a2..20e7cac10 100644 --- a/pl/yapor.yap +++ b/pl/yapor.yap @@ -49,13 +49,13 @@ default_sequential(_). functor(T,A,N), '$flags'(T,M,F,F), ( - X is F /\ 8'000040, X =\= 0, !, + X is F /\ 0x00000020, X =\= 0, !, write(user_error, '[ Warning: '), write(user_error, M:A/N), write(user_error, ' is already declared as sequential ]'), nl(user_error) ; - X is F /\ 8'170000, X =:= 0, !, '$sequential'(T,M) + X is F /\ 0x1991F880, X =:= 0, !, '$sequential'(T,M) ; write(user_error, '[ Error: '), write(user_error, M:A/N), @@ -79,13 +79,13 @@ default_sequential(_). '$parallel_directive'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), ( - NF is F /\ \(8'000040), '$flags'(T,F,NF) ; + NF is F /\ 0x00000020, '$flags'(T,F,NF) ; write(user_error, '[ Warning: '), write(user_error, M:A/N), write(user_error, ' is already declared as sequential ]'), nl(user_error) ; - X is F /\ 8'170000, X =:= 0, !, '$sequential'(T) + X is F /\ 0x1991FC80, X =:= 0, !, '$sequential'(T) ; write(user_error, '[ Error: '), write(user_error, M:A/N),