=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/stackmachine.c,v retrieving revision 1.11 retrieving revision 1.33 diff -u -p -r1.11 -r1.33 --- OpenXM/src/kan96xx/Kan/stackmachine.c 2002/11/04 11:08:59 1.11 +++ OpenXM/src/kan96xx/Kan/stackmachine.c 2005/07/18 10:55:16 1.33 @@ -1,7 +1,9 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.10 2002/11/04 10:53:56 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.32 2005/07/03 11:08:54 ohara Exp $ */ /* stackmachin.c */ #include +#include +#include #include "datatype.h" #include "stackm.h" #include "extern.h" @@ -52,8 +54,10 @@ struct context *CurrentContextp = &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 StandardMacros = 1; int StartAFile = 0; char *StartFile; @@ -72,14 +76,22 @@ static strToInteger(char *); static power(int s,int i); static void pstack(void); static struct object executableStringToExecutableArray(char *str); +static int isThereExecutableArrayOnStack(int n); extern int SerialCurrent; +extern int QuoteMode; int SGClock = 0; int UserCtrlC = 0; int OXlock = 0; int OXlockSaved = 0; +char *UD_str; +int UD_attr; + +char *MsgStackTrace = NULL; +char *MsgSourceTrace = NULL; + struct object * newObject() { struct object *r; @@ -88,13 +100,14 @@ struct object * newObject() r->tag = 0; (r->lc).ival = 0; (r->rc).ival = 0; + r->attr = NULL; return(r); } struct object newObjectArray(size) int size; { - struct object rob; + struct object rob = OINIT; struct object *op; if (size < 0) return(NullObject); if (size > 0) { @@ -215,7 +228,7 @@ int putUserDictionary(str,h0,h1,ob,dic) } r = x; if (Strict2) { - switch((dic[x]).attr) { + switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) { case PROTECT: r = -PROTECT; /* Protected, but we rewrite it. */ break; @@ -223,7 +236,7 @@ int putUserDictionary(str,h0,h1,ob,dic) r = -ABSOLUTE_PROTECT; /* Protected and we do not rewrite it. */ return(r); default: - (dic[x]).attr = 0; + /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */ break; } } @@ -246,14 +259,19 @@ struct object findUserDictionary(str,h0,h1,cp) char *str; /* key */ int h0,h1; /* The hashing values of the key. */ struct context *cp; + /* Set char *UD_str, int UD_attr (attributes) */ { int x; struct dictionary *dic; + extern char *UD_str; + extern int UD_attr; + UD_str = NULL; UD_attr = -1; dic = cp->userDictionary; x = h0; while (1) { if ((dic[x]).key == EMPTY) { break; } if (strcmp((dic[x]).key,str) == 0) { + UD_str = (dic[x]).key; UD_attr = (dic[x]).attr; return( (dic[x]).obj ); } x = (x+h1) % USER_DICTIONARY_SIZE; @@ -284,6 +302,12 @@ int putUserDictionary2(str,h0,h1,attr,dic) } return(0); } + if (OR_ATTR_FOR_ALL_WORDS & attr) { + for (i=0; i=0; i--) { @@ -634,7 +684,7 @@ struct object showSystemDictionary(int f) { int maxl; char format[1000]; int nl; - struct object rob; + struct object rob = OINIT; rob = NullObject; if (f != 0) { rob = newObjectArray(Sdp); @@ -707,7 +757,7 @@ static struct object executableStringToExecutableArray char *s; { struct tokens *tokenArray; - struct object ob; + struct object ob = OINIT; int i; int size; tokenArray = decomposeToTokens(s,&size); @@ -726,13 +776,17 @@ static struct object executableStringToExecutableArray /**************** stack machine **************************/ void scanner() { struct tokens token; - struct object ob; + struct object ob = OINIT; extern int Quiet; extern void ctrlC(); - int tmp; + int tmp, status; char *tmp2; extern int ErrorMessageMode; int jval; + extern int InSendmsg2; + int infixOn = 0; + struct tokens infixToken; + extern int RestrictedMode, RestrictedMode_saved; getokenSM(INIT); initSystemDictionary(); @@ -750,14 +804,14 @@ void scanner() { } /* setup quiet mode or not */ - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; if (Quiet) { token.token = " /@@@.quiet 1 def "; }else { token.token = " /@@@.quiet 0 def "; } executeToken(token); /* execute startup commands */ - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* set hashing values */ tmp = findSystemDictionary(token.token); @@ -773,10 +827,10 @@ void scanner() { StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+ 40)); sprintf(StartFile,"$%s$ run\n",tmp2); - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; token.token = StartFile; executeToken(token); /* execute startup commands */ - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* set hashing values */ tmp = findSystemDictionary(token.token); @@ -786,10 +840,10 @@ void scanner() { } if (StartAString) { - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; token.token = StartString; executeToken(token); /* execute startup commands */ - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* set hashing values */ tmp = findSystemDictionary(token.token); @@ -815,14 +869,28 @@ void scanner() { if (DebugStack >= 1) { fprintf(Fstack,"\nscanner> "); } - KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ - KSexecuteString(" (Computation is interrupted.) "); + if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */ + Calling_ctrlC_hook = 1; RestrictedMode = 0; + KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ + RestrictedMode = RestrictedMode_saved; + } + Calling_ctrlC_hook = 0; + KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */ + InSendmsg2 = 0; + infixOn = 0; continue ; } else { } if (DebugStack >= 1) { printOperandStack(); } - token = getokenSM(GET); - if ((tmp=executeToken(token)) < 0) break; - /***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/ + token = getokenSM(GET); + if ((status=executeToken(token)) < 0) break; + /***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; + } } } @@ -835,9 +903,11 @@ void ctrlC(sig) extern int SGClock; extern int UserCtrlC; extern int OXlock; - + extern int RestrictedMode, RestrictedMode_saved; + signal(sig,SIG_IGN); /* see 133p */ + RestrictedMode = RestrictedMode_saved; cancelAlarm(); if (sig == SIGALRM) { fprintf(stderr,"ctrlC by SIGALRM\n"); @@ -863,9 +933,11 @@ void ctrlC(sig) return; } if (ErrorMessageMode != 1) { + (void *) traceShowStack(); 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"); } + traceClearStack(); if (GotoP) { fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel); GotoP = 0; @@ -890,15 +962,18 @@ void ctrlC(sig) int executeToken(token) struct tokens token; { - struct object ob; + struct object ob = OINIT; int primitive; int size; int status; - struct tokens *tokenArray; int i,h0,h1; extern int WarningMessageMode; extern int Strict; + extern int InSendmsg2; + extern int RestrictedMode, RestrictedMode_saved; + int localRestrictedMode_saved; + localRestrictedMode_saved = 0; if (GotoP) { /* for goto */ if (token.kind == ID && isLiteral(token.token)) { if (strcmp(&((token.token)[1]),GotoLabel) == 0) { @@ -944,24 +1019,51 @@ int executeToken(token) h1 = ((token.object.lc.op)->rc).ival; ob=findUserDictionary(token.token,h0,h1,CurrentContextp); 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) { /* there is a definition in the user dictionary */ if (ob.tag == SexecutableArray) { - tokenArray = ob.lc.tokenArray; - size = ob.rc.ival; - for (i=0; i>. It is also aborted.\n",GotoLabel); GotoP = 0; @@ -1079,7 +1188,7 @@ KSexecuteString(s) char *s; { struct tokens token; - struct object ob; + struct object ob = OINIT; int tmp; extern int CatchCtrlC; int jval; @@ -1089,6 +1198,7 @@ KSexecuteString(s) jmp_buf saved_EnvOfStackMachine; void (*sigfunc)(); int localCatchCtrlC ; + extern int RestrictedMode, RestrictedMode_saved; localCatchCtrlC = CatchCtrlC; /* If CatchCtrlC is rewrited in this program, @@ -1114,8 +1224,13 @@ KSexecuteString(s) } recursive--; if (localCatchCtrlC) { signal(SIGINT, sigfunc); } - KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ - KSexecuteString(" (Computation is interrupted.) "); + if (!Calling_ctrlC_hook) { + Calling_ctrlC_hook = 1; RestrictedMode = 0; + KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ + RestrictedMode_saved; + } + Calling_ctrlC_hook = 0; + KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ return(-1); }else{ } }else{ @@ -1132,7 +1247,13 @@ KSexecuteString(s) } recursive = 0; if (localCatchCtrlC) { signal(SIGINT, sigfunc); } - KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ + if (!Calling_ctrlC_hook) { + Calling_ctrlC_hook = 1; RestrictedMode = 0; + KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ + RestrictedMode = RestrictedMode_saved; + } + Calling_ctrlC_hook = 0; + Calling_ctrlC_hook = 0; KSexecuteString(" (Computation is interrupted.) "); return(-1); }else { } @@ -1141,9 +1262,9 @@ KSexecuteString(s) recursive++; token.token = s; - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; executeToken(token); - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* no use */ tmp = findSystemDictionary(token.token); @@ -1159,13 +1280,13 @@ KSexecuteString(s) KSdefineMacros() { struct tokens token; int tmp; - struct object ob; + struct object ob = OINIT; if (StandardMacros && (strlen(SMacros))) { - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; token.token = SMacros; executeToken(token); /* execute startup commands */ - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* no use */ tmp = findSystemDictionary(token.token); @@ -1180,7 +1301,7 @@ KSdefineMacros() { void KSstart() { struct tokens token; int tmp; - struct object ob; + struct object ob = OINIT; extern int Quiet; stackmachine_init(); KinitKan(); @@ -1195,14 +1316,14 @@ void KSstart() { } else { } */ /* setup quiet mode or not */ - token.kind = EXECUTABLE_STRING; + token.kind = EXECUTABLE_STRING; token.tflag = 0; if (Quiet) { token.token = " /@@@.quiet 1 def "; }else { token.token = " /@@@.quiet 0 def "; } executeToken(token); /* execute startup commands */ - token.kind = ID; + token.kind = ID; token.tflag = 0; token.token = "exec"; token = lookupTokens(token); /* set hashing values */ tmp = findSystemDictionary(token.token); @@ -1234,7 +1355,7 @@ struct object KSpeek(k) { char *KSstringPop() { /* pop a string */ - struct object rob; + struct object rob = OINIT; rob = Kpop(); if (rob.tag == Sdollar) { return(rob.lc.str); @@ -1304,8 +1425,8 @@ struct object popErrorStack(void) { } char *popErrorStackByString(void) { - struct object obj; - struct object eobj; + struct object obj = OINIT; + struct object eobj = OINIT; eobj = popErrorStack(); if (ectag(eobj) != CLASSNAME_ERROR_PACKET) { return(NULL); @@ -1334,7 +1455,7 @@ int KScheckErrorStack(void) struct object KnewErrorPacket(int serial,int no,char *message) { - struct object obj; + struct object obj = OINIT; struct object *myop; char *s; /* Set extended tag. */ @@ -1356,7 +1477,7 @@ struct object KnewErrorPacket(int serial,int no,char * struct object KnewErrorPacketObj(struct object ob1) { - struct object obj; + struct object obj = OINIT; struct object *myop; char *s; /* Set extended tag. */ @@ -1455,8 +1576,8 @@ int KSstackPointer() { } struct object KSdupErrors() { - struct object rob; - struct object ob; + struct object rob = OINIT; + struct object ob = OINIT; int i; int n; int m; @@ -1484,4 +1605,101 @@ struct object KSdupErrors() { 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) > (TRACE_MSG_SIZE-10)) { + /* 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; +} + +/* + 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