version 1.9, 2002/02/24 10:27:18 |
version 1.16, 2004/09/05 00:51:17 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.8 2001/12/19 23:39:53 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.15 2004/09/04 11:25:58 takayama Exp $ */ |
/* stackmachin.c */ |
/* stackmachin.c */ |
|
|
#include <stdio.h> |
#include <stdio.h> |
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; |
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(); |
|
|
Line 815 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; |
Line 893 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 942 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) { |
|
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); |
|
if (status == 0) 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 1004 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 1037 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 1108 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{ |
Line 1124 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 1470 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; |
|
} |