version 1.31, 2005/06/16 05:07:23 |
version 1.43, 2018/09/07 00:15:44 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.30 2005/06/09 04:47:16 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.42 2016/03/31 06:34:29 takayama Exp $ */ |
/* stackmachin.c */ |
/* stackmachin.c */ |
|
|
#include <stdio.h> |
#include <stdio.h> |
|
#include <stdlib.h> |
|
#include <string.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
#include "extern.h" |
#include "extern.h" |
|
|
#include "kclass.h" |
#include "kclass.h" |
#include <signal.h> |
#include <signal.h> |
#include <sys/types.h> |
#include <sys/types.h> |
|
#include "mysig.h" |
|
|
|
/* The msys2 seems to make a buffer overflow of EnvOfStackmachine[]. |
|
The code |
|
[(x) ring_of_differential_operators 11] define_ring |
|
( Dx*(x+Dx) ) /ff set |
|
causes the segfault because Mp_zero is borken. Is it a bug of msys2? |
|
Anyway, the following definition seems to be a workaround. 2015.09 |
|
Singnals do not work properly on msys2. (gcc -dM -E ... to see macros defs) |
|
See stackm.h |
|
*/ |
|
|
/* #define OPERAND_STACK_SIZE 2000 */ |
/* #define OPERAND_STACK_SIZE 2000 */ |
#define OPERAND_STACK_SIZE 30000 |
#define OPERAND_STACK_SIZE 30000 |
Line 87 int OXlockSaved = 0; |
|
Line 99 int OXlockSaved = 0; |
|
char *UD_str; |
char *UD_str; |
int UD_attr; |
int UD_attr; |
|
|
|
struct object *MsgStackTraceInArrayp = NULL; |
|
char *MsgStackTrace = NULL; |
|
char *MsgSourceTrace = NULL; |
|
|
struct object * newObject() |
struct object * newObject() |
{ |
{ |
struct object *r; |
struct object *r; |
Line 786 void scanner() { |
|
Line 802 void scanner() { |
|
initSystemDictionary(); |
initSystemDictionary(); |
|
|
#if defined(__CYGWIN__) |
#if defined(__CYGWIN__) |
if (sigsetjmp(EnvOfStackMachine,1)) { |
if (MYSIGSETJMP(EnvOfStackMachine,1)) { |
#else |
#else |
if (setjmp(EnvOfStackMachine)) { |
if (MYSETJMP(EnvOfStackMachine)) { |
#endif |
#endif |
/* do nothing in the case of error */ |
/* do nothing in the case of error */ |
fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n"); |
fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n"); |
exit(10); |
exit(10); |
} else { } |
} else { } |
if (signal(SIGINT,SIG_IGN) != SIG_IGN) { |
if (mysignal(SIGINT,SIG_IGN) != SIG_IGN) { |
signal(SIGINT,ctrlC); |
mysignal(SIGINT,ctrlC); |
} |
} |
|
|
/* setup quiet mode or not */ |
/* setup quiet mode or not */ |
Line 850 void scanner() { |
|
Line 866 void scanner() { |
|
|
|
for (;;) { |
for (;;) { |
#if defined(__CYGWIN__) |
#if defined(__CYGWIN__) |
if (jval=sigsetjmp(EnvOfStackMachine,1)) { |
if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) { |
#else |
#else |
if (jval=setjmp(EnvOfStackMachine)) { |
if (jval=MYSETJMP(EnvOfStackMachine)) { |
#endif |
#endif |
/* *** The following does not work properly. **** |
/* *** The following does not work properly. **** |
if (jval == 2) { |
if (jval == 2) { |
|
|
extern int OXlock; |
extern int OXlock; |
extern int RestrictedMode, RestrictedMode_saved; |
extern int RestrictedMode, RestrictedMode_saved; |
|
|
signal(sig,SIG_IGN); |
mysignal(sig,SIG_IGN); |
/* see 133p */ |
/* see 133p */ |
RestrictedMode = RestrictedMode_saved; |
RestrictedMode = RestrictedMode_saved; |
cancelAlarm(); |
cancelAlarm(); |
|
|
if (SGClock) { |
if (SGClock) { |
UserCtrlC = 1; |
UserCtrlC = 1; |
fprintf(stderr,"ctrl-c is locked because of gc.\n"); |
fprintf(stderr,"ctrl-c is locked because of gc.\n"); |
signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
mysignal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
return; |
return; |
} |
} |
if (OXlock) { |
if (OXlock) { |
|
|
if (UserCtrlC > 3) { |
if (UserCtrlC > 3) { |
fprintf(stderr,"OK. You are eager to cancel the computation.\n"); |
fprintf(stderr,"OK. You are eager to cancel the computation.\n"); |
fprintf(stderr,"You should close the ox communication cannel.\n"); |
fprintf(stderr,"You should close the ox communication cannel.\n"); |
signal(SIGINT,ctrlC); |
mysignal(SIGINT,ctrlC); |
unlockCtrlCForOx(); |
unlockCtrlCForOx(); |
} |
} |
fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC); |
fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC); |
signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
mysignal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
return; |
return; |
} |
} |
if (ErrorMessageMode != 1) { |
if (ErrorMessageMode != 1) { |
|
|
It SOMETIMES makes core dump. |
It SOMETIMES makes core dump. |
*/ |
*/ |
getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */ |
getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */ |
signal(SIGINT,ctrlC); |
mysignal(SIGINT,ctrlC); |
#if defined(__CYGWIN__) |
#if defined(__CYGWIN__) |
siglongjmp(EnvOfStackMachine,2); |
MYSIGLONGJMP(EnvOfStackMachine,2); |
#else |
#else |
longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */ |
MYLONGJMP(EnvOfStackMachine,2); /* returns 2 for ctrl-C */ |
#endif |
#endif |
} |
} |
|
|
Line 1059 int executeToken(token) |
|
Line 1075 int executeToken(token) |
|
return(0); /* normal exit.*/ |
return(0); /* normal exit.*/ |
} |
} |
} |
} |
if (WarningMessageMode == 1 || WarningMessageMode == 2) { |
{ |
char tmpc[1024]; |
char tmpc[1024]; |
if (strlen(token.token) < 900) { |
if (strlen(token.token) < 900) { |
sprintf(tmpc,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionaries. Push NullObject.\n",token.token); |
sprintf(tmpc,"\n>>Warning: The identifier <<%s>> is not in the system dictionary\n>> nor in the user dictionaries. Push NullObject.\n",token.token); |
}else {strcpy(tmpc,"Warning: identifier is not in the dictionaries.");} |
}else {strcpy(tmpc,"\n>>Warning: identifier is not in the dictionaries.\n");} |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc)); |
/* do not use %% in a string. tmpc will be used as fprintf(stderr,tmpc); */ |
|
if (WarningMessageMode == 1 || WarningMessageMode == 2) { |
|
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc)); |
|
} |
|
if (WarningMessageMode != 1) { |
|
fprintf(Fstack,"%s",tmpc); |
|
/*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/ |
|
} |
|
if (Strict) { |
|
errorStackmachine(tmpc); |
|
} |
|
Kpush(NullObject); |
} |
} |
if (WarningMessageMode != 1) { |
|
fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionaries. Push NullObject.\n",token.token); |
|
/*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/ |
|
} |
|
if (Strict) { |
|
errorStackmachine("Warning: identifier is not in the dictionaries"); |
|
} |
|
Kpush(NullObject); |
|
} |
} |
} |
} |
} else if (token.kind == EXECUTABLE_STRING) { |
} else if (token.kind == EXECUTABLE_STRING) { |
Line 1109 errorStackmachine(str) |
|
Line 1128 errorStackmachine(str) |
|
extern int RestrictedMode, RestrictedMode_saved; |
extern int RestrictedMode, RestrictedMode_saved; |
RestrictedMode = RestrictedMode_saved; |
RestrictedMode = RestrictedMode_saved; |
cancelAlarm(); |
cancelAlarm(); |
|
MsgStackTrace = NULL; |
|
MsgSourceTrace = NULL; |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
} |
} |
Line 1142 errorStackmachine(str) |
|
Line 1163 errorStackmachine(str) |
|
fprintf(stderr,str); |
fprintf(stderr,str); |
} |
} |
fprintf(stderr,"\n"); |
fprintf(stderr,"\n"); |
(void) traceShowStack(); |
MsgStackTraceInArrayp = traceNameStackToArrayp(); |
|
MsgStackTrace = traceShowStack(); |
|
MsgSourceTrace = traceShowScannerBuf(); |
} |
} |
traceClearStack(); |
traceClearStack(); |
if (GotoP) { |
if (GotoP) { |
Line 1152 errorStackmachine(str) |
|
Line 1175 errorStackmachine(str) |
|
stdOperandStack(); contextControl(CCRESTORE); |
stdOperandStack(); contextControl(CCRESTORE); |
getokenSM(INIT); /* It might fix the bug. 1996/3/10 */ |
getokenSM(INIT); /* It might fix the bug. 1996/3/10 */ |
/* fprintf(stderr,"Now, Long jump!\n"); */ |
/* fprintf(stderr,"Now, Long jump!\n"); */ |
longjmp(EnvOfStackMachine,1); |
MYLONGJMP(EnvOfStackMachine,1); |
} |
} |
|
|
warningStackmachine(str) |
warningStackmachine(str) |
Line 1197 KSexecuteString(s) |
|
Line 1220 KSexecuteString(s) |
|
we crash. So, we use localCatchCtrlC. */ |
we crash. So, we use localCatchCtrlC. */ |
|
|
if (localCatchCtrlC) { |
if (localCatchCtrlC) { |
sigfunc = signal(SIGINT,SIG_IGN); |
sigfunc = mysignal(SIGINT,SIG_IGN); |
signal(SIGINT,ctrlC); |
mysignal(SIGINT,ctrlC); |
} |
} |
|
|
if (KSPushEnvMode) { |
if (KSPushEnvMode) { |
*saved_EnvOfStackMachine = *EnvOfStackMachine; |
*saved_EnvOfStackMachine = *EnvOfStackMachine; |
#if defined(__CYGWIN__) |
#if defined(__CYGWIN__) |
if (jval = sigsetjmp(EnvOfStackMachine,1)) { |
if (jval = MYSIGSETJMP(EnvOfStackMachine,1)) { |
#else |
#else |
if (jval = setjmp(EnvOfStackMachine)) { |
if (jval = MYSETJMP(EnvOfStackMachine)) { |
#endif |
#endif |
*EnvOfStackMachine = *saved_EnvOfStackMachine; |
*EnvOfStackMachine = *saved_EnvOfStackMachine; |
if (jval == 2) { |
if (jval == 2) { |
Line 1215 KSexecuteString(s) |
|
Line 1238 KSexecuteString(s) |
|
} |
} |
} |
} |
recursive--; |
recursive--; |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); } |
if (!Calling_ctrlC_hook) { |
if (!Calling_ctrlC_hook) { |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
Line 1223 KSexecuteString(s) |
|
Line 1246 KSexecuteString(s) |
|
} |
} |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
|
/* fprintf(stderr,"result code=-1 for %s\n",s); */ |
return(-1); |
return(-1); |
}else{ } |
}else{ } |
}else{ |
}else{ |
if (recursive == 0) { |
if (recursive == 0) { |
#if defined(__CYGWIN__) |
#if defined(__CYGWIN__) |
if (jval=sigsetjmp(EnvOfStackMachine,1)) { |
if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) { |
#else |
#else |
if (jval=setjmp(EnvOfStackMachine)) { |
if (jval=MYSETJMP(EnvOfStackMachine)) { |
#endif |
#endif |
if (jval == 2) { |
if (jval == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
Line 1238 KSexecuteString(s) |
|
Line 1262 KSexecuteString(s) |
|
} |
} |
} |
} |
recursive = 0; |
recursive = 0; |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); } |
if (!Calling_ctrlC_hook) { |
if (!Calling_ctrlC_hook) { |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
Line 1247 KSexecuteString(s) |
|
Line 1271 KSexecuteString(s) |
|
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
KSexecuteString(" (Computation is interrupted.) "); |
KSexecuteString(" (Computation is interrupted.) "); |
|
/* fprintf(stderr,"result code=-1 for %s\n",s);*/ |
return(-1); |
return(-1); |
}else { } |
}else { } |
} |
} |
Line 1265 KSexecuteString(s) |
|
Line 1290 KSexecuteString(s) |
|
executePrimitive(ob); |
executePrimitive(ob); |
recursive--; |
recursive--; |
if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine; |
if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine; |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); } |
return(0); |
return(0); |
} |
} |
|
|
Line 1290 KSdefineMacros() { |
|
Line 1315 KSdefineMacros() { |
|
|
|
} |
} |
|
|
|
void KSstart_quiet() { |
|
extern int Quiet; |
|
Quiet=1; |
|
KSstart(); |
|
} |
void KSstart() { |
void KSstart() { |
struct tokens token; |
struct tokens token; |
int tmp; |
int tmp; |
Line 1302 void KSstart() { |
|
Line 1332 void KSstart() { |
|
/* The following line may cause a core dump, if you do not setjmp properly |
/* The following line may cause a core dump, if you do not setjmp properly |
after calling KSstart().*/ |
after calling KSstart().*/ |
/* |
/* |
if (setjmp(EnvOfStackMachine)) { |
if (MYSETJMP(EnvOfStackMachine)) { |
fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n"); |
fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n"); |
exit(10); |
exit(10); |
} else { } */ |
} else { } */ |
Line 1387 char *KSpopBinary(int *size) { |
|
Line 1417 char *KSpopBinary(int *size) { |
|
return((char *)NULL); |
return((char *)NULL); |
} |
} |
|
|
|
struct object KSnewObjectArray(int k) { |
|
return newObjectArray(k); |
|
} |
|
|
int pushErrorStack(struct object obj) |
int pushErrorStack(struct object obj) |
{ |
{ |
if (CurrentOperandStack == &ErrorStack) { |
if (CurrentOperandStack == &ErrorStack) { |
Line 1596 struct object KSdupErrors() { |
|
Line 1630 struct object KSdupErrors() { |
|
|
|
void cancelAlarm() { |
void cancelAlarm() { |
alarm((unsigned int) 0); |
alarm((unsigned int) 0); |
signal(SIGALRM,SIG_DFL); |
mysignal(SIGALRM,SIG_DFL); |
} |
} |
|
|
/* back-trace */ |
/* back-trace */ |
Line 1625 void traceClearStack(void) { |
|
Line 1659 void traceClearStack(void) { |
|
char *tracePopName(void) { |
char *tracePopName(void) { |
if (TraceNameStackp <= 0) return (char *) NULL; |
if (TraceNameStackp <= 0) return (char *) NULL; |
return TraceNameStack[--TraceNameStackp]; |
return TraceNameStack[--TraceNameStackp]; |
|
} |
|
struct object *traceNameStackToArrayp(void) { |
|
int n,i; |
|
struct object *op; |
|
op = sGC_malloc(sizeof(struct object)); |
|
n = TraceNameStackp; if (n < 0) n = 0; |
|
*op = newObjectArray(n); |
|
for (i=0; i<n; i++) { |
|
putoa((*op),i, KpoString(TraceNameStack[i])); |
|
} |
|
return op; |
} |
} |
#define TRACE_MSG_SIZE 320 |
#define TRACE_MSG_SIZE 320 |
char *traceShowStack(void) { |
char *traceShowStack(void) { |