[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.22

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

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