version 1.7, 2001/05/04 01:06:25 |
version 1.18, 2004/09/05 08:08:41 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.6 2001/01/27 05:48:46 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.17 2004/09/05 01:15:47 takayama Exp $ */ |
/* stackmachin.c */ |
/* stackmachin.c */ |
|
|
#include <stdio.h> |
#include <stdio.h> |
|
|
/* #define OPERAND_STACK_SIZE 2000 */ |
/* #define OPERAND_STACK_SIZE 2000 */ |
#define OPERAND_STACK_SIZE 30000 |
#define OPERAND_STACK_SIZE 30000 |
#define SYSTEM_DICTIONARY_SIZE 200 |
#define SYSTEM_DICTIONARY_SIZE 200 |
/* #define USER_DICTIONARY_SIZE 1223, 3581 */ |
/* #define USER_DICTIONARY_SIZE 1223, 3581, 27449 */ |
#define USER_DICTIONARY_SIZE 27449 |
#define USER_DICTIONARY_SIZE 59359 |
/* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing |
/* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing |
method */ |
method */ |
#define ARGV_WORK_MAX (AGLIMIT+100) |
#define ARGV_WORK_MAX (AGLIMIT+100) |
Line 54 struct context *PrimitiveContextp = &StandardContext; |
|
Line 54 struct context *PrimitiveContextp = &StandardContext; |
|
|
|
static struct object ObjTmp; /* for poor compiler */ |
static struct object ObjTmp; /* for poor compiler */ |
|
|
|
int Calling_ctrlC_hook = 0; |
|
|
int StandardMacros = 1; |
int StandardMacros = 1; |
int StartAFile = 0; |
int StartAFile = 0; |
char *StartFile; |
char *StartFile; |
Line 74 static void pstack(void); |
|
Line 76 static void pstack(void); |
|
static struct object executableStringToExecutableArray(char *str); |
static struct object executableStringToExecutableArray(char *str); |
|
|
extern int SerialCurrent; |
extern int SerialCurrent; |
|
extern int QuoteMode; |
|
|
int SGClock = 0; |
int SGClock = 0; |
int UserCtrlC = 0; |
int UserCtrlC = 0; |
|
|
{ |
{ |
int h=0; |
int h=0; |
while (*str != '\0') { |
while (*str != '\0') { |
h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE; |
h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE; |
str++; |
str++; |
} |
} |
return(h); |
return(h); |
|
|
int hash1(str) |
int hash1(str) |
char *str; |
char *str; |
{ |
{ |
return(8-(str[0]%8)); |
return(8-((unsigned char)(str[0])%8)); |
} |
} |
|
|
void hashInitialize(struct dictionary *dic) |
void hashInitialize(struct dictionary *dic) |
Line 733 void scanner() { |
|
Line 736 void scanner() { |
|
char *tmp2; |
char *tmp2; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
int jval; |
int jval; |
|
extern int InSendmsg2; |
getokenSM(INIT); |
getokenSM(INIT); |
initSystemDictionary(); |
initSystemDictionary(); |
|
|
|
#if defined(__CYGWIN__) |
|
if (sigsetjmp(EnvOfStackMachine,1)) { |
|
#else |
if (setjmp(EnvOfStackMachine)) { |
if (setjmp(EnvOfStackMachine)) { |
|
#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); |
Line 796 void scanner() { |
|
Line 804 void scanner() { |
|
|
|
|
|
for (;;) { |
for (;;) { |
|
#if defined(__CYGWIN__) |
|
if (jval=sigsetjmp(EnvOfStackMachine,1)) { |
|
#else |
if (jval=setjmp(EnvOfStackMachine)) { |
if (jval=setjmp(EnvOfStackMachine)) { |
|
#endif |
/* *** The following does not work properly. **** |
/* *** The following does not work properly. **** |
if (jval == 2) { |
if (jval == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
Line 807 void scanner() { |
|
Line 819 void scanner() { |
|
if (DebugStack >= 1) { |
if (DebugStack >= 1) { |
fprintf(Fstack,"\nscanner> "); |
fprintf(Fstack,"\nscanner> "); |
} |
} |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */ |
|
Calling_ctrlC_hook = 1; |
|
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
} |
|
Calling_ctrlC_hook = 0; |
|
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */ |
|
InSendmsg2 = 0; |
continue ; |
continue ; |
} else { } |
} else { } |
if (DebugStack >= 1) { printOperandStack(); } |
if (DebugStack >= 1) { printOperandStack(); } |
|
|
extern int SGClock; |
extern int SGClock; |
extern int UserCtrlC; |
extern int UserCtrlC; |
extern int OXlock; |
extern int OXlock; |
|
|
signal(sig,SIG_IGN); |
signal(sig,SIG_IGN); |
/* see 133p */ |
/* see 133p */ |
|
cancelAlarm(); |
|
if (sig == SIGALRM) { |
|
fprintf(stderr,"ctrlC by SIGALRM\n"); |
|
} |
|
|
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(SIGINT,ctrlC); |
signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
return; |
return; |
} |
} |
if (OXlock) { |
if (OXlock) { |
|
|
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(SIGINT,ctrlC); |
signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10); |
return; |
return; |
} |
} |
if (ErrorMessageMode != 1) { |
if (ErrorMessageMode != 1) { |
|
(void *) traceShowStack(); |
fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n"); |
fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n"); |
fprintf(Fstack,"Type in quit in order to exit sm1.\n"); |
fprintf(Fstack,"Type in quit in order to exit sm1.\n"); |
} |
} |
|
traceClearStack(); |
if (GotoP) { |
if (GotoP) { |
fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel); |
fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel); |
GotoP = 0; |
GotoP = 0; |
|
|
*/ |
*/ |
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); |
signal(SIGINT,ctrlC); |
|
#if defined(__CYGWIN__) |
|
siglongjmp(EnvOfStackMachine,2); |
|
#else |
longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */ |
longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */ |
|
#endif |
} |
} |
|
|
int executeToken(token) |
int executeToken(token) |
Line 881 int executeToken(token) |
|
Line 909 int executeToken(token) |
|
int i,h0,h1; |
int i,h0,h1; |
extern int WarningMessageMode; |
extern int WarningMessageMode; |
extern int Strict; |
extern int Strict; |
|
extern int InSendmsg2; |
|
|
if (GotoP) { /* for goto */ |
if (GotoP) { /* for goto */ |
if (token.kind == ID && isLiteral(token.token)) { |
if (token.kind == ID && isLiteral(token.token)) { |
Line 930 int executeToken(token) |
|
Line 959 int executeToken(token) |
|
if (ob.tag >= 0) { |
if (ob.tag >= 0) { |
/* there is a definition in the user dictionary */ |
/* there is a definition in the user dictionary */ |
if (ob.tag == SexecutableArray) { |
if (ob.tag == SexecutableArray) { |
|
tracePushName(token.token); |
tokenArray = ob.lc.tokenArray; |
tokenArray = ob.lc.tokenArray; |
size = ob.rc.ival; |
size = ob.rc.ival; |
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
status = executeToken(tokenArray[i]); |
status = executeToken(tokenArray[i]); |
if (status != 0) return(status); |
if (status != 0) { |
|
tracePopName(); return(status); |
|
} |
} |
} |
|
tracePopName(); |
}else { |
}else { |
Kpush(ob); |
Kpush(ob); |
} |
} |
} else if (primitive) { |
} else if (primitive) { |
|
tracePushName(token.token); |
/* system operator */ |
/* system operator */ |
ob.tag = Soperator; |
ob.tag = Soperator; |
ob.lc.ival = primitive; |
ob.lc.ival = primitive; |
return(executePrimitive(ob)); |
status = executePrimitive(ob); |
|
tracePopName(); |
|
return(status); |
} else { |
} else { |
|
if (QuoteMode) { |
|
if (InSendmsg2) return(DO_QUOTE); |
|
else { |
|
Kpush(KpoString(token.token)); |
|
return(0); /* normal exit.*/ |
|
} |
|
} |
if (WarningMessageMode == 1 || WarningMessageMode == 2) { |
if (WarningMessageMode == 1 || WarningMessageMode == 2) { |
char tmpc[1024]; |
char tmpc[1024]; |
if (strlen(token.token) < 900) { |
if (strlen(token.token) < 900) { |
Line 992 errorStackmachine(str) |
|
Line 1035 errorStackmachine(str) |
|
char message0[1024]; |
char message0[1024]; |
char *message; |
char *message; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
|
cancelAlarm(); |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str)); |
} |
} |
Line 1025 errorStackmachine(str) |
|
Line 1069 errorStackmachine(str) |
|
fprintf(stderr,str); |
fprintf(stderr,str); |
} |
} |
fprintf(stderr,"\n"); |
fprintf(stderr,"\n"); |
|
(void) traceShowStack(); |
} |
} |
|
traceClearStack(); |
if (GotoP) { |
if (GotoP) { |
fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel); |
fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel); |
GotoP = 0; |
GotoP = 0; |
Line 1083 KSexecuteString(s) |
|
Line 1129 KSexecuteString(s) |
|
|
|
if (KSPushEnvMode) { |
if (KSPushEnvMode) { |
*saved_EnvOfStackMachine = *EnvOfStackMachine; |
*saved_EnvOfStackMachine = *EnvOfStackMachine; |
|
#if defined(__CYGWIN__) |
|
if (jval = sigsetjmp(EnvOfStackMachine,1)) { |
|
#else |
if (jval = setjmp(EnvOfStackMachine)) { |
if (jval = setjmp(EnvOfStackMachine)) { |
|
#endif |
*EnvOfStackMachine = *saved_EnvOfStackMachine; |
*EnvOfStackMachine = *saved_EnvOfStackMachine; |
if (jval == 2) { |
if (jval == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
Line 1092 KSexecuteString(s) |
|
Line 1142 KSexecuteString(s) |
|
} |
} |
recursive--; |
recursive--; |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
|
if (!Calling_ctrlC_hook) { |
|
Calling_ctrlC_hook = 1; |
|
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
} |
|
Calling_ctrlC_hook = 0; |
|
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
return(-1); |
return(-1); |
}else{ } |
}else{ } |
}else{ |
}else{ |
if (recursive == 0) { |
if (recursive == 0) { |
|
#if defined(__CYGWIN__) |
|
if (jval=sigsetjmp(EnvOfStackMachine,1)) { |
|
#else |
if (jval=setjmp(EnvOfStackMachine)) { |
if (jval=setjmp(EnvOfStackMachine)) { |
|
#endif |
if (jval == 2) { |
if (jval == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C.")); |
pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C.")); |
Line 1104 KSexecuteString(s) |
|
Line 1164 KSexecuteString(s) |
|
} |
} |
recursive = 0; |
recursive = 0; |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
|
if (!Calling_ctrlC_hook) { |
|
Calling_ctrlC_hook = 1; |
|
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
} |
|
Calling_ctrlC_hook = 0; |
|
Calling_ctrlC_hook = 0; |
|
KSexecuteString(" (Computation is interrupted.) "); |
return(-1); |
return(-1); |
}else { } |
}else { } |
} |
} |
Line 1450 struct object KSdupErrors() { |
|
Line 1517 struct object KSdupErrors() { |
|
} |
} |
return(rob); |
return(rob); |
} |
} |
|
|
|
void cancelAlarm() { |
|
alarm((unsigned int) 0); |
|
signal(SIGALRM,SIG_DFL); |
|
} |
|
|
|
/* back-trace */ |
|
#define TraceNameStackSize 3000 |
|
char *TraceNameStack[TraceNameStackSize]; |
|
int TraceNameStackp = 0; |
|
void tracePushName(char *s) { |
|
char *t; |
|
/* |
|
t = (char *)sGC_malloc(strlen(s)+1); |
|
if (t == NULL) { |
|
fprintf(stderr,"No more memory.\n"); return; |
|
} |
|
strcpy(t,s); |
|
*/ |
|
t = s; |
|
TraceNameStack[TraceNameStackp++] = t; |
|
if (TraceNameStackp >= TraceNameStackSize) { |
|
fprintf(stderr,"Warning: TraceNameStack overflow. Clearing the stack.\n"); |
|
TraceNameStackp = 0; |
|
} |
|
} |
|
void traceClearStack(void) { |
|
TraceNameStackp = 0; |
|
} |
|
char *tracePopName(void) { |
|
if (TraceNameStackp <= 0) return (char *) NULL; |
|
return TraceNameStack[--TraceNameStackp]; |
|
} |
|
#define TRACE_MSG_SIZE 320 |
|
char *traceShowStack(void) { |
|
char *s; |
|
char *t; |
|
int p; |
|
s = (char *) sGC_malloc(TRACE_MSG_SIZE); |
|
if (s == NULL) { |
|
fprintf(stderr,"No more memory.\n"); return NULL; |
|
} |
|
sprintf(s,"Trace: "); |
|
p = strlen(s); |
|
do { |
|
t = tracePopName(); |
|
if (t == NULL) { |
|
s[p] = ';'; s[p+1] = 0; |
|
break; |
|
}else if ((strlen(t) + p -10) > TRACE_MSG_SIZE) { |
|
/* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */ |
|
strcpy(&(s[p])," ..."); |
|
break; |
|
} |
|
strcpy(&(s[p]),t); p += strlen(t); |
|
strcpy(&(s[p]),"<-"); p += 2; |
|
} while (t != (char *)NULL); |
|
fprintf(stderr,"%s\n",s); |
|
return s; |
|
} |