[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

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>