version 1.32, 2005/07/03 11:08:54 |
version 1.44, 2020/10/06 11:33:47 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.31 2005/06/16 05:07:23 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.43 2018/09/07 00:15:44 takayama Exp $ */ |
/* stackmachin.c */ |
/* stackmachin.c */ |
|
|
#include <stdio.h> |
#include <stdio.h> |
|
|
#include "kclass.h" |
#include "kclass.h" |
#include <signal.h> |
#include <signal.h> |
#include <sys/types.h> |
#include <sys/types.h> |
|
#include <unistd.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 |
|
|
static char *SMacros = |
static char *SMacros = |
#include "smacro.h" |
#include "smacro.h" |
|
|
static isInteger(char *); |
static int isInteger(char *); |
static strToInteger(char *); |
static int strToInteger(char *); |
static power(int s,int i); |
static int power(int s,int i); |
static void pstack(void); |
static void pstack(void); |
static struct object executableStringToExecutableArray(char *str); |
static struct object executableStringToExecutableArray(char *str); |
static int isThereExecutableArrayOnStack(int n); |
static int isThereExecutableArrayOnStack(int n); |
|
|
|
|
extern int SerialCurrent; |
extern int SerialCurrent; |
extern int QuoteMode; |
extern int QuoteMode; |
|
|
Line 89 int OXlockSaved = 0; |
|
Line 101 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 119 struct object newObjectArray(size) |
|
Line 135 struct object newObjectArray(size) |
|
return(rob); |
return(rob); |
} |
} |
|
|
isNullObject(obj) |
int isNullObject(obj) |
struct object obj; |
struct object obj; |
{ |
{ |
if (obj.tag == 0) return(1); |
if (obj.tag == 0) return(1); |
Line 387 void hashInitialize(struct dictionary *dic) |
|
Line 403 void hashInitialize(struct dictionary *dic) |
|
} |
} |
} |
} |
|
|
static isInteger(str) |
static int isInteger(str) |
char *str; |
char *str; |
{ |
{ |
int i; |
int i; |
Line 408 static isInteger(str) |
|
Line 424 static isInteger(str) |
|
return(1); |
return(1); |
} |
} |
|
|
static strToInteger(str) |
static int strToInteger(str) |
char *str; |
char *str; |
{ |
{ |
int i; |
int i; |
Line 429 static strToInteger(str) |
|
Line 445 static strToInteger(str) |
|
return(r); |
return(r); |
} |
} |
|
|
static power(s,i) |
static int power(s,i) |
int s; |
int s; |
int i; |
int i; |
{ |
{ |
Line 658 void printOperandStack() { |
|
Line 674 void printOperandStack() { |
|
|
|
|
|
|
|
static initSystemDictionary() |
static int initSystemDictionary() |
{ |
{ |
StandardStack.ostack = StandardStackA; |
StandardStack.ostack = StandardStackA; |
StandardStack.sp = StandardStackP; |
StandardStack.sp = StandardStackP; |
Line 788 void scanner() { |
|
Line 804 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 852 void scanner() { |
|
Line 868 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 1061 int executeToken(token) |
|
Line 1077 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 1100 int executeToken(token) |
|
Line 1119 int executeToken(token) |
|
|
|
|
|
|
|
errorStackmachine(str) |
void errorStackmachine(char *str) |
char *str; |
|
{ |
{ |
int i,j,k; |
int i,j,k; |
static char *u="Usage:"; |
static char *u="Usage:"; |
Line 1111 errorStackmachine(str) |
|
Line 1129 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 1141 errorStackmachine(str) |
|
Line 1161 errorStackmachine(str) |
|
} |
} |
}else { |
}else { |
fprintf(stderr,"ERROR(sm): "); |
fprintf(stderr,"ERROR(sm): "); |
fprintf(stderr,str); |
fprintf(stderr,"%s",str); |
} |
} |
fprintf(stderr,"\n"); |
fprintf(stderr,"\n"); |
(void) traceShowStack(); |
MsgStackTraceInArrayp = traceNameStackToArrayp(); |
|
MsgStackTrace = traceShowStack(); |
|
MsgSourceTrace = traceShowScannerBuf(); |
} |
} |
traceClearStack(); |
traceClearStack(); |
if (GotoP) { |
if (GotoP) { |
Line 1154 errorStackmachine(str) |
|
Line 1176 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) |
int warningStackmachine(char *str) |
char *str; |
|
{ |
{ |
extern int WarningMessageMode; |
extern int WarningMessageMode; |
extern int Strict; |
extern int Strict; |
Line 1166 warningStackmachine(str) |
|
Line 1187 warningStackmachine(str) |
|
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
} |
} |
if (WarningMessageMode != 1) { |
if (WarningMessageMode != 1) { |
fprintf(stderr,"WARNING(sm): "); |
fprintf(stderr,"%s","WARNING(sm): "); |
fprintf(stderr,str); |
fprintf(stderr,"%s",str); |
} |
} |
if (Strict) errorStackmachine(" "); |
if (Strict) errorStackmachine(" "); |
return(0); |
return(0); |
Line 1178 warningStackmachine(str) |
|
Line 1199 warningStackmachine(str) |
|
/* NOTE: If you call this function and an error occured, |
/* NOTE: If you call this function and an error occured, |
you have to reset the jump buffer by setjmp(EnvOfStackMachine). |
you have to reset the jump buffer by setjmp(EnvOfStackMachine). |
cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */ |
cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */ |
KSexecuteString(s) |
int KSexecuteString(s) |
char *s; |
char *s; |
{ |
{ |
struct tokens token; |
struct tokens token; |
Line 1199 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 1217 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 1225 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 1240 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 1249 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 1267 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); |
} |
} |
|
|
KSdefineMacros() { |
int KSdefineMacros() { |
struct tokens token; |
struct tokens token; |
int tmp; |
int tmp; |
struct object ob = OINIT; |
struct object ob = OINIT; |
Line 1292 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 1304 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 1343 void KSpush(ob) |
|
Line 1371 void KSpush(ob) |
|
Kpush(ob); |
Kpush(ob); |
} |
} |
|
|
struct object KSpeek(k) { |
struct object KSpeek(int k) { |
return(peek(k)); |
return(peek(k)); |
} |
} |
|
|
Line 1389 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 1598 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 1627 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) { |