fix MacOSX interrupt handling
fix using Yap files as Yap scripts. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1555 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
2a16c4df67
commit
b8e524424c
17
C/absmi.c
17
C/absmi.c
|
|
@ -10,8 +10,11 @@
|
|||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2006-02-01 13:28:56 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-03-03 23:10:47 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.195 2006/02/01 13:28:56 vsc
|
||||
* bignum support fixes
|
||||
*
|
||||
* Revision 1.194 2006/01/26 19:13:24 vsc
|
||||
* avoid compilation issues with lack of gmp (Remko Troncon)
|
||||
*
|
||||
|
|
@ -467,10 +470,6 @@ Yap_absmi(int inp)
|
|||
register CELL *HBREG = HB;
|
||||
#endif /* SHADOW_HB */
|
||||
|
||||
#if SHADOW_CrFl
|
||||
register CELL CFREG = CreepFlag;
|
||||
#endif /* SHADOW_CP */
|
||||
|
||||
#if SHADOW_Y
|
||||
register CELL *YREG = Yap_REGS.YENV_;
|
||||
#endif /* SHADOW_Y */
|
||||
|
|
@ -2700,7 +2699,7 @@ Yap_absmi(int inp)
|
|||
is not proceesed by same thread as absmi */
|
||||
LOCK(SignalLock);
|
||||
if (Yap_PrologMode & (AbortMode|InterruptMode)) {
|
||||
CFREG = CalculateStackGap();
|
||||
CreepFlag = CalculateStackGap();
|
||||
UNLOCK(SignalLock);
|
||||
/* same instruction */
|
||||
if (Yap_PrologMode & InterruptMode) {
|
||||
|
|
@ -2766,7 +2765,7 @@ Yap_absmi(int inp)
|
|||
|
||||
H += 2;
|
||||
LOCK(SignalLock);
|
||||
CFREG = CalculateStackGap();
|
||||
CreepFlag = CalculateStackGap();
|
||||
#ifdef COROUTINING
|
||||
if (ActiveSignals & YAP_WAKEUP_SIGNAL) {
|
||||
ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
|
||||
|
|
@ -12839,7 +12838,7 @@ Yap_absmi(int inp)
|
|||
setregs_and_ycache();
|
||||
LOCK(SignalLock);
|
||||
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
|
||||
CFREG = CalculateStackGap();
|
||||
CreepFlag = CalculateStackGap();
|
||||
UNLOCK(SignalLock);
|
||||
if (!ActiveSignals) {
|
||||
goto execute_after_comma;
|
||||
|
|
@ -12858,7 +12857,7 @@ Yap_absmi(int inp)
|
|||
setregs_and_ycache();
|
||||
LOCK(SignalLock);
|
||||
ActiveSignals &= ~YAP_TROVF_SIGNAL;
|
||||
CFREG = CalculateStackGap();
|
||||
CreepFlag = CalculateStackGap();
|
||||
UNLOCK(SignalLock);
|
||||
if (!ActiveSignals) {
|
||||
goto execute_after_comma;
|
||||
|
|
|
|||
|
|
@ -2205,7 +2205,7 @@ SetAlias (Atom arg, int sno)
|
|||
default:
|
||||
break;
|
||||
}
|
||||
#if HAVE_SETBUF
|
||||
#if HAVE_SETBUF_COMMENTED_OUT
|
||||
YP_setbuf (Stream[sno].u.file.file, NULL);
|
||||
#endif /* HAVE_SETBUF */
|
||||
}
|
||||
|
|
|
|||
|
|
@ -798,8 +798,7 @@ Yap_tokenizer(int inp_stream)
|
|||
/* serious error now */
|
||||
return l;
|
||||
}
|
||||
if (ASP-H < 1024 ||
|
||||
((t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096)) == 0L)) {
|
||||
if (ASP-H < 1024) {
|
||||
Yap_ErrorMessage = "Stack Overflow";
|
||||
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
|
||||
if (p)
|
||||
|
|
@ -807,6 +806,12 @@ Yap_tokenizer(int inp_stream)
|
|||
/* serious error now */
|
||||
return l;
|
||||
}
|
||||
if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096)) == 0L) {
|
||||
if (p)
|
||||
p->Tok = Ord(kind = eot_tok);
|
||||
/* serious error now */
|
||||
return l;
|
||||
}
|
||||
PopScannerMemory(ptr, 4096);
|
||||
ch = cha;
|
||||
if (cherr) {
|
||||
|
|
|
|||
16
H/Regs.h
16
H/Regs.h
|
|
@ -10,7 +10,7 @@
|
|||
* File: Regs.h *
|
||||
* mods: *
|
||||
* comments: YAP abstract machine registers *
|
||||
* version: $Id: Regs.h,v 1.36 2006-02-13 16:58:55 vsc Exp $ *
|
||||
* version: $Id: Regs.h,v 1.37 2006-03-03 23:11:03 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
|
||||
|
|
@ -543,10 +543,15 @@ EXTERN inline void restore_TR(void) {
|
|||
restore the global registers :-(.
|
||||
|
||||
*/
|
||||
#define CreepFlag Yap_REGS.CreepFlag_
|
||||
/*
|
||||
vsc: this MUST start from register 13, otherwise GCC will break down in flames and
|
||||
use the registers for evil purposes. :-(
|
||||
*/
|
||||
#ifndef __svr4__
|
||||
register CELL CreepFlag asm ("r13");
|
||||
register tr_fr_ptr TR asm ("r13");
|
||||
#else
|
||||
register CELL CreepFlag asm ("r21");
|
||||
register tr_fr_ptr TR asm ("r21");
|
||||
#endif
|
||||
register CELL *H asm ("r14");
|
||||
register CELL *HB asm ("r15");
|
||||
|
|
@ -554,7 +559,6 @@ register choiceptr B asm ("r16");
|
|||
register yamop *CP asm ("r17");
|
||||
register CELL *S asm ("r18");
|
||||
register CELL *YENV asm ("r19");
|
||||
register tr_fr_ptr TR asm ("r20");
|
||||
#define P Yap_REGS.P_ /* prolog machine program counter */
|
||||
|
||||
#undef YENV2MEM
|
||||
|
|
@ -568,7 +572,6 @@ register tr_fr_ptr TR asm ("r20");
|
|||
|
||||
|
||||
EXTERN inline void save_machine_regs(void) {
|
||||
Yap_REGS.CreepFlag_ = CreepFlag;
|
||||
Yap_REGS.H_ = H;
|
||||
Yap_REGS.HB_ = HB;
|
||||
Yap_REGS.B_ = B;
|
||||
|
|
@ -578,7 +581,6 @@ EXTERN inline void save_machine_regs(void) {
|
|||
}
|
||||
|
||||
EXTERN inline void restore_machine_regs(void) {
|
||||
CreepFlag = Yap_REGS.CreepFlag_;
|
||||
H = Yap_REGS.H_;
|
||||
HB = Yap_REGS.HB_;
|
||||
B = Yap_REGS.B_;
|
||||
|
|
@ -591,7 +593,6 @@ EXTERN inline void restore_machine_regs(void) {
|
|||
CELL *BK_H = H; \
|
||||
CELL *BK_HB = HB; \
|
||||
choiceptr BK_B = B; \
|
||||
CELL BK_CreepFlag = CreepFlag; \
|
||||
yamop *BK_CP = CP; \
|
||||
tr_fr_ptr BK_TR = TR; \
|
||||
restore_machine_regs()
|
||||
|
|
@ -601,7 +602,6 @@ EXTERN inline void restore_machine_regs(void) {
|
|||
H = BK_H; \
|
||||
HB = BK_HB; \
|
||||
B = BK_B; \
|
||||
CreepFlag = BK_CreepFlag; \
|
||||
CP = BK_CP; \
|
||||
TR = BK_TR
|
||||
|
||||
|
|
|
|||
39
H/TermExt.h
39
H/TermExt.h
|
|
@ -10,7 +10,7 @@
|
|||
* File: TermExt.h *
|
||||
* mods: *
|
||||
* comments: Extensions to standard terms for YAP *
|
||||
* version: $Id: TermExt.h,v 1.6 2006-01-18 15:34:54 vsc Exp $ *
|
||||
* version: $Id: TermExt.h,v 1.7 2006-03-03 23:11:03 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#ifdef USE_SYSTEM_MALLOC
|
||||
|
|
@ -288,33 +288,22 @@ IsFloatTerm (Term t)
|
|||
|
||||
|
||||
/* extern Functor FunctorLongInt; */
|
||||
|
||||
inline EXTERN Term MkLongIntTerm (Int);
|
||||
|
||||
inline EXTERN Term
|
||||
MkLongIntTerm (Int i)
|
||||
{
|
||||
H[0] = (CELL) FunctorLongInt;
|
||||
H[1] = (CELL) (i);
|
||||
#if GC_NO_TAGS
|
||||
|
||||
inline EXTERN Term MkLongIntTerm (Int);
|
||||
|
||||
inline EXTERN Term
|
||||
MkLongIntTerm (Int i)
|
||||
{
|
||||
return (Term) ((H[0] = (CELL) FunctorLongInt, H[1] = (CELL) (i), H[2] =
|
||||
(2 * sizeof (CELL) + EndSpecials), H +=
|
||||
3, AbsAppl (H - 3)));
|
||||
}
|
||||
|
||||
|
||||
H[2] = 2 * sizeof (CELL) + EndSpecials;
|
||||
#else
|
||||
|
||||
inline EXTERN Term MkLongIntTerm (Int);
|
||||
|
||||
inline EXTERN Term
|
||||
MkLongIntTerm (Int i)
|
||||
{
|
||||
return (Term) ((H[0] = (CELL) FunctorLongInt, H[1] = (CELL) (i), H[2] =
|
||||
((2 * sizeof (CELL) + EndSpecials) | MBIT), H +=
|
||||
3, AbsAppl (H - 3)));
|
||||
}
|
||||
|
||||
|
||||
H[2] = ((2 * sizeof (CELL) + EndSpecials) | MBIT);
|
||||
#endif
|
||||
H += 3;
|
||||
return AbsAppl(H - 3);
|
||||
}
|
||||
|
||||
inline EXTERN Int LongIntOfTerm (Term t);
|
||||
|
||||
|
|
|
|||
20
H/absmi.h
20
H/absmi.h
|
|
@ -35,7 +35,6 @@ static char SccsId[] = "%W% %G%";
|
|||
#define SHADOW_REGS 1
|
||||
#define SHADOW_CP 1
|
||||
#define SHADOW_HB 1
|
||||
/*#define SHADOW_CrFl 1 Breaks alarm/3 */
|
||||
#define USE_PREFETCH 1
|
||||
#endif
|
||||
|
||||
|
|
@ -621,30 +620,15 @@ typedef CELL label;
|
|||
#define CPREG CP
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Next, CP
|
||||
*/
|
||||
/* Breaks alarm/3 */
|
||||
#if SHADOW_CrFl
|
||||
#define set_cf() CFREG = CreepFlag
|
||||
#define save_cf() CreepFlag = CFREG
|
||||
#else
|
||||
#define set_cf()
|
||||
#define save_cf()
|
||||
#define CFREG CreepFlag
|
||||
#endif
|
||||
|
||||
/* Say which registers must be saved at register entry and register
|
||||
* exit */
|
||||
#define setregs() \
|
||||
set_cf(); \
|
||||
set_hb(); \
|
||||
set_cp(); \
|
||||
set_pc(); \
|
||||
set_y()
|
||||
|
||||
#define saveregs() \
|
||||
save_cf(); \
|
||||
save_hb(); \
|
||||
save_cp(); \
|
||||
save_pc(); \
|
||||
|
|
@ -687,10 +671,10 @@ Macros to check the limits of stacks
|
|||
|
||||
#if (defined(SBA) && defined(YAPOR)) || defined(TABLING)
|
||||
#define check_stack(Label, GLOB) \
|
||||
if ( (Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CFREG ) goto Label
|
||||
if ( (Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CreepFlag ) goto Label
|
||||
#else
|
||||
#define check_stack(Label, GLOB) \
|
||||
if ( (Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CFREG ) goto Label
|
||||
if ( (Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag ) goto Label
|
||||
#endif /* SBA && YAPOR */
|
||||
|
||||
/***************************************************************
|
||||
|
|
|
|||
|
|
@ -16,6 +16,10 @@
|
|||
|
||||
<h2>Yap-5.1.0:</h2>
|
||||
<ul>
|
||||
<li> FIXED: Yap on OSX should not make CreepFlag a register, as this
|
||||
breaks Interrupt Handling. Also, it seems that if I do not reserve
|
||||
r13, GCC will use r14 for its own evil purposes.</li>
|
||||
<li> FIXED: make Yap files usable again as a script (Ales Kozumplik).</li>
|
||||
<li> FIXED: informational_messages was being ignored (Nicos Angelopoulos).</li>
|
||||
<li> FIXED: initialization should only be performed after all
|
||||
consulted files are done.</li>
|
||||
|
|
|
|||
|
|
@ -906,7 +906,7 @@ Unix-like environments. A simple example is shown next:
|
|||
|
||||
@example
|
||||
@cartouche
|
||||
#!/usr/local/bin/yap -L
|
||||
#!/usr/local/bin/yap -L --
|
||||
#
|
||||
# Hello World script file using Yap
|
||||
#
|
||||
|
|
|
|||
24
pl/boot.yap
24
pl/boot.yap
|
|
@ -14,6 +14,8 @@
|
|||
* comments: boot file for Prolog *
|
||||
* *
|
||||
*************************************************************************/
|
||||
'$spycall'(G, M, InControl) :-
|
||||
F /\ 0x18402000 =\= 0, !. % dynamic procedure, logical semantics, user-C, or source
|
||||
|
||||
% This one should come first so that disjunctions and long distance
|
||||
% cuts are compiled right with co-routining.
|
||||
|
|
@ -1054,28 +1056,6 @@ throw(Ball) :-
|
|||
throw(Ball)
|
||||
).
|
||||
|
||||
'$exec_initialisation_goals' :-
|
||||
recorded('$blocking_code',_,R),
|
||||
erase(R),
|
||||
fail.
|
||||
% system goals must be performed first
|
||||
'$exec_initialisation_goals' :-
|
||||
recorded('$system_initialisation',G,R),
|
||||
erase(R),
|
||||
G \= '$',
|
||||
call(G),
|
||||
fail.
|
||||
'$exec_initialisation_goals' :-
|
||||
'$show_consult_level'(Level),
|
||||
recorded('$initialisation',do(Level,G),R),
|
||||
erase(R),
|
||||
G \= '$',
|
||||
'$current_module'(M),
|
||||
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
|
||||
'$do_not_creep',
|
||||
fail.
|
||||
'$exec_initialisation_goals'.
|
||||
|
||||
'$run_toplevel_hooks' :-
|
||||
get_value('$break',0),
|
||||
recorded('$toplevel_hooks',H,_), !,
|
||||
|
|
|
|||
123
pl/consult.yap
123
pl/consult.yap
|
|
@ -32,55 +32,56 @@ load_files(Files,Opts) :-
|
|||
'$load_files'(Files,Opts,load_files(Files,Opts)).
|
||||
|
||||
'$load_files'(Files,Opts,Call) :-
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call),
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,Files,Call),
|
||||
'$check_use_module'(Call,UseModule),
|
||||
'$current_module'(M0),
|
||||
'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule),
|
||||
'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,UseModule),
|
||||
'$close_lf'(Silent).
|
||||
|
||||
'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
var(V), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$process_lf_opts'([],_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call) :-
|
||||
'$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call), !,
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call).
|
||||
'$process_lf_opts'([Opt|Opts],_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$process_lf_opts'([],_,_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,Files,Call) :-
|
||||
'$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,Files,Call), !,
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,Files,Call).
|
||||
'$process_lf_opts'([Opt|Opts],_,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,Opt),Call).
|
||||
|
||||
'$process_lf_opt'(autoload(true),_,InfLevel,_,_,_,_,_,_,_,_,_) :-
|
||||
'$process_lf_opt'(autoload(true),_,InfLevel,_,_,_,_,_,_,_,_,_,_) :-
|
||||
get_value('$verbose_auto_load',VAL),
|
||||
(VAL = true ->
|
||||
InfLevel = informational
|
||||
;
|
||||
InfLevel = silent
|
||||
).
|
||||
'$process_lf_opt'(autoload(false),_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(derived_from(File),_,_,_,_,_,_,_,_,_,Files,Call) :-
|
||||
'$process_lf_opt'(autoload(false),_,_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(derived_from(File),_,_,_,_,_,_,_,_,_,_,Files,Call) :-
|
||||
( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ),
|
||||
( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ),
|
||||
/* call make */
|
||||
'$do_error'(domain_error(unimplemented_option,derived_from),Call).
|
||||
'$process_lf_opt'(encoding(Encoding),_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$process_lf_opt'(encoding(Encoding),_,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,encoding),Call).
|
||||
'$process_lf_opt'(expand(true),_,_,true,_,_,_,_,_,_,_,Call) :-
|
||||
'$process_lf_opt'(expand(true),_,_,true,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,expand),Call).
|
||||
'$process_lf_opt'(expand(false),_,_,false,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(changed),_,_,_,changed,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(true),_,_,_,true,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(not_loaded),_,_,_,not_loaded,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(all),_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(Imports),_,_,_,_,_,Imports,_,_,_,_,_).
|
||||
'$process_lf_opt'(qcompile(true),_,_,_,_,true,_,_,_,_,_,Call) :-
|
||||
'$process_lf_opt'(expand(false),_,_,false,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(changed),_,_,_,changed,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(true),_,_,_,true,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(not_loaded),_,_,_,not_loaded,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(all),_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(Imports),_,_,_,_,_,Imports,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(qcompile(true),_,_,_,_,true,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,qcompile),Call).
|
||||
'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_).
|
||||
'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_) :-
|
||||
'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_,_) :-
|
||||
( get_value('$lf_verbose',Silent) -> true ; Silent = informational),
|
||||
set_value('$lf_verbose',silent).
|
||||
'$process_lf_opt'(silent(false),_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,reconsult,_,_).
|
||||
'$process_lf_opt'(consult(consult),_,_,_,_,_,_,_,_,consult,_,_).
|
||||
'$process_lf_opt'(stream(Stream),_,_,_,_,_,_,Stream,_,_,Files,_) :-
|
||||
'$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_).
|
||||
'$process_lf_opt'(silent(false),_,_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,_,reconsult,_,_).
|
||||
'$process_lf_opt'(consult(consult),_,_,_,_,_,_,_,_,_,consult,_,_).
|
||||
'$process_lf_opt'(stream(Stream),_,_,_,_,_,_,Stream,_,_,_,Files,_) :-
|
||||
/* ( '$stream'(Stream) -> true ; '$do_error'(domain_error(stream,Stream),Call) ), */
|
||||
( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ).
|
||||
|
||||
|
|
@ -89,45 +90,45 @@ load_files(Files,Opts) :-
|
|||
'$check_use_module'(use_module(M,_,_),use_module(M)) :- !.
|
||||
'$check_use_module'(_,load_files) :- !.
|
||||
|
||||
'$lf'(V,_,Call,_,_,_,_,_,_,_,_) :- var(V), !,
|
||||
'$lf'(V,_,Call,_,_,_,_,_,_,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$lf'([],_,_,_,_,_,_,_,_,_,_,_) :- !.
|
||||
'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule) :- !,
|
||||
'$lf'([],_,_,_,_,_,_,_,_,_,_,_,_) :- !.
|
||||
'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,UseModule) :- !,
|
||||
(
|
||||
atom(M)
|
||||
->
|
||||
'$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule)
|
||||
'$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,UseModule)
|
||||
;
|
||||
'$do_error'(type_error(atom,M),Call)
|
||||
).
|
||||
'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule) :- !,
|
||||
'$lf'(F,Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,_),
|
||||
'$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule).
|
||||
'$lf'(X, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,Stream,_,Reconsult,UseModule) :-
|
||||
'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,UseModule) :- !,
|
||||
'$lf'(F,Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,_),
|
||||
'$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,Reconsult,UseModule).
|
||||
'$lf'(X, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,Stream,_,Reconsult,SkipUnixComments,UseModule) :-
|
||||
nonvar(Stream), !,
|
||||
'$do_lf'(X, Mod, Stream, InfLevel,CompilationMode,Imports,Reconsult,UseModule).
|
||||
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult,UseModule) :- !,
|
||||
'$do_lf'(X, Mod, Stream, InfLevel,CompilationMode,Imports,SkipUnixComments,Reconsult,UseModule).
|
||||
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,Reconsult,UseModule).
|
||||
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,Reconsult,UseModule).
|
||||
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,UseModule) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,UseModule).
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult,UseModule) :-
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :-
|
||||
'$find_in_path'(X, Y, Call),
|
||||
'$open'(Y, '$csult', Stream, 0), !,
|
||||
'$set_changed_lfmode'(Changed),
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,Reconsult,UseModule),
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,SkipUnixComments,Reconsult,UseModule),
|
||||
'$close'(Stream).
|
||||
'$lf'(X, _, Call, _, _, _, _, _, _, _,_,_) :-
|
||||
'$lf'(X, _, Call, _, _, _, _, _, _, _, _, _, _) :-
|
||||
'$do_error'(permission_error(input,stream,X),Call).
|
||||
|
||||
'$set_changed_lfmode'(true) :- !.
|
||||
'$set_changed_lfmode'(_).
|
||||
|
||||
'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _,_) :-
|
||||
'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _, _, _) :-
|
||||
'$file_loaded'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _,_) :-
|
||||
'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _, _, _) :-
|
||||
'$file_unchanged'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, _, Reconsult, UseModule) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Reconsult, UseModule).
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, _, SkipUnixComments, Reconsult, UseModule) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, SkipUnixComments, Reconsult, UseModule).
|
||||
|
||||
'$close_lf'(Silent) :-
|
||||
nonvar(Silent), !,
|
||||
|
|
@ -177,7 +178,7 @@ use_module(M,F,Is) :-
|
|||
'$csult'([-F|L], M) :- !, '$load_files'(M:F, [],[-M:F]), '$csult'(L, M).
|
||||
'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M).
|
||||
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult, UseModule) :-
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, Reconsult, UseModule) :-
|
||||
'$record_loaded'(Stream, M),
|
||||
'$current_module'(OldModule,ContextModule),
|
||||
getcwd(OldD),
|
||||
|
|
@ -204,6 +205,11 @@ use_module(M,F,Is) :-
|
|||
),
|
||||
'$print_message'(InfLevel, loading(StartMsg, File)),
|
||||
( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
|
||||
( SkipUnixComments == skip_unix_comments ->
|
||||
'$skip_unix_comments'(Stream)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$loop'(Stream,Reconsult),
|
||||
'$end_consult',
|
||||
( nonvar(TraceR) -> recorda('$trace', on, _) ; true),
|
||||
|
|
@ -258,6 +264,27 @@ use_module(M,F,Is) :-
|
|||
fail.
|
||||
'$initialization'(_).
|
||||
|
||||
'$exec_initialisation_goals' :-
|
||||
recorded('$blocking_code',_,R),
|
||||
erase(R),
|
||||
fail.
|
||||
% system goals must be performed first
|
||||
'$exec_initialisation_goals' :-
|
||||
recorded('$system_initialisation',G,R),
|
||||
erase(R),
|
||||
G \= '$',
|
||||
call(G),
|
||||
fail.
|
||||
'$exec_initialisation_goals' :-
|
||||
'$show_consult_level'(Level),
|
||||
recorded('$initialisation',do(Level,G),R),
|
||||
erase(R),
|
||||
G \= '$',
|
||||
'$current_module'(M),
|
||||
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
|
||||
'$do_not_creep',
|
||||
fail.
|
||||
'$exec_initialisation_goals'.
|
||||
|
||||
'$include'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,include(V)).
|
||||
|
|
@ -285,8 +312,8 @@ use_module(M,F,Is) :-
|
|||
( '$access_yap_flags'(15, 0) ->
|
||||
'$system_catch'(load_files(X, []),Module,Error,'$Error'(Error))
|
||||
;
|
||||
'$set_value'('$verbose',off),
|
||||
load_files(X, [silent(true)])
|
||||
set_value('$verbose',off),
|
||||
load_files(X, [silent(true),skip_unix_comments])
|
||||
),
|
||||
( '$access_yap_flags'(15, 0) -> true ; halt).
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@
|
|||
* comments: module support *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
% module handling
|
||||
|
||||
'$consulting_file_name'(Stream,F) :-
|
||||
|
|
|
|||
Reference in New Issue