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

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

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