| version 1.29, 2004/09/19 00:47:47 |
version 1.44, 2020/10/06 11:33:47 |
|
|
| /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.28 2004/09/17 02:42:57 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 <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 <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 |
| Line 52 struct context *CurrentContextp = &StandardContext; |
|
| Line 65 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; |
| |
|
|
|
| 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 87 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 95 struct object * newObject() |
|
| Line 113 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 116 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 323 int putPrimitiveFunction(str,number) |
|
| Line 342 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 384 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 405 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 426 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 467 struct object peek(k) |
|
| Line 486 struct object peek(k) |
|
| |
|
| static int isThereExecutableArray(struct object ob) { |
static int isThereExecutableArray(struct object ob) { |
| int n,i; |
int n,i; |
| struct object otmp; |
struct object otmp = OINIT; |
| if (ob.tag == SexecutableArray) return(1); |
if (ob.tag == SexecutableArray) return(1); |
| if (ob.tag == Sarray) { |
if (ob.tag == Sarray) { |
| n = getoaSize(ob); |
n = getoaSize(ob); |
| Line 483 static int isThereExecutableArray(struct object ob) { |
|
| Line 502 static int isThereExecutableArray(struct object ob) { |
|
| } |
} |
| static int isThereExecutableArrayOnStack(int n) { |
static int isThereExecutableArrayOnStack(int n) { |
| int i; |
int i; |
| struct object ob; |
struct object ob = OINIT; |
| for (i=0; i<n; i++) { |
for (i=0; i<n; i++) { |
| if (Osp-i-1 < 0) return(0); |
if (Osp-i-1 < 0) return(0); |
| ob = peek(i); |
ob = peek(i); |
| Line 495 static int isThereExecutableArrayOnStack(int n) { |
|
| Line 514 static int isThereExecutableArrayOnStack(int n) { |
|
| 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 576 void KsetContext(struct object contextObj) { |
|
| Line 595 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 642 int isLiteral(str) |
|
| Line 661 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 655 void printOperandStack() { |
|
| Line 674 void printOperandStack() { |
|
| |
|
| |
|
| |
|
| static initSystemDictionary() |
static int initSystemDictionary() |
| { |
{ |
| StandardStack.ostack = StandardStackA; |
StandardStack.ostack = StandardStackA; |
| StandardStack.sp = StandardStackP; |
StandardStack.sp = StandardStackP; |
| Line 678 struct object showSystemDictionary(int f) { |
|
| Line 697 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 751 static struct object executableStringToExecutableArray |
|
| Line 770 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 770 static struct object executableStringToExecutableArray |
|
| Line 789 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, status; |
int tmp, status; |
| Line 785 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 849 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 |
| } |
} |
| |
|
| 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; |
| Line 1058 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 1097 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 1108 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 1138 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 1151 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 1163 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 1175 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; |
| struct object ob; |
struct object ob = OINIT; |
| int tmp; |
int tmp; |
| extern int CatchCtrlC; |
extern int CatchCtrlC; |
| int jval; |
int jval; |
| Line 1196 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 1214 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 1222 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 1237 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 1246 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 1264 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; |
struct object ob = OINIT; |
| |
|
| if (StandardMacros && (strlen(SMacros))) { |
if (StandardMacros && (strlen(SMacros))) { |
| token.kind = EXECUTABLE_STRING; token.tflag = 0; |
token.kind = EXECUTABLE_STRING; token.tflag = 0; |
| Line 1289 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; |
| struct object ob; |
struct object ob = OINIT; |
| extern int Quiet; |
extern int Quiet; |
| |
|
| stackmachine_init(); KinitKan(); |
stackmachine_init(); KinitKan(); |
| Line 1301 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 1340 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)); |
| } |
} |
| |
|
| 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 1386 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 1416 struct object popErrorStack(void) { |
|
| Line 1451 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 1446 int KScheckErrorStack(void) |
|
| Line 1481 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 1468 struct object KnewErrorPacket(int serial,int no,char * |
|
| Line 1503 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 1567 int KSstackPointer() { |
|
| Line 1602 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 1595 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 1624 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) { |