home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d518 / post.lha / Post / post16s.lzh / postop1.c < prev    next >
C/C++ Source or Header  |  1991-04-17  |  45KB  |  1,532 lines
  1. /* PostScript interpreter file "postop1.c" - operators (1) */
  2. /* (C) Adrian Aylward 1989, 1991 */
  3.  
  4. # include "post.h"
  5.  
  6. /* .error */
  7.  
  8. void operror(void)
  9. {   struct object token;
  10.     int i;
  11.     token.type = typebool;
  12.     token.flags = 0;
  13.     token.length = 0;
  14.     token.value.ival = 1;
  15.     errdstoken[0] = token;
  16.     errorflag = 1;
  17.     for (i = 0; i < edsmax; i++)
  18.         dictput(errdsdict.value.vref, &errdsname[i], &errdstoken[i]);
  19.     errorflag = 2;
  20.  
  21.     stop();
  22.  
  23.     errorexit();
  24.     if (dictget(errordict.value.vref, &errorname[0], &token, 0))
  25.         execstack[execnest++] = token;
  26.     else
  27.         errormsg();
  28.     errorjmp(0, 1);
  29. }
  30.  
  31. /* .handleerror */
  32.  
  33. void ophandleerror(void)
  34. {   struct object token;
  35.     int i;
  36.     token.type = typebool;
  37.     token.flags = 0;
  38.     token.length = 0;
  39.     token.value.ival = 0;
  40.     errorflag = 1;
  41.     for (i = 0; i < edsmax; i++)
  42.         dictget(errdsdict.value.vref, &errdsname[i], &errdstoken[i], 0);
  43.     dictput(errdsdict.value.vref, &errdsname[0], &token);
  44.     errorflag = 2;
  45.     token = errdstoken[0];
  46.     if (token.type == typebool && token.value.ival) errormsg();
  47. }
  48.  
  49. /* [ */
  50.  
  51. void opmark(void)
  52. {   struct object token;
  53.     if (opernest == operstacksize) error(errstackoverflow);
  54.     token.type = typemark;
  55.     token.flags = 0;
  56.     token.length = 0;
  57.     token.value.ival = 0;
  58.     operstack[opernest++] = token;
  59. }
  60.  
  61. /* ] */
  62.  
  63. void opkram(void)
  64. {   struct object token, *token1;
  65.     int nest, length;
  66.     nest = opernest;
  67.     token1 = &operstack[nest];
  68.     for (;;)
  69.     {    if (nest == 0) error(errunmatchedmark);
  70.          if ((--token1)->type == typemark) break;
  71.          nest--;
  72.     }
  73.     length = opernest - nest;
  74.     token.type = typearray;
  75.     token.flags = 0;
  76.     token.length = length;
  77.     token.value.vref = arrayalloc(length);
  78.     arraycopy(vmaptr(token.value.vref), token1 + 1, length);
  79.     *token1 = token;
  80.     opernest = nest;
  81. }
  82.  
  83. /* = */
  84.  
  85. void opequals(void)
  86. {   if (opernest < 1) error(errstackunderflow);
  87.     if (sstdout)
  88.     {   printequals(sstdout, &operstack[opernest - 1]);
  89.         putch(sstdout, '\n');
  90.     }
  91.     opernest--;
  92. }
  93.  
  94. /* == */
  95.  
  96. void opeqeq(void)
  97. {   if (opernest < 1) error(errstackunderflow);
  98.     if (sstdout)
  99.     {   printeqeq(sstdout, &operstack[opernest - 1], 0, 0);
  100.         putch(sstdout, '\n');
  101.     }
  102.     opernest--;
  103. }
  104.  
  105. /* abs */
  106.  
  107. void opabs(void)
  108. {   struct object *token1;
  109.     int num1;
  110.     if (opernest < 1) error(errstackunderflow);
  111.     token1 = &operstack[opernest - 1];
  112.     if      (token1->type == typeint)
  113.     {   num1 = token1->value.ival;
  114.         if (num1 < 0)
  115.         {   num1 = -num1;
  116.             if (num1 < 0)
  117.             {   token1->type = typereal;
  118.                 token1->value.rval = -((float) num1);
  119.             }
  120.             else
  121.                 token1->value.ival = num1;
  122.         }
  123.     }
  124.     else if (token1->type == typereal)
  125.     {   if (token1->value.rval < 0.0)
  126.             token1->value.rval = -token1->value.rval;
  127.     }
  128.     else
  129.         error(errtypecheck);
  130. }
  131.  
  132. /* add */
  133.  
  134. void opadd(void)
  135. {   struct object token, *token1, *token2;
  136.     int num1, num2;
  137.     if (opernest < 2) error(errstackunderflow);
  138.     token2 = &operstack[opernest - 1];
  139.     token1 = token2 - 1;
  140.     if (token1->type == typeint && token2->type == typeint)
  141.     {   num1 = token1->value.ival;
  142.         num2 = token2->value.ival;
  143.         if      (num1 > 0 && num2 > 0)
  144.         {   num1 += num2;
  145.             if (num1 > 0)
  146.             {   token1->value.ival = num1;
  147.                 opernest--;
  148.                 return;
  149.             }
  150.         }
  151.         else if (num1 < 0 && num2 < 0)
  152.         {   num1 += num2;
  153.             if (num1 < 0)
  154.             {   token1->value.ival = num1;
  155.                 opernest--;
  156.                 return;
  157.             }
  158.         }
  159.         else
  160.         {   num1 += num2;
  161.             token1->value.ival = num1;
  162.             opernest--;
  163.             return;
  164.         }
  165.     }
  166.     token = *token1;
  167.     if (token.type == typeint)
  168.     {   token.type = typereal;
  169.         token.value.rval = token.value.ival;
  170.     }
  171.     else
  172.         if (token.type != typereal) error(errtypecheck);
  173.     if (token2->type == typeint)
  174.         token.value.rval += token2->value.ival;
  175.     else
  176.     {   if (token2->type != typereal) error(errtypecheck);
  177.         token.value.rval += token2->value.rval;
  178.     }
  179.     *token1 = token;
  180.     opernest--;
  181. }
  182.  
  183. /* aload */
  184.  
  185. void opaload(void)
  186. {   struct object *token1;
  187.     int length;
  188.     if (opernest < 1) error(errstackunderflow);
  189.     token1 = &operstack[opernest - 1];
  190.     if (token1->type != typearray && token1->type != typepacked)
  191.         error(errtypecheck);
  192.     if (token1->flags & flagrprot) error(errinvalidaccess);
  193.     length = token1->length;
  194.     if (opernest + length > operstacksize) error(errstackoverflow);
  195.     *(token1 + length) = *token1;
  196.     if (token1->type == typearray)
  197.         arraycopy(token1, vmaptr(token1->value.vref), length);
  198.     else
  199.         arrayunpk(token1, vmsptr(token1->value.vref), length);
  200.     opernest += length;
  201. }
  202.  
  203. /* anchorsearch */
  204.  
  205. void opanchorsearch(void)
  206. {   struct object token, *token1, *token2;
  207.     char *sptr1, *sptr2;
  208.     int len1, len2, bool;
  209.     if (opernest < 2) error(errstackunderflow);
  210.     if (opernest + 1 > operstacksize) error(errstackoverflow);
  211.     token2 = &operstack[opernest - 1];
  212.     token1 = token2 - 1;
  213.     if (token1->type != typestring) error(errtypecheck);
  214.     if (token1->flags & flagrprot) error(errinvalidaccess);
  215.     len1 = token1->length;
  216.     sptr1 = vmsptr(token1->value.vref);
  217.     if (token2->type != typestring) error(errtypecheck);
  218.     if (token2->flags & flagrprot) error(errinvalidaccess);
  219.     len2 = token2->length;
  220.     sptr2 = vmsptr(token2->value.vref);
  221.     bool = 0;
  222.     if (len2 <= len1 && memcmp(sptr1, sptr2, len2) == 0)
  223.     {   bool = 1;
  224.         token = *token1;
  225.         token.length = len2;
  226.         *token2 = token;
  227.         token.length = len1 - len2;
  228.         token.value.vref = token1->value.vref + len2;
  229.         *token1 = token;
  230.         token2++;
  231.         opernest++;
  232.     }
  233.     token.type = typebool;
  234.     token.flags = 0;
  235.     token.length = 0;
  236.     token.value.ival = bool;
  237.     *token2 = token;
  238. }
  239.  
  240. /* and */
  241.  
  242. void opand(void)
  243. {   struct object *token1, *token2;
  244.     if (opernest < 2) error(errstackunderflow);
  245.     token2 = &operstack[opernest - 1];
  246.     token1 = token2 - 1;
  247.     if ((token1->type == typebool && token2->type == typebool) ||
  248.         (token1->type == typeint  && token2->type == typeint))
  249.         token1->value.ival &= token2->value.ival;
  250.     else
  251.         error(errtypecheck);
  252.     opernest--;
  253. }
  254.  
  255. /* array */
  256.  
  257. void oparray(void)
  258. {   struct object token, *token1;
  259.     int length;
  260.     if (opernest < 1) error(errstackunderflow);
  261.     token1 = &operstack[opernest - 1];
  262.     if (token1->type != typeint) error(errtypecheck);
  263.     length = token1->value.ival;
  264.     if (length < 0 || length > 65535) error(errrangecheck);
  265.     token.type = typearray;
  266.     token.flags = 0;
  267.     token.length = length;
  268.     token.value.vref = arrayalloc(length);
  269.     *token1 = token;
  270. }
  271.  
  272. /* astore */
  273.  
  274. void opastore(void)
  275. {   struct object *token1, *aptr;
  276.     int length;
  277.     if (opernest < 1) error(errstackunderflow);
  278.     token1 = &operstack[opernest - 1];
  279.     if (token1->type != typearray) error(errtypecheck);
  280.     if (token1->flags & flagwprot) error(errinvalidaccess);
  281.     length = token1->length;
  282.     if (opernest < length + 1) error(errstackunderflow);
  283.     aptr = token1 - length;
  284.     arraysave(token1->value.vref, length);
  285.     arraycopy(vmaptr(token1->value.vref), aptr, length);
  286.     *aptr = *token1;
  287.     opernest -= length;
  288. }
  289.  
  290. /* atan */
  291.  
  292. void opatan(void)
  293. {   struct object token, *token1, *token2;
  294.     float flt2;
  295.     if (opernest < 2) error(errstackunderflow);
  296.     token2 = &operstack[opernest - 1];
  297.     token1 = token2 - 1;
  298.     token = *token1;
  299.     if (token.type == typeint)
  300.     {   token.type = typereal;
  301.         token.value.rval = token.value.ival;
  302.     }
  303.     if (token.type != typereal) error(errtypecheck);
  304.     if      (token2->type == typeint)
  305.         flt2 = token2->value.ival;
  306.     else if (token2->type == typereal)
  307.         flt2 = token2->value.rval;
  308.     else
  309.         error(errtypecheck);
  310.     flt2 = (float) atan2((double) token.value.rval, (double) flt2);
  311.     flt2 *= radtodeg;
  312.     if (flt2 < 0.0) flt2 += 360.0;
  313.     token.value.rval = flt2;
  314.     *token1 = token;
  315.     opernest--;
  316. }
  317.  
  318. /* begin */
  319.  
  320. void opbegin(void)
  321. {   struct object *token1;
  322.     struct dictionary *dict;
  323.     if (opernest < 1) error(errstackunderflow);
  324.     token1 = &operstack[opernest - 1];
  325.     if (token1->type != typedict) error(errtypecheck);
  326.     dict = vmdptr(token1->value.vref);
  327.     if (dict->flags & flagrprot) error(errinvalidaccess);
  328.     if (dictnest == dictstacksize) error(errdictstackoverflow);
  329.     dictstack[dictnest++] = *token1;
  330.     opernest--;
  331. }
  332.  
  333. /* bind */
  334.  
  335. void opbind(void)
  336. {   struct object *token1;
  337.     if (opernest < 1) error(errstackunderflow);
  338.     token1 = &operstack[opernest - 1];
  339.     if      (token1->type == typearray || token1->type == typepacked)
  340.         bind(token1, 0);
  341.     else
  342.         error(errtypecheck);
  343. }
  344.  
  345. /* bitshift */
  346.  
  347. void opbitshift(void)
  348. {   struct object *token1, *token2;
  349.     int num1, num2;
  350.     if (opernest < 2) error(errstackunderflow);
  351.     token2 = &operstack[opernest - 1];
  352.     token1 = token2 - 1;
  353.     if (token1->type != typeint || token2->type != typeint)
  354.         error(errtypecheck);
  355.     num1 = token1->value.ival;
  356.     num2 = token2->value.ival;
  357.     if (num2 >= 0)
  358.         if (num2 > 31)
  359.             token1->value.ival = 0;
  360.         else
  361.             token1->value.ival = (unsigned) num1 << num2;
  362.     else
  363.     {   num2 = -num2;
  364.         if (num2 > 31)
  365.             token1->value.ival = 0;
  366.         else
  367.             token1->value.ival = (unsigned) num1 >> num2;
  368.     }
  369.     opernest--;
  370. }
  371.  
  372. /* bytesavailable */
  373.  
  374. void opbytesavailable(void)
  375. {   struct object token, *token1;
  376.     if (opernest < 1) error(errstackunderflow);
  377.     token1 = &operstack[opernest - 1];
  378.     if (token1->type != typefile) error(errtypecheck);
  379.     if (token1->flags & flagrprot) error(errinvalidaccess);
  380.     if (filecheck(token1, openread) == NULL) error(errioerror);
  381.     token.type = typeint;
  382.     token.flags = 0;
  383.     token.length = 0;
  384.     token.value.ival = -1;
  385.     *token1 = token;
  386. }
  387.  
  388. /* ceiling */
  389.  
  390. void opceiling(void)
  391. {   struct object *token1;
  392.     if (opernest < 1) error(errstackunderflow);
  393.     token1 = &operstack[opernest - 1];
  394.     if (token1->type == typeint)
  395.         return;
  396.     else if (token1->type == typereal)
  397.         token1->value.rval = (float) ceil((double) token1->value.rval);
  398.     else
  399.         error(errtypecheck);
  400. }
  401.  
  402. /* clear */
  403.  
  404. void opclear(void)
  405. {   opernest = 0;
  406. }
  407.  
  408. /* cleardictstack */
  409.  
  410. void opcleardictstack(void)
  411. {   dictnest = 2;
  412. }
  413.  
  414. /* cleartomark */
  415.  
  416. void opcleartomark(void)
  417. {   struct object *token1;
  418.     int nest;
  419.     nest = opernest;
  420.     token1 = &operstack[nest];
  421.     for (;;)
  422.     {    if (nest == 0) error(errunmatchedmark);
  423.          nest--;
  424.          if ((--token1)->type == typemark) break;
  425.     }
  426.     opernest = nest;
  427. }
  428.  
  429. /* closefile */
  430.  
  431. void opclosefile(void)
  432. {   struct object *token1;
  433.     struct file *file;
  434.     if (opernest < 1) error(errstackunderflow);
  435.     token1 = &operstack[opernest - 1];
  436.     if (token1->type != typefile) error(errtypecheck);
  437.     file = filecheck(token1, (openread | openwrite));
  438.     if (file == NULL) error(errioerror);
  439.     if (file->emode > 0)
  440.     {   file->emode = -1;
  441.         file->uflg = 0;
  442.     }
  443.     else
  444.         fileclose(token1);
  445.     opernest--;
  446. }
  447.  
  448. /* copy */
  449.  
  450. void opcopy(void)
  451. {   struct object *token1, *token2;
  452.     struct dictionary *dict1, *dict2;
  453.     int num;
  454.     if (opernest < 1) error(errstackunderflow);
  455.     token2 = &operstack[opernest - 1];
  456.     if      (token2->type == typeint)
  457.     {   num = token2->value.ival;
  458.         if (num < 0 || num > opernest - 1) error(errrangecheck);
  459.         if (opernest + num - 1 > operstacksize) error(errstackoverflow);
  460.         arraycopy(token2, token2 - num, num);
  461.         opernest += num - 1;
  462.     }
  463.     else
  464.     {   if (opernest < 1) error(errstackunderflow);
  465.         token1 = token2 - 1;
  466.         if      (token1->type == typestring)
  467.         {   if (token2->type != typestring) error(errtypecheck);
  468.             if ((token1->flags & flagrprot) || (token2->flags & flagwprot))
  469.                 error(errinvalidaccess);
  470.             if (token1->length > token2->length) error(errrangecheck);
  471.             memcpy(vmsptr(token2->value.vref),
  472.                    vmsptr(token1->value.vref), token1->length);
  473.             token1->flags = token2->flags;
  474.             token1->value.vref = token2->value.vref;
  475.         }
  476.         else if (token1->type == typearray)
  477.         {   if (token2->type != typearray) error(errtypecheck);
  478.             if ((token1->flags & flagrprot) || (token2->flags & flagwprot))
  479.                 error(errinvalidaccess);
  480.             if (token1->length > token2->length) error(errrangecheck);
  481.             arraysave(token2->value.vref, token2->length);
  482.             arraycopy(vmaptr(token2->value.vref),
  483.                       vmaptr(token1->value.vref), token1->length);
  484.             token1->flags = token2->flags;
  485.             token1->value.vref = token2->value.vref;
  486.         }
  487.         else if (token1->type == typepacked)
  488.         {   if (token2->type != typearray) error(errtypecheck);
  489.             if ((token1->flags & flagrprot) || (token2->flags & flagwprot))
  490.                 error(errinvalidaccess);
  491.             if (token1->length > token2->length) error(errrangecheck);
  492.             arraysave(token2->value.vref, token2->length);
  493.             arrayunpk(vmaptr(token2->value.vref),
  494.                       vmsptr(token1->value.vref), token1->length);
  495.             token1->type = typearray;
  496.             token1->flags = token2->flags;
  497.             token1->value.vref = token2->value.vref;
  498.         }
  499.         else if (token1->type == typedict)
  500.         {   if (token2->type != typedict) error(errtypecheck);
  501.             dict2 = vmdptr(token2->value.vref);
  502.             dict1 = vmdptr(token1->value.vref);
  503.             if (dict1->flags & flagrprot) error(errinvalidaccess);
  504.             if (dict1->full > dict2->size || dict2->full != 0)
  505.                 error(errrangecheck);
  506.             num = dict1->slots;
  507.             while (num--)
  508.                 if (dict1->entries[num].key.type != 0)
  509.                     dictput(token2->value.vref, &dict1->entries[num].key,
  510.                                                 &dict1->entries[num].val);
  511.             dict2->flags = dict1->flags;
  512.             token1->value.vref = token2->value.vref;
  513.         }
  514.         else
  515.             error(errtypecheck);
  516.         opernest--;
  517.     }
  518. }
  519.  
  520. /* cos */
  521.  
  522. void opcos(void)
  523. {   struct object token, *token1;
  524.     if (opernest < 1) error(errstackunderflow);
  525.     token1 = &operstack[opernest - 1];
  526.     token = *token1;
  527.     if (token.type == typeint)
  528.     {   token.type = typereal;
  529.         token.value.rval = token.value.ival;
  530.     }
  531.     if (token.type == typereal)
  532.         token.value.rval = (float) cos((double) token.value.rval * degtorad);
  533.     else
  534.         error(errtypecheck);
  535.     *token1 = token;
  536. }
  537.  
  538. /* count */
  539.  
  540. void opcount(void)
  541. {   struct object token;
  542.     if (opernest == operstacksize) error(errstackoverflow);
  543.     token.type = typeint;
  544.     token.flags = 0;
  545.     token.length = 0;
  546.     token.value.ival = opernest;
  547.     operstack[opernest++] = token;
  548. }
  549.  
  550. /* countdictstack */
  551.  
  552. void opcountdictstack(void)
  553. {   struct object token;
  554.     if (opernest == operstacksize) error(errstackoverflow);
  555.     token.type = typeint;
  556.     token.flags = 0;
  557.     token.length = 0;
  558.     token.value.ival = dictnest;
  559.     operstack[opernest++] = token;
  560. }
  561.  
  562. /* countexecstack */
  563.  
  564. void opcountexecstack(void)
  565. {   struct object token;
  566.     if (opernest == operstacksize) error(errstackoverflow);
  567.     token.type = typeint;
  568.     token.flags = 0;
  569.     token.length = 0;
  570.     token.value.ival = execnest - istate.execbase;
  571.     operstack[opernest++] = token;
  572. }
  573.  
  574. /* counttomark */
  575.  
  576. void opcounttomark(void)
  577. {   struct object token, *token1, *token2;
  578.     int nest = opernest;
  579.     if (nest == operstacksize) error(errstackoverflow);
  580.     token1 = &operstack[nest];
  581.     token2 = token1;
  582.     for (;;)
  583.     {    if (nest == 0) error(errunmatchedmark);
  584.          if ((--token1)->type == typemark) break;
  585.          nest--;
  586.     }
  587.     token.type = typeint;
  588.     token.flags = 0;
  589.     token.length = 0;
  590.     token.value.ival = opernest - nest;
  591.     *token2 = token;
  592.     opernest++;
  593. }
  594.  
  595. /* currentdict */
  596.  
  597. void opcurrentdict(void)
  598. {   if (opernest == operstacksize) error(errstackoverflow);
  599.     operstack[opernest++] = dictstack[dictnest - 1];
  600. }
  601.  
  602. /* currentfile */
  603.  
  604. void opcurrentfile(void)
  605. {   struct object *token1;
  606.     int nest;
  607.     if (opernest == operstacksize) error(errstackoverflow);
  608.     nest = execnest;
  609.     token1 = &execstack[execnest];
  610.     while (nest)
  611.     {   nest--;
  612.         token1--;
  613.         if (token1->type == typefile)
  614.         {   operstack[opernest++] = *token1;
  615.             return;
  616.         }
  617.     }
  618.     error(errundefinedresult);
  619. }
  620.  
  621. /* currentpacking */
  622.  
  623. void opcurrentpacking(void)
  624. {   struct object token;
  625.     if (opernest == operstacksize) error(errstackoverflow);
  626.     token.type = typebool;
  627.     token.flags = 0;
  628.     token.length = 0;
  629.     token.value.ival = packing;
  630.     operstack[opernest++] = token;
  631. }
  632.  
  633. /* cvi */
  634.  
  635. void opcvi(void)
  636. {   struct object token, *token1;
  637.     char *sptr;
  638.     int length;
  639.     if (opernest < 1) error(errstackunderflow);
  640.     token1 = &operstack[opernest - 1];
  641.     token = *token1;
  642.     if (token.type == typestring)
  643.     {   if (token1->flags & flagrprot) error(errinvalidaccess);
  644.         if (token.length > namebufsize) error(errlimitcheck);
  645.         length = 0;
  646.         sptr = vmsptr(token.value.vref);
  647.         while (length < token.length)
  648.             if ((namebuf[length++] = *sptr++) == ' ') error(errsyntaxerror);
  649.         namebuf[length] = ' ';
  650.         if (!numtoken(&token, namebuf)) error(errsyntaxerror);
  651.     }
  652.     if (token.type == typereal)
  653.     {   token.type = typeint;
  654.         if (token.value.rval > 0x7fffffff || token.value.rval < 0x80000000)
  655.             error(errrangecheck);
  656.         token.value.ival = itrunc(token.value.rval);
  657.     }
  658.     if (token.type != typeint)
  659.         error(errtypecheck);
  660.     *token1 = token;
  661. }
  662.  
  663. /* cvlit */
  664.  
  665. void opcvlit(void)
  666. {   struct object *token1;
  667.     if (opernest < 1) error(errstackunderflow);
  668.     token1 = &operstack[opernest - 1];
  669.     token1->flags &= ~flagexec;
  670. }
  671.  
  672. /* cvn */
  673.  
  674. void opcvn(void)
  675. {   struct object token, *token1;
  676.     if (opernest < 1) error(errstackunderflow);
  677.     token1 = &operstack[opernest - 1];
  678.     if (token1->type != typestring) error(errtypecheck);
  679.     if (token1->flags & flagrprot) error(errinvalidaccess);
  680.     nametoken(&token, vmsptr(token1->value.vref), token1->length,
  681.                       token1->flags & flagexec);
  682.     *token1 = token;
  683. }
  684.  
  685. /* cvr */
  686.  
  687. void opcvr(void)
  688. {   struct object token, *token1;
  689.     char *sptr;
  690.     int length;
  691.     if (opernest < 1) error(errstackunderflow);
  692.     token1 = &operstack[opernest - 1];
  693.     token = *token1;
  694.     if (token.type == typestring)
  695.     {   if (token.flags & flagrprot) error(errinvalidaccess);
  696.         if (token.length > namebufsize) error(errlimitcheck);
  697.         length = 0;
  698.         sptr = vmsptr(token.value.vref);
  699.         while (length < token.length)
  700.             if ((namebuf[length++] = *sptr++) == ' ') error(errsyntaxerror);
  701.         namebuf[length] = ' ';
  702.         if (!numtoken(&token, namebuf)) error(errsyntaxerror);
  703.     }
  704.     if (token.type == typeint)
  705.     {   token.type = typereal;
  706.         token.value.rval = token.value.ival;
  707.     }
  708.     if (token.type != typereal)
  709.         error(errtypecheck);
  710.     *token1 = token;
  711. }
  712.  
  713. /* cvrs */
  714.  
  715. void opcvrs(void)
  716. {   struct object token, *token1, *token2, *token3;
  717.     char *sptr;
  718.     unsigned int num, dig, base;
  719.     int length;
  720.     if (opernest < 3) error(errstackunderflow);
  721.     token3 = &operstack[opernest - 1];
  722.     token2 = token3 - 1;
  723.     token1 = token2 - 1;
  724.     if (token2->type != typeint) error(errtypecheck);
  725.     base = token2->value.ival;
  726.     if (base < 2 || base > 36) error(errrangecheck);
  727.     if (token3->type != typestring) error(errtypecheck);
  728.     if (token3->flags & flagwprot) error(errinvalidaccess);
  729.     token = *token3;
  730.     sptr = vmsptr(token3->value.vref);
  731.     if (base == 10)
  732.     {   if (token1->type != typeint && token1->type != typereal)
  733.             error(errtypecheck);
  734.         token.length = cvstring(token1, sptr, token3->length);
  735.     }
  736.     else
  737.     {   if      (token1->type == typeint)
  738.         {   num = token1->value.ival;
  739.         }
  740.         else if (token1->type == typereal)
  741.         {   if (token.value.rval > 0x7fffffff ||
  742.                 token.value.rval < 0x80000000)
  743.                 error(errrangecheck);
  744.             num = itrunc(token1->value.rval);
  745.         }
  746.         else
  747.             error(errtypecheck);
  748.         length = 0;
  749.         do
  750.         {   dig = num % base;
  751.             num = num / base;
  752.             dig += (dig < 10) ? '0' : 'A' - 10;
  753.             namebuf[length] = dig;
  754.             length++;
  755.         }   while (num != 0);
  756.         if (length > token3->length) error(errrangecheck);
  757.         token.length = length;
  758.         while (length) *sptr++ = namebuf[--length]; 
  759.     }
  760.     *token1 = token;
  761.     opernest -= 2;
  762. }
  763.  
  764. /* cvs */
  765.  
  766. void opcvs(void)
  767. {   struct object token, *token1, *token2;
  768.     if (opernest < 2) error(errstackunderflow);
  769.     token2 = &operstack[opernest - 1];
  770.     token1 = token2 - 1;
  771.     if (token2->type != typestring) error(errtypecheck);
  772.     if (token2->flags & flagwprot) error(errinvalidaccess);
  773.     token = *token2;
  774.     token.length =
  775.         cvstring(token1, vmsptr(token2->value.vref), token2->length);
  776.     *token1 = token;
  777.     opernest -= 1;
  778. }
  779.  
  780. /* cvx */
  781.  
  782. void opcvx(void)
  783. {   struct object *token1;
  784.     if (opernest < 1) error(errstackunderflow);
  785.     token1 = &operstack[opernest - 1];
  786.     switch (token1->type)
  787.     {   case typenull:
  788.         case typeoper:
  789.         case typename:
  790.         case typefile:
  791.         case typearray:
  792.         case typepacked:
  793.         case typestring:
  794.             token1->flags |= flagexec;
  795.     }
  796. }
  797.  
  798. /* def */
  799.  
  800. void opdef(void)
  801. {   struct object *token1, *token2;
  802.     if (opernest < 2) error(errstackunderflow);
  803.     token2 = &operstack[opernest - 1];
  804.     token1 = token2 - 1;
  805.     dictput(dictstack[dictnest - 1].value.vref, token1, token2);
  806.     opernest -= 2;
  807. }
  808.  
  809. /* dict */
  810.  
  811. void opdict(void)
  812. {   struct object token, *token1;
  813.     if (opernest < 1) error(errstackunderflow);
  814.     token1 = &operstack[opernest - 1];
  815.     if (token1->type != typeint) error(errtypecheck);
  816.     dicttoken(&token, token1->value.ival);
  817.     *token1 = token;
  818. }
  819.  
  820. /* dictstack */
  821.  
  822. void opdictstack(void)
  823. {   struct object *token1;
  824.     if (opernest < 1) error(errstackunderflow);
  825.     token1 = &operstack[opernest - 1];
  826.     if (token1->type != typearray) error(errtypecheck);
  827.     if (token1->flags & flagwprot) error(errinvalidaccess);
  828.     if (token1->length < dictnest) error(errrangecheck);
  829.     arraysave(token1->value.vref, token1->length);
  830.     arraycopy(vmaptr(token1->value.vref), dictstack, dictnest);
  831.     token1->length = dictnest;
  832. }
  833.  
  834. /* div */
  835.  
  836. void opdiv(void)
  837. {   struct object token, *token1, *token2;
  838.     if (opernest < 2) error(errstackunderflow);
  839.     token2 = &operstack[opernest - 1];
  840.     token1 = token2 - 1;
  841.     token = *token1;
  842.     if (token.type == typeint)
  843.     {   token.type = typereal;
  844.         token.value.rval = token.value.ival;
  845.     }
  846.     else
  847.         if (token.type != typereal) error(errtypecheck);
  848.     if (token2->type == typeint)
  849.         token.value.rval /= token2->value.ival;
  850.     else
  851.     {   if (token2->type != typereal) error(errtypecheck);
  852.         token.value.rval /= token2->value.rval;
  853.     }
  854.     *token1 = token;
  855.     opernest--;
  856. }
  857.  
  858. /* dup */
  859.  
  860. void opdup(void)
  861. {   if (opernest < 1) error(errstackunderflow);
  862.     if (opernest == operstacksize) error(errstackoverflow);
  863.     operstack[opernest] = operstack[opernest - 1];
  864.     opernest++;
  865. }
  866.  
  867. /* eexec */
  868.  
  869. void opeexec(void)
  870. {   struct object *token1;
  871.     if (opernest < 1) error(errstackunderflow);
  872.     token1 = &operstack[opernest - 1];
  873.     if (token1->type != typefile) error(errtypecheck);
  874.     if (!equal(&execstack[execnest - 1], token1)) error(errundefined);
  875.     if (dictnest == dictstacksize) error(errdictstackoverflow);
  876.     if (execnest == execstacksize) error(errexecstackoverflow);
  877.     fileeinit(token1);
  878.     dictstack[dictnest++] = dictstack[0];
  879.     token1->flags |= flagexec;
  880.     execstack[execnest++] = *token1;
  881.     opernest--;
  882. }
  883.  
  884. /* end */
  885.  
  886. void opend(void)
  887. {    if (dictnest < 3) error(errdictstackunderflow);
  888.      dictnest--;
  889. }
  890.  
  891. /* eq */
  892.  
  893. void opeq(void)
  894. {   struct object token, *token1, *token2;
  895.     if (opernest < 2) error(errstackunderflow);
  896.     token2 = &operstack[opernest - 1];
  897.     token1 = token2 - 1;
  898.     token.type = typebool;
  899.     token.flags = 0;
  900.     token.length = 0;
  901.     token.value.ival = equal(token1, token2);
  902.     *token1 = token;
  903.     opernest--;
  904. }
  905.  
  906. /* exch */
  907.  
  908. void opexch(void)
  909. {   struct object token, *token1, *token2;
  910.     if (opernest < 2) error(errstackunderflow);
  911.     token2 = &operstack[opernest - 1];
  912.     token1 = token2 - 1;
  913.     token = *token1;
  914.     *token1 = *token2;
  915.     *token2 = token;
  916. }
  917.  
  918. /* exec */
  919.  
  920. void opexec(void)
  921. {   if (opernest < 1) error(errstackunderflow);
  922.     if (execnest == execstacksize) error(errexecstackoverflow);
  923.     execstack[execnest++] = operstack[--opernest];
  924. }
  925.  
  926. /* execstack */
  927.  
  928. void opexecstack(void)
  929. {   struct object *token1, *aptr;
  930.     int length;
  931.     if (opernest < 1) error(errstackunderflow);
  932.     token1 = &operstack[opernest - 1];
  933.     if (token1->type != typearray) error(errtypecheck);
  934.     if (token1->flags & flagwprot) error(errinvalidaccess);
  935.     length = execnest - istate.execbase;
  936.     if (token1->length < length) error(errrangecheck);
  937.     if (opernest == operstacksize) error(errstackoverflow);
  938.     aptr = vmaptr(token1->value.vref);
  939.     arraysave(token1->value.vref, token1->length);
  940.     arraycopy(aptr, &execstack[istate.execbase], length);
  941.     token1->length = length;
  942.     while (length--)
  943.     {   aptr->flags &= ~(flagctrl | flagloop | flagrun | flagstop);
  944.         if (aptr->type == typedict) aptr->length = 0;
  945.     }
  946. }
  947.  
  948. /* executeonly */
  949.  
  950. void opexecuteonly(void)
  951. {   struct object *token1;
  952.     int type;
  953.     if (opernest < 1) error(errstackunderflow);
  954.     token1 = &operstack[opernest - 1];
  955.     type = token1->type;
  956.     if      (type == typefile || type == typestring ||
  957.              type == typearray || type == typepacked)
  958.     {   if (token1->flags & flagxprot) error(errinvalidaccess);
  959.         token1->flags |= (flagwprot | flagrprot);
  960.     }
  961.     else
  962.         error(errtypecheck);
  963. }
  964.  
  965. /* exit */
  966.  
  967. void opexit(void)
  968. {   struct object *token1;
  969.     int nest;
  970.     nest = execnest;
  971.     while (nest >= istate.execbase)
  972.     {   token1 = &execstack[nest - 1];
  973.         if (token1->flags & (flagrun | flagstop)) break;
  974.         if (token1->flags & flagloop)
  975.         {   execnest = nest - token1->length;
  976.             return;
  977.         }
  978.         nest--;
  979.     }
  980.     error(errinvalidexit);
  981. }
  982.  
  983. /* exp */
  984.  
  985. void opexp(void)
  986. {   struct object token, *token1, *token2;
  987.     float flt2;
  988.     if (opernest < 2) error(errstackunderflow);
  989.     token2 = &operstack[opernest - 1];
  990.     token1 = token2 - 1;
  991.     token = *token1;
  992.     if (token.type == typeint)
  993.     {   token.type = typereal;
  994.         token.value.rval = token.value.ival;
  995.     }
  996.     if (token.type != typereal) error(errtypecheck);
  997.     if      (token2->type == typeint)
  998.         flt2 = token2->value.ival;
  999.     else if (token2->type == typereal)
  1000.         flt2 = token2->value.rval;
  1001.     else
  1002.         error(errtypecheck);
  1003.     token.value.rval = (float) pow((double) token.value.rval, (double) flt2);
  1004.     *token1 = token;
  1005.     opernest--;
  1006. }
  1007.  
  1008. /* file */
  1009.  
  1010. void opfile(void)
  1011. {   struct object token, *token1, *token2;
  1012.     int ch, open;
  1013.     if (opernest < 2) error(errstackunderflow);
  1014.     token2 = &operstack[opernest - 1];
  1015.     token1 = token2 - 1;
  1016.     if (token1->type != typestring) error(errtypecheck);
  1017.     if (token1->flags & flagrprot) error(errinvalidaccess);
  1018.     if (token2->type != typestring) error(errtypecheck);
  1019.     if (token2->flags & flagrprot) error(errinvalidaccess);
  1020.     if (token2->length == 1)
  1021.         ch = *vmsptr(token2->value.vref);
  1022.     else
  1023.         ch = -1;
  1024.     if      (ch == 'r')
  1025.         open = openread;
  1026.     else if (ch == 'w')
  1027.         open = openwrite;
  1028.     else
  1029.         error(errrangecheck);
  1030.     fileopen(&token, open, vmsptr(token1->value.vref), token1->length);
  1031.     *token1 = token;
  1032.     opernest--;
  1033. }
  1034.  
  1035. /* floor */
  1036.  
  1037. void opfloor(void)
  1038. {   struct object *token1;
  1039.     if (opernest < 1) error(errstackunderflow);
  1040.     token1 = &operstack[opernest - 1];
  1041.     if (token1->type == typeint)
  1042.         return;
  1043.     else if (token1->type == typereal)
  1044.         token1->value.rval = (float) floor((double) token1->value.rval);
  1045.     else
  1046.         error(errtypecheck);
  1047. }
  1048.  
  1049. /* flush */
  1050.  
  1051. void opflush(void)
  1052. {   if (sstdout)
  1053.         if (fflush(sstdout) == EOF) error(errioerror);
  1054. }
  1055.  
  1056. /* flushfile */
  1057.  
  1058. void opflushfile(void)
  1059. {   struct object *token1;
  1060.     struct file *file;
  1061.     FILE *fptr;
  1062.     if (opernest < 1) error(errstackunderflow);
  1063.     token1 = &operstack[opernest - 1];
  1064.     if (token1->type != typefile) error(errtypecheck);
  1065.     file = filecheck(token1, openread | openwrite);
  1066.     if (file == NULL) error(errioerror);
  1067.     fptr = file->fptr;
  1068.     if (file->open == openread)
  1069.     {   file->stype = 0;
  1070.         file->slen = 0x80000000;
  1071.         while (getc(fptr) != EOF) continue;
  1072.     }
  1073.     else
  1074.         fflush(fptr);
  1075.     if (ferror(fptr)) error(errioerror);
  1076.     opernest--;
  1077. }
  1078.  
  1079. /* fontfile */
  1080.  
  1081. void opfontfile(void)
  1082. {   struct object token, *token1;
  1083.     if (opernest < 1) error(errstackunderflow);
  1084.     token1 = &operstack[opernest - 1];
  1085.     if (token1->type != typestring) error(errtypecheck);
  1086.     if (token1->flags & flagrprot) error(errinvalidaccess);
  1087.     fileopen(&token, (openread | openfont),
  1088.              vmsptr(token1->value.vref), token1->length);
  1089.     *token1 = token;
  1090. }
  1091.  
  1092. /* for */
  1093.  
  1094. void opfor(void)
  1095. {   struct object token, *token1, *token2, *token3, *token4, *tokenx;
  1096.     int type;
  1097.     if (currtoken->flags & flagctrl)
  1098.     {   token4 = &execstack[execnest - 2];
  1099.         token3 = token4 - 1;
  1100.         token2 = token3 - 1;
  1101.         token1 = token2 - 1;
  1102.         token = *token1;
  1103.         if (token1->type == typeint)
  1104.         {   if (token2->value.ival >= 0)
  1105.             {   if (token1->value.ival > token3->value.ival)
  1106.                 {   execnest -= 5;
  1107.                     return;
  1108.                 }
  1109.                 token1->value.ival += token2->value.ival;
  1110.             }
  1111.             else
  1112.             {   if (token1->value.ival < token3->value.ival)
  1113.                 {   execnest -= 5;
  1114.                     return;
  1115.                 }
  1116.                 token1->value.ival += token2->value.ival;
  1117.             }
  1118.         }
  1119.         else
  1120.         {   if (token2->value.rval >= 0)
  1121.             {   if (token1->value.rval > token3->value.rval)
  1122.                 {   execnest -= 5;
  1123.                     return;
  1124.                 }
  1125.                 token1->value.rval += token2->value.rval;
  1126.             }
  1127.             else
  1128.             {   if (token1->value.rval < token3->value.rval)
  1129.                 {   execnest -= 5;
  1130.                     return;
  1131.                 }
  1132.                 token1->value.rval += token2->value.rval;
  1133.             }
  1134.         }
  1135.         if (opernest == operstacksize) error(errstackoverflow);
  1136.         operstack[opernest++] = token;
  1137.         token4[2] = *token4;
  1138.         execnest++;
  1139.     }
  1140.     else
  1141.     {   if (opernest < 4) error(errstackunderflow);
  1142.         token4 = &operstack[opernest - 1];
  1143.         token3 = token4 - 1;
  1144.         token2 = token3 - 1;
  1145.         token1 = token2 - 1;
  1146.         type = typeint;
  1147.         if (token1->type != typeint)
  1148.         {   type = typereal;
  1149.             if (token1->type != typereal) error(errtypecheck);
  1150.         }
  1151.         if (token2->type != typeint)
  1152.         {   type = typereal;
  1153.             if (token2->type != typereal) error(errtypecheck);
  1154.         }
  1155.         if (token3->type != typeint)
  1156.         {   type = typereal;
  1157.             if (token3->type != typereal) error(errtypecheck);
  1158.         }
  1159.         if (token4->type != typearray && token4->type != typepacked)
  1160.             error(errtypecheck);
  1161.         if (execnest + 6 > execstacksize) error(errexecstackoverflow);
  1162.         token = *token1;
  1163.         if (token.type != type)
  1164.         {   token.type = typereal;
  1165.             token.value.rval = token.value.ival;
  1166.         }
  1167.         tokenx = &execstack[execnest];
  1168.         tokenx[0] = token;
  1169.         token = *token2;
  1170.         if (token.type != type)
  1171.         {   token.type = typereal;
  1172.             token.value.rval = token.value.ival;
  1173.         }
  1174.         tokenx[1] = token;
  1175.         token = *token3;
  1176.         if (token.type != type)
  1177.         {   token.type = typereal;
  1178.             token.value.rval = token.value.ival;
  1179.         }
  1180.         tokenx[2] = token;
  1181.         tokenx[3] = *token4;
  1182.         token = *currtoken;
  1183.         token.flags &= ~flagexec;
  1184.         token.flags |= flagctrl | flagloop;
  1185.         token.length = 5;
  1186.         tokenx[4] = token;
  1187.         execnest += 5;
  1188.         opernest -= 4;
  1189.     }
  1190. }
  1191.  
  1192. /* forall */
  1193.  
  1194. void opforall(void)
  1195. {   struct object token, *token1, *token2, *tokenx;
  1196.     struct dictionary *dict1;
  1197.     int length;
  1198.     if (currtoken->flags & flagctrl)
  1199.     {   token2 = &execstack[execnest - 2];
  1200.         token1 = token2 - 1;
  1201.         if      (token1->type == typestring)
  1202.         {   if (token1->length == 0)
  1203.             {   execnest -= 3;
  1204.                 return;
  1205.             }
  1206.             token1->length--;
  1207.             if (opernest == operstacksize) error(errstackoverflow);
  1208.             token.type = typeint;
  1209.             token.flags = 0;
  1210.             token.length = 0;
  1211.             token.value.ival =
  1212.                 *((unsigned char *) vmsptr(token1->value.vref));
  1213.             token1->value.vref++;
  1214.             operstack[opernest++] = token;
  1215.         }
  1216.         else if (token1->type == typearray)
  1217.         {   if (token1->length == 0)
  1218.             {   execnest -= 3;
  1219.                 return;
  1220.             }
  1221.             token1->length--;
  1222.             if (opernest == operstacksize) error(errstackoverflow);
  1223.             operstack[opernest++] = *vmaptr(token1->value.vref);
  1224.             token1->value.vref += sizeof (struct object);
  1225.         }
  1226.         else if (token1->type == typepacked)
  1227.         {   if (token1->length == 0)
  1228.             {   execnest -= 3;
  1229.                 return;
  1230.             }
  1231.             token1->length--;
  1232.             if (opernest == operstacksize) error(errstackoverflow);
  1233.             token1->value.vref +=
  1234.                 unpack(&operstack[opernest++], vmsptr(token1->value.vref));
  1235.         }
  1236.         else if (token1->type == typedict)
  1237.         {   length = token1->length;
  1238.             dict1 = vmdptr(token1->value.vref);
  1239.             for (;;)
  1240.             {   if (length == dict1->slots)
  1241.                 {   execnest -= 3;
  1242.                     return;
  1243.                 }
  1244.                 if (dict1->entries[length].key.type != 0) break;
  1245.                 length++;
  1246.             }
  1247.             token1->length = length + 1;
  1248.             if (opernest + 2 > operstacksize) error(errstackoverflow);
  1249.             operstack[opernest++] = dict1->entries[length].key;
  1250.             operstack[opernest++] = dict1->entries[length].val;
  1251.         }
  1252.         token2[2] = *token2;
  1253.         execnest++;
  1254.     }
  1255.     else
  1256.     {   if (opernest < 2) error(errstackunderflow);
  1257.         token2 = &operstack[opernest - 1];
  1258.         token1 = token2 - 1;
  1259.         if (token2->type != typearray && token2->type != typepacked)
  1260.             error(errtypecheck);
  1261.         if      (token1->type == typestring ||
  1262.                  token1->type == typearray || token1->type == typepacked)
  1263.         {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1264.         }
  1265.         else if (token1->type == typedict)
  1266.         {   dict1 = vmdptr(token1->value.vref);
  1267.             if (dict1->flags & flagrprot) error(errinvalidaccess);
  1268.         }
  1269.         else
  1270.             error(errtypecheck);
  1271.         if (execnest + 4 > execstacksize) error(errexecstackoverflow);
  1272.         tokenx = &execstack[execnest];
  1273.         tokenx[0] = *token1;
  1274.         tokenx[1] = *token2;
  1275.         token = *currtoken;
  1276.         token.flags &= ~flagexec;
  1277.         token.flags |= flagctrl | flagloop;
  1278.         token.length = 3;
  1279.         tokenx[2] = token;
  1280.         execnest += 3;
  1281.         opernest -= 2;
  1282.     }
  1283. }
  1284.  
  1285. /* ge */
  1286.  
  1287. void opge(void)
  1288. {   struct object token, *token1, *token2;
  1289.     if (opernest < 2) error(errstackunderflow);
  1290.     token2 = &operstack[opernest - 1];
  1291.     token1 = token2 - 1;
  1292.     token.type = typebool;
  1293.     token.flags = 0;
  1294.     token.length = 0;
  1295.     token.value.ival = (compare(token1, token2) >= 0);
  1296.     *token1 = token;
  1297.     opernest--;
  1298. }
  1299.  
  1300. /* get */
  1301.  
  1302. void opget(void)
  1303. {   struct object *token1, *token2;
  1304.     char *sptr;
  1305.     int num;
  1306.     if (opernest < 2) error(errstackunderflow);
  1307.     token2 = &operstack[opernest - 1];
  1308.     token1 = token2 - 1;
  1309.     if (token1->type == typedict)
  1310.     {   if (!(dictget(token1->value.vref, token2, token1, flagrprot)))
  1311.             error(errundefined);
  1312.     }
  1313.     else
  1314.     {   if (token2->type != typeint) error(errtypecheck);
  1315.         num = token2->value.ival;
  1316.         if      (token1->type == typestring)
  1317.         {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1318.             if (num < 0 || num >= token1->length) error(errrangecheck);
  1319.             token1->type = typeint;
  1320.             token1->flags = 0;
  1321.             token1->length = 0;
  1322.             token1->value.ival =
  1323.                 ((unsigned char *)vmsptr(token1->value.vref))[num];
  1324.         }
  1325.         else if (token1->type == typearray)
  1326.         {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1327.             if (num < 0 || num >= token1->length) error(errrangecheck);
  1328.             *token1 = vmaptr(token1->value.vref)[num];
  1329.         }
  1330.         else if (token1->type == typepacked)
  1331.         {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1332.             if (num < 0 || num >= token1->length) error(errrangecheck);
  1333.             sptr = vmsptr(token1->value.vref);
  1334.             for (;;)
  1335.             {   sptr += unpack(token1, sptr);
  1336.                 if (num == 0) break;
  1337.                 num--;
  1338.             }
  1339.         }
  1340.         else
  1341.             error(errtypecheck);
  1342.     }
  1343.     opernest--;
  1344. }
  1345.  
  1346. /* getinterval */
  1347.  
  1348. void opgetinterval(void)
  1349. {   struct object token, *token1, *token2, *token3;
  1350.     char *sptr;
  1351.     int num, len;
  1352.     if (opernest < 3) error(errstackunderflow);
  1353.     token3 = &operstack[opernest - 1];
  1354.     token2 = token3 - 1;
  1355.     token1 = token2 - 1;
  1356.     if (token2->type != typeint || token3->type!=typeint)
  1357.         error(errtypecheck);
  1358.     num = token2->value.ival;
  1359.     len = token3->value.ival;
  1360.     if      (token1->type == typestring)
  1361.     {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1362.         if (num < 0 || num > token1->length) error(errrangecheck);
  1363.         if (len < 0 || num + len > token1->length) error(errrangecheck);
  1364.         token1->length = len;
  1365.         token1->value.vref += num;
  1366.     }
  1367.     else if (token1->type == typearray)
  1368.     {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1369.         if (num < 0 || num > token1->length) error(errrangecheck);
  1370.         if (len < 0 || num + len > token1->length) error(errrangecheck);
  1371.         token1->length = len;
  1372.         token1->value.vref += num * sizeof (struct object);
  1373.     }
  1374.     else if (token1->type == typepacked)
  1375.     {   if (token1->flags & flagrprot) error(errinvalidaccess);
  1376.         if (num < 0 || num > token1->length) error(errrangecheck);
  1377.         if (len < 0 || num + len > token1->length) error(errrangecheck);
  1378.         token1->length = len;
  1379.         len = 0;
  1380.         sptr = vmsptr(token1->value.vref);
  1381.         while (num--)
  1382.             len += unpack(&token, sptr + len);
  1383.         token1->value.vref += len;
  1384.     }
  1385.     else
  1386.         error(errtypecheck);
  1387.     opernest -= 2;
  1388. }
  1389.  
  1390. /* gt */
  1391.  
  1392. void opgt(void)
  1393. {   struct object token, *token1, *token2;
  1394.     if (opernest < 2) error(errstackunderflow);
  1395.     token2 = &operstack[opernest - 1];
  1396.     token1 = token2 - 1;
  1397.     token.type = typebool;
  1398.     token.flags = 0;
  1399.     token.length = 0;
  1400.     token.value.ival = (compare(token1, token2) > 0);
  1401.     *token1 = token;
  1402.     opernest--;
  1403. }
  1404.  
  1405. /* idiv */
  1406.  
  1407. void opidiv(void)
  1408. {   struct object *token1, *token2;
  1409.     int num1, num2;
  1410.     if (opernest < 2) error(errstackunderflow);
  1411.     token2 = &operstack[opernest - 1];
  1412.     token1 = token2 - 1;
  1413.     if (token1->type != typeint || token2->type != typeint)
  1414.         error(errtypecheck);
  1415.     num1 = token1->value.ival;
  1416.     num2 = token2->value.ival;
  1417.     if (num2 == 0) error(errundefinedresult);
  1418.     token1->value.ival = num1 / num2;
  1419.     opernest--;
  1420. }
  1421.  
  1422. /* if */
  1423.  
  1424. void opif(void)
  1425. {   struct object *token1, *token2;
  1426.     if (opernest < 2) error(errstackunderflow);
  1427.     token2 = &operstack[opernest - 1];
  1428.     token1 = token2 - 1;
  1429.     if (token1->type != typebool) error(errtypecheck);
  1430.     if (token2->type != typearray && token2->type != typepacked)
  1431.         error(errtypecheck);
  1432.     if (execnest == execstacksize) error(errexecstackoverflow);
  1433.     if (token1->value.ival) execstack[execnest++] = *token2;
  1434.     opernest -= 2;
  1435. }
  1436.  
  1437. /* ifelse */
  1438.  
  1439. void opifelse(void)
  1440. {   struct object *token1, *token2, *token3;
  1441.     if (opernest < 3) error(errstackunderflow);
  1442.     token3 = &operstack[opernest - 1];
  1443.     token2 = token3 - 1;
  1444.     token1 = token2 - 1;
  1445.     if (token1->type != typebool) error(errtypecheck);
  1446.     if (token2->type != typearray && token2->type != typepacked)
  1447.         error(errtypecheck);
  1448.     if (token2->type != typearray && token2->type != typepacked)
  1449.         error(errtypecheck);
  1450.     if (execnest == execstacksize) error(errexecstackoverflow);
  1451.     if (token1->value.ival)
  1452.         execstack[execnest++] = *token2;
  1453.     else
  1454.         execstack[execnest++] = *token3;
  1455.     opernest -= 3;
  1456. }
  1457.  
  1458. /* Initialise the operators (1) */
  1459.  
  1460. void initop1(void)
  1461. {   systemop(operror,            ".error");
  1462.     systemop(ophandleerror,      ".handleerror");
  1463.     systemop(opmark,             "mark");
  1464.     systemop(opmark,             "[");
  1465.     systemop(opkram,             "]");
  1466.     systemop(opequals,           "=");
  1467.     systemop(opeqeq,             "==");
  1468.     systemop(opabs,              "abs");
  1469.     systemop(opadd,              "add");
  1470.     systemop(opaload,            "aload");
  1471.     systemop(opanchorsearch,     "anchorsearch");
  1472.     systemop(opand,              "and");
  1473.     systemop(oparray,            "array");
  1474.     systemop(opastore,           "astore");
  1475.     systemop(opatan,             "atan");
  1476.     systemop(opbegin,            "begin");
  1477.     systemop(opbind,             "bind");
  1478.     systemop(opbitshift,         "bitshift");
  1479.     systemop(opbytesavailable,   "bytesavailable");
  1480.     systemop(opceiling,          "ceiling");
  1481.     systemop(opclear,            "clear");
  1482.     systemop(opcleardictstack,   "cleardictstack");
  1483.     systemop(opcleartomark,      "cleartomark");
  1484.     systemop(opclosefile,        "closefile");
  1485.     systemop(opcopy,             "copy");
  1486.     systemop(opcount,            "count");
  1487.     systemop(opcountdictstack,   "countdictstack");
  1488.     systemop(opcountexecstack,   "countexecstack");
  1489.     systemop(opcounttomark,      "counttomark");
  1490.     systemop(opcos,              "cos");
  1491.     systemop(opcurrentdict,      "currentdict");
  1492.     systemop(opcurrentfile,      "currentfile");
  1493.     systemop(opcurrentpacking,   "currentpacking");
  1494.     systemop(opcvi,              "cvi");
  1495.     systemop(opcvlit,            "cvlit");
  1496.     systemop(opcvn,              "cvn");
  1497.     systemop(opcvr,              "cvr");
  1498.     systemop(opcvrs,             "cvrs");
  1499.     systemop(opcvs,              "cvs");
  1500.     systemop(opcvx,              "cvx");
  1501.     systemop(opdef,              "def");
  1502.     systemop(opdict,             "dict");
  1503.     systemop(opdictstack,        "dictstack");
  1504.     systemop(opdiv,              "div");
  1505.     systemop(opdup,              "dup");
  1506.     systemop(opeexec,            "eexec");
  1507.     systemop(opend,              "end");
  1508.     systemop(opeq,               "eq");
  1509.     systemop(opexch,             "exch");
  1510.     systemop(opexec,             "exec");
  1511.     systemop(opexit,             "exit");
  1512.     systemop(opexecstack,        "execstack");
  1513.     systemop(opexecuteonly,      "executeonly");
  1514.     systemop(opexp,              "exp");
  1515.     systemop(opfile,             "file");
  1516.     systemop(opfloor,            "floor");
  1517.     systemop(opflush,            "flush");
  1518.     systemop(opflushfile,        "flushfile");
  1519.     systemop(opfontfile,         "fontfile");
  1520.     systemop(opfor,              "for");
  1521.     systemop(opforall,           "forall");
  1522.     systemop(opge,               "ge");
  1523.     systemop(opget,              "get");
  1524.     systemop(opgetinterval,      "getinterval");
  1525.     systemop(opgt,               "gt");
  1526.     systemop(opidiv,             "idiv");
  1527.     systemop(opif,               "if");
  1528.     systemop(opifelse,           "ifelse");
  1529. }
  1530.  
  1531. /* End of file "postop1.c" */
  1532.