diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixes for signal handling

Browse Source 
throw permission error on consulting bad files


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@358 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-02-12 18:24:21 +00:00
parent 39964380f1
commit 777817f8db
9 changed files with 103 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
C/absmi.c
View File

@ -2096,24 +2096,24 @@ absmi(int inp)
}
else {
#endif
#if _MSC_VER || defined(__MINGW32__)
/* I need this for Windows and other systems where SIGINT
is not proceesed by same thread as absmi */
if (PrologMode & (AbortMode|InterruptMode)) {
CFREG = CalculateStackGap();
/* same instruction */
if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode;
ProcessSIGINT();
}
if (PrologMode & AbortMode) {
PrologMode &= ~AbortMode;
ASP = Y+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
Error(PURE_ABORT, TermNil, "");
ProcessSIGINT();
setregs();
}
}
JMPNext();
}
#endif
#if SHADOW_S
S = SREG;
#endif

25
C/iopreds.c
View File

@ -83,8 +83,6 @@ static char SccsId[] = "%W% %G%";
/* if we botched in a LongIO operation */
jmp_buf IOBotch;
int in_getc = FALSE;
#if HAVE_LIBREADLINE
#if _MSC_VER || defined(__MINGW32__)
@ -890,7 +888,6 @@ ReadlineGetc(int sno)
register int ch;
while (ttyptr == NULL) {
in_getc = TRUE;
/* Only sends a newline if we are at the start of a line */
if (_line != NULL && _line != (char *) EOF)
free (_line);
@ -906,16 +903,20 @@ ReadlineGetc(int sno)
while ((ch = *cptr++) != '\0') {
console_count_output_char(ch,Stream+StdErrStream,StdErrStream);
}
PrologMode |= ConsoleGetcMode;
_line = readline (Prompt);
} else {
PrologMode |= ConsoleGetcMode;
_line = readline (NULL);
}
} else {
if (ReadlinePos != ReadlineBuf) {
ReadlinePos[0] = '\0';
ReadlinePos = ReadlineBuf;
PrologMode |= ConsoleGetcMode;
_line = readline (ReadlineBuf);
} else {
PrologMode |= ConsoleGetcMode;
_line = readline (NULL);
}
}
@ -923,16 +924,17 @@ ReadlineGetc(int sno)
if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode;
ProcessSIGINT();
PrologMode &= ~ConsoleGetcMode;
if (PrologMode & AbortMode) {
Error(PURE_ABORT, TermNil, NULL);
ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s, sno));
}
continue;
} else {
PrologMode &= ~ConsoleGetcMode;
}
newline=FALSE;
strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
in_getc = FALSE;
/* window of vulnerability closed */
if (_line == NULL || _line == (char *) EOF)
return(console_post_process_read_char(EOF, s, sno));
@ -1123,11 +1125,13 @@ ConsoleSocketGetc(int sno)
newline = FALSE;
}
/* should be able to use a buffer */
PrologMode |= ConsoleGetcMode;
#if _MSC_VER
count = recv(s->u.socket.fd, &c, sizeof(char), 0);
#else
count = read(s->u.socket.fd, &c, sizeof(char));
#endif
PrologMode &= ~ConsoleGetcMode;
if (count == 0) {
ch = EOF;
} else if (count > 0) {
@ -1196,12 +1200,16 @@ ConsolePipeGetc(int sno)
}
#if _MSC_VER || defined(__MINGW32__)
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
PrologMode |= ConsoleGetcMode;
PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error");
PrologMode &= ~ConsoleGetcMode;
return(EOF);
}
#else
/* should be able to use a buffer */
PrologMode |= ConsoleGetcMode;
count = read(s->u.pipe.fd, &c, sizeof(char));
PrologMode &= ~ConsoleGetcMode;
#endif
if (count == 0) {
ch = EOF;
@ -1282,22 +1290,23 @@ ConsoleGetc(int sno)
#if HAVE_SIGINTERRUPT
siginterrupt(SIGINT, TRUE);
#endif
in_getc = TRUE;
PrologMode |= ConsoleGetcMode;
ch = YP_fgetc(s->u.file.file);
in_getc = FALSE;
#if HAVE_SIGINTERRUPT
siginterrupt(SIGINT, FALSE);
#endif
if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode;
ProcessSIGINT();
PrologMode &= ~ConsoleGetcMode;
newline = TRUE;
if (PrologMode & AbortMode) {
Error(PURE_ABORT, TermNil, NULL);
ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s, sno));
}
goto restart;
} else {
PrologMode &= ~ConsoleGetcMode;
}
return(console_post_process_read_char(ch, s, sno));
}

23
C/sysbits.c
View File

@ -1069,10 +1069,18 @@ InteractSIGINT(int ch) {
switch (ch) {
case 'a':
/* abort computation */
/* we can't do a direct abort, so ask the system to do
it for us */
p_creep();
PrologMode |= AbortMode;
if (PrologMode & ConsoleGetcMode) {
PrologMode |= AbortMode;
} else {
getc(stdin);
Error(PURE_ABORT, TermNil, "");
/* in case someone mangles the P register */
#if _MSC_VER || defined(__MINGW32__)
/* don't even think about trying this */
#else
siglongjmp (RestartEnv, 1);
#endif
}
return(-1);
case 'c':
/* continue */
@ -1177,7 +1185,7 @@ ProcessSIGINT(void)
do {
#if HAVE_LIBREADLINE
if (_line != (char *) NULL) {
if ((PrologMode & ConsoleGetcMode) && _line != (char *) NULL) {
ch = _line[0];
free(_line);
_line = NULL;
@ -1188,6 +1196,7 @@ ProcessSIGINT(void)
continue;
} else {
ch = _line[0];
free(_line);
_line = NULL;
}
@ -1221,10 +1230,10 @@ HandleSIGINT (int sig)
InteractSIGINT('e');
}
#endif
if (in_getc || (PrologMode & CritMode)) {
if (PrologMode & (CritMode|ConsoleGetcMode)) {
PrologMode |= InterruptMode;
#if HAVE_LIBREADLINE
if (in_getc) {
if (PrologMode & ConsoleGetcMode) {
fprintf(stderr, "Action (h for help): ");
#if HAVE_RL_SET_PROMPT
rl_set_prompt("Action (h for help): ");

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.10 2002-02-11 20:46:41 stasinos Exp $ *
* version: $Id: Yapproto.h,v 1.11 2002-02-12 18:24:20 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -255,6 +255,7 @@ void STD_PROTO(InitSysPreds,(void));
int STD_PROTO(TrueFileName, (char *, char *, int));
int STD_PROTO(ProcessSIGINT,(void));
double STD_PROTO(yap_random, (void));
void STD_PROTO(set_fpu_exceptions, (int));
/* tracer.c */
#ifdef LOW_LEVEL_TRACER

5
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.20 2002-02-04 16:12:54 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.21 2002-02-12 18:24:20 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -767,7 +767,8 @@ typedef enum {
CritMode = 4, /* If we are meddling with the heap */
AbortMode = 8, /* expecting to abort */
InterruptMode = 16, /* under an interrupt */
InErrorMode = 32 /* under an interrupt */
InErrorMode = 32, /* under an interrupt */
ConsoleGetcMode = 64 /* blocked reading from console */
} prolog_exec_mode;
extern prolog_exec_mode PrologMode;

13
pl/boot.yap
View File

@ -886,13 +886,12 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$change_module'(M0).
'$consult'(X) :-
'$find_in_path'(X,Y,consult(X)),
( '$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream),
'$consult'(X,Stream),
'$close'(Stream)
;
throw(error(permission_error(input,stream,Y),consult(X)))
).
'$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream),
'$consult'(X,Stream),
'$close'(Stream).
'$consult'(X) :-
throw(error(permission_error(input,stream,X),consult(X))).
'$consult'(F,Stream) :-

40
pl/consult.yap
View File

@ -31,23 +31,21 @@ ensure_loaded(V) :-
'$change_module'(M0).
'$ensure_loaded'(X) :-
'$find_in_path'(X,Y,ensure_loaded(X)),
( '$open'(Y, '$csult', Stream, 0), !,
( '$loaded'(Stream) ->
( '$consulting_file_name'(Stream,TFN),
'$recorded'('$module','$module'(TFN,M,P),_) ->
'$current_module'(T), '$import'(P,M,T)
'$open'(Y, '$csult', Stream, 0), !,
( '$loaded'(Stream) ->
( '$consulting_file_name'(Stream,TFN),
'$recorded'('$module','$module'(TFN,M,P),_) ->
'$current_module'(T), '$import'(P,M,T)
;
true
)
;
'$record_loaded'(Stream),
'$reconsult'(X,Stream)
),
'$close'(Stream)
true
)
;
throw(error(permission_error(input,stream,X),ensure_loaded(X)))
).
'$record_loaded'(Stream),
'$reconsult'(X,Stream)
),
'$close'(Stream).
'$ensure_loaded'(X) :-
throw(error(permission_error(input,stream,X),ensure_loaded(X))).
compile(P) :-
@ -87,12 +85,12 @@ reconsult(Fs) :-
'$reconsult'(Fs).
'$reconsult'(X) :-
'$find_in_path'(X,Y,reconsult(X)),
( '$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream),
'$reconsult'(X,Stream), '$close'(Stream)
;
throw(error(permission_error(input,stream,X),reconsult(X)))
).
'$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream),
'$reconsult'(X,Stream),
'$close'(Stream).
'$reconsult'(X) :-
throw(error(permission_error(input,stream,X),reconsult(X))).
'$reconsult'(F,Stream) :-
'$getcwd'(OldD),

2
pl/errors.yap
View File

@ -50,7 +50,7 @@ print_message(Level, Mss) :-
'$print_message'(error,error(Msg,Where)) :-
'$output_error_message'(Msg, Where), !.
'$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for ball ~w ]~n", [Throw]).
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :-
( '$get_value'('$verbose',on) ->
'$do_print_message'(M) ;

60
pl/modules.yap
View File

@ -34,12 +34,15 @@ use_module(M) :-
'$use_module'(F),
'$change_module'(M0).
'$use_module'(File) :-
'$find_in_path'(File,X,use_module(File)),
'$find_in_path'(File,X,use_module(File)), !,
( '$recorded'('$module','$module'(_,X,Publics),_) ->
'$use_module'(File,Publics)
;
'$ensure_loaded'(File)
).
'$use_module'(File) :-
throw(error(permission_error(input,stream,File),use_module(File))).
use_module(M,I) :-
'$use_module'(M, I).
@ -55,8 +58,8 @@ use_module(M,I) :-
'$change_module'(M0).
'$use_module'(File,Imports) :-
'$current_module'(M),
'$find_in_path'(File,X,use_module(File,Imports)),
( '$open'(X,'$csult',Stream,0), !,
'$find_in_path'(File,X,use_module(File,Imports)), !,
'$open'(X,'$csult',Stream,0), !,
'$consulting_file_name'(Stream,TrueFileName),
( '$loaded'(Stream) -> true
;
@ -72,10 +75,9 @@ use_module(M,I) :-
;
'$format'(user_error,"[ use_module/2 can not find a module in file ~w]~n",File),
fail
)
;
throw(error(permission_error(input,stream,X),use_module(X,Imports)))
).
).
'$use_module'(File,Imports) :-
throw(error(permission_error(input,stream,File),use_module(File,Imports))).
use_module(Mod,F,I) :-
'$use_module'(Mod,F,I).
@ -87,28 +89,32 @@ use_module(Mod,F,I) :-
'$use_module'(Module,File,Imports),
'$change_module'(M0).
'$use_module'(Module,File,Imports) :-
'$current_module'(M),
'$find_in_path'(File,X,use_module(Module,File,Imports)),
( '$open'(X,'$csult',Stream,0), !,
'$open'(X,'$csult',Stream,0), !,
'$consulting_file_name'(Stream,TrueFileName),
( '$loaded'(Stream) -> true
;
'$record_loaded'(Stream),
% the following avoids import of all public predicates
'$recorda'('$importing','$importing'(TrueFileName),R),
'$reconsult'(File,Stream)
),
'$close'(Stream),
( var(R) -> true; erased(R) -> true; erase(R)),
( '$recorded'('$module','$module'(TrueFileName,Module,Publics),_) ->
'$use_preds'(Imports,Publics,Module,M)
;
'$format'(user_error,"[ use_module/2 can not find module ~w in file ~w]~n",[Module,File]),
fail
)
;
throw(error(permission_error(input,stream,library(X)),use_module(Module,File,Imports)))
).
'$current_module'(M),
(
'$loaded'(Stream)
->
true
;
'$record_loaded'(Stream),
% the following avoids import of all public predicates
'$recorda'('$importing','$importing'(TrueFileName),R),
'$reconsult'(File,Stream)
),
'$close'(Stream),
( var(R) -> true; erased(R) -> true; erase(R)),
(
'$recorded'('$module','$module'(TrueFileName,Module,Publics),_)
->
'$use_preds'(Imports,Publics,Module,M)
;
'$format'(user_error,"[ use_module/2 can not find module ~w in file ~w]~n",[Module,File]),
fail
).
'$use_module'(Module,File,Imports) :-
throw(error(permission_error(input,stream,File),use_module(Module,File,Imports))).
'$consulting_file_name'(Stream,F) :-
'$file_name'(Stream, F).