[BACK]Return to primitive.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Annotation of OpenXM/src/kan96xx/Kan/primitive.c, Revision 1.11

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

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