[BACK]Return to test.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097 / Replace

Annotation of OpenXM/src/k097/Replace/test.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 <signal.h>
                      8: #include <sys/types.h>
                      9: #include <sys/times.h>
                     10:
                     11:
                     12: #define OPERAND_STACK_SIZE  2000
                     13: #define SYSTEM_DICTIONARY_SIZE 200
                     14: #define USER_DICTIONARY_SIZE   1223
                     15: /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
                     16:    method */
                     17: #define OB_ARRAY_MAX   (AGLIMIT+100)
                     18: #define ARGV_WORK_MAX  (AGLIMIT+100)
                     19: #define EMPTY (char *)NULL
                     20:
                     21: /* global variables */
                     22: struct object OperandStack[OPERAND_STACK_SIZE];
                     23: int Osp = 0;   /* OperandStack pointer */
                     24: struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
                     25: int Sdp = 0;   /* SystemDictionary pointer */
                     26: struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
                     27: int Udp = 0;   /* UserDictionary pointer */
                     28:
                     29: int PrintDollar = 1;         /* flag for printObject() */
                     30: int PrintComma  = 1;         /* flag for printObject() */
                     31: static struct object ObjTmp; /* for poor compiler */
                     32:
                     33: int StandardMacros = 1;
                     34: int StartAFile = 0;
                     35: char *StartFile;
                     36:
                     37:
                     38:
                     39: static char *SMacros =
                     40: #include "smacro.h"
                     41:
                     42: static isInteger(char *);
                     43: static strToInteger(char *);
                     44: static power(int s,int i);
                     45: static struct object pop(void);
                     46: static push(struct object);
                     47: static char *operatorType(int i);
                     48: static void pstack(void);
                     49: static struct object executableStringToExecutableArray(char *str);
                     50:
                     51: /****** primitive functions *****************************************
                     52:   the values must be greater than 1. 0 is used for special purposes.*/
                     53: #define Sadd              1
                     54: #define Ssub              2
                     55: #define Smult             3
                     56: #define Sset_up_ring      4
                     57: #define Soptions          6
                     58: #define Sgroebner       7
                     59: #define Sdef              8
                     60: #define Spop              9
                     61: #define Sput              10
                     62: #define Sprint            11
                     63: #define Spstack           12
                     64: #define Sshow_ring        13
                     65: #define Sprint_options    14
                     66: #define Sshow_systemdictionary 15
                     67: #define Slength            16
                     68: #define Sfor               17
                     69: #define Sroll              18
                     70: #define Squit              19
                     71: #define Stest              20      /* this is used for test of new function*/
                     72: #define Ssyzygies        21
                     73: #define Sresolution        22
                     74: #define Sfileopen      23
                     75: #define Sclosefile 24
                     76: #define Sidiv      25
                     77: #define Sdup       26
                     78: #define Smap       27
                     79: #define Sreduction 28
                     80: #define Sreplace 29
                     81: #define SleftBrace 30       /* primitive [ */
                     82: #define SrightBrace 31      /* primitive ] */
                     83: #define Srun 32            /* run from a file */
                     84: #define Sloop 33
                     85: #define Saload 34
                     86: #define Sifelse 35
                     87: #define Sequal 36
                     88: #define Sexec 37
                     89: #define Sset 38
                     90: #define Sget 41
                     91: #define Scopy 43
                     92: #define Sindex 44
                     93: #define Ssystem 45
                     94: #define Shilbert 47
                     95: #define Sset_order_by_matrix 50
                     96: #define Sshow_user_dictionary 54
                     97: #define Selimination_order 55
                     98: #define Sswitch_function 58
                     99: #define Sprint_switch_status 59
                    100: #define Scat_n 62
                    101: #define Sless  63
                    102: #define Sgreater  64
                    103: #define Swritestring  66
                    104: #define Sset_timer 67
                    105: #define Sspol 68
                    106: #define Susage 69
                    107: #define Sto_records 70
                    108: #define Scoefficients 71
                    109: #define Ssystem_variable 72
                    110: #define Sdata_conversion 73
                    111: #define Sdegree 74
                    112: #define Sinit 75
                    113: #define Sload 76
                    114: #define Seval 77
                    115: #define Shomogenize 78
                    116: #define Sprincipal 79
                    117: #define Spushfile 80
                    118: /***********************************************/
                    119:
                    120: struct object * newObject()
                    121: {
                    122:   struct object *r;
                    123:   r = (struct object *)GC_malloc(sizeof(struct object));
                    124:   if (r == (struct object *)NULL) errorStackmachine("No memory\n");
                    125:   r->tag = 0;
                    126:   (r->lc).ival = 0;
                    127:   (r->rc).ival = 0;
                    128:   return(r);
                    129: }
                    130:
                    131: struct object newObjectArray(size)
                    132: int size;
                    133: {
                    134:   struct object rob;
                    135:   struct object *op;
                    136:   if (size < 0) return(NullObject);
                    137:   if (size > 0) {
                    138:     op = (struct object *)GC_malloc(size*sizeof(struct object));
                    139:     if (op == (struct object *)NULL) errorStackmachine("No memory\n");
                    140:   }else{
                    141:     op = (struct object *)NULL;
                    142:   }
                    143:   rob.tag = Sarray;
                    144:   rob.lc.ival = size;
                    145:   rob.rc.op = op;
                    146:   return(rob);
                    147: }
                    148:
                    149: isNullObject(obj)
                    150: struct object obj;
                    151: {
                    152:   if (obj.tag == 0) return(1);
                    153:   else return(0);
                    154: }
                    155:
                    156: int putSystemDictionary(str,ob)
                    157: char *str;   /* key */
                    158: struct object ob; /* value */
                    159: {
                    160:   int i;
                    161:   int j;
                    162:   int flag = 0;
                    163:
                    164:   for (i = Sdp-1; i>=0; i--) {
                    165:     /*printf("Add %d %s\n",i,str);*/
                    166:     if (strcmp(str,(SystemDictionary[i]).key) > 0) {
                    167:       for (j=Sdp-1; j>=i+1; j--) {
                    168:        (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
                    169:        (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
                    170:       }
                    171:       (SystemDictionary[i+1]).key = str;
                    172:       (SystemDictionary[i+1]).obj = ob;
                    173:       flag = 1;
                    174:       break;
                    175:     }
                    176:   }
                    177:   if (!flag) { /* str is the minimum element */
                    178:     for (j=Sdp-1; j>=0; j--) {
                    179:       (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
                    180:       (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
                    181:     }
                    182:     (SystemDictionary[0]).key = str;
                    183:     (SystemDictionary[0]).obj = ob;
                    184:   }
                    185:   Sdp++;
                    186:   if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
                    187:     warningStackmachine("No space for system dictionary area.\n");
                    188:     Sdp--;
                    189:     return(-1);
                    190:   }
                    191:   return(Sdp-1);
                    192: }
                    193:
                    194: int findSystemDictionary(str)
                    195:      /* only used for primitive functions */
                    196:      /* returns 0, if there is no item. */
                    197:      /* This function assumes that the dictionary is sorted by strcmp() */
                    198:      char *str;    /* key */
                    199: {
                    200:   int first,last,rr,middle;
                    201:
                    202:   /* binary search */
                    203:   first = 0; last = Sdp-1;
                    204:   while (1) {
                    205:     if (first > last) {
                    206:       return(0);
                    207:     } else if (first == last) {
                    208:       if (strcmp(str,(SystemDictionary[first]).key) == 0) {
                    209:        return((SystemDictionary[first]).obj.lc.ival);
                    210:       }else {
                    211:        return(0);
                    212:       }
                    213:     } else if (last - first == 1) { /* This case is necessary */
                    214:       if (strcmp(str,(SystemDictionary[first]).key) == 0) {
                    215:        return((SystemDictionary[first]).obj.lc.ival);
                    216:       }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
                    217:        return((SystemDictionary[last]).obj.lc.ival);
                    218:       }else return(0);
                    219:     }
                    220:
                    221:     middle = (first + last)/2;
                    222:     rr = strcmp(str,(SystemDictionary[middle]).key);
                    223:     if (rr < 0) { /* str < middle */
                    224:       last = middle;
                    225:     }else if (rr == 0) {
                    226:       return((SystemDictionary[middle]).obj.lc.ival);
                    227:     }else {       /* str > middle */
                    228:       first = middle;
                    229:     }
                    230:   }
                    231: }
                    232:
                    233: int putUserDictionary(str,h0,h1,ob)
                    234: char *str;   /* key */
                    235: int h0,h1;   /* Hash values of the key */
                    236: struct object ob; /* value */
                    237: {
                    238:   int x;
                    239:   x = h0;
                    240:   if (str[0] == '\0') {
                    241:     errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
                    242:   }
                    243:   while (1) {
                    244:     if ((UserDictionary[x]).key == EMPTY) break;
                    245:     if (strcmp((UserDictionary[x]).key,str) == 0) break;
                    246:     x = (x+h1) % USER_DICTIONARY_SIZE;
                    247:     if (x == h0) {
                    248:       errorStackmachine("User dictionary is full. loop hashing.\n");
                    249:     }
                    250:   }
                    251:   (UserDictionary[x]).key = str;
                    252:   (UserDictionary[x]).obj = ob;
                    253:   (UserDictionary[x]).h0 = h0;
                    254:   (UserDictionary[x]).h1 = h1;
                    255:   return(x);
                    256: }
                    257:
                    258: struct object findUserDictionary(str,h0,h1)
                    259: /* returns NoObject, if there is no item. */
                    260: char *str;    /* key */
                    261: int h0,h1;    /* The hashing values of the key. */
                    262: {
                    263:   int x;
                    264:   x = h0;
                    265:   while (1) {
                    266:     if ((UserDictionary[x]).key == EMPTY) return(NoObject);
                    267:     /* if ((UserDictionary[x]).h1 != h1) return(NoObject); */
                    268:     if (strcmp((UserDictionary[x]).key,str) == 0) {
                    269:       return( (UserDictionary[x]).obj );
                    270:     }
                    271:     x = (x+h1) % USER_DICTIONARY_SIZE;
                    272:     if (x == h0) {
                    273:       errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
                    274:     }
                    275:   }
                    276:
                    277: }
                    278:
                    279:
                    280: int putPrimitiveFunction(str,number)
                    281: char *str;
                    282: int number;
                    283: {
                    284:   struct object ob;
                    285:   ob.tag = Soperator;
                    286:   ob.lc.ival = number;
                    287:   return(putSystemDictionary(str,ob));
                    288: }
                    289:
                    290: struct tokens lookupTokens(t)
                    291: struct tokens t;
                    292: {
                    293:   struct object *left;
                    294:   struct object *right;
                    295:   t.object.tag = Slist;
                    296:   left = t.object.lc.op = newObject();
                    297:   right = t.object.rc.op = newObject();
                    298:   left->tag = Sinteger;
                    299:   (left->lc).ival = hash0(t.token);
                    300:   (left->rc).ival = hash1(t.token);
                    301:   right->tag = Sinteger;
                    302:   (right->lc).ival = findSystemDictionary(t.token);
                    303:   return(t);
                    304: }
                    305:
                    306: struct object lookupLiteralString(s)
                    307: char *s; /* s must be a literal string */
                    308: {
                    309:   struct object ob;
                    310:   ob.tag = Slist;
                    311:   ob.lc.op = newObject();
                    312:   ob.rc.op = (struct object *)NULL;
                    313:   ob.lc.op->tag = Sinteger;
                    314:   (ob.lc.op->lc).ival = hash0(&(s[1]));
                    315:   (ob.lc.op->rc).ival = hash1(&(s[1]));
                    316:   return(ob);
                    317: }
                    318:
                    319:
                    320: int hash0(str)
                    321: char *str;
                    322: {
                    323:   int h=0;
                    324:   while (*str != '\0') {
                    325:     h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE;
                    326:     str++;
                    327:   }
                    328:   return(h);
                    329: }
                    330:
                    331: int hash1(str)
                    332: char *str;
                    333: {
                    334:   return(8-(str[0]%8));
                    335: }
                    336:
                    337: void hashInitialize(void)
                    338: {
                    339:   int i;
                    340:   for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    341:     (UserDictionary[i]).key = EMPTY;
                    342:   }
                    343: }
                    344:
                    345: static isInteger(str)
                    346: char *str;
                    347: {
                    348:   int i;
                    349:   int n;
                    350:   int start;
                    351:
                    352:   n = strlen(str);
                    353:   if ((str[0] == '+') ||  (str[0] == '-'))
                    354:     start = 1;
                    355:   else
                    356:     start = 0;
                    357:   if (start >= n) return(0);
                    358:
                    359:   for (i=start; i<n; i++) {
                    360:     if (('0' <= str[i]) && (str[i] <= '9')) ;
                    361:     else return(0);
                    362:   }
                    363:   return(1);
                    364: }
                    365:
                    366: static strToInteger(str)
                    367: char *str;
                    368: {
                    369:   int i;
                    370:   int n;
                    371:   int r;
                    372:   int start;
                    373:
                    374:   if ((str[0] == '+') || (str[0] == '-'))
                    375:     start = 1;
                    376:   else
                    377:     start = 0;
                    378:   n = strlen(str);
                    379:   r = 0;
                    380:   for (i=n-1; i>=start ; i--) {
                    381:     r += (int)(str[i]-'0') *power(10,n-1-i);
                    382:   }
                    383:   if (str[0] == '-') r = -r;
                    384:   return(r);
                    385: }
                    386:
                    387: static power(s,i)
                    388: int s;
                    389: int i;
                    390: {
                    391:   if (i == 0) return 1;
                    392:   else return( s*power(s,i-1) );
                    393: }
                    394:
                    395: static push(ob)
                    396: struct object ob;
                    397: {
                    398:   OperandStack[Osp++] = ob;
                    399:   if (Osp >= OPERAND_STACK_SIZE) {
                    400:     warningStackmachine("Operand stack overflow. \n");
                    401:     Osp--;
                    402:     return(-1);
                    403:   }
                    404:   return(0);
                    405: }
                    406:
                    407: static struct object pop()
                    408: {
                    409:   if (Osp <= 0) {
                    410:     return( NullObject );
                    411:   }else{
                    412:     return( OperandStack[--Osp]);
                    413:   }
                    414: }
                    415:
                    416: struct object peek(k)
                    417: int k;
                    418: {
                    419:   if ((Osp-k-1) < 0) {
                    420:     return( NullObject );
                    421:   }else{
                    422:     return( OperandStack[Osp-k-1]);
                    423:   }
                    424: }
                    425:
                    426: int isLiteral(str)
                    427: char *str;
                    428: {
                    429:   if (strlen(str) <2) return(0);
                    430:   else {
                    431:     if ((str[0] == '/') && (str[1] != '/')) return(1);
                    432:     else return(0);
                    433:   }
                    434: }
                    435:
                    436: void printOperandStack() {
                    437:   int i;
                    438:   struct object ob;
                    439:   int vs;
                    440:   vs = VerboseStack; VerboseStack = 2;
                    441:   for (i=Osp-1; i>=0; i--) {
                    442:     fprintf(Fstack,"[%d] ",i);
                    443:     ob = OperandStack[i];
                    444:     printObject(ob,1,Fstack);
                    445:   }
                    446:   VerboseStack = vs;
                    447: }
                    448:
                    449:
                    450: void printObject(ob,nl,fp)
                    451: struct object ob;
                    452: int nl;
                    453: FILE *fp;
                    454: /* print the object on the top of the stack. */
                    455: {
                    456:
                    457:   int size;
                    458:   int i;
                    459:   struct tokens *ta;
                    460:
                    461:   if (VerboseStack >= 2) {
                    462:     /*fprintf(fp,"@@@");*/
                    463:     switch (ob.tag) {
                    464:     case 0:
                    465:       fprintf(fp,"<null> "); /* null object */
                    466:       break;
                    467:     case Sinteger:
                    468:       fprintf(fp,"<integer> ");
                    469:       break;
                    470:     case Sstring:
                    471:       fprintf(fp,"<literal-string> ");
                    472:       break;
                    473:     case Soperator:
                    474:       fprintf(fp,"<operator> ");
                    475:       break;
                    476:     case Sdollar:
                    477:       fprintf(fp,"<string(dollar)> ");
                    478:       break;
                    479:     case SexecutableArray:
                    480:       fprintf(fp,"<executable array> ");
                    481:       break;
                    482:     case Sarray:
                    483:       fprintf(fp,"<array> ");
                    484:       break;
                    485:     case SleftBraceTag:
                    486:       fprintf(fp,"<leftBraceTag> ");
                    487:       break;
                    488:     case SrightBraceTag:
                    489:       fprintf(fp,"<rightBraceTag> ");
                    490:       break;
                    491:     case Spoly:
                    492:       fprintf(fp,"<poly> ");
                    493:       break;
                    494:     case SarrayOfPOLY:
                    495:       fprintf(fp,"<arrayOfPOLY> ");
                    496:       break;
                    497:     case SmatrixOfPOLY:
                    498:       fprintf(fp,"<matrixOfPOLY> ");
                    499:       break;
                    500:     case Slist:
                    501:       fprintf(fp,"<list> ");
                    502:       break;
                    503:     case Sfile:
                    504:       fprintf(fp,"<file> ");
                    505:       break;
                    506:     case Sring:
                    507:       fprintf(fp,"<ring> ");
                    508:       break;
                    509:     default:
                    510:       fprintf(fp,"<Unknown object tag. %d >",ob.tag);
                    511:       break;
                    512:     }
                    513:   }
                    514:   switch (ob.tag) {
                    515:   case 0:
                    516:     fprintf(fp,"%%[null]"); /* null object */
                    517:     break;
                    518:   case Sinteger:
                    519:     fprintf(fp,"%d",ob.lc.ival);
                    520:     break;
                    521:   case Sstring:
                    522:     fprintf(fp,"%s",ob.lc.str);
                    523:     break;
                    524:   case Soperator:
                    525:     fprintf(fp,"%s %%[operator] ",operatorType(ob.lc.ival));
                    526:     break;
                    527:   case Sdollar:
                    528:     if (PrintDollar == 2) {
                    529:       fprintf(fp,"(%s)",ob.lc.str);
                    530:     } else if (PrintDollar == 0 ) {
                    531:       fprintf(fp,ob.lc.str);
                    532:     } else {
                    533:       fprintf(fp,"$%s$",ob.lc.str);
                    534:     }
                    535:     break;
                    536:   case SexecutableArray:
                    537:     size = ob.rc.ival;
                    538:     ta = ob.lc.tokenArray;
                    539:     fprintf(fp,"{ ");
                    540:     for (i=0; i<size; i++) {
                    541:       switch ((ta[i]).kind) {
                    542:       case ID:
                    543:        fprintf(fp,"<<ID>>%s ",(ta[i]).token);
                    544:        break;
                    545:       case EXECUTABLE_STRING:
                    546:        fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
                    547:        break;
                    548:       case EXECUTABLE_ARRAY:
                    549:        printObject((ta[i]).object,nl,fp);
                    550:        break;
                    551:       default:
                    552:        fprintf(fp,"Unknown token type\n");
                    553:        break;
                    554:       }
                    555:     }
                    556:     fprintf(fp," }");
                    557:     break;
                    558:   case Sarray:
                    559:     printObjectArray(ob,0,fp);
                    560:     break;
                    561:   case SleftBraceTag:
                    562:     fprintf(fp,"[ ");
                    563:     break;
                    564:   case SrightBraceTag:
                    565:     fprintf(fp,"] ");
                    566:     break;
                    567:   case Spoly:
                    568:     fprintf(fp,"%s",KPOLYToString(ob.lc.poly));
                    569:     break;
                    570:   case SarrayOfPOLY:
                    571:     fprintf(fp,"Sorry! The object arrayOfPOLY cannot be printed.");
                    572:     break;
                    573:   case SmatrixOfPOLY:
                    574:     fprintf(fp,"Sorry! The object matrixOfPOLY cannot be printed.");
                    575:     break;
                    576:   case Slist:
                    577:     printObjectList(&ob);
                    578:     break;
                    579:   case Sfile:
                    580:     fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file);
                    581:     break;
                    582:   case Sring:
                    583:     fprintf(fp,"Ring."); KshowRing(KopRingp(ob));
                    584:     break;
                    585:   default:
                    586:     fprintf(fp,"[Unknown object tag.]");
                    587:     break;
                    588:   }
                    589:   if (nl) fprintf(fp,"\n");
                    590: }
                    591:
                    592:
                    593: void printObjectArray(ob,nl,fp)
                    594: struct object ob;
                    595: int nl;
                    596: FILE *fp;
                    597: {
                    598:   int size;
                    599:   int i;
                    600:   size = ob.lc.ival;
                    601:   fprintf(fp,"[  ");
                    602:   for (i=0; i<size; i++) {
                    603:     if (PrintComma && (i != 0)) {
                    604:       fprintf(fp," , ");
                    605:     }else{
                    606:       fprintf(fp,"  ");
                    607:     }
                    608:     printObject((ob.rc.op)[i],0,fp);
                    609:   }
                    610:   fprintf(fp," ] ");
                    611:   if (nl) fprintf(fp,"\n");
                    612: }
                    613:
                    614: static initSystemDictionary()
                    615:  {
                    616:    /* It is recommended to sort the follows for performance */
                    617:    putPrimitiveFunction("mul",Smult);
                    618:    putPrimitiveFunction("add",Sadd);
                    619:    putPrimitiveFunction("sub",Ssub);
                    620:    putPrimitiveFunction("lt",Sless);
                    621:    putPrimitiveFunction("set",Sset);
                    622:    putPrimitiveFunction("eq",Sequal);
                    623:    putPrimitiveFunction("gt",Sgreater);
                    624:    putPrimitiveFunction("QUIT",Squit);
                    625:    putPrimitiveFunction("[",SleftBrace);
                    626:    putPrimitiveFunction("]",SrightBrace);
                    627:    putPrimitiveFunction("bye",Squit);
                    628:    putPrimitiveFunction("length",Slength);
                    629:    putPrimitiveFunction("for",Sfor);
                    630:    putPrimitiveFunction("roll",Sroll);
                    631:    putPrimitiveFunction("cat_n",Scat_n);
                    632:    putPrimitiveFunction("coefficients",Scoefficients);
                    633:    putPrimitiveFunction("copy",Scopy);
                    634:    putPrimitiveFunction("data_conversion",Sdata_conversion);
                    635:    putPrimitiveFunction("aload",Saload);
                    636:    putPrimitiveFunction("def",Sdef);
                    637:    putPrimitiveFunction("degree",Sdegree);
                    638:    putPrimitiveFunction("elimination_order",Selimination_order);
                    639:    putPrimitiveFunction("exec",Sexec);
                    640:    putPrimitiveFunction("exit",Squit);
                    641:    putPrimitiveFunction("get",Sget);
                    642:    putPrimitiveFunction("groebner",Sgroebner);
                    643:    putPrimitiveFunction("hilbert",Shilbert);
                    644:    putPrimitiveFunction("ifelse",Sifelse);
                    645:    putPrimitiveFunction("index",Sindex);
                    646:    putPrimitiveFunction("dup",Sdup);
                    647:    putPrimitiveFunction("init",Sinit);
                    648:    putPrimitiveFunction("loop",Sloop);
                    649:    putPrimitiveFunction("options",Soptions);
                    650:    putPrimitiveFunction("pop",Spop);
                    651:    putPrimitiveFunction("put",Sput);
                    652:    putPrimitiveFunction("print",Sprint);
                    653:    putPrimitiveFunction("pstack",Spstack);
                    654:    putPrimitiveFunction("print_options",Sprint_options);
                    655:    putPrimitiveFunction("print_switch_status",Sprint_switch_status);
                    656:    putPrimitiveFunction("quit",Squit);
                    657:    putPrimitiveFunction("file",Sfileopen);
                    658:    putPrimitiveFunction("closefile",Sclosefile);
                    659:    putPrimitiveFunction("idiv",Sidiv);
                    660:    putPrimitiveFunction("reduction",Sreduction);
                    661:    putPrimitiveFunction("replace",Sreplace);
                    662:    putPrimitiveFunction("resolution",Sresolution);
                    663:    putPrimitiveFunction("run",Srun);
                    664:    putPrimitiveFunction("set_order_by_matrix",Sset_order_by_matrix);
                    665:    putPrimitiveFunction("set_timer",Sset_timer);
                    666:    putPrimitiveFunction("set_up_ring@",Sset_up_ring);
                    667:    putPrimitiveFunction("show_ring",Sshow_ring);
                    668:    putPrimitiveFunction("show_systemdictionary",Sshow_systemdictionary);
                    669:    putPrimitiveFunction("show_user_dictionary",Sshow_user_dictionary);
                    670:    putPrimitiveFunction("spol",Sspol);
                    671:    putPrimitiveFunction("switch_function",Sswitch_function);
                    672:    putPrimitiveFunction("system",Ssystem);
                    673:    putPrimitiveFunction("system_variable",Ssystem_variable);
                    674:    putPrimitiveFunction("syzygies",Ssyzygies);
                    675:    putPrimitiveFunction("test",Stest);
                    676:    putPrimitiveFunction("map",Smap);
                    677:    putPrimitiveFunction("to_records",Sto_records);
                    678:    putPrimitiveFunction("Usage",Susage);
                    679:    putPrimitiveFunction("load",Sload);
                    680:    putPrimitiveFunction("writestring",Swritestring);
                    681:    putPrimitiveFunction("eval",Seval);
                    682:    putPrimitiveFunction("homogenize",Shomogenize);
                    683:    putPrimitiveFunction("principal",Sprincipal);
                    684:    putPrimitiveFunction("pushfile",Spushfile);
                    685:
                    686:  }
                    687:
                    688: static showSystemDictionary() {
                    689:   int i;
                    690:   int maxl;
                    691:   char format[1000];
                    692:   int nl;
                    693:   maxl = 1;
                    694:   for (i=0; i<Sdp; i++) {
                    695:     if (strlen((SystemDictionary[i]).key) >maxl)
                    696:       maxl = strlen((SystemDictionary[i]).key);
                    697:   }
                    698:   maxl += 3;
                    699:   nl = 80/maxl;
                    700:   if (nl < 2) nl = 2;
                    701:   sprintf(format,"%%-%ds",maxl);
                    702:   for (i=0; i<Sdp; i++) {
                    703:     fprintf(Fstack,format,(SystemDictionary[i]).key);
                    704:     if (i % nl == nl-1) fprintf(Fstack,"\n");
                    705:   }
                    706:   fprintf(Fstack,"\n");
                    707: }
                    708:
                    709: static showUserDictionary()
                    710: {
                    711:   int i,j;
                    712:   int maxl;
                    713:   char format[1000];
                    714:   int nl;
                    715:   maxl = 1;
                    716:   for (i=0; i<USER_DICTIONARY_SIZE; i++) {
                    717:     if ((UserDictionary[i]).key != EMPTY) {
                    718:       if (strlen((UserDictionary[i]).key) >maxl)
                    719:        maxl = strlen((UserDictionary[i]).key);
                    720:     }
                    721:   }
                    722:   maxl += 3;
                    723:   nl = 80/maxl;
                    724:   if (nl < 2) nl = 2;
                    725:   sprintf(format,"%%-%ds",maxl);
                    726:   for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
                    727:     if ((UserDictionary[i]).key != EMPTY) {
                    728:       fprintf(Fstack,format,(UserDictionary[i]).key);
                    729:       /*{ char *sss; int ii,h0,h1;
                    730:        sss = UserDictionary[i].key;
                    731:        h0 = UserDictionary[i].h0;
                    732:        h1 = UserDictionary[i].h1;
                    733:        for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
                    734:        fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
                    735:       }*/
                    736:       if (j % nl == nl-1) fprintf(Fstack,"\n");
                    737:       j++;
                    738:     }
                    739:   }
                    740:   fprintf(Fstack,"\n");
                    741: }
                    742:
                    743: static char *operatorType(type)
                    744: int type;
                    745: { int i;
                    746:   for (i=0; i<Sdp; i++) {
                    747:     if (type == (SystemDictionary[i]).obj.lc.ival) {
                    748:       return((SystemDictionary[i]).key);
                    749:     }
                    750:   }
                    751:   return("Unknown operator");
                    752: }
                    753:
                    754: static struct object executableStringToExecutableArray(s)
                    755: char *s;
                    756: {
                    757:   struct tokens *tokenArray;
                    758:   struct object ob;
                    759:   int i;
                    760:   int size;
                    761:   tokenArray = decomposeToTokens(s,&size);
                    762:   ob.tag = SexecutableArray;
                    763:   ob.lc.tokenArray = tokenArray;
                    764:   ob.rc.ival = size;
                    765:   for (i=0; i<size; i++) {
                    766:     if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
                    767:       ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
                    768:       ((ob.lc.tokenArray)[i]).object =
                    769:        executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
                    770:     }
                    771:   }
                    772:   return(ob);
                    773: }
                    774: /****************  stack machine **************************/
                    775: void scanner() {
                    776:   struct tokens token;
                    777:   struct object ob;
                    778:   extern int ctrlC();
                    779:   int tmp;
                    780:   char *tmp2;
                    781:   getokenSM(INIT);
                    782:   initSystemDictionary();
                    783:
                    784:   if (setjmp(EnvOfStackMachine)) {
                    785:     /* do nothing in the case of error */
                    786:   } else {
                    787:     if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
                    788:       signal(SIGINT,ctrlC);
                    789:     }
                    790:
                    791:     KSdefineMacros();
                    792:
                    793:     if (StartAFile) {
                    794:       tmp2 = StartFile;
                    795:       StartFile = (char *)GC_malloc(sizeof(char)*(strlen(StartFile)+
                    796:                                                  40));
                    797:       sprintf(StartFile,"$%s$ run\n",tmp2);
                    798:       token.kind = EXECUTABLE_STRING;
                    799:       token.token = StartFile;
                    800:       executeToken(token); /* execute startup commands */
                    801:       token.kind = ID;
                    802:       token.token = "exec";
                    803:       token = lookupTokens(token); /* set hashing values */
                    804:       tmp = findSystemDictionary(token.token);
                    805:       ob.tag = Soperator;
                    806:       ob.lc.ival = tmp;
                    807:       executePrimitive(ob); /* exec */
                    808:     }
                    809:
                    810:   }
                    811:
                    812:   for (;;) {
                    813:     if (setjmp(EnvOfStackMachine)) {
                    814:       if (DebugStack >= 1) {
                    815:        fprintf(Fstack,"\nscanner> ");
                    816:       }
                    817:     } else {  }
                    818:     if (DebugStack >= 1) { printOperandStack(); }
                    819:     token = getokenSM(GET);
                    820:     if ((tmp=executeToken(token)) < 0) break;
                    821:     /***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/
                    822:   }
                    823: }
                    824:
                    825:
                    826: int ctrlC(sig)
                    827: int sig;
                    828: {
                    829:   extern int ctrlC();
                    830:
                    831:   signal(sig,SIG_IGN);
                    832:   /* see 133p */
                    833:
                    834:   fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
                    835:   fprintf(Fstack,"Type in quit in order to exit sm1.\n");
                    836:   /*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
                    837:   /*
                    838:     $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
                    839:     ctrl-C
                    840:     $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
                    841:     It SOMETIMES makes core dump.
                    842:   */
                    843:   getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
                    844:   signal(SIGINT,ctrlC);
                    845:   longjmp(EnvOfStackMachine,1);
                    846: }
                    847:
                    848: int executeToken(token)
                    849: struct tokens token;
                    850: {
                    851:   struct object ob;
                    852:   int primitive;
                    853:   int size;
                    854:   int status;
                    855:   struct tokens *tokenArray;
                    856:   int i,h0,h1;
                    857:
                    858:   if (token.kind == DOLLAR) {
                    859:     ob.tag = Sdollar;
                    860:     ob.lc.str = token.token;
                    861:     push(ob);
                    862:   } else if (token.kind == ID) {  /* ID */
                    863:
                    864:     if (strcmp(token.token,"exit") == 0) return(1);
                    865:     /* "exit" is not primitive here. */
                    866:
                    867:     if (isLiteral(token.token)) {
                    868:       /* literal object */
                    869:       ob.tag = Sstring;
                    870:       ob.lc.str = (char *)GC_malloc((strlen(token.token)+1)*sizeof(char));
                    871:       if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
                    872:       strcpy(ob.lc.str, &((token.token)[1]));
                    873:
                    874:       if (token.object.tag != Slist) {
                    875:        fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
                    876:        token.object = lookupLiteralString(token.token);
                    877:       }
                    878:       ob.rc.op = token.object.lc.op;
                    879:       push(ob);
                    880:     } else if (isInteger(token.token)) {
                    881:       /* integer object */
                    882:       ob.tag = Sinteger ;
                    883:       ob.lc.ival = strToInteger(token.token);
                    884:       push(ob);
                    885:     } else {
                    886:       if (token.object.tag != Slist) {
                    887:        fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
                    888:        token = lookupTokens(token);
                    889:       }
                    890:       h0 = ((token.object.lc.op)->lc).ival;
                    891:       h1 = ((token.object.lc.op)->rc).ival;
                    892:       ob = findUserDictionary(token.token,h0,h1);
                    893:       primitive = ((token.object.rc.op)->lc).ival;
                    894:       if (ob.tag >= 0) {
                    895:        /* there is a definition in the user dictionary */
                    896:        if (ob.tag == SexecutableArray) {
                    897:          tokenArray = ob.lc.tokenArray;
                    898:          size = ob.rc.ival;
                    899:          for (i=0; i<size; i++) {
                    900:            status = executeToken(tokenArray[i]);
                    901:            if (status != 0) return(status);
                    902:          }
                    903:        }else {
                    904:          push(ob);
                    905:        }
                    906:       } else if (primitive) {
                    907:        /* system operator */
                    908:        ob.tag = Soperator;
                    909:        ob.lc.ival = primitive;
                    910:        return(executePrimitive(ob));
                    911:       } else {
                    912:        fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%%   nor in the user dictionary. Push NullObject.\n",token.token);
                    913:        /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
                    914:        push(NullObject);
                    915:       }
                    916:     }
                    917:   } else if (token.kind == EXECUTABLE_STRING) {
                    918:     push(executableStringToExecutableArray(token.token));
                    919:   } else if (token.kind == EXECUTABLE_ARRAY) {
                    920:     push(token.object);
                    921:   } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
                    922:     return(-1);
                    923:   } else {
                    924:     /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
                    925:     fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
                    926:     fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
                    927:     fprintf(stderr,"If you like to continue, type in RETURN key.\n");
                    928:     fprintf(stderr,"The author expects the bug report.\n");
                    929:     getchar();
                    930:     errorStackmachine("Error: Unknown token type.\n");
                    931:     /**return(-2); /* exit */
                    932:   }
                    933:   return(0); /* normal exit */
                    934: }
                    935:
                    936: int executePrimitive(ob)
                    937: struct object ob;
                    938: {
                    939:   struct object ob1;
                    940:   struct object ob2;
                    941:   struct object ob3;
                    942:   struct object ob4;
                    943:   struct object ob5;
                    944:   struct object rob;
                    945:   struct object obArray[OB_ARRAY_MAX];
                    946:   struct object obArray2[OB_ARRAY_MAX];
                    947:   int size;
                    948:   int i,j,k,n;
                    949:   int status;
                    950:   struct tokens *tokenArray;
                    951:   struct tokens token;
                    952:   FILE *fp;
                    953:   char *fname;
                    954:   int rank;
                    955:   struct object oMat;
                    956:   static int timerStart = 1;
                    957:   static struct tms before, after;
                    958:   struct object oInput;
                    959:   char *str;
                    960:   extern int KeepInput;
                    961:   extern int History;
                    962:   extern struct ring *CurrentRingp;
                    963:
                    964:   if (DebugStack >= 2) {
                    965:     fprintf(Fstack,"In execute\n"); printOperandStack();
                    966:   }
                    967:
                    968:   switch (ob.lc.ival) {
                    969:     /* Postscript primitives :stack */
                    970:   case Spop:
                    971:     ob1 = pop();
                    972:     break;
                    973:
                    974:   case Sdup:
                    975:     ob1 = pop();
                    976:     push(ob1); push(ob1);
                    977:     break;
                    978:   case Scopy:  /* copy values. cf. dup */
                    979:     ob1 = pop();
                    980:     switch(ob1.tag) {
                    981:     case Sinteger: break;
                    982:     default: errorStackmachine("Usage:copy");
                    983:     }
                    984:     size = ob1.lc.ival;
                    985:     k = 0;
                    986:     for (i=size-1; i>=0; i--) {
                    987:       ob2 = peek(i+k);
                    988:       switch(ob2.tag) {
                    989:       case Sdollar: /* copy by value */
                    990:        str = (char *)GC_malloc(strlen(ob2.lc.str)+3);
                    991:        if (str == (char *)NULL) errorStackmachine("No memory (copy)");
                    992:        strcpy(str,ob2.lc.str);
                    993:        push(KpoString(str));
                    994:        break;
                    995:       case Spoly:
                    996:        errorStackmachine("no pCopy (copy)");
                    997:        break;
                    998:       case Sarray:
                    999:        n = ob2.lc.ival;
                   1000:        ob3 = newObjectArray(n);
                   1001:        for (j=0; j<n; j++) {
                   1002:          putoa(ob3,j,getoa(ob2,j));
                   1003:        }
                   1004:        push(ob3);
                   1005:        break;
                   1006:       default:
                   1007:        push(ob2);
                   1008:        break;
                   1009:       }
                   1010:       k++;
                   1011:     }
                   1012:     break;
                   1013:   case Sroll:
                   1014:     ob1 = pop();
                   1015:     ob2 = pop();
                   1016:     switch(ob1.tag) {
                   1017:     case Sinteger:
                   1018:       j = ob1.lc.ival;
                   1019:       break;
                   1020:     default: errorStackmachine("Usage:roll");
                   1021:     }
                   1022:     switch(ob2.tag) {
                   1023:     case Sinteger:
                   1024:       n = ob2.lc.ival;
                   1025:       break;
                   1026:     default: errorStackmachine("Usage:roll");
                   1027:     }
                   1028:     for (i=0; i<n; i++) {
                   1029:       if (i < OB_ARRAY_MAX) {
                   1030:        obArray[i] = pop();
                   1031:       }else{
                   1032:        errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
                   1033:       }
                   1034:     }
                   1035:     for (i=0; i<n; i++) {
                   1036:       k = (j-1)%n;
                   1037:       k = (k>=0?k: k+n);
                   1038:       push(obArray[k]);
                   1039:       j--;
                   1040:     }
                   1041:     break;
                   1042:   case Spstack:
                   1043:     printOperandStack();
                   1044:     break;
                   1045:
                   1046:     /* Postscript primitives :arithmetic */
                   1047:   case Sadd:
                   1048:     ob1 = pop();
                   1049:     ob2 = pop();
                   1050:     rob = KooAdd(ob1,ob2);
                   1051:     push(rob);
                   1052:     break;
                   1053:   case Ssub:
                   1054:     ob2 = pop();
                   1055:     ob1 = pop();
                   1056:     rob = KooSub(ob1,ob2);
                   1057:     push(rob);
                   1058:     break;
                   1059:   case Smult:
                   1060:     ob2 = pop();
                   1061:     ob1 = pop();
                   1062:     rob = KooMult(ob1,ob2);
                   1063:     push(rob);
                   1064:     break;
                   1065:   case Sidiv:
                   1066:     ob2 = pop(); ob1 = pop();
                   1067:     rob = KooDiv(ob1,ob2);
                   1068:     push(rob);
                   1069:     break;
                   1070:
                   1071:     /* Postscript primitives :array */
                   1072:   case SleftBrace:
                   1073:     rob.tag = SleftBraceTag;
                   1074:     push(rob);
                   1075:     break;
                   1076:
                   1077:   case SrightBrace:
                   1078:     size = 0;
                   1079:     ob1 = peek(size);
                   1080:     while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
                   1081:       if (ob1.tag == SleftBraceTag) {
                   1082:        rob = newObjectArray(size);
                   1083:        for (i=0; i<size; i++) {
                   1084:          (rob.rc.op)[i] = peek(size-1-i);
                   1085:        }
                   1086:        for (i=0; i<size+1; i++) {
                   1087:          pop();
                   1088:        }
                   1089:        break;
                   1090:       }
                   1091:       size++;
                   1092:       ob1 = peek(size);
                   1093:     }
                   1094:     push(rob);
                   1095:     break;
                   1096:
                   1097:   case Sget:
                   1098:     /* [a_0 ... a_{n-1}] i   get a_i */
                   1099:     /* ob2               ob1 get     */
                   1100:     ob1 = pop();
                   1101:     ob2 = pop();
                   1102:     switch(ob2.tag) {
                   1103:     case Sarray: break;
                   1104:     default: errorStackmachine("Usage:get");
                   1105:     }
                   1106:     switch(ob1.tag) {
                   1107:     case Sinteger: break;
                   1108:     default: errorStackmachine("Usage:get");
                   1109:     }
                   1110:     i =ob1.lc.ival;
                   1111:     size = getoaSize(ob2);
                   1112:     if ((0 <= i) && (i<size)) {
                   1113:       push(getoa(ob2,i));
                   1114:     }else{
                   1115:       errorStackmachine("Index is out of bound. (get)\n");
                   1116:     }
                   1117:     break;
                   1118:
                   1119:   case Sput:
                   1120:     /* [a_0 ... a_{n-1}] index any put */
                   1121:     /* ob3               ob2   ob1 put     */
                   1122:     ob1 = pop(); ob2 = pop(); ob3 = pop();
                   1123:     switch(ob2.tag) {
                   1124:     case Sinteger: break;
                   1125:     default: errorStackmachine("Usage:put");
                   1126:     }
                   1127:     switch(ob3.tag) {
                   1128:     case Sarray:
                   1129:       i = ob2.lc.ival;
                   1130:       size = getoaSize(ob3);
                   1131:       if ((0 <= i) && (i<size)) {
                   1132:        getoa(ob3,i) = ob1;
                   1133:       }else{
                   1134:        errorStackmachine("Index is out of bound. (put)\n");
                   1135:       }
                   1136:       break;
                   1137:     case Sdollar:
                   1138:       i = ob2.lc.ival;
                   1139:       size = strlen(ob3.lc.str);
                   1140:       if ((0 <= i) && (i<size)) {
                   1141:        if (ob1.tag == Sdollar) {
                   1142:          (ob3.lc.str)[i] = (ob1.lc.str)[0];
                   1143:        }else{
                   1144:          (ob3.lc.str)[i] = ob1.lc.ival;
                   1145:        }
                   1146:       }else{
                   1147:        errorStackmachine("Index is out of bound. (put)\n");
                   1148:       }
                   1149:       break;
                   1150:     default: errorStackmachine("Usage:put");
                   1151:     }
                   1152:     break;
                   1153:
                   1154:   case Sindex:
                   1155:     ob1 = pop();
                   1156:     switch(ob1.tag) {
                   1157:     case Sinteger: break;
                   1158:     default: errorStackmachine("Usage:index");
                   1159:     }
                   1160:     size = ob1.lc.ival;
                   1161:     push(peek(size-1));
                   1162:     break;
                   1163:
                   1164:   case Saload:
                   1165:     /* [a1 a2 ... an] aload a1 a2 ... an [a1 ... an] */
                   1166:     ob1 = pop();
                   1167:     switch(ob1.tag) {
                   1168:     case Sarray: break;
                   1169:     default:
                   1170:       errorStackmachine("Usage:aload");
                   1171:     }
                   1172:     size = getoaSize(ob1);
                   1173:     for (i=0; i<size; i++) {
                   1174:       push(getoa(ob1,i));
                   1175:     }
                   1176:     push(ob1);
                   1177:
                   1178:     break;
                   1179:
                   1180:   case Slength:
                   1181:     /* [a_0 ... a_{n-1}] length n */
                   1182:     /*               ob1 length rob */
                   1183:     ob1 = pop();
                   1184:     switch(ob1.tag) {
                   1185:     case Sarray:
                   1186:       size = getoaSize(ob1);
                   1187:       push(KpoInteger(size));
                   1188:       break;
                   1189:     case Sdollar:
                   1190:       push(KpoInteger(strlen(ob1.lc.str)));
                   1191:       break;
                   1192:     default: errorStackmachine("Usage:length");
                   1193:     }
                   1194:     break;
                   1195:
                   1196:     /* Postscript primitives :relation */
                   1197:   case Sequal:
                   1198:     /* obj1 obj2 == bool */
                   1199:     ob2 = pop();
                   1200:     ob1 = pop();
                   1201:     if(KooEqualQ(ob1,ob2)) {
                   1202:       push(KpoInteger(1));
                   1203:     }else{
                   1204:       push(KpoInteger(0));
                   1205:     }
                   1206:     break;
                   1207:
                   1208:   case Sless:
                   1209:     /* obj1 obj2 < bool */
                   1210:     ob2 = pop();
                   1211:     ob1 = pop();
                   1212:     push(KooLess(ob1,ob2));
                   1213:     break;
                   1214:
                   1215:   case Sgreater:
                   1216:     /* obj1 obj2 < bool */
                   1217:     ob2 = pop();
                   1218:     ob1 = pop();
                   1219:     push(KooGreater(ob1,ob2));
                   1220:     break;
                   1221:
                   1222:
                   1223:     /* Postscript primitives :controle */
                   1224:   case Sloop:
                   1225:     /* { .... exit .....} loop */
                   1226:     ob1 = pop();
                   1227:     switch(ob1.tag) {
                   1228:     case SexecutableArray: break;
                   1229:     default:
                   1230:       errorStackmachine("Usage:loop");
                   1231:       break;
                   1232:     }
                   1233:     tokenArray = ob1.lc.tokenArray;
                   1234:     size = ob1.rc.ival;
                   1235:     i = 0;
                   1236:     while (1) {
                   1237:       token = tokenArray[i];
                   1238:       /***printf("[token %d]%s\n",i,token.token);*/
                   1239:       i++;
                   1240:       if (i >= size) i=0;
                   1241:       status = executeToken(token);
                   1242:       if (status != 0) break;
                   1243:       /* here, do not return 1. Do not propagate exit signal outside of the
                   1244:         loop. */
                   1245:     }
                   1246:     break;
                   1247:
                   1248:   case Sfor:
                   1249:     /* init inc limit { } for */
                   1250:     /* ob4  ob3 ob2   ob1 */
                   1251:     ob1 =pop(); ob2 = pop(); ob3 = pop(); ob4 = pop();
                   1252:     switch(ob1.tag) {
                   1253:     case SexecutableArray: break;
                   1254:     default: errorStackmachine("Usage:for");
                   1255:     }
                   1256:     switch(ob2.tag) {
                   1257:     case Sinteger: break;
                   1258:     default:
                   1259:       errorStackmachine("Usage:for The 3rd argument must be integer.");
                   1260:     }
                   1261:     switch(ob3.tag) {
                   1262:     case Sinteger: break;
                   1263:     default: errorStackmachine("Usage:for The 2nd argument must be integer.");
                   1264:     }
                   1265:     switch(ob4.tag) {
                   1266:     case Sinteger: break;
                   1267:     default: errorStackmachine("Usage:for The 1st argument must be integer.");
                   1268:     }
                   1269:     {
                   1270:       int i,lim,inc,j;
                   1271:       i = ob4.lc.ival;
                   1272:       lim = ob2.lc.ival;
                   1273:       inc = ob3.lc.ival;
                   1274:       if (inc > 0) {
                   1275:         /*
                   1276:        if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n");
                   1277:         */
                   1278:        for ( ; i<=lim; i += inc) {
                   1279:          push(KpoInteger(i));
                   1280:          tokenArray = ob1.lc.tokenArray;
                   1281:          size = ob1.rc.ival;
                   1282:          for (j=0; j<size; j++) {
                   1283:            status = executeToken(tokenArray[j]);
                   1284:            if (status) goto xyz;
                   1285:          }
                   1286:        }
                   1287:       }else{
                   1288:         /*
                   1289:        if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n");
                   1290:         */
                   1291:        for ( ; i>=lim; i += inc) {
                   1292:          push(KpoInteger(i));
                   1293:          tokenArray = ob1.lc.tokenArray;
                   1294:          size = ob1.rc.ival;
                   1295:          for (j=0; j<size; j++) {
                   1296:            status = executeToken(tokenArray[j]);
                   1297:            if (status) goto xyz;
                   1298:          }
                   1299:        }
                   1300:       }
                   1301:       xyz:  ;
                   1302:     }
                   1303:     break;
                   1304:
                   1305:   case Smap:
                   1306:     ob2 = pop(); ob1 = pop();
                   1307:     switch(ob1.tag) {
                   1308:     case Sarray: break;
                   1309:     default:
                   1310:       errorStackmachine("Usage:map The 1st argument must be an array.");
                   1311:       break;
                   1312:     }
                   1313:     switch(ob2.tag) {
                   1314:     case SexecutableArray: break;
                   1315:     default:
                   1316:       errorStackmachine("Usage:map The 2nd argument must be an executable array.");
                   1317:       break;
                   1318:     }
                   1319:     { int osize,size;
                   1320:       int i,j;
                   1321:       osize = getoaSize(ob1);
                   1322:
                   1323:       /*KSexecuteString("[");*/
                   1324:       rob.tag = SleftBraceTag;
                   1325:       push(rob);
                   1326:
                   1327:       for (i=0; i<osize; i++) {
                   1328:        push(getoa(ob1,i));
                   1329:        tokenArray = ob2.lc.tokenArray;
                   1330:        size = ob2.rc.ival;
                   1331:        for (j=0; j<size; j++) {
                   1332:          status = executeToken(tokenArray[j]);
                   1333:          if (status) goto foor;
                   1334:        }
                   1335:       }
                   1336:     foor: ;
                   1337:       /*KSexecuteString("]");*/
                   1338:       {
                   1339:        size = 0;
                   1340:        ob1 = peek(size);
                   1341:        while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
                   1342:          if (ob1.tag == SleftBraceTag) {
                   1343:            rob = newObjectArray(size);
                   1344:            for (i=0; i<size; i++) {
                   1345:              (rob.rc.op)[i] = peek(size-1-i);
                   1346:            }
                   1347:            for (i=0; i<size+1; i++) {
                   1348:              pop();
                   1349:            }
                   1350:            break;
                   1351:          }
                   1352:          size++;
                   1353:          ob1 = peek(size);
                   1354:        }
                   1355:        push(rob);
                   1356:       }
                   1357:     }
                   1358:     break;
                   1359:
                   1360:
                   1361:   case Sifelse:
                   1362:     /* bool { } { } ifelse */
                   1363:     ob1 = pop();
                   1364:     ob2 = pop();
                   1365:     ob3 = pop();
                   1366:     switch (ob1.tag) {
                   1367:     case SexecutableArray: break;
                   1368:     default: errorStackmachine("Usage:ifelse");
                   1369:     }
                   1370:     switch (ob2.tag) {
                   1371:     case SexecutableArray: break;
                   1372:     default: errorStackmachine("Usage:ifelse");
                   1373:     }
                   1374:     switch (ob3.tag) {
                   1375:     case Sinteger: break;
                   1376:     default: errorStackmachine("Usage:ifelse");
                   1377:     }
                   1378:     if (ob3.lc.ival) {
                   1379:       /* execute ob2 */
                   1380:       ob1 = ob2;
                   1381:     }
                   1382:     /* execute ob1 */
                   1383:     tokenArray = ob1.lc.tokenArray;
                   1384:     size = ob1.rc.ival;
                   1385:     for (i=0; i<size; i++) {
                   1386:       token = tokenArray[i];
                   1387:       status = executeToken(token);
                   1388:       if (status != 0) return(status);
                   1389:     }
                   1390:
                   1391:     break;
                   1392:
                   1393:   case Sexec:
                   1394:     /* { .........} exec */
                   1395:     ob1 = pop();
                   1396:     switch(ob1.tag) {
                   1397:     case SexecutableArray: break;
                   1398:     default: errorStackmachine("Usage:exec");
                   1399:     }
                   1400:     tokenArray = ob1.lc.tokenArray;
                   1401:     size = ob1.rc.ival;
                   1402:     for (i=0; i<size; i++) {
                   1403:       token = tokenArray[i];
                   1404:       /***printf("[token %d]%s\n",i,token.token);*/
                   1405:       status = executeToken(token);
                   1406:       if (status != 0) break;
                   1407:     }
                   1408:     break;
                   1409:
                   1410:    /* Postscript primitives :dictionary */
                   1411:   case Sdef:
                   1412:     ob2 = pop();
                   1413:     ob1 = pop();
                   1414:     /* type check */
                   1415:     switch(ob1.tag) {
                   1416:     case Sstring: break;
                   1417:     default:
                   1418:       errorStackmachine("Usage:def");
                   1419:       break;
                   1420:     }
                   1421:     putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
                   1422:                      (ob1.rc.op->rc).ival,ob2);
                   1423:     break;
                   1424:
                   1425:   case Sload:
                   1426:     ob1 = pop();
                   1427:     switch(ob1.tag) {
                   1428:     case Sstring: break;
                   1429:     default: errorStackmachine("Usage:load");
                   1430:     }
                   1431:     ob1 =  findUserDictionary(ob1.lc.str,
                   1432:                             (ob1.rc.op->lc).ival,
                   1433:                             (ob1.rc.op->rc).ival);
                   1434:     if (ob1.tag == -1) push(NullObject);
                   1435:     else push(ob1);
                   1436:
                   1437:     break;
                   1438:
                   1439:   case Sset:
                   1440:     ob1 = pop();
                   1441:     ob2 = pop();
                   1442:     switch(ob1.tag) {
                   1443:     case Sstring: break;
                   1444:     default: errorStackmachine("Usage:set");
                   1445:     }
                   1446:     putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
                   1447:                      (ob1.rc.op->rc).ival,ob2);
                   1448:     break;
                   1449:
                   1450:   case Sshow_systemdictionary:
                   1451:     fprintf(Fstack,"------------- system dictionary -------------------\n");
                   1452:     showSystemDictionary();
                   1453:     break;
                   1454:
                   1455:   case Sshow_user_dictionary:
                   1456:     showUserDictionary("");
                   1457:     break;
                   1458:
                   1459:
                   1460:
                   1461:     /* Postscript primitives : convert */
                   1462:   case Sdata_conversion:
                   1463:     ob2 = pop();
                   1464:     ob1 = pop();
                   1465:     switch(ob2.tag) {
                   1466:     case Sdollar: break;
                   1467:     default: errorStackmachine("Usage:data_conversion");
                   1468:     }
                   1469:     rob = KdataConversion(ob1,ob2.lc.str);
                   1470:     push(rob);
                   1471:     break;
                   1472:
                   1473:
                   1474:     /* Postscript ptimitives :file */
                   1475:   case Srun:
                   1476:     ob1 = pop();
                   1477:     switch(ob1.tag) {
                   1478:     case Sdollar: break;
                   1479:     case Sstring: break;
                   1480:     default:
                   1481:       errorStackmachine("Usage:run");
                   1482:       break;
                   1483:     }
                   1484:     getokenSM(OPEN,ob1.lc.str);  /* open the file, $filename$ run */
                   1485:     break;
                   1486:
                   1487:   case Sprint:
                   1488:     ob1 = pop();
                   1489:     printObject(ob1,0,Fstack);
                   1490:     break;
                   1491:
                   1492:   case Sfileopen: /* filename  mode   file  descripter */
                   1493:               /* ob2       ob1  */
                   1494:     ob1 = pop();
                   1495:     ob2 = pop();
                   1496:     switch(ob1.tag) {
                   1497:     case Sdollar: break;
                   1498:     default: errorStackmachine("Usage:file");
                   1499:     }
                   1500:     switch(ob2.tag) {
                   1501:     case Sdollar: break;
                   1502:     default:errorStackmachine("Usage:file");
                   1503:     }
                   1504:     rob = NullObject;
                   1505:     if (strcmp(ob2.lc.str,"%stdin") == 0) {
                   1506:       rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin;
                   1507:     }else if (strcmp(ob2.lc.str,"%stdout") == 0) {
                   1508:       rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout;
                   1509:     }else if (strcmp(ob2.lc.str,"%stderr") == 0) {
                   1510:       rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr;
                   1511:     }else if ( (rob.rc.file = fopen(ob2.lc.str,ob1.lc.str)) != (FILE *)NULL) {
                   1512:       rob.tag = Sfile; rob.lc.str = ob2.lc.str;
                   1513:     }else {
                   1514:       errorStackmachine("I cannot open the file.");
                   1515:     }
                   1516:     push(rob);
                   1517:     break;
                   1518:
                   1519:
                   1520:   case Swritestring:
                   1521:     /* file string writestring
                   1522:        ob2  ob1
                   1523:     */
                   1524:     ob1 = pop();
                   1525:     ob2 = pop();
                   1526:     switch(ob2.tag) {
                   1527:     case Sfile: break;
                   1528:     default: errorStackmachine("Usage:writestring");
                   1529:     }
                   1530:     switch(ob1.tag) {
                   1531:     case Sdollar: break;
                   1532:     default:  errorStackmachine("Usage:writestring");
                   1533:     }
                   1534:     fprintf(ob2.rc.file,"%s",ob1.lc.str);
                   1535:     break;
                   1536:
                   1537:   case Sclosefile:
                   1538:     ob1 = pop();
                   1539:     switch(ob1.tag) {
                   1540:     case Sfile: break;
                   1541:     default: errorStackmachine("Usage:closefile");
                   1542:     }
                   1543:     if (fclose(ob1.rc.file) == EOF) {
                   1544:       errorStackmachine("I couldn't close the file.\n");
                   1545:     }
                   1546:     break;
                   1547:
                   1548:   case Spushfile: /* filename pushfile  string */
                   1549:                   /* ob2       */
                   1550:     ob2 = pop();
                   1551:     switch(ob2.tag) {
                   1552:     case Sdollar: break;
                   1553:     default:errorStackmachine("Usage:pushfile");
                   1554:     }
                   1555:     rob = NullObject;
                   1556:     if (strcmp(ob2.lc.str,"%stdin") == 0) {
                   1557:       ob1.tag = Sfile; ob1.lc.str="%stdin"; ob1.rc.file = stdin;
                   1558:     }else if (strcmp(ob2.lc.str,"%stdout") == 0) {
                   1559:       ob1.tag = Sfile; ob1.lc.str="%stdout"; ob1.rc.file = stdout;
                   1560:     }else if (strcmp(ob2.lc.str,"%stderr") == 0) {
                   1561:       ob1.tag = Sfile; ob1.lc.str="%stderr"; ob1.rc.file = stderr;
                   1562:     }else if ( (ob1.rc.file = fopen(ob2.lc.str,"r")) != (FILE *)NULL) {
                   1563:       ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;
                   1564:     }else {
                   1565:       errorStackmachine("I cannot open the file.");
                   1566:     }
                   1567:
                   1568:     /* read the strings
                   1569:     */
                   1570:     n = 256; j=0;
                   1571:     rob.tag = Sdollar; rob.lc.str = (char *) GC_malloc(sizeof(char)*n);
                   1572:     if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");
                   1573:     while ((i = fgetc(ob1.rc.file)) != EOF) {
                   1574:       if (j >= n-1) {
                   1575:        n = 2*n;
                   1576:        if (n <= 0) errorStackmachine("Too large file to put on the stack.");
                   1577:         str = (char *)GC_malloc(sizeof(char)*n);
                   1578:        if (str == (char *)NULL) errorStackmachine("No more memory.");
                   1579:        for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
                   1580:        rob.lc.str = str;
                   1581:       }
                   1582:       (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';
                   1583:       j++;
                   1584:     }
                   1585:
                   1586:     fclose(ob1.rc.file);
                   1587:     push(rob);
                   1588:     break;
                   1589:
                   1590:     /* Postscript primitives :misc */
                   1591:   case Squit:
                   1592:     Kclose(); stackmachine_close();
                   1593:     exit(0);
                   1594:     break;
                   1595:
                   1596:   case Ssystem:
                   1597:     ob1 = pop();
                   1598:     switch(ob1.tag) {
                   1599:     case Sdollar: break;
                   1600:     case Sstring: break;
                   1601:     default: errorStackmachine("Usage:system");
                   1602:     }
                   1603:     system( ob1.lc.str );
                   1604:     break;
                   1605:
                   1606:   case Scat_n:
                   1607:     ob1 = pop();
                   1608:     switch(ob1.tag) {
                   1609:     case Sinteger: break;
                   1610:     default: errorStackmachine("Usage:cat_n");
                   1611:     }
                   1612:     size = ob1.lc.ival;
                   1613:     k = 0;
                   1614:     for (i=size-1; i>=0; i--) {
                   1615:       ob2 = peek(i);
                   1616:       switch(ob2.tag) {
                   1617:       case Sdollar: break;
                   1618:       default: errorStackmachine("Usage:cat_n");
                   1619:       }
                   1620:       k += strlen(ob2.lc.str);
                   1621:     }
                   1622:     ob1.tag = Sdollar;
                   1623:     ob1.lc.str = (char *)GC_malloc(sizeof(char)*(k+1));
                   1624:     if (ob1.lc.str == (char *)NULL) {
                   1625:       errorStackmachine("No more memory.\n");
                   1626:     }
                   1627:     /* concatnate */
                   1628:     k = 0;
                   1629:     for (i=size-1; i>=0; i--) {
                   1630:       ob2 = peek(i);
                   1631:       strcpy(&((ob1.lc.str)[k]),ob2.lc.str);
                   1632:       k = strlen(ob1.lc.str);
                   1633:     }
                   1634:     /* clear the arguments */
                   1635:     for (i=size-1; i>=0; i--) {
                   1636:       ob2 = pop();
                   1637:     }
                   1638:     push(ob1);
                   1639:     break;
                   1640:
                   1641:   case Sset_timer:
                   1642:     /* 118p */
                   1643:     if (timerStart) {
                   1644:       times(&before);
                   1645:       timerStart = 0;
                   1646:     }else{
                   1647:       times(&after);
                   1648:       printf("User time: %f seconds, System time: %f seconds\n",
                   1649:             ((double)(after.tms_utime - before.tms_utime)) /60.0,
                   1650:             ((double)(after.tms_stime - before.tms_stime)) /60.0);
                   1651:       timerStart = 1;
                   1652:     }
                   1653:     break;
                   1654:
                   1655:   case Susage:
                   1656:     ob1 = pop();
                   1657:     Kusage(ob1);
                   1658:     break;
                   1659:
                   1660:   case Sto_records:
                   1661:     ob1 = pop();
                   1662:     switch(ob1.tag) {
                   1663:     case Sdollar: break;
                   1664:     default:  errorStackmachine("Usage:to_records");
                   1665:     }
                   1666:     ob2 = KtoRecords(ob1);
                   1667:     size = getoaSize(ob2);
                   1668:     for (i=0; i<size; i++) {
                   1669:       push(getoa(ob2,i));
                   1670:     }
                   1671:     rob.tag = Sinteger;
                   1672:     rob.lc.ival = size;
                   1673:     push(rob);
                   1674:     break;
                   1675:
                   1676:   case Ssystem_variable:
                   1677:     ob1 = pop();
                   1678:     switch(ob1.tag) {
                   1679:     case Sarray: break;
                   1680:     default: errorStackmachine("Usage:system_variable");
                   1681:     }
                   1682:     push(KsystemVariable(ob1));
                   1683:     break;
                   1684:
                   1685:     /* kan primitives :kan :ring */
                   1686:   case Sset_order_by_matrix:
                   1687:     ob1 = pop();
                   1688:     KsetOrderByObjArray(ob1);
                   1689:     break;
                   1690:   case Sset_up_ring:
                   1691:     ob5 = pop(); ob4=pop(); ob3=pop(); ob2=pop(); ob1=pop();
                   1692:     KsetUpRing(ob1,ob2,ob3,ob4,ob5);
                   1693:     break;
                   1694:   case Sshow_ring:
                   1695:     KshowRing(CurrentRingp);
                   1696:     break;
                   1697:   case Sswitch_function:
                   1698:     ob1 = pop();
                   1699:     ob2 = pop();
                   1700:     KswitchFunction(ob2,ob1);
                   1701:     break;
                   1702:   case Sprint_switch_status:
                   1703:     KprintSwitchStatus();
                   1704:     break;
                   1705:   case Sreplace:
                   1706:     ob2 = pop();
                   1707:     ob1 = pop();
                   1708:     push(KoReplace(ob1,ob2));
                   1709:     break;
                   1710:
                   1711:   case Scoefficients:
                   1712:     ob2 = pop();
                   1713:     ob1 = pop();
                   1714:     push(Kparts(ob1,ob2));
                   1715:     break;
                   1716:
                   1717:   case Sdegree:
                   1718:     ob2 = pop();
                   1719:     ob1 = pop();
                   1720:     push(Kdegree(ob1,ob2));
                   1721:     break;
                   1722:   case Sspol:
                   1723:     ob2 = pop();
                   1724:     ob1 = pop();
                   1725:     push(Ksp(ob1,ob2));
                   1726:     break;
                   1727:
                   1728:   case Seval:
                   1729:     ob1 = pop();
                   1730:     push(Keval(ob1));
                   1731:     break;
                   1732:
                   1733:   case Sreduction:
                   1734:     ob2 = pop();
                   1735:     ob1 = pop();
                   1736:     push(Kreduction(ob1,ob2));
                   1737:     break;
                   1738:
                   1739:   case Sgroebner :
                   1740:     ob1 = pop();
                   1741:     push(Kgroebner(ob1));
                   1742:     break;
                   1743:
                   1744:   case Shomogenize :
                   1745:     ob1 = pop();
                   1746:     push(homogenizeObject(ob1,&i));
                   1747:     break;
                   1748:
                   1749:   case Sprincipal :
                   1750:     ob1 = pop();
                   1751:     push(oPrincipalPart(ob1));
                   1752:     break;
                   1753:
                   1754:   case Sinit:
                   1755:     ob1 = pop();
                   1756:     push(Khead(ob1));
                   1757:     break;
                   1758:
                   1759:   case Stest:
                   1760:     /* test is used for a test of a new function. */
                   1761:     ob1 = pop();
                   1762:     push(test(ob1));
                   1763:     /*
                   1764:     {
                   1765:
                   1766:     }
                   1767:     */
                   1768:     break;
                   1769:
                   1770:
                   1771:   default:
                   1772:     errorStackmachine("Unknown Soperator type. \n");
                   1773:   }
                   1774:   return(0);  /* normal exit */
                   1775: }
                   1776:
                   1777:
                   1778:
                   1779:
                   1780:
                   1781: errorStackmachine(str)
                   1782: char *str;
                   1783: {
                   1784:   int i,j,k;
                   1785:   static char *u="Usage:";
                   1786:   char message0[1024];
                   1787:   char *message;
                   1788:   message = message0;
                   1789:   i = 0;
                   1790:   while (i<6 && str[i]!='0') {
                   1791:     if (str[i] != u[i]) break;
                   1792:     i++;
                   1793:   }
                   1794:   if (i==6) {
                   1795:     fprintf(stderr,"ERROR(sm): \n");
                   1796:     while (str[i] != '\0' && str[i] != ' ') {
                   1797:       i++;
                   1798:     }
                   1799:     if (str[i] == ' ') {
                   1800:       fprintf(stderr,"  %s\n",&(str[i+1]));
                   1801:       k = 0;
                   1802:       if (i-6 > 1022) message = (char *)GC_malloc(sizeof(char)*i);
                   1803:       for (j=6; j<i ; j++) {
                   1804:        message[k] = str[j];
                   1805:        message[k+1] = '\0';
                   1806:        k++;
                   1807:       }
                   1808:       Kusage2(stderr,message);
                   1809:     }else{
                   1810:       Kusage2(stderr,&(str[6]));
                   1811:     }
                   1812:   }else {
                   1813:     fprintf(stderr,"ERROR(sm): ");
                   1814:     fprintf(stderr,str);
                   1815:   }
                   1816:   fprintf(stderr,"\n");
                   1817:   longjmp(EnvOfStackMachine,1);
                   1818: }
                   1819:
                   1820: warningStackmachine(str)
                   1821: char *str;
                   1822: {
                   1823:   fprintf(stderr,"WARNING(sm): ");
                   1824:   fprintf(stderr,str);
                   1825:   return(0);
                   1826: }
                   1827:
                   1828:
                   1829: /* exports */
                   1830: KSexecuteString(s)
                   1831: char *s;
                   1832: {
                   1833:   struct tokens token;
                   1834:   struct object ob;
                   1835:   int tmp;
                   1836:
                   1837:
                   1838:   if (setjmp(EnvOfStackMachine)) {
                   1839:     return(-1);
                   1840:   }else{
                   1841:     token.token = s;
                   1842:     token.kind = EXECUTABLE_STRING;
                   1843:     executeToken(token);
                   1844:     token.kind = ID;
                   1845:     token.token = "exec";
                   1846:     token = lookupTokens(token); /* no use */
                   1847:     tmp = findSystemDictionary(token.token);
                   1848:     ob.tag = Soperator;
                   1849:     ob.lc.ival = tmp;
                   1850:     executePrimitive(ob);
                   1851:     return(0);
                   1852:   }
                   1853: }
                   1854:
                   1855: KSdefineMacros() {
                   1856:   struct tokens token;
                   1857:   int tmp;
                   1858:   struct object ob;
                   1859:
                   1860:   if (setjmp(EnvOfStackMachine)) {
                   1861:     return(-1);
                   1862:   }else{
                   1863:     if (StandardMacros && (strlen(SMacros))) {
                   1864:       token.kind = EXECUTABLE_STRING;
                   1865:       token.token = SMacros;
                   1866:       executeToken(token); /* execute startup commands */
                   1867:       token.kind = ID;
                   1868:       token.token = "exec";
                   1869:       token = lookupTokens(token); /* no use */
                   1870:       tmp = findSystemDictionary(token.token);
                   1871:       ob.tag = Soperator;
                   1872:       ob.lc.ival = tmp;
                   1873:       executePrimitive(ob); /* exec */
                   1874:     }
                   1875:     return(0);
                   1876:   }
                   1877: }
                   1878:
                   1879: void KSstart() {
                   1880:   stackmachine_init(); KinitKan();
                   1881:   getokenSM(INIT); initSystemDictionary();
                   1882:   KSdefineMacros();
                   1883:   /* setjmp(EnvOfStackMachine) */
                   1884: }
                   1885:
                   1886: void KSstop() {
                   1887:   Kclose(); stackmachine_close();
                   1888: }
                   1889:
                   1890:
                   1891: struct object KSpop() {
                   1892:   return(pop());
                   1893: }
                   1894:
                   1895: void KSpush(ob)
                   1896: struct object ob;
                   1897: {
                   1898:   push(ob);
                   1899: }

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