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

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

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