[BACK]Return to stackmachine.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Annotation of OpenXM/src/kan96xx/Kan/stackmachine.c, Revision 1.39

1.39    ! takayama    1: /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.38 2015/09/29 01:52:14 takayama Exp $ */
1.1       maekawa     2: /*   stackmachin.c */
                      3:
                      4: #include <stdio.h>
1.32      ohara       5: #include <stdlib.h>
                      6: #include <string.h>
1.1       maekawa     7: #include "datatype.h"
                      8: #include "stackm.h"
                      9: #include "extern.h"
                     10: #include "gradedset.h"
                     11: #include "kclass.h"
                     12: #include <signal.h>
                     13: #include <sys/types.h>
                     14:
1.37      takayama   15: /* The msys2 seems to make a buffer overflow of  EnvOfStackmachine[].
                     16: The code
                     17: [(x) ring_of_differential_operators 11] define_ring
                     18: ( Dx*(x+Dx) ) /ff set
                     19: causes the segfault because Mp_zero is borken. Is it a bug of msys2?
                     20: Anyway, the following definition seems to be a workaround. 2015.09
                     21: Singnals do not work properly on msys2. (gcc -dM -E ... to see macros defs)
1.39    ! takayama   22: See stackm.h
1.37      takayama   23: */
1.1       maekawa    24:
                     25: /* #define OPERAND_STACK_SIZE  2000 */
                     26: #define OPERAND_STACK_SIZE 30000
                     27: #define SYSTEM_DICTIONARY_SIZE 200
1.8       takayama   28: /* #define USER_DICTIONARY_SIZE   1223, 3581, 27449 */
                     29: #define USER_DICTIONARY_SIZE  59359
1.1       maekawa    30: /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
                     31:    method */
                     32: #define ARGV_WORK_MAX  (AGLIMIT+100)
                     33: #define EMPTY (char *)NULL
                     34:
                     35:
                     36: /* global variables */
                     37: struct object StandardStackA[OPERAND_STACK_SIZE];
                     38: int StandardStackP = 0;
                     39: int StandardStackMax = OPERAND_STACK_SIZE;
                     40: struct operandStack StandardStack;
                     41: /* Initialization of operandStack will be done in initSystemDictionary(). */
                     42: #define ERROR_STACK_SIZE 100
                     43: struct object ErrorStackA[ERROR_STACK_SIZE];
                     44: int ErrorStackP = 0;
                     45: int ErrorStackMax = ERROR_STACK_SIZE;
                     46: struct operandStack ErrorStack;
                     47: /* Initialization of ErrorStack will be done in initSystemDictionary(). */
                     48:
                     49: struct operandStack *CurrentOperandStack = &StandardStack;
                     50: struct object *OperandStack = StandardStackA;
                     51: int Osp = 0;   /* OperandStack pointer */
                     52: int OspMax = OPERAND_STACK_SIZE;
                     53:
                     54: struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
                     55: int Sdp = 0;   /* SystemDictionary pointer */
                     56: struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
                     57:
                     58: struct context StandardContext ;
                     59: /* Initialization of StructContext will be done in initSystemDictionary(). */
                     60: /* hashInitialize is done in global.c (initStackmachine()) */
                     61: struct context *StandardContextp = &StandardContext;
                     62: struct context *CurrentContextp = &StandardContext;
                     63: struct context *PrimitiveContextp = &StandardContext;
                     64:
                     65:
1.31      takayama   66: static struct object ObjTmp = OINIT; /* for poor compiler */
1.1       maekawa    67:
1.16      takayama   68: int Calling_ctrlC_hook = 0;
                     69:
1.1       maekawa    70: int StandardMacros = 1;
                     71: int StartAFile = 0;
                     72: char *StartFile;
                     73:
                     74: int StartAString = 0;
                     75: char *StartString;
                     76:
                     77: char *GotoLabel = (char *)NULL;
                     78: int GotoP = 0;
                     79:
                     80: static char *SMacros =
                     81: #include "smacro.h"
                     82:
                     83: static isInteger(char *);
                     84: static strToInteger(char *);
                     85: static power(int s,int i);
                     86: static void pstack(void);
                     87: static struct object executableStringToExecutableArray(char *str);
1.29      takayama   88: static int isThereExecutableArrayOnStack(int n);
1.1       maekawa    89:
                     90: extern int SerialCurrent;
1.13      takayama   91: extern int QuoteMode;
1.1       maekawa    92:
                     93: int SGClock = 0;
                     94: int UserCtrlC = 0;
                     95: int OXlock = 0;
                     96: int OXlockSaved = 0;
                     97:
1.19      takayama   98: char *UD_str;
                     99: int  UD_attr;
                    100:
1.34      takayama  101: struct object *MsgStackTraceInArrayp = NULL;
1.33      takayama  102: char *MsgStackTrace = NULL;
                    103: char *MsgSourceTrace = NULL;
                    104:
1.1       maekawa   105: struct object * newObject()
                    106: {
                    107:   struct object *r;
                    108:   r = (struct object *)sGC_malloc(sizeof(struct object));
                    109:   if (r == (struct object *)NULL) errorStackmachine("No memory\n");
                    110:   r->tag = 0;
                    111:   (r->lc).ival = 0;
                    112:   (r->rc).ival = 0;
1.30      takayama  113:   r->attr = NULL;
1.1       maekawa   114:   return(r);
                    115: }
                    116:
                    117: struct object newObjectArray(size)
1.7       takayama  118:      int size;
1.1       maekawa   119: {
1.31      takayama  120:   struct object rob = OINIT;
1.1       maekawa   121:   struct object *op;
                    122:   if (size < 0) return(NullObject);
                    123:   if (size > 0) {
                    124:     op = (struct object *)sGC_malloc(size*sizeof(struct object));
                    125:     if (op == (struct object *)NULL) errorStackmachine("No memory\n");
                    126:   }else{
                    127:     op = (struct object *)NULL;
                    128:   }
                    129:   rob.tag = Sarray;
                    130:   rob.lc.ival = size;
                    131:   rob.rc.op = op;
                    132:   return(rob);
                    133: }
                    134:
                    135: isNullObject(obj)
1.7       takayama  136:      struct object obj;
1.1       maekawa   137: {
                    138:   if (obj.tag == 0) return(1);
                    139:   else return(0);
                    140: }
                    141:
                    142: int putSystemDictionary(str,ob)
1.7       takayama  143:      char *str;   /* key */
                    144:      struct object ob; /* value */
1.1       maekawa   145: {
                    146:   int i;
                    147:   int j;
                    148:   int flag = 0;
                    149:
                    150:   for (i = Sdp-1; i>=0; i--) {
                    151:     /*printf("Add %d %s\n",i,str);*/
                    152:     if (strcmp(str,(SystemDictionary[i]).key) > 0) {
                    153:       for (j=Sdp-1; j>=i+1; j--) {
1.7       takayama  154:         (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
                    155:         (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
1.1       maekawa   156:       }
                    157:       (SystemDictionary[i+1]).key = str;
                    158:       (SystemDictionary[i+1]).obj = ob;
                    159:       flag = 1;
                    160:       break;
                    161:     }
                    162:   }
                    163:   if (!flag) { /* str is the minimum element */
                    164:     for (j=Sdp-1; j>=0; j--) {
                    165:       (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
                    166:       (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
                    167:     }
                    168:     (SystemDictionary[0]).key = str;
                    169:     (SystemDictionary[0]).obj = ob;
                    170:   }
                    171:   Sdp++;
                    172:   if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
                    173:     warningStackmachine("No space for system dictionary area.\n");
                    174:     Sdp--;
                    175:     return(-1);
                    176:   }
                    177:   return(Sdp-1);
                    178: }
                    179:
                    180: int findSystemDictionary(str)
                    181:      /* only used for primitive functions */
                    182:      /* returns 0, if there is no item. */
                    183:      /* This function assumes that the dictionary is sorted by strcmp() */
                    184:      char *str;    /* key */
                    185: {
                    186:   int first,last,rr,middle;
                    187:
                    188:   /* binary search */
                    189:   first = 0; last = Sdp-1;
                    190:   while (1) {
                    191:     if (first > last) {
                    192:       return(0);
                    193:     } else if (first == last) {
                    194:       if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7       takayama  195:         return((SystemDictionary[first]).obj.lc.ival);
1.1       maekawa   196:       }else {
1.7       takayama  197:         return(0);
1.1       maekawa   198:       }
                    199:     } else if (last - first == 1) { /* This case is necessary */
                    200:       if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7       takayama  201:         return((SystemDictionary[first]).obj.lc.ival);
1.1       maekawa   202:       }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
1.7       takayama  203:         return((SystemDictionary[last]).obj.lc.ival);
1.1       maekawa   204:       }else return(0);
                    205:     }
                    206:
                    207:     middle = (first + last)/2;
                    208:     rr = strcmp(str,(SystemDictionary[middle]).key);
                    209:     if (rr < 0) { /* str < middle */
                    210:       last = middle;
                    211:     }else if (rr == 0) {
                    212:       return((SystemDictionary[middle]).obj.lc.ival);
                    213:     }else {       /* str > middle */
                    214:       first = middle;
                    215:     }
                    216:   }
                    217: }
                    218:
                    219: int putUserDictionary(str,h0,h1,ob,dic)
1.7       takayama  220:      char *str;   /* key */
                    221:      int h0,h1;   /* Hash values of the key */
                    222:      struct object ob; /* value */
                    223:      struct dictionary *dic;
1.1       maekawa   224: {
                    225:   int x,r;
                    226:   extern int Strict2;
                    227:   x = h0;
                    228:   if (str[0] == '\0') {
                    229:     errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
                    230:   }
                    231:   while (1) {
                    232:     if ((dic[x]).key == EMPTY) break;
                    233:     if (strcmp((dic[x]).key,str) == 0) break;
                    234:     x = (x+h1) % USER_DICTIONARY_SIZE;
                    235:     if (x == h0) {
                    236:       errorStackmachine("User dictionary is full. loop hashing.\n");
                    237:     }
                    238:   }
                    239:   r = x;
                    240:   if (Strict2) {
1.20      takayama  241:     switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) {
1.1       maekawa   242:     case PROTECT:
                    243:       r = -PROTECT;   /* Protected, but we rewrite it. */
                    244:       break;
                    245:     case ABSOLUTE_PROTECT:
                    246:       r = -ABSOLUTE_PROTECT;  /* Protected and we do not rewrite it. */
                    247:       return(r);
                    248:     default:
1.20      takayama  249:       /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */
1.1       maekawa   250:       break;
                    251:     }
                    252:   }
                    253:   (dic[x]).key = str;
                    254:   (dic[x]).obj = ob;
                    255:   (dic[x]).h0 = h0;
                    256:   (dic[x]).h1 = h1;
                    257:   return(r);
                    258: }
                    259:
                    260: struct object KputUserDictionary(char *str,struct object ob)
                    261: {
                    262:   int r;
                    263:   r = putUserDictionary(str,hash0(str),hash1(str),ob,CurrentContextp->userDictionary);
                    264:   return(KpoInteger(r));
                    265: }
                    266:
                    267: struct object findUserDictionary(str,h0,h1,cp)
1.7       takayama  268:      /* returns NoObject, if there is no item. */
                    269:      char *str;    /* key */
                    270:      int h0,h1;    /* The hashing values of the key. */
                    271:      struct context *cp;
1.19      takayama  272:         /* Set char *UD_str, int UD_attr (attributes) */
1.1       maekawa   273: {
                    274:   int x;
                    275:   struct dictionary *dic;
1.19      takayama  276:   extern char *UD_str;
                    277:   extern int UD_attr;
                    278:   UD_str = NULL; UD_attr = -1;
1.1       maekawa   279:   dic = cp->userDictionary;
                    280:   x = h0;
                    281:   while (1) {
                    282:     if ((dic[x]).key == EMPTY) { break; }
                    283:     if (strcmp((dic[x]).key,str) == 0) {
1.19      takayama  284:          UD_str = (dic[x]).key; UD_attr = (dic[x]).attr;
1.1       maekawa   285:       return( (dic[x]).obj );
                    286:     }
                    287:     x = (x+h1) % USER_DICTIONARY_SIZE;
                    288:     if (x == h0) {
                    289:       errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
                    290:     }
                    291:   }
                    292:   if (cp->super == (struct context *)NULL) return(NoObject);
                    293:   else return(findUserDictionary(str,h0,h1,cp->super));
                    294:
                    295: }
                    296:
                    297: struct object KfindUserDictionary(char *str) {
                    298:   return(findUserDictionary(str,hash0(str),hash1(str),CurrentContextp));
                    299: }
                    300:
                    301: int putUserDictionary2(str,h0,h1,attr,dic)
1.7       takayama  302:      char *str;   /* key */
                    303:      int h0,h1;   /* Hash values of the key */
                    304:      int attr;    /* attribute field */
                    305:      struct dictionary *dic;
1.1       maekawa   306: {
                    307:   int x;
                    308:   int i;
                    309:   if (SET_ATTR_FOR_ALL_WORDS & attr) {
                    310:     for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    311:       if ((dic[i]).key !=EMPTY) (dic[i]).attr = attr&(~SET_ATTR_FOR_ALL_WORDS);
1.27      takayama  312:     }
                    313:     return(0);
                    314:   }
                    315:   if (OR_ATTR_FOR_ALL_WORDS & attr) {
                    316:     for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    317:       if ((dic[i]).key !=EMPTY) (dic[i]).attr |= attr&(~OR_ATTR_FOR_ALL_WORDS);
1.1       maekawa   318:     }
                    319:     return(0);
                    320:   }
                    321:   x = h0;
                    322:   if (str[0] == '\0') {
                    323:     errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");
                    324:   }
                    325:   while (1) {
                    326:     if ((dic[x]).key == EMPTY) return(-1);
                    327:     if (strcmp((dic[x]).key,str) == 0) break;
                    328:     x = (x+h1) % USER_DICTIONARY_SIZE;
                    329:     if (x == h0) {
                    330:       errorStackmachine("User dictionary is full. loop hashing.\n");
                    331:     }
                    332:   }
                    333:   (dic[x]).attr = attr;
                    334:   return(x);
                    335: }
                    336:
                    337:
                    338: int putPrimitiveFunction(str,number)
1.7       takayama  339:      char *str;
                    340:      int number;
1.1       maekawa   341: {
1.31      takayama  342:   struct object ob = OINIT;
1.1       maekawa   343:   ob.tag = Soperator;
                    344:   ob.lc.ival = number;
                    345:   return(putSystemDictionary(str,ob));
                    346: }
                    347:
                    348: struct tokens lookupTokens(t)
1.7       takayama  349:      struct tokens t;
1.1       maekawa   350: {
                    351:   struct object *left;
                    352:   struct object *right;
                    353:   t.object.tag = Slist;
                    354:   left = t.object.lc.op = newObject();
                    355:   right = t.object.rc.op = newObject();
                    356:   left->tag = Sinteger;
                    357:   (left->lc).ival = hash0(t.token);
                    358:   (left->rc).ival = hash1(t.token);
                    359:   right->tag = Sinteger;
                    360:   (right->lc).ival = findSystemDictionary(t.token);
                    361:   return(t);
                    362: }
                    363:
                    364: struct object lookupLiteralString(s)
1.7       takayama  365:      char *s; /* s must be a literal string */
1.1       maekawa   366: {
                    367:   struct object ob;
                    368:   ob.tag = Slist;
                    369:   ob.lc.op = newObject();
                    370:   ob.rc.op = (struct object *)NULL;
                    371:   ob.lc.op->tag = Sinteger;
                    372:   (ob.lc.op->lc).ival = hash0(&(s[1]));
                    373:   (ob.lc.op->rc).ival = hash1(&(s[1]));
                    374:   return(ob);
                    375: }
                    376:
                    377:
                    378: int hash0(str)
1.7       takayama  379:      char *str;
1.1       maekawa   380: {
                    381:   int h=0;
                    382:   while (*str != '\0') {
1.17      takayama  383:     h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE;
1.1       maekawa   384:     str++;
                    385:   }
                    386:   return(h);
                    387: }
                    388:
                    389: int hash1(str)
1.7       takayama  390:      char *str;
1.1       maekawa   391: {
1.17      takayama  392:   return(8-((unsigned char)(str[0])%8));
1.1       maekawa   393: }
                    394:
                    395: void hashInitialize(struct dictionary *dic)
                    396: {
                    397:   int i;
                    398:   for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    399:     (dic[i]).key = EMPTY; (dic[i]).attr = 0;
                    400:   }
                    401: }
                    402:
                    403: static isInteger(str)
1.7       takayama  404:      char *str;
1.1       maekawa   405: {
                    406:   int i;
                    407:   int n;
                    408:   int start;
                    409:
                    410:   n = strlen(str);
                    411:   if ((str[0] == '+') ||  (str[0] == '-'))
                    412:     start = 1;
                    413:   else
                    414:     start = 0;
                    415:   if (start >= n) return(0);
                    416:
                    417:   for (i=start; i<n; i++) {
                    418:     if (('0' <= str[i]) && (str[i] <= '9')) ;
                    419:     else return(0);
                    420:   }
                    421:   return(1);
                    422: }
                    423:
                    424: static strToInteger(str)
1.7       takayama  425:      char *str;
1.1       maekawa   426: {
                    427:   int i;
                    428:   int n;
                    429:   int r;
                    430:   int start;
                    431:
                    432:   if ((str[0] == '+') || (str[0] == '-'))
                    433:     start = 1;
                    434:   else
                    435:     start = 0;
                    436:   n = strlen(str);
                    437:   r = 0;
                    438:   for (i=n-1; i>=start ; i--) {
                    439:     r += (int)(str[i]-'0') *power(10,n-1-i);
                    440:   }
                    441:   if (str[0] == '-') r = -r;
                    442:   return(r);
                    443: }
                    444:
                    445: static power(s,i)
1.7       takayama  446:      int s;
                    447:      int i;
1.1       maekawa   448: {
                    449:   if (i == 0) return 1;
                    450:   else return( s*power(s,i-1) );
                    451: }
                    452:
                    453: int Kpush(ob)
1.7       takayama  454:      struct object ob;
1.1       maekawa   455: {
                    456:   OperandStack[Osp++] = ob;
                    457:   if (Osp >= OspMax) {
                    458:     warningStackmachine("Operand stack overflow. \n");
                    459:     Osp--;
                    460:     return(-1);
                    461:   }
                    462:   return(0);
                    463: }
                    464:
                    465: struct object Kpop()
                    466: {
                    467:   if (Osp <= 0) {
                    468:     return( NullObject );
                    469:   }else{
                    470:     return( OperandStack[--Osp]);
                    471:   }
                    472: }
                    473:
                    474: struct object peek(k)
1.7       takayama  475:      int k;
1.1       maekawa   476: {
                    477:   if ((Osp-k-1) < 0) {
                    478:     return( NullObject );
                    479:   }else{
                    480:     return( OperandStack[Osp-k-1]);
                    481:   }
                    482: }
                    483:
1.29      takayama  484: static int isThereExecutableArray(struct object ob) {
                    485:   int n,i;
1.31      takayama  486:   struct object otmp = OINIT;
1.29      takayama  487:   if (ob.tag == SexecutableArray) return(1);
                    488:   if (ob.tag == Sarray) {
                    489:     n = getoaSize(ob);
                    490:     for (i=0; i<n; i++) {
                    491:       otmp = getoa(ob,i);
                    492:       if (isThereExecutableArray(otmp)) return(1);
                    493:     }
                    494:     return(0);
                    495:   }
                    496:   /* Class and list is not checked, since there is no parser
                    497:      to directory translte these objects. */
                    498:   return(0);
                    499: }
                    500: static int isThereExecutableArrayOnStack(int n) {
                    501:   int i;
1.31      takayama  502:   struct object ob = OINIT;
1.29      takayama  503:   for (i=0; i<n; i++) {
                    504:     if (Osp-i-1 < 0) return(0);
                    505:     ob = peek(i);
                    506:     if (isThereExecutableArray(ob)) return(1);
                    507:   }
                    508:   return(0);
                    509: }
1.1       maekawa   510:
                    511: struct object newOperandStack(int size)
                    512: {
                    513:   struct operandStack *os ;
1.31      takayama  514:   struct object ob = OINIT;
1.1       maekawa   515:   os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));
                    516:   if (os == (void *)NULL) errorStackmachine("No more memory.");
                    517:   if (size <= 0) errorStackmachine("Size of stack must be more than 1.");
                    518:   os->size = size;
                    519:   os->sp = 0;
                    520:   os->ostack = (struct object *)sGC_malloc(sizeof(struct object)*(size+1));
                    521:   if (os->ostack == (void *)NULL) errorStackmachine("No more memory.");
                    522:   ob.tag = Sclass;
                    523:   ob.lc.ival = CLASSNAME_OPERANDSTACK;
                    524:   ob.rc.voidp = os;
                    525:   return(ob);
                    526: }
                    527:
                    528: void setOperandStack(struct object ob) {
                    529:   if (ob.tag != Sclass) errorStackmachine("The argument must be class.");
                    530:   if (ob.lc.ival != CLASSNAME_OPERANDSTACK)
                    531:     errorStackmachine("The argument must be class.OperandStack.");
                    532:   CurrentOperandStack->ostack = OperandStack;
                    533:   CurrentOperandStack->sp = Osp;
                    534:   CurrentOperandStack->size = OspMax;
                    535:   OperandStack = ((struct operandStack *)(ob.rc.voidp))->ostack;
                    536:   Osp = ((struct operandStack *)(ob.rc.voidp))->sp;
                    537:   OspMax = ((struct operandStack *)(ob.rc.voidp))->size;
                    538:   CurrentOperandStack = ob.rc.voidp;
                    539: }
                    540:
                    541: void stdOperandStack(void) {
                    542:   CurrentOperandStack->ostack = OperandStack;
                    543:   CurrentOperandStack->sp = Osp;
                    544:   CurrentOperandStack->size = OspMax;
                    545:
                    546:   CurrentOperandStack = &StandardStack;
                    547:   OperandStack =   CurrentOperandStack->ostack;
                    548:   Osp =  CurrentOperandStack->sp;
                    549:   OspMax = CurrentOperandStack->size;
                    550: }
                    551:
                    552: /* functions to handle contexts. */
                    553: void fprintContext(FILE *fp,struct context *cp) {
                    554:   if (cp == (struct context *)NULL) {
                    555:     fprintf(fp," Context=NIL \n");
                    556:     return;
                    557:   }
                    558:   fprintf(fp,"  ContextName = %s, ",cp->contextName);
                    559:   fprintf(fp,"Super = ");
                    560:   if (cp->super == (struct context *)NULL) fprintf(fp,"NIL");
                    561:   else {
                    562:     fprintf(fp,"%s",cp->super->contextName);
                    563:   }
                    564:   fprintf(fp,"\n");
                    565: }
                    566:
                    567: struct context *newContext0(struct context *super,char *name) {
                    568:   struct context *cp;
                    569:   cp = sGC_malloc(sizeof(struct context));
                    570:   if (cp == (struct context *)NULL) errorStackmachine("No memory (newContext0)");
                    571:   cp->userDictionary=sGC_malloc(sizeof(struct dictionary)*USER_DICTIONARY_SIZE);
                    572:   if (cp->userDictionary==(struct dictionary *)NULL)
                    573:     errorStackmachine("No memory (newContext0)");
                    574:   hashInitialize(cp->userDictionary);
                    575:   cp->contextName = name;
                    576:   cp->super = super;
                    577:   return(cp);
                    578: }
                    579:
                    580: void KsetContext(struct object contextObj)  {
                    581:   if (contextObj.tag != Sclass) {
                    582:     errorStackmachine("Usage:setcontext");
                    583:   }
                    584:   if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
                    585:     errorStackmachine("Usage:setcontext");
                    586:   }
                    587:   if (contextObj.rc.voidp == NULL) {
                    588:     errorStackmachine("You cannot set NullContext to the CurrentContext.");
                    589:   }
                    590:   CurrentContextp = (struct context *)(contextObj.rc.voidp);
                    591: }
                    592:
                    593:
                    594: struct object getSuperContext(struct object contextObj) {
1.31      takayama  595:   struct object rob = OINIT;
1.1       maekawa   596:   struct context *cp;
                    597:   if (contextObj.tag != Sclass) {
                    598:     errorStackmachine("Usage:supercontext");
                    599:   }
                    600:   if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
                    601:     errorStackmachine("Usage:supercontext");
                    602:   }
                    603:   cp = (struct context *)(contextObj.rc.voidp);
                    604:   if (cp->super == (struct context *)NULL) {
                    605:     return(NullObject);
                    606:   }else{
                    607:     rob.tag = Sclass;
                    608:     rob.lc.ival = CLASSNAME_CONTEXT;
                    609:     rob.rc.voidp = cp->super;
                    610:   }
                    611:   return(rob);
                    612: }
                    613:
                    614: #define CSTACK_SIZE 1000
                    615: void contextControl(actionOfContextControl ctl) {
                    616:   static struct context *cstack[CSTACK_SIZE];
                    617:   static int cstackp = 0;
                    618:   switch(ctl) {
                    619:   case CCRESTORE:
                    620:     if (cstackp == 0) return;
                    621:     else {
                    622:       CurrentContextp = cstack[0];
                    623:       cstackp = 0;
                    624:     }
                    625:     break;
                    626:   case CCPUSH:
                    627:     if (cstackp < CSTACK_SIZE) {
                    628:       cstack[cstackp] = CurrentContextp;
                    629:       cstackp++;
                    630:     }else{
                    631:       contextControl(CCRESTORE);
                    632:       errorStackmachine("Context stack (cstack) is overflow. CurrentContext is restored.\n");
                    633:     }
                    634:     break;
                    635:   case CCPOP:
                    636:     if (cstackp > 0) {
                    637:       cstackp--;
                    638:       CurrentContextp = cstack[cstackp];
                    639:     }
                    640:     break;
                    641:   default:
                    642:     break;
                    643:   }
                    644:   return;
                    645: }
                    646:
                    647:
                    648:
                    649: int isLiteral(str)
1.7       takayama  650:      char *str;
1.1       maekawa   651: {
                    652:   if (strlen(str) <2) return(0);
                    653:   else {
                    654:     if ((str[0] == '/') && (str[1] != '/')) return(1);
                    655:     else return(0);
                    656:   }
                    657: }
                    658:
                    659: void printOperandStack() {
                    660:   int i;
1.31      takayama  661:   struct object ob = OINIT;
1.1       maekawa   662:   int vs;
                    663:   vs = VerboseStack; VerboseStack = 2;
                    664:   for (i=Osp-1; i>=0; i--) {
                    665:     fprintf(Fstack,"[%d] ",i);
                    666:     ob = OperandStack[i];
                    667:     printObject(ob,1,Fstack);
                    668:   }
                    669:   VerboseStack = vs;
                    670: }
                    671:
                    672:
                    673:
                    674: static initSystemDictionary()
1.7       takayama  675: {
1.1       maekawa   676:   StandardStack.ostack = StandardStackA;
                    677:   StandardStack.sp = StandardStackP;
                    678:   StandardStack.size = OPERAND_STACK_SIZE;
                    679:
                    680:   ErrorStack.ostack = ErrorStackA;
                    681:   ErrorStack.sp = ErrorStackP;
                    682:   ErrorStack.size = ErrorStackMax;
                    683:
                    684:   StandardContext.userDictionary = UserDictionary;
                    685:   StandardContext.contextName = "StandardContext";
                    686:   StandardContext.super = (struct context *)NULL;
                    687:
                    688:   KdefinePrimitiveFunctions();
                    689:
1.7       takayama  690: }
1.1       maekawa   691:
                    692: struct object showSystemDictionary(int f) {
                    693:   int i;
                    694:   int maxl;
                    695:   char format[1000];
                    696:   int nl;
1.31      takayama  697:   struct object rob = OINIT;
1.1       maekawa   698:   rob = NullObject;
                    699:   if (f != 0) {
                    700:     rob = newObjectArray(Sdp);
                    701:     for (i=0; i<Sdp; i++) {
                    702:       putoa(rob,i,KpoString((SystemDictionary[i]).key));
                    703:     }
                    704:     return(rob);
                    705:   }
                    706:   maxl = 1;
                    707:   for (i=0; i<Sdp; i++) {
                    708:     if (strlen((SystemDictionary[i]).key) >maxl)
                    709:       maxl = strlen((SystemDictionary[i]).key);
                    710:   }
                    711:   maxl += 3;
                    712:   nl = 80/maxl;
                    713:   if (nl < 2) nl = 2;
                    714:   sprintf(format,"%%-%ds",maxl);
                    715:   for (i=0; i<Sdp; i++) {
                    716:     fprintf(Fstack,format,(SystemDictionary[i]).key);
                    717:     if (i % nl == nl-1) fprintf(Fstack,"\n");
                    718:   }
                    719:   fprintf(Fstack,"\n");
                    720:   return(rob);
                    721: }
                    722:
                    723: int showUserDictionary()
                    724: {
                    725:   int i,j;
                    726:   int maxl;
                    727:   char format[1000];
                    728:   int nl;
                    729:   struct dictionary *dic;
                    730:   dic = CurrentContextp->userDictionary;
                    731:   fprintf(Fstack,"DictionaryName=%s, super= ",CurrentContextp->contextName);
                    732:   if (CurrentContextp->super == (struct context *)NULL) {
                    733:     fprintf(Fstack,"NIL\n");
                    734:   }else{
                    735:     fprintf(Fstack,"%s\n",CurrentContextp->super->contextName);
                    736:   }
                    737:   maxl = 1;
                    738:   for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    739:     if ((dic[i]).key != EMPTY) {
                    740:       if (strlen((dic[i]).key) >maxl)
1.7       takayama  741:         maxl = strlen((dic[i]).key);
1.1       maekawa   742:     }
                    743:   }
                    744:   maxl += 3;
                    745:   nl = 80/maxl;
                    746:   if (nl < 2) nl = 2;
                    747:   sprintf(format,"%%-%ds",maxl);
                    748:   for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
                    749:     if ((dic[i]).key != EMPTY) {
                    750:       fprintf(Fstack,format,(dic[i]).key);
                    751:       /*{ char *sss; int ii,h0,h1;
1.7       takayama  752:         sss = dic[i].key;
                    753:         h0 = dic[i].h0;
                    754:         h1 = dic[i].h1;
                    755:         for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
                    756:         fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
                    757:         }*/
1.1       maekawa   758:       if (j % nl == nl-1) fprintf(Fstack,"\n");
                    759:       j++;
                    760:     }
                    761:   }
                    762:   fprintf(Fstack,"\n");
                    763: }
                    764:
                    765:
                    766: static struct object executableStringToExecutableArray(s)
1.7       takayama  767:      char *s;
1.1       maekawa   768: {
                    769:   struct tokens *tokenArray;
1.31      takayama  770:   struct object ob = OINIT;
1.1       maekawa   771:   int i;
                    772:   int size;
                    773:   tokenArray = decomposeToTokens(s,&size);
                    774:   ob.tag = SexecutableArray;
                    775:   ob.lc.tokenArray = tokenArray;
                    776:   ob.rc.ival = size;
                    777:   for (i=0; i<size; i++) {
                    778:     if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
                    779:       ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
                    780:       ((ob.lc.tokenArray)[i]).object =
1.7       takayama  781:         executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
1.1       maekawa   782:     }
                    783:   }
                    784:   return(ob);
                    785: }
                    786: /****************  stack machine **************************/
                    787: void scanner() {
                    788:   struct tokens token;
1.31      takayama  789:   struct object ob = OINIT;
1.1       maekawa   790:   extern int Quiet;
                    791:   extern void ctrlC();
1.22      takayama  792:   int tmp, status;
1.1       maekawa   793:   char *tmp2;
                    794:   extern int ErrorMessageMode;
                    795:   int jval;
1.14      takayama  796:   extern int InSendmsg2;
1.22      takayama  797:   int infixOn = 0;
                    798:   struct tokens infixToken;
1.28      takayama  799:   extern int RestrictedMode, RestrictedMode_saved;
1.1       maekawa   800:   getokenSM(INIT);
                    801:   initSystemDictionary();
                    802:
1.9       takayama  803: #if defined(__CYGWIN__)
1.39    ! takayama  804:   if (MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9       takayama  805: #else
1.39    ! takayama  806:   if (MYSETJMP(EnvOfStackMachine)) {
1.9       takayama  807: #endif
1.1       maekawa   808:     /* do nothing in the case of error */
                    809:     fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");
                    810:     exit(10);
                    811:   } else {  }
                    812:   if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
                    813:     signal(SIGINT,ctrlC);
                    814:   }
                    815:
                    816:   /* setup quiet mode or not */
1.21      takayama  817:   token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1       maekawa   818:   if (Quiet) {
                    819:     token.token = " /@@@.quiet 1 def ";
                    820:   }else {
                    821:     token.token = " /@@@.quiet 0 def ";
                    822:   }
                    823:   executeToken(token); /* execute startup commands */
1.21      takayama  824:   token.kind = ID; token.tflag = 0;
1.1       maekawa   825:   token.token = "exec";
                    826:   token = lookupTokens(token); /* set hashing values */
                    827:   tmp = findSystemDictionary(token.token);
                    828:   ob.tag = Soperator;
                    829:   ob.lc.ival = tmp;
                    830:   executePrimitive(ob); /* exec */
                    831:
                    832:
                    833:   KSdefineMacros();
                    834:
                    835:   if (StartAFile) {
                    836:     tmp2 = StartFile;
                    837:     StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+
1.7       takayama  838:                                                  40));
1.1       maekawa   839:     sprintf(StartFile,"$%s$ run\n",tmp2);
1.21      takayama  840:     token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1       maekawa   841:     token.token = StartFile;
1.7       takayama  842:     executeToken(token);    /* execute startup commands */
1.21      takayama  843:     token.kind = ID; token.tflag = 0;
1.1       maekawa   844:     token.token = "exec";
                    845:     token = lookupTokens(token); /* set hashing values */
                    846:     tmp = findSystemDictionary(token.token);
                    847:     ob.tag = Soperator;
                    848:     ob.lc.ival = tmp;
1.7       takayama  849:     executePrimitive(ob);   /* exec */
1.1       maekawa   850:   }
                    851:
                    852:   if (StartAString) {
1.21      takayama  853:     token.kind = EXECUTABLE_STRING;  token.tflag = 0;
1.1       maekawa   854:     token.token = StartString;
1.7       takayama  855:     executeToken(token);    /* execute startup commands */
1.21      takayama  856:     token.kind = ID; token.tflag = 0;
1.1       maekawa   857:     token.token = "exec";
                    858:     token = lookupTokens(token); /* set hashing values */
                    859:     tmp = findSystemDictionary(token.token);
                    860:     ob.tag = Soperator;
                    861:     ob.lc.ival = tmp;
1.7       takayama  862:     executePrimitive(ob);   /* exec */
1.1       maekawa   863:   }
                    864:
                    865:
                    866:   for (;;) {
1.9       takayama  867: #if defined(__CYGWIN__)
1.39    ! takayama  868:     if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9       takayama  869: #else
1.39    ! takayama  870:     if (jval=MYSETJMP(EnvOfStackMachine)) {
1.9       takayama  871: #endif
1.1       maekawa   872:       /* ***  The following does not work properly.  ****
1.7       takayama  873:          if (jval == 2) {
                    874:          if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
                    875:          pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
                    876:          }
                    877:          }
                    878:          **** */
1.1       maekawa   879:       if (DebugStack >= 1) {
1.7       takayama  880:         fprintf(Fstack,"\nscanner> ");
1.1       maekawa   881:       }
1.16      takayama  882:       if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
1.28      takayama  883:         Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16      takayama  884:         KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28      takayama  885:         RestrictedMode = RestrictedMode_saved;
1.16      takayama  886:       }
                    887:       Calling_ctrlC_hook = 0;
1.12      takayama  888:       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
1.14      takayama  889:       InSendmsg2 = 0;
1.22      takayama  890:       infixOn = 0;
1.7       takayama  891:       continue ;
1.1       maekawa   892:     } else {  }
                    893:     if (DebugStack >= 1) { printOperandStack(); }
1.22      takayama  894:     token = getokenSM(GET);
                    895:     if ((status=executeToken(token)) < 0) break;
                    896:     /***if (status == 1) fprintf(stderr," --- exit --- \n");*/
                    897:     /* fprintf(stderr,"token.token=%s, status=%d, infixOn=%d\n",token.token,status,infixOn); */
                    898:     if (status & STATUS_INFIX) {
                    899:       infixOn = 1;  infixToken = token; infixToken.tflag |= NO_DELAY;
                    900:     }else if (infixOn) {
                    901:       infixOn = 0;
                    902:       if ((status=executeToken(infixToken)) < 0) break;
                    903:     }
1.1       maekawa   904:   }
                    905: }
                    906:
                    907:
                    908: void ctrlC(sig)
1.7       takayama  909:      int sig;
1.1       maekawa   910: {
                    911:   extern void ctrlC();
                    912:   extern int ErrorMessageMode;
                    913:   extern int SGClock;
                    914:   extern int UserCtrlC;
                    915:   extern int OXlock;
1.28      takayama  916:   extern int RestrictedMode, RestrictedMode_saved;
1.14      takayama  917:
1.1       maekawa   918:   signal(sig,SIG_IGN);
                    919:   /* see 133p */
1.28      takayama  920:   RestrictedMode = RestrictedMode_saved;
1.10      takayama  921:   cancelAlarm();
                    922:   if (sig == SIGALRM) {
                    923:     fprintf(stderr,"ctrlC by SIGALRM\n");
                    924:   }
1.1       maekawa   925:
                    926:   if (SGClock) {
                    927:     UserCtrlC = 1;
                    928:     fprintf(stderr,"ctrl-c is locked because of gc.\n");
1.10      takayama  929:     signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
1.1       maekawa   930:     return;
                    931:   }
                    932:   if (OXlock) {
                    933:     if (UserCtrlC > 0) UserCtrlC++;
                    934:     else UserCtrlC = 1;
                    935:     if (UserCtrlC > 3) {
                    936:       fprintf(stderr,"OK. You are eager to cancel the computation.\n");
                    937:       fprintf(stderr,"You should close the ox communication cannel.\n");
                    938:       signal(SIGINT,ctrlC);
                    939:       unlockCtrlCForOx();
                    940:     }
                    941:     fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC);
1.10      takayama  942:     signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
1.1       maekawa   943:     return;
                    944:   }
                    945:   if (ErrorMessageMode != 1) {
1.16      takayama  946:     (void *) traceShowStack();
1.1       maekawa   947:     fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
                    948:     fprintf(Fstack,"Type in quit in order to exit sm1.\n");
                    949:   }
1.16      takayama  950:   traceClearStack();
1.1       maekawa   951:   if (GotoP) {
                    952:     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
                    953:     GotoP = 0;
                    954:   }
                    955:   stdOperandStack(); contextControl(CCRESTORE);
                    956:   /*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
                    957:   /*
                    958:     $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
                    959:     ctrl-C
                    960:     $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
                    961:     It SOMETIMES makes core dump.
                    962:   */
                    963:   getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
                    964:   signal(SIGINT,ctrlC);
1.9       takayama  965: #if defined(__CYGWIN__)
1.39    ! takayama  966:   MYSIGLONGJMP(EnvOfStackMachine,2);
1.9       takayama  967: #else
1.39    ! takayama  968:   MYLONGJMP(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
1.9       takayama  969: #endif
1.1       maekawa   970: }
                    971:
                    972: int executeToken(token)
1.7       takayama  973:      struct tokens token;
1.1       maekawa   974: {
1.31      takayama  975:   struct object ob = OINIT;
1.1       maekawa   976:   int primitive;
                    977:   int size;
                    978:   int status;
                    979:   int i,h0,h1;
                    980:   extern int WarningMessageMode;
                    981:   extern int Strict;
1.14      takayama  982:   extern int InSendmsg2;
1.28      takayama  983:   extern int RestrictedMode, RestrictedMode_saved;
                    984:   int localRestrictedMode_saved;
1.1       maekawa   985:
1.28      takayama  986:   localRestrictedMode_saved = 0;
1.1       maekawa   987:   if (GotoP) { /* for goto */
                    988:     if (token.kind == ID && isLiteral(token.token)) {
                    989:       if (strcmp(&((token.token)[1]),GotoLabel) == 0) {
1.7       takayama  990:         GotoP = 0;
                    991:         return(0); /* normal exit */
1.1       maekawa   992:       }
                    993:     }
                    994:     return(0);  /* normal exit */
                    995:   }
                    996:   if (token.kind == DOLLAR) {
                    997:     ob.tag = Sdollar;
                    998:     ob.lc.str = token.token;
                    999:     Kpush(ob);
                   1000:   } else if (token.kind == ID) {  /* ID */
                   1001:
                   1002:     if (strcmp(token.token,"exit") == 0) return(1);
                   1003:     /* "exit" is not primitive here. */
                   1004:
                   1005:     if (isLiteral(token.token)) {
                   1006:       /* literal object */
                   1007:       ob.tag = Sstring;
                   1008:       ob.lc.str = (char *)sGC_malloc((strlen(token.token)+1)*sizeof(char));
                   1009:       if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
                   1010:       strcpy(ob.lc.str, &((token.token)[1]));
                   1011:
                   1012:       if (token.object.tag != Slist) {
1.7       takayama 1013:         fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
                   1014:         token.object = lookupLiteralString(token.token);
1.1       maekawa  1015:       }
                   1016:       ob.rc.op = token.object.lc.op;
                   1017:       Kpush(ob);
                   1018:     } else if (isInteger(token.token)) {
                   1019:       /* integer object */
                   1020:       ob.tag = Sinteger ;
                   1021:       ob.lc.ival = strToInteger(token.token);
                   1022:       Kpush(ob);
                   1023:     } else {
                   1024:       if (token.object.tag != Slist) {
1.7       takayama 1025:         fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
                   1026:         token = lookupTokens(token);
1.1       maekawa  1027:       }
                   1028:       h0 = ((token.object.lc.op)->lc).ival;
                   1029:       h1 = ((token.object.lc.op)->rc).ival;
                   1030:       ob=findUserDictionary(token.token,h0,h1,CurrentContextp);
                   1031:       primitive = ((token.object.rc.op)->lc).ival;
1.22      takayama 1032:       if (!(token.tflag & NO_DELAY)) {
                   1033:         if ((ob.tag >= 0) && (UD_attr & ATTR_INFIX)) {
1.24      takayama 1034:           return STATUS_INFIX;
1.22      takayama 1035:         }
                   1036:       }
1.1       maekawa  1037:       if (ob.tag >= 0) {
1.7       takayama 1038:         /* there is a definition in the user dictionary */
                   1039:         if (ob.tag == SexecutableArray) {
1.28      takayama 1040:           if (RestrictedMode) {
                   1041:             if (UD_attr & ATTR_EXPORT) {
                   1042:               localRestrictedMode_saved = RestrictedMode; RestrictedMode = 0;
1.29      takayama 1043:               if (isThereExecutableArrayOnStack(5)) {
                   1044:                                int i;
                   1045:                 for (i=0; i<5; i++) { (void) Kpop(); }
                   1046:                 errorStackmachine("Executable array is on the argument stack (restricted mode). They are automatically removed.\n");
                   1047:                          }
1.28      takayama 1048:             }else{
                   1049:               tracePushName(token.token);
                   1050:               errorStackmachine("You cannot execute this function in restricted mode.\n");
                   1051:             }
                   1052:           }
                   1053:
1.25      takayama 1054:           status = executeExecutableArray(ob,token.token,0);
1.28      takayama 1055:
                   1056:           if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved;
1.24      takayama 1057:           if ((status & STATUS_BREAK) || (status < 0)) return status;
1.7       takayama 1058:         }else {
                   1059:           Kpush(ob);
                   1060:         }
1.1       maekawa  1061:       } else if (primitive) {
1.15      takayama 1062:         tracePushName(token.token);
1.7       takayama 1063:         /* system operator */
                   1064:         ob.tag = Soperator;
                   1065:         ob.lc.ival = primitive;
1.15      takayama 1066:         status = executePrimitive(ob);
1.18      takayama 1067:         tracePopName();
1.15      takayama 1068:         return(status);
1.1       maekawa  1069:       } else {
1.14      takayama 1070:         if (QuoteMode) {
                   1071:           if (InSendmsg2) return(DO_QUOTE);
                   1072:           else {
                   1073:             Kpush(KpoString(token.token));
                   1074:             return(0); /* normal exit.*/
                   1075:           }
1.13      takayama 1076:                }
1.35      takayama 1077:         {
1.7       takayama 1078:           char tmpc[1024];
                   1079:           if (strlen(token.token) < 900) {
1.36      takayama 1080:             sprintf(tmpc,"\n>>Warning: The identifier <<%s>> is not in the system dictionary\n>>   nor in the user dictionaries. Push NullObject.\n",token.token);
                   1081:           }else {strcpy(tmpc,"\n>>Warning: identifier is not in the dictionaries.\n");}
                   1082:           /* do not use %% in a string. tmpc will be used as  fprintf(stderr,tmpc); */
1.35      takayama 1083:           if (WarningMessageMode == 1 || WarningMessageMode == 2) {
                   1084:             pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
                   1085:           }
                   1086:           if (WarningMessageMode != 1) {
                   1087:             fprintf(Fstack,"%s",tmpc);
                   1088:             /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
                   1089:           }
                   1090:           if (Strict) {
                   1091:             errorStackmachine(tmpc);
                   1092:           }
                   1093:           Kpush(NullObject);
1.7       takayama 1094:         }
1.1       maekawa  1095:       }
                   1096:     }
                   1097:   } else if (token.kind == EXECUTABLE_STRING) {
                   1098:     Kpush(executableStringToExecutableArray(token.token));
                   1099:   } else if (token.kind == EXECUTABLE_ARRAY) {
                   1100:     Kpush(token.object);
                   1101:   } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
                   1102:     return(-1);
                   1103:   } else {
                   1104:     /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
                   1105:     fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
                   1106:     fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
                   1107:     fprintf(stderr,"If you like to continue, type in RETURN key.\n");
                   1108:     fprintf(stderr,"Note that you cannot input null string.\n");
                   1109:     getchar();
                   1110:     errorStackmachine("Error: Unknown token type.\n");
                   1111:     /* return(-2); /* exit */
                   1112:   }
                   1113:   return(0); /* normal exit */
                   1114: }
                   1115:
                   1116:
                   1117:
                   1118:
                   1119: errorStackmachine(str)
1.7       takayama 1120:      char *str;
1.1       maekawa  1121: {
                   1122:   int i,j,k;
                   1123:   static char *u="Usage:";
                   1124:   char message0[1024];
                   1125:   char *message;
                   1126:   extern int ErrorMessageMode;
1.28      takayama 1127:   extern int RestrictedMode, RestrictedMode_saved;
                   1128:   RestrictedMode = RestrictedMode_saved;
1.10      takayama 1129:   cancelAlarm();
1.33      takayama 1130:   MsgStackTrace = NULL;
                   1131:   MsgSourceTrace = NULL;
1.1       maekawa  1132:   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
                   1133:     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
                   1134:   }
                   1135:   if (ErrorMessageMode != 1) {
                   1136:     message = message0;
                   1137:     i = 0;
                   1138:     while (i<6 && str[i]!='0') {
                   1139:       if (str[i] != u[i]) break;
                   1140:       i++;
                   1141:     }
                   1142:     if (i==6) {
                   1143:       fprintf(stderr,"ERROR(sm): \n");
                   1144:       while (str[i] != '\0' && str[i] != ' ') {
1.7       takayama 1145:         i++;
1.1       maekawa  1146:       }
                   1147:       if (str[i] == ' ') {
1.7       takayama 1148:         fprintf(stderr,"  %s\n",&(str[i+1]));
                   1149:         k = 0;
                   1150:         if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);
                   1151:         for (j=6; j<i ; j++) {
                   1152:           message[k] = str[j];
                   1153:           message[k+1] = '\0';
                   1154:           k++;
                   1155:         }
                   1156:         Kusage2(stderr,message);
1.1       maekawa  1157:       }else{
1.7       takayama 1158:         Kusage2(stderr,&(str[6]));
1.1       maekawa  1159:       }
                   1160:     }else {
                   1161:       fprintf(stderr,"ERROR(sm): ");
                   1162:       fprintf(stderr,str);
                   1163:     }
                   1164:     fprintf(stderr,"\n");
1.34      takayama 1165:        MsgStackTraceInArrayp = traceNameStackToArrayp();
1.33      takayama 1166:     MsgStackTrace = traceShowStack();
                   1167:     MsgSourceTrace = traceShowScannerBuf();
1.1       maekawa  1168:   }
1.16      takayama 1169:   traceClearStack();
1.1       maekawa  1170:   if (GotoP) {
                   1171:     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
                   1172:     GotoP = 0;
                   1173:   }
                   1174:   stdOperandStack(); contextControl(CCRESTORE);
                   1175:   getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
                   1176:   /* fprintf(stderr,"Now, Long jump!\n"); */
1.39    ! takayama 1177:   MYLONGJMP(EnvOfStackMachine,1);
1.1       maekawa  1178: }
                   1179:
                   1180: warningStackmachine(str)
1.7       takayama 1181:      char *str;
1.1       maekawa  1182: {
                   1183:   extern int WarningMessageMode;
                   1184:   extern int Strict;
                   1185:   if (WarningMessageMode == 1 || WarningMessageMode == 2) {
                   1186:     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
                   1187:   }
                   1188:   if (WarningMessageMode != 1) {
                   1189:     fprintf(stderr,"WARNING(sm): ");
                   1190:     fprintf(stderr,str);
                   1191:   }
                   1192:   if (Strict) errorStackmachine(" ");
                   1193:   return(0);
                   1194: }
                   1195:
                   1196:
                   1197: /* exports */
                   1198: /* NOTE:  If you call this function and an error occured,
                   1199:    you have to reset the jump buffer by setjmp(EnvOfStackMachine).
                   1200:    cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
                   1201: KSexecuteString(s)
1.7       takayama 1202:      char *s;
1.1       maekawa  1203: {
                   1204:   struct tokens token;
1.31      takayama 1205:   struct object ob = OINIT;
1.1       maekawa  1206:   int tmp;
                   1207:   extern int CatchCtrlC;
                   1208:   int jval;
                   1209:   static int recursive = 0;
                   1210:   extern int ErrorMessageMode;
                   1211:   extern int KSPushEnvMode;
                   1212:   jmp_buf saved_EnvOfStackMachine;
                   1213:   void (*sigfunc)();
                   1214:   int localCatchCtrlC ;
1.28      takayama 1215:   extern int RestrictedMode, RestrictedMode_saved;
1.1       maekawa  1216:
                   1217:   localCatchCtrlC = CatchCtrlC;
                   1218:   /* If CatchCtrlC is rewrited in this program,
                   1219:      we crash. So, we use localCatchCtrlC. */
                   1220:
                   1221:   if (localCatchCtrlC) {
                   1222:     sigfunc = signal(SIGINT,SIG_IGN);
                   1223:     signal(SIGINT,ctrlC);
                   1224:   }
                   1225:
                   1226:   if (KSPushEnvMode) {
                   1227:     *saved_EnvOfStackMachine = *EnvOfStackMachine;
1.9       takayama 1228: #if defined(__CYGWIN__)
1.39    ! takayama 1229:     if (jval = MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9       takayama 1230: #else
1.39    ! takayama 1231:     if (jval = MYSETJMP(EnvOfStackMachine)) {
1.9       takayama 1232: #endif
1.1       maekawa  1233:       *EnvOfStackMachine = *saved_EnvOfStackMachine;
                   1234:       if (jval == 2) {
1.7       takayama 1235:         if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
                   1236:           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
                   1237:         }
1.1       maekawa  1238:       }
                   1239:       recursive--;
                   1240:       if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16      takayama 1241:       if (!Calling_ctrlC_hook) {
1.28      takayama 1242:         Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16      takayama 1243:         KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28      takayama 1244:         RestrictedMode_saved;
1.16      takayama 1245:       }
                   1246:       Calling_ctrlC_hook = 0;
1.12      takayama 1247:       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
1.1       maekawa  1248:       return(-1);
                   1249:     }else{ }
                   1250:   }else{
                   1251:     if (recursive == 0) {
1.9       takayama 1252: #if defined(__CYGWIN__)
1.39    ! takayama 1253:       if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9       takayama 1254: #else
1.39    ! takayama 1255:       if (jval=MYSETJMP(EnvOfStackMachine)) {
1.9       takayama 1256: #endif
1.7       takayama 1257:         if (jval == 2) {
                   1258:           if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
                   1259:             pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
                   1260:           }
                   1261:         }
                   1262:         recursive = 0;
                   1263:         if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16      takayama 1264:         if (!Calling_ctrlC_hook) {
1.28      takayama 1265:           Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16      takayama 1266:           KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28      takayama 1267:           RestrictedMode = RestrictedMode_saved;
1.16      takayama 1268:         }
                   1269:         Calling_ctrlC_hook = 0;
                   1270:         Calling_ctrlC_hook = 0;
1.11      takayama 1271:                KSexecuteString(" (Computation is interrupted.) ");
1.7       takayama 1272:         return(-1);
1.1       maekawa  1273:       }else { }
                   1274:     }
                   1275:   }
                   1276:
                   1277:   recursive++;
                   1278:   token.token = s;
1.21      takayama 1279:   token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1       maekawa  1280:   executeToken(token);
1.21      takayama 1281:   token.kind = ID; token.tflag = 0;
1.1       maekawa  1282:   token.token = "exec";
                   1283:   token = lookupTokens(token); /* no use */
                   1284:   tmp = findSystemDictionary(token.token);
                   1285:   ob.tag = Soperator;
                   1286:   ob.lc.ival = tmp;
                   1287:   executePrimitive(ob);
                   1288:   recursive--;
                   1289:   if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;
                   1290:   if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
                   1291:   return(0);
                   1292: }
                   1293:
                   1294: KSdefineMacros() {
                   1295:   struct tokens token;
                   1296:   int tmp;
1.31      takayama 1297:   struct object ob = OINIT;
1.1       maekawa  1298:
                   1299:   if (StandardMacros && (strlen(SMacros))) {
1.21      takayama 1300:     token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1       maekawa  1301:     token.token = SMacros;
1.7       takayama 1302:     executeToken(token);    /* execute startup commands */
1.21      takayama 1303:     token.kind = ID; token.tflag = 0;
1.1       maekawa  1304:     token.token = "exec";
                   1305:     token = lookupTokens(token); /* no use */
                   1306:     tmp = findSystemDictionary(token.token);
                   1307:     ob.tag = Soperator;
                   1308:     ob.lc.ival = tmp;
1.7       takayama 1309:     executePrimitive(ob);   /* exec */
1.1       maekawa  1310:   }
                   1311:   return(0);
                   1312:
                   1313: }
                   1314:
                   1315: void KSstart() {
                   1316:   struct tokens token;
                   1317:   int tmp;
1.31      takayama 1318:   struct object ob = OINIT;
1.1       maekawa  1319:   extern int Quiet;
                   1320:
                   1321:   stackmachine_init(); KinitKan();
                   1322:   getokenSM(INIT); initSystemDictionary();
                   1323:
                   1324:   /* The following line may cause a core dump, if you do not setjmp properly
                   1325:      after calling KSstart().*/
                   1326:   /*
1.39    ! takayama 1327:     if (MYSETJMP(EnvOfStackMachine)) {
1.1       maekawa  1328:     fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");
                   1329:     exit(10);
1.7       takayama 1330:     } else {  }  */
1.1       maekawa  1331:
                   1332:   /* setup quiet mode or not */
1.21      takayama 1333:   token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1       maekawa  1334:   if (Quiet) {
                   1335:     token.token = " /@@@.quiet 1 def ";
                   1336:   }else {
                   1337:     token.token = " /@@@.quiet 0 def ";
                   1338:   }
                   1339:   executeToken(token); /* execute startup commands */
1.21      takayama 1340:   token.kind = ID; token.tflag = 0;
1.1       maekawa  1341:   token.token = "exec";
                   1342:   token = lookupTokens(token); /* set hashing values */
                   1343:   tmp = findSystemDictionary(token.token);
                   1344:   ob.tag = Soperator;
                   1345:   ob.lc.ival = tmp;
                   1346:   executePrimitive(ob); /* exec */
                   1347:
                   1348:   KSdefineMacros();
                   1349: }
                   1350:
                   1351: void KSstop() {
                   1352:   Kclose(); stackmachine_close();
                   1353: }
                   1354:
                   1355:
                   1356: struct object KSpop() {
                   1357:   return(Kpop());
                   1358: }
                   1359:
                   1360: void KSpush(ob)
1.7       takayama 1361:      struct object ob;
1.1       maekawa  1362: {
                   1363:   Kpush(ob);
1.4       takayama 1364: }
                   1365:
                   1366: struct object KSpeek(k) {
                   1367:   return(peek(k));
1.1       maekawa  1368: }
                   1369:
                   1370: char *KSstringPop() {
                   1371:   /* pop a string */
1.31      takayama 1372:   struct object rob = OINIT;
1.1       maekawa  1373:   rob = Kpop();
                   1374:   if (rob.tag == Sdollar) {
                   1375:     return(rob.lc.str);
                   1376:   }else{
                   1377:     return((char *)NULL);
                   1378:   }
                   1379: }
                   1380:
                   1381: char *KSpopString() {
                   1382:   return(KSstringPop());
                   1383: }
                   1384:
                   1385: int KSset(char *name) {
                   1386:   char *tmp2;
                   1387:   char tmp[1024];
                   1388:   tmp2 = tmp;
                   1389:   if (strlen(name) < 1000) {
                   1390:     sprintf(tmp2," /%s set ",name);
                   1391:   }else{
                   1392:     tmp2 = sGC_malloc(sizeof(char)*(strlen(name)+20));
                   1393:     if (tmp2 == (char *)NULL) errorStackmachine("Out of memory.");
                   1394:     sprintf(tmp2," /%s set ",name);
                   1395:   }
                   1396:   return( KSexecuteString(tmp2) );
                   1397: }
                   1398:
                   1399: int KSpushBinary(int size,char *data) {
                   1400:   /* struct object KbinaryToObject(int size, char *data); */
                   1401:   errorStackmachine("KSpushBinary is not implemented.\n");
                   1402:   return(-1);
                   1403: }
                   1404:
                   1405: char *KSpopBinary(int *size) {
                   1406:   /* char *KobjectToBinary(struct object ob,int *size); */
                   1407:   errorStackmachine("KSpopBinary is not implemented.\n");
                   1408:   *size = 0;
                   1409:   return((char *)NULL);
                   1410: }
                   1411:
1.34      takayama 1412: struct object KSnewObjectArray(int k) {
                   1413:    return newObjectArray(k);
                   1414: }
                   1415:
1.1       maekawa  1416: int pushErrorStack(struct object obj)
                   1417: {
                   1418:   if (CurrentOperandStack == &ErrorStack) {
                   1419:     fprintf(stderr,"You cannot call pushErrorStack when ErrorStack is the CurrentOperandStack. \n");
                   1420:     return(-1);
                   1421:   }
                   1422:   (ErrorStack.ostack)[(ErrorStack.sp)++] = obj;
                   1423:   /* printf("ErrorStack.sp = %d\n",ErrorStack.sp); */
                   1424:   if ((ErrorStack.sp) >= (ErrorStack.size)) {
                   1425:     ErrorStack.sp = 0;
                   1426:     fprintf(stderr,"pushErrorStack():ErrorStack overflow. It is reset.\n");
                   1427:     /* Note that it avoids recursive call.*/
                   1428:     return(-1);
                   1429:   }
                   1430:   return(0);
                   1431: }
                   1432:
                   1433: struct object popErrorStack(void) {
                   1434:   if (CurrentOperandStack == &ErrorStack) {
                   1435:     fprintf(stderr,"You cannot call popErrorStack when ErrorStack is the CurrentOperandStack. \n");
                   1436:     return(NullObject);
                   1437:   }
                   1438:   if ((ErrorStack.sp) <= 0) {
                   1439:     return( NullObject );
                   1440:   }else{
                   1441:     return( (ErrorStack.ostack)[--(ErrorStack.sp)]);
                   1442:   }
                   1443: }
                   1444:
                   1445: char *popErrorStackByString(void) {
1.31      takayama 1446:   struct object obj = OINIT;
                   1447:   struct object eobj = OINIT;
1.1       maekawa  1448:   eobj = popErrorStack();
                   1449:   if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {
                   1450:     return(NULL);
                   1451:   }else{
                   1452:     obj = *(KopErrorPacket(eobj));
                   1453:   }
                   1454:   if (obj.tag != Sarray || getoaSize(obj) != 3) {
                   1455:     fprintf(stderr,"errorPacket format error.\n");
                   1456:     printObject(eobj,0,stderr); fflush(stderr);
                   1457:     return("class errorPacket format error. Bug of sm1.");
                   1458:   }
                   1459:   obj = getoa(obj,2);
                   1460:   if (obj.tag != Sdollar) {
                   1461:     fprintf(stderr,"errorPacket format error at position 2..\n");
                   1462:     printObject(eobj,0,stderr); fflush(stderr);
                   1463:     return("class errorPacket format error at the position 2. Bug of sm1.");
                   1464:   }
                   1465:   return(KopString(obj));
                   1466: }
                   1467:
                   1468:
                   1469: int KScheckErrorStack(void)
                   1470: {
                   1471:   return(ErrorStack.sp);
                   1472: }
                   1473:
                   1474: struct object KnewErrorPacket(int serial,int no,char *message)
                   1475: {
1.31      takayama 1476:   struct object obj = OINIT;
1.1       maekawa  1477:   struct object *myop;
                   1478:   char *s;
                   1479:   /* Set extended tag. */
                   1480:   obj.tag = Sclass;  obj.lc.ival = CLASSNAME_ERROR_PACKET ;
                   1481:   myop = (struct object *)sGC_malloc(sizeof(struct object));
                   1482:   if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
                   1483:   *myop = newObjectArray(3);
                   1484:   /*fprintf(stderr,"newErrorPacket() in stackmachine.c: [%d, %d, %s] \n",serial,no,message);  **kxx:CMO_ERROR  */
                   1485:   putoa((*myop),0,KpoInteger(serial));
                   1486:   putoa((*myop),1,KpoInteger(no));
                   1487:   s = (char *)sGC_malloc(sizeof(char)*(strlen(message)+2));
                   1488:   if (s == (char *)NULL) errorStackmachine("No memory\n");
                   1489:   strcpy(s,message);
                   1490:   putoa((*myop),2,KpoString(s));
                   1491:   obj.rc.op = myop;
                   1492:   return(obj);
                   1493: }
                   1494:
                   1495:
                   1496: struct object KnewErrorPacketObj(struct object ob1)
                   1497: {
1.31      takayama 1498:   struct object obj = OINIT;
1.1       maekawa  1499:   struct object *myop;
                   1500:   char *s;
                   1501:   /* Set extended tag. */
                   1502:   obj.tag = Sclass;  obj.lc.ival = CLASSNAME_ERROR_PACKET ;
                   1503:   myop = (struct object *)sGC_malloc(sizeof(struct object));
                   1504:   if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
                   1505:   *myop = ob1;
                   1506:   obj.rc.op = myop;
                   1507:   return(obj);
                   1508: }
                   1509:
                   1510: void *sGC_malloc(size_t n) { /* synchronized function */
                   1511:   void *c;
                   1512:   int id;
                   1513:   extern int SGClock, UserCtrlC;
                   1514:
                   1515:   SGClock = 1;
                   1516:   c = GC_malloc(n);
                   1517:   SGClock = 0;
                   1518:   if (UserCtrlC) {
                   1519:     UserCtrlC = 0;
                   1520:     id = getpid();
                   1521:     kill(id,SIGINT);
                   1522:     return(c);
                   1523:   }else{
                   1524:     return(c);
                   1525:   }
                   1526: }
                   1527:
                   1528: void *sGC_realloc(void *p,size_t new) { /* synchronized function */
                   1529:   void *c;
                   1530:   int id;
                   1531:   extern int SGClock, UserCtrlC;
                   1532:
                   1533:   SGClock = 1;
                   1534:   c = GC_realloc(p,new);
                   1535:   SGClock = 0;
                   1536:   if (UserCtrlC) {
                   1537:     UserCtrlC = 0;
                   1538:     id = getpid();
                   1539:     kill(id,SIGINT);
                   1540:     return(c);
                   1541:   }else{
                   1542:     return(c);
                   1543:   }
                   1544: }
                   1545:
                   1546: void sGC_free(void *c) { /* synchronized function */
                   1547:   int id;
                   1548:   extern int SGClock, UserCtrlC;
                   1549:
                   1550:   SGClock = 1;
                   1551:   GC_free(c);
                   1552:   SGClock = 0;
                   1553:   if (UserCtrlC) {
                   1554:     UserCtrlC = 0;
                   1555:     id = getpid();
                   1556:     kill(id,SIGINT);
                   1557:     return;
                   1558:   }else{
                   1559:     return;
                   1560:   }
                   1561: }
                   1562:
                   1563: void lockCtrlCForOx() {
                   1564:   extern int OXlock;
                   1565:   extern int OXlockSaved;
                   1566:   OXlockSaved = OXlock;
                   1567:   OXlock = 1;
                   1568: }
                   1569:
                   1570: void unlockCtrlCForOx() {
                   1571:   int id;
                   1572:   extern int OXlock, UserCtrlC;
                   1573:   extern int OXlockSaved;
                   1574:   OXlockSaved = OXlock;
                   1575:   OXlock = 0;
                   1576:   if (UserCtrlC) {
                   1577:     UserCtrlC = 0;
                   1578:     id = getpid();
                   1579:     kill(id,SIGINT);
                   1580:     return;
                   1581:   }else{
                   1582:     return;
                   1583:   }
                   1584: }
                   1585:
                   1586: void restoreLockCtrlCForOx() {
                   1587:   extern int OXlock;
                   1588:   extern int OXlockSaved;
                   1589:   OXlock = OXlockSaved;
                   1590: }
                   1591:
                   1592: int KSstackPointer() {
                   1593:   return(Osp);
                   1594: }
                   1595:
                   1596: struct object KSdupErrors() {
1.31      takayama 1597:   struct object rob = OINIT;
                   1598:   struct object ob = OINIT;
1.1       maekawa  1599:   int i;
                   1600:   int n;
                   1601:   int m;
                   1602:
                   1603:   n = KSstackPointer();
                   1604:   m = 0;
                   1605:   for (i=0; i<n; i++) {
                   1606:     ob = peek(i);
                   1607:     if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
                   1608:       m++;
                   1609:     }
                   1610:   }
                   1611:   rob = newObjectArray(m);
                   1612:   m = 0;
                   1613:   for (i=0; i<n; i++) {
                   1614:     ob = peek(i);
                   1615:     if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
                   1616:       putoa(rob, m, ob);
                   1617:       m++;
                   1618:     }
                   1619:   }
                   1620:   return(rob);
                   1621: }
1.10      takayama 1622:
                   1623: void cancelAlarm() {
                   1624:   alarm((unsigned int) 0);
                   1625:   signal(SIGALRM,SIG_DFL);
1.15      takayama 1626: }
                   1627:
                   1628: /* back-trace */
                   1629: #define TraceNameStackSize 3000
                   1630: char *TraceNameStack[TraceNameStackSize];
                   1631: int TraceNameStackp = 0;
                   1632: void tracePushName(char *s) {
                   1633:   char *t;
                   1634:   /*
                   1635:   t = (char *)sGC_malloc(strlen(s)+1);
                   1636:   if (t == NULL) {
                   1637:     fprintf(stderr,"No more memory.\n"); return;
                   1638:   }
                   1639:   strcpy(t,s);
                   1640:   */
                   1641:   t = s;
                   1642:   TraceNameStack[TraceNameStackp++] = t;
                   1643:   if (TraceNameStackp >= TraceNameStackSize) {
                   1644:     fprintf(stderr,"Warning: TraceNameStack overflow. Clearing the stack.\n");
                   1645:     TraceNameStackp = 0;
                   1646:   }
                   1647: }
                   1648: void traceClearStack(void) {
                   1649:   TraceNameStackp = 0;
                   1650: }
                   1651: char *tracePopName(void) {
                   1652:   if (TraceNameStackp <= 0) return (char *) NULL;
                   1653:   return TraceNameStack[--TraceNameStackp];
1.34      takayama 1654: }
                   1655: struct object *traceNameStackToArrayp(void) {
                   1656:   int n,i;
                   1657:   struct object *op;
                   1658:   op = sGC_malloc(sizeof(struct object));
                   1659:   n = TraceNameStackp; if (n < 0) n = 0;
                   1660:   *op = newObjectArray(n);
                   1661:   for (i=0; i<n; i++) {
                   1662:        putoa((*op),i, KpoString(TraceNameStack[i]));
                   1663:   }
                   1664:   return op;
1.15      takayama 1665: }
                   1666: #define TRACE_MSG_SIZE 320
                   1667: char *traceShowStack(void) {
                   1668:   char *s;
                   1669:   char *t;
                   1670:   int p;
                   1671:   s = (char *) sGC_malloc(TRACE_MSG_SIZE);
                   1672:   if (s == NULL) {
                   1673:     fprintf(stderr,"No more memory.\n"); return NULL;
                   1674:   }
                   1675:   sprintf(s,"Trace: ");
                   1676:   p = strlen(s);
                   1677:   do {
                   1678:     t = tracePopName();
                   1679:     if (t == NULL) {
                   1680:       s[p] = ';'; s[p+1] = 0;
                   1681:       break;
1.26      takayama 1682:     }else if ((strlen(t) + p) > (TRACE_MSG_SIZE-10)) {
                   1683:          /* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */
1.15      takayama 1684:       strcpy(&(s[p])," ...");
                   1685:       break;
                   1686:     }
                   1687:     strcpy(&(s[p]),t); p += strlen(t);
                   1688:     strcpy(&(s[p]),"<-"); p += 2;
                   1689:   } while (t != (char *)NULL);
                   1690:   fprintf(stderr,"%s\n",s);
                   1691:   return s;
1.24      takayama 1692: }
                   1693:
                   1694: /*
                   1695:   if (fname != NULL) fname is pushed to the trace stack.
                   1696:  */
1.25      takayama 1697: int executeExecutableArray(struct object ob,char *fname,int withGotoP) {
1.24      takayama 1698:   struct tokens *tokenArray;
                   1699:   int size,i;
                   1700:   int status;
                   1701:   int infixOn;
                   1702:   struct tokens infixToken;
                   1703:   extern int GotoP;
                   1704:
                   1705:   infixOn = 0;
                   1706:   if (ob.tag != SexecutableArray) errorStackmachine("Error (executeTokenArray): the argument is not a token array.");
                   1707:
                   1708:   if (fname != NULL) tracePushName(fname);
                   1709:   tokenArray = ob.lc.tokenArray;
                   1710:   size = ob.rc.ival;
                   1711:   for (i=0; i<size; i++) {
                   1712:     status = executeToken(tokenArray[i]);
1.25      takayama 1713:     if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24      takayama 1714:       if (fname != NULL) tracePopName();
                   1715:       return(status);
                   1716:     }
                   1717:
                   1718:     if (status & STATUS_INFIX) {
                   1719:       if (i == size-1) errorStackmachine("Infix operator at the end of an executable array.");
                   1720:       infixOn = 1; infixToken = tokenArray[i];
                   1721:       infixToken.tflag |= NO_DELAY;
                   1722:       continue;
                   1723:     }else if (infixOn) {
                   1724:       infixOn = 0;
                   1725:       status = executeToken(infixToken);
1.25      takayama 1726:       if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24      takayama 1727:         if (fname != NULL) tracePopName();
                   1728:         return(status);
                   1729:       }
                   1730:     }
                   1731:   }
                   1732:   if (fname != NULL) tracePopName();
                   1733:   return(0); /* normal exit */
1.10      takayama 1734: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>