| version 1.14, 2003/12/05 13:51:31 |
version 1.26, 2004/09/16 02:22:03 |
|
|
| /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.13 2003/11/20 09:20:36 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.25 2004/09/12 10:22:50 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 81 int UserCtrlC = 0; |
|
| Line 83 int UserCtrlC = 0; |
|
| int OXlock = 0; |
int OXlock = 0; |
| int OXlockSaved = 0; |
int OXlockSaved = 0; |
| |
|
| |
char *UD_str; |
| |
int UD_attr; |
| |
|
| struct object * newObject() |
struct object * newObject() |
| { |
{ |
| struct object *r; |
struct object *r; |
| Line 216 int putUserDictionary(str,h0,h1,ob,dic) |
|
| Line 221 int putUserDictionary(str,h0,h1,ob,dic) |
|
| } |
} |
| r = x; |
r = x; |
| if (Strict2) { |
if (Strict2) { |
| switch((dic[x]).attr) { |
switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) { |
| case PROTECT: |
case PROTECT: |
| r = -PROTECT; /* Protected, but we rewrite it. */ |
r = -PROTECT; /* Protected, but we rewrite it. */ |
| break; |
break; |
| Line 224 int putUserDictionary(str,h0,h1,ob,dic) |
|
| Line 229 int putUserDictionary(str,h0,h1,ob,dic) |
|
| r = -ABSOLUTE_PROTECT; /* Protected and we do not rewrite it. */ |
r = -ABSOLUTE_PROTECT; /* Protected and we do not rewrite it. */ |
| return(r); |
return(r); |
| default: |
default: |
| (dic[x]).attr = 0; |
/* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */ |
| break; |
break; |
| } |
} |
| } |
} |
| Line 247 struct object findUserDictionary(str,h0,h1,cp) |
|
| Line 252 struct object findUserDictionary(str,h0,h1,cp) |
|
| char *str; /* key */ |
char *str; /* key */ |
| int h0,h1; /* The hashing values of the key. */ |
int h0,h1; /* The hashing values of the key. */ |
| struct context *cp; |
struct context *cp; |
| |
/* Set char *UD_str, int UD_attr (attributes) */ |
| { |
{ |
| int x; |
int x; |
| struct dictionary *dic; |
struct dictionary *dic; |
| |
extern char *UD_str; |
| |
extern int UD_attr; |
| |
UD_str = NULL; UD_attr = -1; |
| dic = cp->userDictionary; |
dic = cp->userDictionary; |
| x = h0; |
x = h0; |
| while (1) { |
while (1) { |
| if ((dic[x]).key == EMPTY) { break; } |
if ((dic[x]).key == EMPTY) { break; } |
| if (strcmp((dic[x]).key,str) == 0) { |
if (strcmp((dic[x]).key,str) == 0) { |
| |
UD_str = (dic[x]).key; UD_attr = (dic[x]).attr; |
| return( (dic[x]).obj ); |
return( (dic[x]).obj ); |
| } |
} |
| x = (x+h1) % USER_DICTIONARY_SIZE; |
x = (x+h1) % USER_DICTIONARY_SIZE; |
|
|
| { |
{ |
| 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 730 void scanner() { |
|
| Line 740 void scanner() { |
|
| struct object ob; |
struct object ob; |
| 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; |
| getokenSM(INIT); |
getokenSM(INIT); |
| initSystemDictionary(); |
initSystemDictionary(); |
| |
|
| Line 752 void scanner() { |
|
| Line 764 void scanner() { |
|
| } |
} |
| |
|
| /* 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 775 void scanner() { |
|
| Line 787 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 788 void scanner() { |
|
| Line 800 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 817 void scanner() { |
|
| Line 829 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? */ |
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; |
| |
} |
| } |
} |
| } |
} |
| |
|
|
|
| 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 897 int executeToken(token) |
|
| Line 923 int executeToken(token) |
|
| 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; |
| Line 948 int executeToken(token) |
|
| Line 973 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) { |
| tokenArray = ob.lc.tokenArray; |
status = executeExecutableArray(ob,token.token,0); |
| size = ob.rc.ival; |
if ((status & STATUS_BREAK) || (status < 0)) return status; |
| for (i=0; i<size; i++) { |
|
| status = executeToken(tokenArray[i]); |
|
| if (status != 0) return(status); |
|
| } |
|
| }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 (QuoteMode) { |
| if (InSendmsg2) return(DO_QUOTE); |
if (InSendmsg2) return(DO_QUOTE); |
| Line 1054 errorStackmachine(str) |
|
| Line 1083 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 1125 KSexecuteString(s) |
|
| Line 1156 KSexecuteString(s) |
|
| } |
} |
| recursive--; |
recursive--; |
| if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
| KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
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?*/ |
KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/ |
| return(-1); |
return(-1); |
| }else{ } |
}else{ } |
| Line 1143 KSexecuteString(s) |
|
| Line 1178 KSexecuteString(s) |
|
| } |
} |
| recursive = 0; |
recursive = 0; |
| if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
if (localCatchCtrlC) { signal(SIGINT, sigfunc); } |
| KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */ |
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.) "); |
KSexecuteString(" (Computation is interrupted.) "); |
| return(-1); |
return(-1); |
| }else { } |
}else { } |
| Line 1152 KSexecuteString(s) |
|
| Line 1192 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 1173 KSdefineMacros() { |
|
| Line 1213 KSdefineMacros() { |
|
| struct object ob; |
struct object ob; |
| |
|
| 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 1206 void KSstart() { |
|
| Line 1246 void KSstart() { |
|
| } 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 1495 struct object KSdupErrors() { |
|
| Line 1535 struct object KSdupErrors() { |
|
| void cancelAlarm() { |
void cancelAlarm() { |
| alarm((unsigned int) 0); |
alarm((unsigned int) 0); |
| signal(SIGALRM,SIG_DFL); |
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<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 */ |
| } |
} |