version 1.20, 2004/09/11 23:49:34 |
version 1.41, 2016/03/31 05:27:34 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.19 2004/09/11 12:13:41 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.40 2016/03/31 03:22:54 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 52 struct context *CurrentContextp = &StandardContext; |
|
Line 64 struct context *CurrentContextp = &StandardContext; |
|
struct context *PrimitiveContextp = &StandardContext; |
struct context *PrimitiveContextp = &StandardContext; |
|
|
|
|
static struct object ObjTmp; /* for poor compiler */ |
static struct object ObjTmp = OINIT; /* for poor compiler */ |
|
|
int Calling_ctrlC_hook = 0; |
int Calling_ctrlC_hook = 0; |
|
|
Line 74 static strToInteger(char *); |
|
Line 86 static strToInteger(char *); |
|
static power(int s,int i); |
static 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); |
|
|
extern int SerialCurrent; |
extern int SerialCurrent; |
extern int QuoteMode; |
extern int QuoteMode; |
Line 86 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 94 struct object * newObject() |
|
Line 111 struct object * newObject() |
|
r->tag = 0; |
r->tag = 0; |
(r->lc).ival = 0; |
(r->lc).ival = 0; |
(r->rc).ival = 0; |
(r->rc).ival = 0; |
|
r->attr = NULL; |
return(r); |
return(r); |
} |
} |
|
|
struct object newObjectArray(size) |
struct object newObjectArray(size) |
int size; |
int size; |
{ |
{ |
struct object rob; |
struct object rob = OINIT; |
struct object *op; |
struct object *op; |
if (size < 0) return(NullObject); |
if (size < 0) return(NullObject); |
if (size > 0) { |
if (size > 0) { |
Line 295 int putUserDictionary2(str,h0,h1,attr,dic) |
|
Line 313 int putUserDictionary2(str,h0,h1,attr,dic) |
|
} |
} |
return(0); |
return(0); |
} |
} |
|
if (OR_ATTR_FOR_ALL_WORDS & attr) { |
|
for (i=0; i<USER_DICTIONARY_SIZE; i++) { |
|
if ((dic[i]).key !=EMPTY) (dic[i]).attr |= attr&(~OR_ATTR_FOR_ALL_WORDS); |
|
} |
|
return(0); |
|
} |
x = h0; |
x = h0; |
if (str[0] == '\0') { |
if (str[0] == '\0') { |
errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key."); |
errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key."); |
Line 316 int putPrimitiveFunction(str,number) |
|
Line 340 int putPrimitiveFunction(str,number) |
|
char *str; |
char *str; |
int number; |
int number; |
{ |
{ |
struct object ob; |
struct object ob = OINIT; |
ob.tag = Soperator; |
ob.tag = Soperator; |
ob.lc.ival = number; |
ob.lc.ival = number; |
return(putSystemDictionary(str,ob)); |
return(putSystemDictionary(str,ob)); |
Line 458 struct object peek(k) |
|
Line 482 struct object peek(k) |
|
} |
} |
} |
} |
|
|
|
static int isThereExecutableArray(struct object ob) { |
|
int n,i; |
|
struct object otmp = OINIT; |
|
if (ob.tag == SexecutableArray) return(1); |
|
if (ob.tag == Sarray) { |
|
n = getoaSize(ob); |
|
for (i=0; i<n; i++) { |
|
otmp = getoa(ob,i); |
|
if (isThereExecutableArray(otmp)) return(1); |
|
} |
|
return(0); |
|
} |
|
/* Class and list is not checked, since there is no parser |
|
to directory translte these objects. */ |
|
return(0); |
|
} |
|
static int isThereExecutableArrayOnStack(int n) { |
|
int i; |
|
struct object ob = OINIT; |
|
for (i=0; i<n; i++) { |
|
if (Osp-i-1 < 0) return(0); |
|
ob = peek(i); |
|
if (isThereExecutableArray(ob)) return(1); |
|
} |
|
return(0); |
|
} |
|
|
struct object newOperandStack(int size) |
struct object newOperandStack(int size) |
{ |
{ |
struct operandStack *os ; |
struct operandStack *os ; |
struct object ob; |
struct object ob = OINIT; |
os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack)); |
os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack)); |
if (os == (void *)NULL) errorStackmachine("No more memory."); |
if (os == (void *)NULL) errorStackmachine("No more memory."); |
if (size <= 0) errorStackmachine("Size of stack must be more than 1."); |
if (size <= 0) errorStackmachine("Size of stack must be more than 1."); |
Line 543 void KsetContext(struct object contextObj) { |
|
Line 593 void KsetContext(struct object contextObj) { |
|
|
|
|
|
struct object getSuperContext(struct object contextObj) { |
struct object getSuperContext(struct object contextObj) { |
struct object rob; |
struct object rob = OINIT; |
struct context *cp; |
struct context *cp; |
if (contextObj.tag != Sclass) { |
if (contextObj.tag != Sclass) { |
errorStackmachine("Usage:supercontext"); |
errorStackmachine("Usage:supercontext"); |
Line 609 int isLiteral(str) |
|
Line 659 int isLiteral(str) |
|
|
|
void printOperandStack() { |
void printOperandStack() { |
int i; |
int i; |
struct object ob; |
struct object ob = OINIT; |
int vs; |
int vs; |
vs = VerboseStack; VerboseStack = 2; |
vs = VerboseStack; VerboseStack = 2; |
for (i=Osp-1; i>=0; i--) { |
for (i=Osp-1; i>=0; i--) { |
Line 645 struct object showSystemDictionary(int f) { |
|
Line 695 struct object showSystemDictionary(int f) { |
|
int maxl; |
int maxl; |
char format[1000]; |
char format[1000]; |
int nl; |
int nl; |
struct object rob; |
struct object rob = OINIT; |
rob = NullObject; |
rob = NullObject; |
if (f != 0) { |
if (f != 0) { |
rob = newObjectArray(Sdp); |
rob = newObjectArray(Sdp); |
Line 718 static struct object executableStringToExecutableArray |
|
Line 768 static struct object executableStringToExecutableArray |
|
char *s; |
char *s; |
{ |
{ |
struct tokens *tokenArray; |
struct tokens *tokenArray; |
struct object ob; |
struct object ob = OINIT; |
int i; |
int i; |
int size; |
int size; |
tokenArray = decomposeToTokens(s,&size); |
tokenArray = decomposeToTokens(s,&size); |
Line 737 static struct object executableStringToExecutableArray |
|
Line 787 static struct object executableStringToExecutableArray |
|
/**************** stack machine **************************/ |
/**************** stack machine **************************/ |
void scanner() { |
void scanner() { |
struct tokens token; |
struct tokens token; |
struct object ob; |
struct object ob = OINIT; |
extern int Quiet; |
extern int Quiet; |
extern void ctrlC(); |
extern void ctrlC(); |
int tmp; |
int tmp, status; |
char *tmp2; |
char *tmp2; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
int jval; |
int jval; |
extern int InSendmsg2; |
extern int InSendmsg2; |
|
int infixOn = 0; |
|
struct tokens infixToken; |
|
extern int RestrictedMode, RestrictedMode_saved; |
getokenSM(INIT); |
getokenSM(INIT); |
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 */ |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
if (Quiet) { |
if (Quiet) { |
token.token = " /@@@.quiet 1 def "; |
token.token = " /@@@.quiet 1 def "; |
}else { |
}else { |
token.token = " /@@@.quiet 0 def "; |
token.token = " /@@@.quiet 0 def "; |
} |
} |
executeToken(token); /* execute startup commands */ |
executeToken(token); /* execute startup commands */ |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* set hashing values */ |
token = lookupTokens(token); /* set hashing values */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 785 void scanner() { |
|
Line 838 void scanner() { |
|
StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+ |
StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+ |
40)); |
40)); |
sprintf(StartFile,"$%s$ run\n",tmp2); |
sprintf(StartFile,"$%s$ run\n",tmp2); |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
token.token = StartFile; |
token.token = StartFile; |
executeToken(token); /* execute startup commands */ |
executeToken(token); /* execute startup commands */ |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* set hashing values */ |
token = lookupTokens(token); /* set hashing values */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 798 void scanner() { |
|
Line 851 void scanner() { |
|
} |
} |
|
|
if (StartAString) { |
if (StartAString) { |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
token.token = StartString; |
token.token = StartString; |
executeToken(token); /* execute startup commands */ |
executeToken(token); /* execute startup commands */ |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* set hashing values */ |
token = lookupTokens(token); /* set hashing values */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 813 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) { |
Line 828 void scanner() { |
|
Line 881 void scanner() { |
|
fprintf(Fstack,"\nscanner> "); |
fprintf(Fstack,"\nscanner> "); |
} |
} |
if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */ |
if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */ |
Calling_ctrlC_hook = 1; |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
RestrictedMode = RestrictedMode_saved; |
} |
} |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */ |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */ |
InSendmsg2 = 0; |
InSendmsg2 = 0; |
|
infixOn = 0; |
continue ; |
continue ; |
} else { } |
} else { } |
if (DebugStack >= 1) { printOperandStack(); } |
if (DebugStack >= 1) { printOperandStack(); } |
token = getokenSM(GET); |
token = getokenSM(GET); |
if ((tmp=executeToken(token)) < 0) break; |
if ((status=executeToken(token)) < 0) break; |
/***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/ |
/***if (status == 1) fprintf(stderr," --- exit --- \n");*/ |
|
/* fprintf(stderr,"token.token=%s, status=%d, infixOn=%d\n",token.token,status,infixOn); */ |
|
if (status & STATUS_INFIX) { |
|
infixOn = 1; infixToken = token; infixToken.tflag |= NO_DELAY; |
|
}else if (infixOn) { |
|
infixOn = 0; |
|
if ((status=executeToken(infixToken)) < 0) break; |
|
} |
} |
} |
} |
} |
|
|
|
|
extern int SGClock; |
extern int SGClock; |
extern int UserCtrlC; |
extern int UserCtrlC; |
extern int OXlock; |
extern int OXlock; |
|
extern int RestrictedMode, RestrictedMode_saved; |
|
|
signal(sig,SIG_IGN); |
mysignal(sig,SIG_IGN); |
/* see 133p */ |
/* see 133p */ |
|
RestrictedMode = RestrictedMode_saved; |
cancelAlarm(); |
cancelAlarm(); |
if (sig == SIGALRM) { |
if (sig == SIGALRM) { |
fprintf(stderr,"ctrlC by SIGALRM\n"); |
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(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 |
} |
} |
|
|
int executeToken(token) |
int executeToken(token) |
struct tokens token; |
struct tokens token; |
{ |
{ |
struct object ob; |
struct object ob = OINIT; |
int primitive; |
int primitive; |
int size; |
int size; |
int status; |
int status; |
struct tokens *tokenArray; |
|
int i,h0,h1; |
int i,h0,h1; |
extern int WarningMessageMode; |
extern int WarningMessageMode; |
extern int Strict; |
extern int Strict; |
extern int InSendmsg2; |
extern int InSendmsg2; |
|
extern int RestrictedMode, RestrictedMode_saved; |
|
int localRestrictedMode_saved; |
|
|
|
localRestrictedMode_saved = 0; |
if (GotoP) { /* for goto */ |
if (GotoP) { /* for goto */ |
if (token.kind == ID && isLiteral(token.token)) { |
if (token.kind == ID && isLiteral(token.token)) { |
if (strcmp(&((token.token)[1]),GotoLabel) == 0) { |
if (strcmp(&((token.token)[1]),GotoLabel) == 0) { |
Line 964 int executeToken(token) |
|
Line 1030 int executeToken(token) |
|
h1 = ((token.object.lc.op)->rc).ival; |
h1 = ((token.object.lc.op)->rc).ival; |
ob=findUserDictionary(token.token,h0,h1,CurrentContextp); |
ob=findUserDictionary(token.token,h0,h1,CurrentContextp); |
primitive = ((token.object.rc.op)->lc).ival; |
primitive = ((token.object.rc.op)->lc).ival; |
|
if (!(token.tflag & NO_DELAY)) { |
|
if ((ob.tag >= 0) && (UD_attr & ATTR_INFIX)) { |
|
return STATUS_INFIX; |
|
} |
|
} |
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); |
if (RestrictedMode) { |
tokenArray = ob.lc.tokenArray; |
if (UD_attr & ATTR_EXPORT) { |
size = ob.rc.ival; |
localRestrictedMode_saved = RestrictedMode; RestrictedMode = 0; |
for (i=0; i<size; i++) { |
if (isThereExecutableArrayOnStack(5)) { |
status = executeToken(tokenArray[i]); |
int i; |
if (status != 0) { |
for (i=0; i<5; i++) { (void) Kpop(); } |
tracePopName(); return(status); |
errorStackmachine("Executable array is on the argument stack (restricted mode). They are automatically removed.\n"); |
} |
} |
|
}else{ |
|
tracePushName(token.token); |
|
errorStackmachine("You cannot execute this function in restricted mode.\n"); |
|
} |
} |
} |
tracePopName(); |
|
|
status = executeExecutableArray(ob,token.token,0); |
|
|
|
if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved; |
|
if ((status & STATUS_BREAK) || (status < 0)) return status; |
}else { |
}else { |
Kpush(ob); |
Kpush(ob); |
} |
} |
Line 996 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 1043 errorStackmachine(str) |
|
Line 1125 errorStackmachine(str) |
|
char message0[1024]; |
char message0[1024]; |
char *message; |
char *message; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
|
extern int 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 1077 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 1087 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 1115 KSexecuteString(s) |
|
Line 1203 KSexecuteString(s) |
|
char *s; |
char *s; |
{ |
{ |
struct tokens token; |
struct tokens token; |
struct object ob; |
struct object ob = OINIT; |
int tmp; |
int tmp; |
extern int CatchCtrlC; |
extern int CatchCtrlC; |
int jval; |
int jval; |
Line 1125 KSexecuteString(s) |
|
Line 1213 KSexecuteString(s) |
|
jmp_buf saved_EnvOfStackMachine; |
jmp_buf saved_EnvOfStackMachine; |
void (*sigfunc)(); |
void (*sigfunc)(); |
int localCatchCtrlC ; |
int localCatchCtrlC ; |
|
extern int RestrictedMode, RestrictedMode_saved; |
|
|
localCatchCtrlC = CatchCtrlC; |
localCatchCtrlC = CatchCtrlC; |
/* If CatchCtrlC is rewrited in this program, |
/* If CatchCtrlC is rewrited in this program, |
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 1149 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; |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
RestrictedMode_saved; |
} |
} |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
Line 1161 KSexecuteString(s) |
|
Line 1251 KSexecuteString(s) |
|
}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 1171 KSexecuteString(s) |
|
Line 1261 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; |
Calling_ctrlC_hook = 1; RestrictedMode = 0; |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
|
RestrictedMode = RestrictedMode_saved; |
} |
} |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
Calling_ctrlC_hook = 0; |
Line 1186 KSexecuteString(s) |
|
Line 1277 KSexecuteString(s) |
|
|
|
recursive++; |
recursive++; |
token.token = s; |
token.token = s; |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
executeToken(token); |
executeToken(token); |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* no use */ |
token = lookupTokens(token); /* no use */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 1197 KSexecuteString(s) |
|
Line 1288 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() { |
KSdefineMacros() { |
struct tokens token; |
struct tokens token; |
int tmp; |
int tmp; |
struct object ob; |
struct object ob = OINIT; |
|
|
if (StandardMacros && (strlen(SMacros))) { |
if (StandardMacros && (strlen(SMacros))) { |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
token.token = SMacros; |
token.token = SMacros; |
executeToken(token); /* execute startup commands */ |
executeToken(token); /* execute startup commands */ |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* no use */ |
token = lookupTokens(token); /* no use */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 1225 KSdefineMacros() { |
|
Line 1316 KSdefineMacros() { |
|
void KSstart() { |
void KSstart() { |
struct tokens token; |
struct tokens token; |
int tmp; |
int tmp; |
struct object ob; |
struct object ob = OINIT; |
extern int Quiet; |
extern int Quiet; |
|
|
stackmachine_init(); KinitKan(); |
stackmachine_init(); KinitKan(); |
Line 1234 void KSstart() { |
|
Line 1325 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 { } */ |
|
|
/* setup quiet mode or not */ |
/* setup quiet mode or not */ |
token.kind = EXECUTABLE_STRING; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
if (Quiet) { |
if (Quiet) { |
token.token = " /@@@.quiet 1 def "; |
token.token = " /@@@.quiet 1 def "; |
}else { |
}else { |
token.token = " /@@@.quiet 0 def "; |
token.token = " /@@@.quiet 0 def "; |
} |
} |
executeToken(token); /* execute startup commands */ |
executeToken(token); /* execute startup commands */ |
token.kind = ID; |
token.kind = ID; token.tflag = 0; |
token.token = "exec"; |
token.token = "exec"; |
token = lookupTokens(token); /* set hashing values */ |
token = lookupTokens(token); /* set hashing values */ |
tmp = findSystemDictionary(token.token); |
tmp = findSystemDictionary(token.token); |
Line 1279 struct object KSpeek(k) { |
|
Line 1370 struct object KSpeek(k) { |
|
|
|
char *KSstringPop() { |
char *KSstringPop() { |
/* pop a string */ |
/* pop a string */ |
struct object rob; |
struct object rob = OINIT; |
rob = Kpop(); |
rob = Kpop(); |
if (rob.tag == Sdollar) { |
if (rob.tag == Sdollar) { |
return(rob.lc.str); |
return(rob.lc.str); |
Line 1319 char *KSpopBinary(int *size) { |
|
Line 1410 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 1349 struct object popErrorStack(void) { |
|
Line 1444 struct object popErrorStack(void) { |
|
} |
} |
|
|
char *popErrorStackByString(void) { |
char *popErrorStackByString(void) { |
struct object obj; |
struct object obj = OINIT; |
struct object eobj; |
struct object eobj = OINIT; |
eobj = popErrorStack(); |
eobj = popErrorStack(); |
if (ectag(eobj) != CLASSNAME_ERROR_PACKET) { |
if (ectag(eobj) != CLASSNAME_ERROR_PACKET) { |
return(NULL); |
return(NULL); |
Line 1379 int KScheckErrorStack(void) |
|
Line 1474 int KScheckErrorStack(void) |
|
|
|
struct object KnewErrorPacket(int serial,int no,char *message) |
struct object KnewErrorPacket(int serial,int no,char *message) |
{ |
{ |
struct object obj; |
struct object obj = OINIT; |
struct object *myop; |
struct object *myop; |
char *s; |
char *s; |
/* Set extended tag. */ |
/* Set extended tag. */ |
Line 1401 struct object KnewErrorPacket(int serial,int no,char * |
|
Line 1496 struct object KnewErrorPacket(int serial,int no,char * |
|
|
|
struct object KnewErrorPacketObj(struct object ob1) |
struct object KnewErrorPacketObj(struct object ob1) |
{ |
{ |
struct object obj; |
struct object obj = OINIT; |
struct object *myop; |
struct object *myop; |
char *s; |
char *s; |
/* Set extended tag. */ |
/* Set extended tag. */ |
Line 1500 int KSstackPointer() { |
|
Line 1595 int KSstackPointer() { |
|
} |
} |
|
|
struct object KSdupErrors() { |
struct object KSdupErrors() { |
struct object rob; |
struct object rob = OINIT; |
struct object ob; |
struct object ob = OINIT; |
int i; |
int i; |
int n; |
int n; |
int m; |
int m; |
Line 1528 struct object KSdupErrors() { |
|
Line 1623 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 1558 char *tracePopName(void) { |
|
Line 1653 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) { |
char *s; |
char *s; |
Line 1574 char *traceShowStack(void) { |
|
Line 1680 char *traceShowStack(void) { |
|
if (t == NULL) { |
if (t == NULL) { |
s[p] = ';'; s[p+1] = 0; |
s[p] = ';'; s[p+1] = 0; |
break; |
break; |
}else if ((strlen(t) + p -10) > TRACE_MSG_SIZE) { |
}else if ((strlen(t) + p) > (TRACE_MSG_SIZE-10)) { |
/* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */ |
/* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */ |
strcpy(&(s[p])," ..."); |
strcpy(&(s[p])," ..."); |
break; |
break; |
} |
} |
Line 1584 char *traceShowStack(void) { |
|
Line 1690 char *traceShowStack(void) { |
|
} while (t != (char *)NULL); |
} while (t != (char *)NULL); |
fprintf(stderr,"%s\n",s); |
fprintf(stderr,"%s\n",s); |
return s; |
return s; |
|
} |
|
|
|
/* |
|
if (fname != NULL) fname is pushed to the trace stack. |
|
*/ |
|
int executeExecutableArray(struct object ob,char *fname,int withGotoP) { |
|
struct tokens *tokenArray; |
|
int size,i; |
|
int status; |
|
int infixOn; |
|
struct tokens infixToken; |
|
extern int GotoP; |
|
|
|
infixOn = 0; |
|
if (ob.tag != SexecutableArray) errorStackmachine("Error (executeTokenArray): the argument is not a token array."); |
|
|
|
if (fname != NULL) tracePushName(fname); |
|
tokenArray = ob.lc.tokenArray; |
|
size = ob.rc.ival; |
|
for (i=0; i<size; i++) { |
|
status = executeToken(tokenArray[i]); |
|
if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) { |
|
if (fname != NULL) tracePopName(); |
|
return(status); |
|
} |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("Infix operator at the end of an executable array."); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; |
|
continue; |
|
}else if (infixOn) { |
|
infixOn = 0; |
|
status = executeToken(infixToken); |
|
if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) { |
|
if (fname != NULL) tracePopName(); |
|
return(status); |
|
} |
|
} |
|
} |
|
if (fname != NULL) tracePopName(); |
|
return(0); /* normal exit */ |
} |
} |