home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / print / post17s.lzh / postint.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-07  |  59.2 KB  |  2,124 lines
  1. /* PostScript interpreter file "postint.c" - the basic interpreter
  2.  * (C) Adrian Aylward 1989, 1992
  3.  * V1.6 First source release
  4.  * V1.7 Fix dictput to convert string keys to names
  5.  * V1.7 Fix fileeinit to handle white space after eexec
  6.  */
  7.  
  8. # include "post.h"
  9.  
  10. /* Initialise the interpreter */
  11.  
  12. void initint(int parms)
  13. {   struct object token, *aptr;
  14.     int i;
  15.  
  16.     /* Initialise the virtual machine */
  17.  
  18.     vminit(parms);
  19.  
  20.     /* Initialise the basic interpreter */
  21.  
  22.     inest = 0;
  23.     istate.flags = 0;
  24.     istate.type = -1;
  25.     istate.vmbase = 0;
  26.     istate.gbase = 0;
  27.     istate.execbase = 0;
  28.     istate.pfcrec = NULL;
  29.     istack = vmallocv(sizeof (struct istate) * istacksize);
  30.     strncpy(prompt1, "> ", promptsize);
  31.     strncpy(prompt2, "- ", promptsize);
  32.     time(&time1);
  33.     random = 1;
  34.     nametable = vmallocv(sizeof (vmref) * nametablesize);
  35.     opernest = 0;
  36.     execnest = 0;
  37.     dictnest = 0;
  38.     operstack = vmallocv(sizeof (struct object) * operstacksize);
  39.     execstack = vmallocv(sizeof (struct object) * execstacksize);
  40.     dictstack = vmallocv(sizeof (struct object) * dictstacksize);
  41.     filetable = vmallocv(sizeof (struct file) * filetablesize);
  42.     filetable[0].ch = '\n';
  43.     filetable[0].open = openread;
  44.     filetable[0].fptr = sstdin;
  45.     filetable[1].ch = EOF;
  46.     filetable[1].open = openwrite;
  47.     filetable[1].fptr = sstdout;
  48.     filetable[2].ch = EOF;
  49.     filetable[2].open = openwrite;
  50.     filetable[2].fptr = sstderr;
  51.     optable = vmallocv(sizeof (struct operator) * (optablesize + 1));
  52.     opnum = 0;
  53.  
  54.     /* Initialise the dictionaries */
  55.  
  56.     dicttoken(&dictstack[0], systemdictsize);
  57.     systemname(&dictstack[0], "systemdict", 0);
  58.     dicttoken(&dictstack[1], userdictsize);
  59.     systemname(&dictstack[1], "userdict", 0);
  60.     dictnest = 2;
  61.     token.type = typestring;
  62.     token.flags = flagwprot;
  63.     token.length = strlen(version);
  64.     token.value.vref = vmalloc(token.length);
  65.     memcpy(vmsptr(token.value.vref), version, token.length);
  66.     systemname(&token, "version", 0);
  67.     token.type = typebool;
  68.     token.flags = 0;
  69.     token.length = 0;
  70.     token.value.ival = 0;
  71.     systemname(&token, "false", 0);
  72.     token.value.ival = 1;
  73.     systemname(&token, "true", 0);
  74.     token.type = typeint;
  75.     token.flags = 0;
  76.     token.length = 0;
  77.     token.value.ival = 1;
  78.     nametoken(&copies, "#copies", -1, 0);
  79.     dictput(dictstack[1].value.vref, &copies, &token);
  80.  
  81.     /* Initialise the operators */
  82.  
  83.     initop1();
  84.     initop2();
  85.     initop3();
  86.     initop4();
  87.  
  88.     /* Initialise "errordict" */
  89.  
  90.     dicttoken(&errordict, errordictsize);
  91.     systemname(&errordict, "errordict", 0);
  92.     token.type = typeoper;
  93.     token.flags = flagexec;
  94.     token.length = 0;
  95.     token.value.ival = 1;
  96.     for (i = 0; i <= errmax; i++)
  97.     {   nametoken(&errorname[i], errortable[i], -1, flagexec);
  98.         dictput(errordict.value.vref, &errorname[i], &token);
  99.         token.value.ival = 0;
  100.     }
  101.  
  102.     /* The value of "handleerror" in "systemdict" is
  103.      *              "errordict /handleerror get exec" */
  104.  
  105.     token.type = typearray;
  106.     token.flags = flagexec;
  107.     token.length = 4;
  108.     token.value.vref = arrayalloc(4);
  109.     aptr = vmaptr(token.value.vref);
  110.     aptr[0] = errordict;
  111.     aptr[1] = errorname[0];
  112.     aptr[1].flags = 0;
  113.     nametoken(&aptr[2], "get", -1, flagexec);
  114.     nametoken(&aptr[3], "exec", -1, flagexec);
  115.     bind(&token, 0);
  116.     dictput(dictstack[0].value.vref, &errorname[0], &token);
  117.  
  118.     /* Initialise "$error" */
  119.  
  120.     dicttoken(&errdsdict, errdsdictsize);
  121.     nametoken(&token, "$error", -1, 0);
  122.     dictput(dictstack[0].value.vref, &token, &errdsdict);
  123.     token.type = typebool;
  124.     token.flags = 0;
  125.     token.length = 0;
  126.     token.value.ival = 0;
  127.     for (i = 0; i < edsmax; i++)
  128.     {   nametoken(&errdsname[i], errdstable[i], -1, flagexec);
  129.         errdstoken[i] = token;
  130.         dictput(errdsdict.value.vref, &errdsname[i], &token);
  131.         token.type = typenull;
  132.     }
  133.  
  134.     /* Initialise the graphics state, character routines */
  135.  
  136.     initgstate();
  137.     initchar();
  138. }
  139.  
  140. /* Tidy up the interpreter */
  141.  
  142. void tidyint()
  143. {   struct file *file;
  144.     int filenum;
  145.  
  146.     /* Close all opened files */
  147.  
  148.     if (filetable)
  149.     {   for (filenum = 3; filenum < filetablesize; filenum++)
  150.         {   file = &filetable[filenum];
  151.             if (file->open != 0) fclose(file->fptr);
  152.         }
  153.         filetable = (struct file *) 0;
  154.     }
  155.  
  156.     /* Tidy up the virtual machine */
  157.  
  158.     vmtidy();
  159. }
  160.  
  161. /* Make a name and insert it into the system dictionary */
  162.  
  163. void systemname(struct object *token, char *sptr, int flags)
  164. {   struct object nameobj;
  165.     nametoken(&nameobj, sptr, -1, flags);
  166.     dictput(dictstack[0].value.vref, &nameobj, token);
  167. }
  168.  
  169. /* Make an operator and insert it into the system dictionary */
  170.  
  171. void systemop(void (*func)(), char *sptr)
  172. {   struct object token;
  173.     if (opnum  == optablesize) error(errlimitcheck);
  174.     optable[opnum].func = func;
  175.     optable[opnum].sptr = sptr;
  176.     token.type = typeoper;
  177.     token.flags = flagexec;
  178.     token.length = 0;
  179.     token.value.ival = opnum;
  180.     systemname(&token, sptr, flagexec);
  181.     opnum++;
  182. }
  183.  
  184. /* The interpreter */
  185.  
  186. void interpret(struct object *interpreting)
  187. {   struct object token, *executing, *savetoken;
  188.  
  189.     /* Start with a null token, in case we get an error before we have read
  190.      * one. */
  191.  
  192.     token.type = 0;
  193.     token.flags = 0;
  194.     token.value.ival = 0;
  195.  
  196.     /* Push the object we want to execute onto the execution stack.  Save the
  197.      * error jump buffer on the error stack.  Set up the current token. */
  198.  
  199.     if (execnest >= execstacksize) error(errexecstackoverflow);
  200.     execstack[execnest++] = *interpreting;
  201.     savetoken = currtoken;
  202.  
  203.     while (setjmp(istate.errjmp) != 0) continue;
  204.  
  205.     currtoken = &token;
  206.  
  207.     /* Loop until the execution stack is empty.  (I.e. the same level as it
  208.      * was when we entered.  Check for interrupt. */
  209.  
  210.     while (execnest != istate.execbase)
  211.     {   if (intsigflag != 0)
  212.         {   if (intsigflag == 1)
  213.             {   intsigflag = 0;
  214.                 error(errinterrupt);
  215.             }
  216.             else
  217.             {   intsigflag = 0;
  218.                 error(errkill);
  219.             }
  220.         }
  221.         executing = &execstack[execnest - 1];
  222.  
  223.         /* If the top of the stack is executable extract the next token from
  224.          * it. */
  225.  
  226.         if (executing->flags & flagexec)
  227.         {   if (executing->flags & flagxprot) error(errinvalidaccess);
  228.             if (executing->type == typearray)
  229.             {   if (executing->length == 0)
  230.                 {   execnest--;
  231.                     continue;
  232.                 }
  233.                 token = *vmaptr(executing->value.vref);
  234.                 executing->value.vref += sizeof (struct object);
  235.                 if (--executing->length == 0)
  236.                     execnest--;
  237.                 goto dir;
  238.             }
  239.             if (executing->type == typepacked)
  240.             {   if (executing->length == 0)
  241.                 {   execnest--;
  242.                     continue;
  243.                 }
  244.                 executing->value.vref +=
  245.                     unpack(&token, vmsptr(executing->value.vref));
  246.                 if (--executing->length == 0)
  247.                     execnest--;
  248.                 goto dir;
  249.             }
  250.             if (executing->type == typefile)
  251.             {   if (!scantoken(&token, executing, 0))
  252.                 {   if (filetable[executing->length].emode != 0)
  253.                     {   filetable[executing->length].emode = 0;
  254.                         if (dictnest < 3) error(errdictstackunderflow);
  255.                         dictnest--;
  256.                     }
  257.                     else
  258.                         fileclose(executing);
  259.                     execnest--;
  260.                     continue;
  261.                 }
  262.                 goto dir;
  263.             }
  264.             if (executing->type == typestring)
  265.             {   if (!scantoken(&token, executing, 0))
  266.                 {   execnest--;
  267.                     continue;
  268.                 }
  269.                 goto dir;
  270.             }
  271.         }
  272.  
  273.         /* Otherwise if it is a control operator execute it without popping
  274.          * the stack;  for all other cases we pop it off the stack and
  275.          * execute it. */
  276.  
  277.         token = *executing;
  278.         if (token.flags & flagctrl)
  279.         {   (*(optable[token.value.ival].func))();
  280.             continue;
  281.         }
  282.         execnest--;
  283.  
  284.         /* Execute an object obtained indirectly.  (Procedures are executed
  285.          * immediately.) */
  286.  
  287. ind:    if (token.flags & flagexec)
  288.         {   if      (token.type == typeoper)
  289.             {   (*(optable[token.value.ival].func))();
  290.                 continue;
  291.             }
  292.             else if (token.type == typename)
  293.             {   if (dictfind(&token, &token) == -1) error(errundefined);
  294.                 goto ind;
  295.             }
  296.             else
  297.             {   if (token.type == typenull) continue;
  298.                 if (execnest == execstacksize) error(errexecstackoverflow);
  299.                 execstack[execnest++] = token;
  300.                 continue;
  301.             }
  302.         }
  303.         if (opernest == operstacksize) error(errstackoverflow);
  304.         operstack[opernest++] = token;
  305.         continue;
  306.  
  307.         /* Execute an object obtained directly.  (Procedures are pushed onto
  308.          * the operand stack.) */
  309.  
  310. dir:    if (token.flags & flagexec)
  311.         {   if      (token.type == typeoper)
  312.             {   (*(optable[token.value.ival].func))();
  313.                 continue;
  314.             }
  315.             else if (token.type == typename)
  316.             {   if (dictfind(&token, &token) == -1) error(errundefined);
  317.                 goto ind;
  318.             }
  319.             else if (token.type != typearray && token.type != typepacked)
  320.             {   if (token.type == typenull) continue;
  321.                 if (execnest == execstacksize) error(errexecstackoverflow);
  322.                 execstack[execnest++] = token;
  323.                 continue;
  324.             }
  325.         }
  326.         if (opernest == operstacksize) error(errstackoverflow);
  327.         operstack[opernest++] = token;
  328.     }
  329.  
  330.     /* Restore the current token and exit to the next outer level. */
  331.  
  332.     currtoken = savetoken;
  333. }
  334.  
  335. /* Push the interpreter stack before recursing */
  336.  
  337. void pushint(void)
  338. {   if (inest == istacksize) error(errlimitcheck);
  339.     istack[inest++] = istate;
  340.     istate.flags = 0;
  341.     istate.type = -1;
  342.     istate.vmbase = vmnest;
  343.     istate.gbase = gnest;
  344.     istate.execbase = execnest;
  345.     istate.pfcrec = NULL;
  346. }
  347.  
  348. /* Pop the interpreter (and vm and graphics) stacks after recursing */
  349.  
  350. void popint(void)
  351. {   if (vmnest != istate.vmbase)
  352.         vmrest(istate.vmbase, -1);
  353.     if (gnest != istate.gbase)
  354.     {   gnest = istate.gbase + 1;
  355.         grest();
  356.     }
  357.     if (istate.pfcrec)
  358.         istate.pfcrec->count = 0;
  359.     istate = istack[--inest];
  360. }
  361.  
  362. /* Put a character on an output stream */
  363.  
  364. void putch(FILE *fptr, int ch)
  365. {   if (putc(ch, fptr) == EOF) error(errioerror);
  366. }
  367.  
  368. /* Put a string on an output stream */
  369.  
  370. void putstr(FILE *fptr, char *str)
  371. {   int ch;
  372.     while (ch = *str++)
  373.         if (putc(ch, fptr) == EOF) error(errioerror);
  374. }
  375.  
  376. /* Put a memory buffer on an output stream */
  377.  
  378. void putmem(FILE *fptr, char *sptr, int length)
  379. {   while (length--)
  380.         if (putc(*sptr++, fptr) == EOF) error(errioerror);
  381. }
  382.  
  383. /* Put a memory buffer on an output stream, checking for funny characters */
  384.  
  385. void putcheck(FILE *fptr, char *sptr, int length)
  386. {   int ch;
  387.     while (length--)
  388.     {   ch = *(unsigned char *)sptr++;
  389.         if (ch < 0x20 || ch >= 0x7f)
  390.         {   if      (ch == '\n')
  391.                 putstr(fptr, "\\n");
  392.             else if (ch == '\r')
  393.                 putstr(fptr, "\\r");
  394.             else if (ch == '\t')
  395.                 putstr(fptr, "\\t");
  396.             else if (ch == '\b')
  397.                 putstr(fptr, "\\b");
  398.             else if (ch == '\f')
  399.                 putstr(fptr, "\\f");
  400.             else
  401.                 if (fprintf(fptr, "\\%03.3o", ch) == EOF) error(errioerror);
  402.         }
  403.         else
  404.             if (putc(ch, fptr) == EOF) error(errioerror);
  405.     }
  406. }
  407.  
  408. /* Open a file */
  409.  
  410. void fileopen(struct object *token, int open, char *name, int length)
  411. {   struct file *file;
  412.     int filenum;
  413.     if (length < 0) length = strlen(name);
  414.     if (length > namebufsize) error(errlimitcheck);
  415.     memcpy(namebuf, name, length);
  416.     namebuf[length] = 0;
  417.     if (strlen(namebuf) != length) error(errrangecheck);
  418.     if      (strcmp(namebuf, "%stdin") == 0)
  419.         filenum = 0;
  420.     else if (strcmp(namebuf, "%stdout") == 0)
  421.         filenum = 1;
  422.     else if (strcmp(namebuf, "%stderr") == 0)
  423.         filenum = 2;
  424.     else
  425.     {   filenum = 3;
  426.         for (;;)
  427.         {   file = &filetable[filenum];
  428.             if (file->open == 0) break;
  429.             ++filenum;
  430.             if (filenum == filetablesize) error(errlimitcheck);
  431.         }
  432.     }
  433.     if (filenum < 3)
  434.     {   file = &filetable[filenum];
  435.         if (file->fptr == NULL) error(errundefinedfilename);
  436.         if (file->open != (open & ~openfont)) error(errinvalidfileaccess);
  437.     }
  438.     else
  439.     {   file->fptr = fopen(namebuf, ((open == openwrite) ? "w" : "r"));
  440.         if (file->fptr == NULL) error(errundefinedfilename);
  441.         file->open = open & ~openfont;
  442.         file->saved = vmnest;
  443.         file->ch = EOF;
  444.         file->uflg = 0;
  445.         file->slen = 0;
  446.         file->emode = 0;
  447.         file->erand = 0;
  448.         file->stype = 0;
  449.         if (open & openfont) file->stype = -1;
  450.     }
  451.     token->type = typefile;
  452.     token->flags = 0;
  453.     token->length = filenum;
  454.     token->value.ival = file->generation;
  455. }
  456.  
  457. /* Close a file */
  458.  
  459. void fileclose(struct object *token)
  460. {   struct file *file;
  461.     FILE *fptr;
  462.     int open;
  463.     if (token->length > 2)
  464.         if (file = filecheck(token, (openread | openwrite)))
  465.         {   fptr = file->fptr;
  466.             open = file->open;
  467.             file->fptr = NULL;
  468.             file->generation++;
  469.             file->open = 0;
  470.             if (fclose(fptr) == EOF)
  471.                 if (open & openwrite) error(errioerror);
  472.         }
  473. }
  474.  
  475. /* Check a file is open */
  476.  
  477. struct file *filecheck(struct object *token, int open)
  478. {   struct file *file;
  479.     file = &filetable[token->length];
  480.     if (file->generation == token->value.ival && (file->open & open) != 0)
  481.         return file;
  482.     else
  483.         return NULL;
  484. }
  485.  
  486. /* Get the next character from a file, allowing IBM font format */
  487.  
  488. # define getf(file,fptr) (--file->slen >= 0 ? getc(fptr) : getfseg(file))
  489.  
  490. /* Unget the last character from a file, allowing IBM font format */
  491.  
  492. # define ungetf(ch,file,fptr) (file->slen++, ungetc(ch, fptr))
  493.  
  494. /* Locate the next segment of an IBM font format file */
  495.  
  496. int getfseg(struct file *file)
  497. {   FILE *fptr;
  498.     int ch, i;
  499.     fptr = file->fptr;
  500.     file->slen = 0;
  501.  
  502.     /* Unknown file type; assume IBM font if first character is 0x80 */
  503.  
  504.     if (file->stype == -1)
  505.     {   ch = getc(fptr);
  506.         if (ch == EOF) error(errioerror);
  507.         ungetc(ch, fptr);
  508.         if (ch != 0x80) file->stype = 0;
  509.     }
  510.  
  511.     /* Standard file; may come here after reading 2 Gigabytes? */
  512.  
  513.     if (file->stype == 0)
  514.     {   file->slen = 0x7fffffff;
  515.         return getc(fptr);
  516.     }
  517.  
  518.     /* IBM font format.  Read 6 byte segment header */
  519.  
  520. gets:
  521.     ch = getc(fptr);
  522.     if (ch != 0x80)
  523.     {  if (ch != EOF || ferror(fptr)) error(errioerror);
  524.        return EOF;
  525.     }
  526.     ch = getc(fptr);
  527.     file->stype = ch;
  528.     if      (ch == 1 || ch == 2)
  529.     {   i = 4;
  530.         while (i--)
  531.         {   ch = getc(fptr);
  532.             if (ch == EOF) error(errioerror);
  533.             file->slen = (((unsigned) file->slen) >> 8) | (ch << 24);
  534.         }
  535.     }
  536.     else if (ch != 3)
  537.         error(errioerror);
  538.     if (--file->slen <= 0) goto gets;
  539.     return getc(fptr);
  540. }
  541.  
  542. /* Initialise a file for decryption */
  543.  
  544. void fileeinit(struct object *token)
  545. {   struct file *file;
  546.     FILE *fptr;
  547.     int digit[4], i, j, k, ch, dig, num;
  548.  
  549.     file = filecheck(token, openread | openwrite);
  550.     if (file == NULL) error(errioerror);
  551.     fptr = file->fptr;
  552.  
  553.     /* Skip white space characters, except for IBM binary sections */
  554.  
  555.     ch = getf(file, fptr);
  556.     if (file->stype != 2)
  557.         while (ch == ' ' || ch == '\t' || ch == '\r' || ch == '\n')
  558.             ch = getf(file, fptr);
  559.     ungetf(ch, file, fptr);
  560.  
  561.     /* Decrypt four binary bytes, checking whether they are all hex digits */
  562.  
  563.     file->erand = einitexec;
  564.     file->emode = 2;
  565.     for (i = 0; i < 4; i++)
  566.     {   ch = getf(file, fptr);
  567.         if (ch == EOF)
  568.         {   if (ferror(fptr)) error(errioerror);
  569.             error(errsyntaxerror);
  570.         }
  571.         if ((digit[i] = digitval(ch)) >= 16) file->emode = 1;
  572.         file->erand = ((file->erand + ch) * ec1 + ec2) & emask;
  573.     }
  574.  
  575.     /* If all hex, must be hex encryption.  So decrypt four hex bytes */
  576.  
  577.     if (file->emode == 2)
  578.     {   file->erand = einitexec;
  579.         j = 0;
  580.         for (k = 0; k < 4; k++)
  581.         {   if (j < i)
  582.             {   num = digit[j];
  583.                 j++;
  584.             }
  585.             else
  586.             {   ch = getf(file, fptr);
  587.                 if (ch == EOF && ferror(fptr)) error(errioerror);
  588.                 if ((num = digitval(ch)) >= 16) error(errsyntaxerror);
  589.             }
  590.             if (j < i)
  591.             {   dig = digit[j];
  592.                 j++;
  593.             }
  594.             else
  595.             {   ch = getf(file, fptr);
  596.                 if (ch == EOF && ferror(fptr)) error(errioerror);
  597.                 if ((dig = digitval(ch)) >= 16) error(errsyntaxerror);
  598.             }
  599.             ch = (num << 4) + dig;
  600.             file->erand = ((file->erand + ch) * ec1 + ec2) & emask;
  601.         }
  602.     }
  603. }
  604.  
  605. /* Read a character from a file or string */
  606.  
  607. int readch(struct object *input, int depth)
  608. {   struct file *file;
  609.     FILE *fptr;
  610.     int ch, cx, num, dig;
  611.     if (input->type == typefile)
  612.     {   file = &filetable[input->length];
  613.         if (file->uflg)
  614.         {   file->uflg = 0;
  615.             return file->ch;
  616.         }
  617.         fptr = file->fptr;
  618.  
  619.         /* Not encrypted */
  620.  
  621.         if (file->emode == 0)
  622.         {   if (file->ch == '\n' && fptr == sstdin && prompting)
  623.             {   if (intsigflag)
  624.                 {   intsigflag = 0;
  625.                     currtoken->type = 0;
  626.                     currtoken->flags = 0;
  627.                     currtoken->value.ival = 0;
  628.                     error(errinterrupt);
  629.                 }
  630.                 if (depth >= 0)
  631.                     fputs(((depth == 0) ? prompt1: prompt2), sstdout);
  632.             }
  633.             ch = getf(file, fptr);
  634.             if (ch == '\r' && depth != -2)
  635.             {   ch = getf(file, fptr);
  636.                 if (ch != '\n')
  637.                 {   ungetf(ch, file, fptr);
  638.                     ch = '\n';
  639.                 }
  640.             }
  641.             if (ch == EOF && ferror(fptr)) error(errioerror);
  642.         }
  643.  
  644.         /* Encrypted */
  645.  
  646.         else
  647.         {
  648.             /* Binary */
  649.  
  650.             if      (file->emode == 1)
  651.             {   cx = getf(file, fptr);
  652.                 if (cx == EOF)
  653.                 {   if (ferror(fptr)) error(errioerror);
  654.                     error(errsyntaxerror);
  655.                 }
  656.             }
  657.  
  658.             /* Hex */
  659.  
  660.             else if (file->emode == 2)
  661.             {   do  ch = getf(file, fptr);
  662.                     while (ch == ' ' || ch == '\t' ||
  663.                            ch == '\r' || ch == '\n');
  664.                 if ((num = digitval(ch)) >= 16)
  665.                 {   if (ch == EOF && ferror(fptr)) error(errioerror);
  666.                     error(errsyntaxerror);
  667.                 }
  668.                 do  ch = getf(file, fptr);
  669.                     while (ch == ' ' || ch == '\t' ||
  670.                            ch == '\r' || ch == '\n');
  671.                 if ((dig = digitval(ch)) >= 16)
  672.                 {   if (ch == EOF && ferror(fptr)) error(errioerror);
  673.                     error(errsyntaxerror);
  674.                 }
  675.                 cx = (num << 4) + dig;
  676.             }
  677.  
  678.             /* End of encryption */
  679.  
  680.             else
  681.             {   file->ch = EOF;
  682.                 return EOF;
  683.             }
  684.  
  685.             /* Decrypt */
  686.  
  687.             ch = cx ^ (file->erand >> eshift);
  688.             file->erand = ((file->erand + cx) * ec1 + ec2) & emask;
  689.             if (ch == '\r' && depth != -2)
  690.                 ch = '\n';
  691.         }
  692.  
  693.         file->ch = ch;
  694.         return ch;
  695.     }
  696.     else
  697.     {   if (input->length == 0)
  698.             return EOF;
  699.         else
  700.         {   input->length--;
  701.             ch = *((unsigned char *) (vmsptr(input->value.vref)));
  702.             input->value.vref++;
  703.             return ch;
  704.         }
  705.     }
  706. }
  707.  
  708. /* Unread a character from a file or string */
  709.  
  710. void unreadch(struct object *input, int ch)
  711. {   if (input->type == typefile)
  712.         filetable[input->length].uflg = 1;
  713.     else
  714.         if (ch != EOF)
  715.         {   input->length++;
  716.             input->value.vref--;
  717.         }
  718. }
  719.  
  720. /* If a character is a digit return its value */
  721.  
  722. int digitval(int ch)
  723. {   if (ch >= '0' && ch <= '9') return ch - '0';
  724.     if (ch >= 'A' && ch <= 'Z') return ch - 'A' + 10;
  725.     if (ch >= 'a' && ch <= 'z') return ch - 'a' + 10;
  726.     return 99;
  727. }
  728.  
  729. /* Scan a file or string for an object token */
  730.  
  731. int scantoken(struct object *token, struct object *input, int depth)
  732. {   int ch, num, dig, length, nest, flags, load;
  733.  
  734.     if (input->type == typefile)
  735.         if (filecheck(input, openread) == NULL) error(errioerror);
  736.     if (input->flags & flagxprot) error(errinvalidaccess);
  737.  
  738. lab:
  739.     ch = readch(input, depth);
  740.     switch (ch)
  741.     {   case EOF:
  742.             return 0;
  743.  
  744.         case ' ': case '\t': case '\n':
  745.             goto lab;
  746.  
  747.         case '%':
  748.             for (;;)
  749.             {   ch = readch(input, depth);
  750.                 if (ch == EOF) return 0;
  751.                 if (ch == '\n') goto lab;
  752.             }
  753.  
  754.         case ')': case '>':
  755.             error(errsyntaxerror);
  756.  
  757.         case '(':
  758.             length = 0;
  759.             nest = 1;
  760.             for (;;)
  761.             {   ch = readch(input, -1);
  762.                 if (ch == EOF) error(errsyntaxerror);
  763.                 if (ch == '(') nest++;
  764.                 if (ch == ')' && --nest == 0) break;
  765.                 if (ch == '\\')
  766.                 {   ch = readch(input, -1);
  767.                     if (ch == EOF) error(errsyntaxerror);
  768.                     if (ch == '\n') continue;
  769.                     if (ch == 'n') ch = '\n';
  770.                     if (ch == 'r') ch = '\r';
  771.                     if (ch == 't') ch = '\t';
  772.                     if (ch == 'b') ch = '\b';
  773.                     if (ch == 'f') ch = '\f';
  774.                     num = digitval(ch);
  775.                     if (num < 8)
  776.                     {   ch = readch(input, -1);
  777.                         dig = digitval(ch);
  778.                         if (dig < 8)
  779.                         {   num = num * 8 + dig;
  780.                             ch = readch(input, -1);
  781.                             dig = digitval(ch);
  782.                             if (dig < 8)
  783.                                 num = num * 8 + dig;
  784.                             else
  785.                                 unreadch(input, ch);
  786.                         }
  787.                         else
  788.                             unreadch(input, ch);
  789.                         ch = num;
  790.                     }
  791.                 }
  792.                 *vmstring(length++, 1) = ch;
  793.             }
  794. str:        if (length > 65535) error(errlimitcheck);
  795.             token->type = typestring;
  796.             token->flags = 0;
  797.             token->length = length;
  798.             token->value.vref = vmalloc(length);
  799.             return 1;
  800.  
  801.         case '<':
  802.             length = 0;
  803.             for (;;)
  804.             {   do
  805.                     ch = readch(input, -1);
  806.                     while (ch == ' ' || ch == '\t' || ch == '\n');
  807.                 if ((num = digitval(ch)) >= 16)
  808.                 {   if (ch == '>')
  809.                         break;
  810.                     else
  811.                         error(errsyntaxerror);
  812.                 }
  813.                 do
  814.                     ch = readch(input, -1);
  815.                     while (ch == ' ' || ch == '\t' || ch == '\n');
  816.                 if ((dig = digitval(ch)) >= 16)
  817.                 {   if (ch == '>')
  818.                         dig = 0;
  819.                     else
  820.                         error(errsyntaxerror);
  821.                 }
  822.                 *vmstring(length++, 1) = (num << 4) + dig;
  823.                 if (ch == '>') break;
  824.             }
  825.             goto str;
  826.  
  827.         case '{':
  828.             if (depth >= maxdepth) error(errlimitcheck);
  829.             nest = opernest;
  830.             for (;;)
  831.             {   ch = readch(input, depth);
  832.                 if (ch == EOF) error(errsyntaxerror);
  833.                 if (ch == ' ' || ch == '\t' || ch == '\n') continue;
  834.                 if (ch == '%')
  835.                 {   for (;;)
  836.                     {   ch = readch(input, depth);
  837.                         if (ch == EOF) error(errsyntaxerror);
  838.                         if (ch == '\n') break;
  839.                     }
  840.                     continue;
  841.                 }
  842.                 if (ch == '}') break;
  843.                 unreadch(input, ch);
  844.                 if (opernest == operstacksize) error(errstackoverflow);
  845.                 if (!scantoken(&operstack[opernest++], input, depth + 1))
  846.                     error(errsyntaxerror);
  847.             }
  848.             token->length = length = opernest - nest;
  849.             if (packing)
  850.             {   token->type = typepacked;
  851.                 token->flags = flagexec | flagwprot;
  852.                 token->value.vref = arraypack(&operstack[nest], length);
  853.             }
  854.             else
  855.             {   token->type = typearray;
  856.                 token->flags = flagexec;
  857.                 token->value.vref = arrayalloc(length);
  858.                 arraycopy(vmaptr(token->value.vref),
  859.                           &operstack[nest], length);
  860.             }
  861.             opernest = nest;
  862.             return 1;
  863.  
  864.         case '}':
  865.             error(errsyntaxerror);
  866.  
  867.         case '[':
  868.         case ']':
  869.             namebuf[0] = ch;
  870.             nametoken(token, namebuf, 1, flagexec);
  871.             return 1;
  872.  
  873.         default:
  874.             flags = flagexec;
  875.             load = 0;
  876.             if (ch == '/')
  877.             {   flags = 0;
  878.                 ch = readch(input, depth);
  879.                 if (ch == '/')
  880.                 {   load = 1;
  881.                     ch = readch(input, depth);
  882.                 }
  883.             }
  884.             length = 0;
  885.             for (;;)
  886.             {   switch (ch)
  887.                 {   case EOF:
  888.                     case '%':
  889.                     case '(': case ')': case '<': case '>':
  890.                     case '[': case ']': case '{': case '}':
  891.                     case '/':
  892.                         unreadch(input, ch);
  893.                     case ' ': case '\t': case '\n':
  894.                         break;
  895.  
  896.                     default:
  897.                         if (length == namebufsize) error(errlimitcheck);
  898.                         namebuf[length++] = ch;
  899.                         ch = readch(input, depth);
  900.                         continue;
  901.                 }
  902.                 break;
  903.             }
  904.             namebuf[length] = ' ';
  905.             if (flags == flagexec)
  906.                 if (numtoken(token, namebuf)) return 1;
  907.             nametoken(token, namebuf, length, flags);
  908.             if (load)
  909.                 if (dictfind(token, token) == -1) error(errundefined);
  910.             return 1;
  911.     }
  912. }
  913.  
  914. /* Make a number token if we can */
  915.  
  916. int numtoken(struct object *token, char *string)
  917. {   char *sptr = string;
  918.     int ch, dig, num;
  919.     unsigned int base, limit;
  920.     int sign = 0, ovf = 0, digits = 0;
  921.     limit = 0x7fffffff;
  922.     ch = *sptr++;
  923.     if      (ch == '+')
  924.     {   sign = 1;
  925.         ch = *sptr++;
  926.     }
  927.     else if (ch == '-')
  928.     {   sign = 2;
  929.         ch = *sptr++;
  930.         limit = 0x80000000;
  931.     }
  932.     if (ch == '.') goto decn;
  933.     num = digitval(ch);
  934.     if (num >= 10) return 0;
  935.     digits = 1;
  936.     for (;;)
  937.     {   ch = *sptr++;
  938.         dig = digitval(ch);
  939.         if (dig >= 10) break;
  940.         if (num > limit/10 - 1)
  941.             if ((dig > limit%10) || (num > limit/10)) ovf = 1;
  942.         num = num * 10 + dig;
  943.     }
  944.  
  945.     if (ch != '#') goto decn;
  946.     ch = *sptr++;
  947.  
  948.     if (sign != 0 || num == 0 || num > 36) return 0;
  949.     limit = 0xffffffff;
  950.     base = num;
  951.     num = digitval(ch);
  952.     if (num >= base) return 0;
  953.     for (;;)
  954.     {   ch = *sptr++;
  955.         dig = digitval(ch);
  956.         if (dig >= base) break;
  957.         if (num > limit/base - 1)
  958.             if ((dig > limit%base) || (num > limit/base)) ovf = 1;
  959.         num = num * base + dig;
  960.     }
  961.     if (ch != ' ') return 0;
  962.     if (ovf == 0) goto numi;
  963.     error(errlimitcheck);
  964.  
  965. decn:
  966.     if (ch == '.')
  967.     {   ovf = 1;
  968.         for (;;)
  969.         {   ch = *sptr++;
  970.             dig = digitval(ch);
  971.             if (dig >= 10) break;
  972.             digits = 1;
  973.         }
  974.     }
  975.     if (digits == 0) return 0;
  976.     if (ch == 'E' || ch == 'e')
  977.     {   ovf = 1;
  978.         digits = 0;
  979.         ch = *sptr++;
  980.         if (ch == '+' || ch == '-') ch = *sptr++;
  981.         for (;;)
  982.         {   dig = digitval(ch);
  983.             if (dig >= 10) break;
  984.             digits = 1;
  985.             ch = *sptr++;
  986.         }
  987.         if (digits == 0) return 0;
  988.     }
  989.     if (ch != ' ') return 0;
  990.     if (ovf == 0) goto numi;
  991.  
  992.     token->type = typereal;
  993.     token->flags = 0;
  994.     token->length = 0;
  995.     token->value.rval = (double) atof(string);
  996.     return 1;
  997.  
  998. numi:
  999.     token->type = typeint;
  1000.     token->flags = 0;
  1001.     token->length = 0;
  1002.     token->value.ival = (sign == 2)? -num: num;
  1003.     return 1;
  1004. }
  1005.  
  1006. /* Make a name token by looking up its string in the name table */
  1007.  
  1008. void nametoken(struct object *token, char *string, int length, int flags)
  1009. {   struct name *nameptr;
  1010.     vmref *nameslot, nameref;
  1011.     char *s;
  1012.     unsigned int hash = 0;
  1013.  
  1014.     if (length < 0) length = strlen(string);
  1015.     s = string + length;
  1016.     while (s != string) hash = hash * 12345 + *--s;
  1017.  
  1018.     nameslot = &nametable[hash % nametablesize];
  1019.     for (;;)
  1020.     {   nameref = *nameslot;
  1021.         if (nameref == 0) break;
  1022.         nameptr = vmnptr(nameref);
  1023.         if (nameptr->hash == hash &&
  1024.             nameptr->length == length &&
  1025.             memcmp(nameptr->string, string, length) == 0)
  1026.             goto lab;
  1027.         nameslot = &nameptr->chain;
  1028.     }
  1029.  
  1030.     nameref = vmalloc(sizeof (struct name) - 2 + length);
  1031.     nameptr = vmnptr(nameref);
  1032.     nameptr->chain = 0;
  1033.     nameptr->hash = hash;
  1034.     nameptr->length = length;
  1035.     memcpy(nameptr->string, string, length);
  1036.     *nameslot = nameref;
  1037.  
  1038. lab:
  1039.     token->type = typename;
  1040.     token->flags = flags;
  1041.     token->length = 0;
  1042.     token->value.vref = nameref;
  1043. }
  1044.  
  1045. /* Create a new dictionary token */
  1046.  
  1047. void dicttoken(struct object *token, int size)
  1048. {   struct dictionary *dict;
  1049.     vmref dref;
  1050.     int length, slots, p, i;
  1051.  
  1052.     /* Table of primes. */
  1053.  
  1054.     static int primes[] =
  1055.         {  3,   5,   7,  11,  13,  17,  19,  23,  29,  31,
  1056.           37,  41,  43,  47,  53,  59,  61,  67,  71,  73,
  1057.           79,  83,  89,  97, 101, 103, 107, 109, 113, 127,
  1058.          131, 137, 139, 149, 151, 157, 163, 167, 173, 179,
  1059.          181, 191, 193, 197, 199, 211, 223, 227, 229, 233,
  1060.          239, 241, 251, 257
  1061.         };
  1062.  
  1063.     /* Choose the number of hash table slots.  Make it an odd number about
  1064.      * 1.25 times the dictionary size, with at least one unused slot (so
  1065.      * the search always terminates). */
  1066.  
  1067.     if (size < 0) error(errrangecheck);
  1068.     slots = size + size/4 + 1 | 1;
  1069.  
  1070.     /* Round the number up to the next prime. */
  1071.  
  1072. lab:
  1073.     if (slots > 65535) error(errlimitcheck);
  1074.     for (i = 0; p = primes[i], p * p <= slots ; i++)
  1075.         if (slots % p == 0)
  1076.         {   slots += 2;
  1077.             goto lab;
  1078.         }
  1079.  
  1080.     /* Now create the dictionary. */
  1081.  
  1082.     length = (sizeof (struct dictionary)) +
  1083.               sizeof (struct dictentry) * (slots - 1);
  1084.     dref = vmalloc(length);
  1085.     dict = vmdptr(dref);
  1086.     dict->type = typedict;
  1087.     dict->flags = 0;
  1088.     dict->slots = slots;
  1089.     dict->size = size;
  1090.     dict->full = 0;
  1091.     dict->saved = vmnest;
  1092.     dict->length = length;
  1093.     token->type = typedict;
  1094.     token->flags = 0;
  1095.     token->length = 0;
  1096.     token->value.vref = dref;
  1097. }
  1098.  
  1099. /* Put the value of a key into a dictionary */
  1100.  
  1101. void dictput(vmref dref, struct object *key, struct object *val)
  1102. {   struct dictionary *dict;
  1103.     union dictkey lkey, ekey;
  1104.     struct object nkey;
  1105.     struct vmlist *vmlist;
  1106.     vmref vmlref, *vmlslot;
  1107.     unsigned int hash, slot;
  1108.  
  1109.     dict = vmdptr(dref);
  1110.     if (dict->flags & flagwprot) error(errinvalidaccess);
  1111.  
  1112.     /* Convert strings to names */
  1113.  
  1114.     if (key->type == typenull)
  1115.         error(errtypecheck);
  1116.     if (key->type == typestring)
  1117.         nametoken(&nkey, vmsptr(key->value.vref), key->length, 0);
  1118.     else
  1119.         nkey = *key;
  1120.     lkey.keyobj = nkey;
  1121.     lkey.keyobj.flags = 0;
  1122.  
  1123.     /* If we have not saved the dictionary since the last vm save, we must
  1124.      * save it now. */
  1125.  
  1126.     if (dict->saved < vmnest)
  1127.     {   vmlslot = &(vmstack[vmnest].hlist[vmhashsize]);
  1128.         vmlref = vmalloc(sizeof (struct vmlist) + dict->length);
  1129.         vmlist = vmvptr(vmlref);
  1130.         vmlist->chain = *vmlslot;
  1131.         vmlist->vref = dref;
  1132.         vmlist->length = dict->length;
  1133.         memcpy((char *) (vmlist + 1), (char *) dict, dict->length);
  1134.         *vmlslot = vmlref;
  1135.         dict->saved = vmnest;
  1136.     }
  1137.  
  1138.     /* Compute the hash value.  If we need to rehash we add the hash value
  1139.      * modulo the table size.  Since the size is a prime number this will
  1140.      * scan the entire table - unless the hash value is zero when we add
  1141.      * one instead. */
  1142.  
  1143.     slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1144.     hash = slot;
  1145.     if (hash == 0) hash = 1;
  1146.  
  1147.     /* Search the table for the key, or an empty slot.  Then insert. */
  1148.  
  1149.     for (;;)
  1150.     {   ekey.keyobj = dict->entries[slot].key;
  1151.         if (ekey.keyobj.type == 0)
  1152.         {   if (dict->full == dict->size) error(errdictfull);
  1153.             dict->full++;
  1154.             dict->entries[slot].key = nkey;
  1155.             break;
  1156.         }
  1157.         ekey.keyobj.flags = 0;
  1158.         if (ekey.keyint[1] == lkey.keyint[1] &&
  1159.             ekey.keyint[0] == lkey.keyint[0])
  1160.         {   dict->entries[slot].key.flags = nkey.flags;
  1161.             break;
  1162.         }
  1163.         slot += hash;
  1164.         if (slot >= dict->slots) slot -= dict->slots;
  1165.     }
  1166.     dict->entries[slot].val = *val;
  1167. }
  1168.  
  1169. /* Get the value of a key from a dictionary */
  1170.  
  1171. int dictget(vmref dref, struct object *key, struct object *val, int flags)
  1172. {   struct dictionary *dict;
  1173.     union dictkey lkey, ekey;
  1174.     unsigned int hash, slot;
  1175.  
  1176.     dict = vmdptr(dref);
  1177.     if (dict->flags & flags) error(errinvalidaccess);
  1178.  
  1179.     /* Convert strings to names */
  1180.  
  1181.     if (key->type == typenull)
  1182.         error(errtypecheck);
  1183.     if (key->type == typestring)
  1184.         nametoken(&lkey.keyobj, vmsptr(key->value.vref), key->length, 0);
  1185.     else
  1186.     {   lkey.keyobj = *key;
  1187.         lkey.keyobj.flags = 0;
  1188.     }
  1189.  
  1190.     /* Compute the hash value. */
  1191.  
  1192.     slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1193.     hash = slot;
  1194.     if (hash == 0) hash = 1;
  1195.  
  1196.     /* Search the table. */
  1197.  
  1198.     for (;;)
  1199.     {   ekey.keyobj = dict->entries[slot].key;
  1200.         if (ekey.keyobj.type == 0)
  1201.             return 0;
  1202.         ekey.keyobj.flags = 0;
  1203.         if (ekey.keyint[1] == lkey.keyint[1] &&
  1204.             ekey.keyint[0] == lkey.keyint[0])
  1205.         {   *val = dict->entries[slot].val;
  1206.             return 1;
  1207.         }
  1208.         slot += hash;
  1209.         if (slot >= dict->slots) slot -= dict->slots;
  1210.     }
  1211. }
  1212.  
  1213. /* Find a key in the dictionary stack */
  1214.  
  1215. int dictfind(struct object *key, struct object *val)
  1216. {   struct dictionary *dict;
  1217.     union dictkey lkey, ekey;
  1218.     unsigned int hash, slot;
  1219.     int nest = dictnest;
  1220.  
  1221.     /* Convert strings to names */
  1222.  
  1223.     if (key->type == typenull)
  1224.         error(errtypecheck);
  1225.     if (key->type == typestring)
  1226.         nametoken(&lkey.keyobj, vmsptr(key->value.vref), key->length, 0);
  1227.     else
  1228.     {   lkey.keyobj = *key;
  1229.         lkey.keyobj.flags = 0;
  1230.     }
  1231.  
  1232.     /* Search all the directories on the stack. */
  1233.  
  1234.     while (nest--)
  1235.     {   dict = vmdptr(dictstack[nest].value.vref);
  1236.         if (dict->flags & flagrprot) error(errinvalidaccess);
  1237.         slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1238.         hash = slot;
  1239.         if (hash == 0) hash = 1;
  1240.         for (;;)
  1241.         {   ekey.keyobj = dict->entries[slot].key;
  1242.             if (ekey.keyobj.type == 0)
  1243.                 break;
  1244.             ekey.keyobj.flags = 0;
  1245.             if (ekey.keyint[1] == lkey.keyint[1] &&
  1246.                 ekey.keyint[0] == lkey.keyint[0])
  1247.             {   *val = dict->entries[slot].val;
  1248.                 return nest;
  1249.             }
  1250.             slot += hash;
  1251.             if (slot >= dict->slots) slot -= dict->slots;
  1252.         }
  1253.     }
  1254.     return -1;
  1255. }
  1256.  
  1257. /* Pack an array */
  1258.  
  1259. vmref arraypack(struct object *aptr, int length)
  1260. {   char *sptr;
  1261.     int len = 0;
  1262.     while (length--)
  1263.     {   sptr = vmstring(len, sizeof (struct object));
  1264.         len += pack(aptr++, sptr);
  1265.     }
  1266.     return vmalloc(len);
  1267. }
  1268.  
  1269. /* Unpack an array */
  1270.  
  1271. void arrayunpk(struct object *aptr, char *sptr, int length)
  1272. {   while (length--) sptr += unpack(aptr++, sptr);
  1273. }
  1274.  
  1275. /* Pack the next element of an array */
  1276.  
  1277. int pack(struct object *token, char *sptr)
  1278. {   int type = token->type;
  1279.     int flags = token->flags;
  1280.     sptr[0] = type | flags;
  1281.     switch (type)
  1282.     {   case typenull:
  1283.         case typemark:
  1284.             return 1;
  1285.  
  1286.         case typesave:
  1287.         case typefile:
  1288.             sptr[1] = token->length;
  1289.             memcpy(sptr + 2, (char *) &token->value, sizeof token->value);
  1290.             return 2 + sizeof token->value;
  1291.  
  1292.         case typeoper:
  1293.         case typebool:
  1294.             sptr[1] = token->value.ival;
  1295.             return 2;
  1296.  
  1297.         case typeint:
  1298.             if (token->value.ival >= -32 && token->value.ival < 224)
  1299.             {   sptr[0] = typechar | flags;
  1300.                 sptr[1] = token->value.ival + 32;
  1301.                 return 2;
  1302.             }
  1303.         case typefont:
  1304.         case typereal:
  1305.         case typename:
  1306.         case typedict:
  1307.         case typeoper2:
  1308.             memcpy(sptr + 1, (char *) &token->value, sizeof token->value);
  1309.             return 1 + sizeof token->value;
  1310.  
  1311.         case typearray:
  1312.         case typepacked:
  1313.         case typestring:
  1314.             memcpy(sptr + 1, (char *) &token->length,
  1315.                    sizeof token->length + sizeof token->value);
  1316.             return 1 + sizeof token->length + sizeof token->value;
  1317.     }
  1318. }
  1319.  
  1320. /* Unpack the next element of an array */
  1321.  
  1322. int unpack(struct object *token, char *sptr)
  1323. {   int type = ((unsigned char *) sptr)[0];
  1324.     token->flags = type & 0xf0;
  1325.     token->type = type = type & 0x0f;
  1326.     switch (type)
  1327.     {   case typenull:
  1328.         case typemark:
  1329.             token->length = 0;
  1330.             token->value.ival = 0;
  1331.             return 1;
  1332.  
  1333.         case typesave:
  1334.         case typefile:
  1335.             token->length = ((unsigned char *) sptr)[1];
  1336.             memcpy((char *) &token->value, sptr + 2, sizeof token->value);
  1337.             return 2 + sizeof token->value;
  1338.  
  1339.         case typeoper:
  1340.         case typebool:
  1341.             token->length = 0;
  1342.             token->value.ival = ((unsigned char *) sptr)[1];
  1343.             return 2;
  1344.  
  1345.         case typeoper2:
  1346.             token->type = typeoper;
  1347.         case typeint:
  1348.         case typefont:
  1349.         case typereal:
  1350.         case typename:
  1351.         case typedict:
  1352.             token->length = 0;
  1353.             memcpy((char *) &token->value, sptr + 1, sizeof token->value);
  1354.             return 1 + sizeof token->value;
  1355.  
  1356.         case typearray:
  1357.         case typepacked:
  1358.         case typestring:
  1359.             memcpy((char *) &token->length, sptr + 1,
  1360.                    sizeof token->length + sizeof token->value);
  1361.             return 1 + sizeof token->length + sizeof token->value;
  1362.  
  1363.         case typechar:
  1364.             token->type = typeint;
  1365.             token->length = 0;
  1366.             token->value.ival = ((unsigned char *) sptr)[1] - 32;
  1367.             return 2;
  1368.     }
  1369. }
  1370.  
  1371. /* Initialise the virtual machine */
  1372.  
  1373. void vminit(int parms)
  1374. {   vmnest = 0;
  1375.     vmsegno = vmparms = parms;
  1376.     vmsegsize = memvmin;
  1377.     if (vmsegsize > 0x1000000) vmsegsize = 0x1000000;
  1378.     vmused = 0;
  1379.     vmhwm = 0;
  1380.     vmmax = vmsegsize * (vmsegmax - vmparms);
  1381.     memset((char *) &vmbeg, 0, sizeof vmbeg);
  1382.     memset((char *) &vmnext, 0, sizeof vmnext);
  1383.     memset((char *) &vmsize, 0, sizeof vmsize);
  1384.     memset((char *) vmstack, 0, sizeof vmstack);
  1385.     packing = 0;
  1386. }
  1387.  
  1388. /* Tidy up the virtual machine */
  1389.  
  1390. void vmtidy(void)
  1391. {   while (vmsegno >= vmparms)
  1392.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1393.         vmsegno--;
  1394.     }
  1395. }
  1396.  
  1397. /* Set up a virtual machine parameter segment */
  1398.  
  1399. void vmparm(int parm, void *beg, int size)
  1400. {   vmbeg[parm] = beg;
  1401.     vmsize[parm] = vmnext[parm] = size;
  1402. }
  1403.  
  1404. /* Allocate some memory in the virtual machine */
  1405.  
  1406. vmref vmalloc(int size)
  1407. {   vmref vref;
  1408.     int blksize = (size + (mcalign - 1)) & ~(mcalign - 1);
  1409.     if (blksize > vmsize[vmsegno] - vmnext[vmsegno])
  1410.         vmallocseg(blksize, 0);
  1411.     vref = vmxref(vmsegno, vmnext[vmsegno]);
  1412.     vmnext[vmsegno] += blksize;
  1413.     vmused += blksize;
  1414.     if (vmused > vmhwm) vmhwm = vmused;
  1415.     return vref;
  1416. }
  1417.  
  1418. /* Allocate some memory in the virtual machine */
  1419.  
  1420. void *vmallocv(int size)
  1421. {   vmref vref = vmalloc(size);
  1422.     return vmvptr(vref);
  1423. }
  1424.  
  1425. /* Convert a virtual machine reference to an address */
  1426.  
  1427. void *vmxptr(vmref vref)
  1428. {   return vmvptr(vref);
  1429. }
  1430.  
  1431. /* Preallocate space for a string at the end of the virtual machine memory */
  1432.  
  1433. char *vmstring(int length, int size)
  1434. {   int blksize = length + size;
  1435.     if (blksize > vmsize[vmsegno] - vmnext[vmsegno])
  1436.         vmallocseg(blksize, length);
  1437.     return vmbeg[vmsegno] + vmnext[vmsegno] + length;
  1438. }
  1439.  
  1440. /* Allocate a new virtual machine memory segment */
  1441.  
  1442. void vmallocseg(int blksize, int length)
  1443. {   char *vbeg;
  1444.     int segsize, numsegs;
  1445.     numsegs = (blksize + vmsegsize - 1) / vmsegsize;
  1446.     segsize = vmsegsize * numsegs;
  1447.     if (vmsegno + numsegs >
  1448.             vmsegmax + (vmnext[vmsegno] == 0 ? 1 : 0)) error(errVMerror);
  1449.     vbeg = memalloc(segsize);
  1450.     if (vbeg == NULL) error(errmemoryallocation);
  1451.     memcpy(vbeg, vmbeg[vmsegno] + vmnext[vmsegno], length);
  1452.     if (vmnext[vmsegno] == 0)
  1453.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1454.         vmsegno--;
  1455.     }
  1456.     else
  1457.         vmused += vmsize[vmsegno] - vmnext[vmsegno];
  1458.     while (numsegs--)
  1459.     {   vmsegno++;
  1460.         if (numsegs == 0)
  1461.         {   vmbeg[vmsegno] = vbeg;
  1462.             vmsize[vmsegno] = segsize;
  1463.         }
  1464.         else
  1465.         {   vmbeg[vmsegno] = NULL;
  1466.             vmsize[vmsegno] = 0;
  1467.         }
  1468.         vmnext[vmsegno] = 0;
  1469.     }
  1470. }
  1471.  
  1472. /* Save some virtual machine memory before updating it */
  1473.  
  1474. void vmsavemem(vmref vref, int length)
  1475. {   struct vmframe *vmframe;
  1476.     struct vmlist *vmlist;
  1477.     vmref vmlref, *vmlslot;
  1478.     unsigned int hash;
  1479.  
  1480.     vmframe = &vmstack[vmnest];
  1481.  
  1482.     /* We don't need to save it if it is more recent than the last save */
  1483.  
  1484.     if (vmscheck(vmframe, vref)) return;
  1485.  
  1486.     /* Compute the hash value */
  1487.  
  1488.     hash = vref % vmhashsize;
  1489.  
  1490.     /* Look on the hash chain to see if we have saved it already */
  1491.  
  1492.     vmlslot = &(vmframe->hlist[hash]);
  1493.     vmlref = *vmlslot;
  1494.     while (vmlref)
  1495.     {   vmlist = vmvptr(vmlref);
  1496.         if (vmlist->vref == vref && vmlist->length >= length)
  1497.             return;
  1498.         vmlref = vmlist->chain;
  1499.     }
  1500.  
  1501.     /* If we cannot find it save a copy and add it to the list */
  1502.  
  1503.     vmlref = vmalloc(sizeof (struct vmlist) + length);
  1504.     vmlist = vmvptr(vmlref);
  1505.     vmlist->chain = *vmlslot;
  1506.     vmlist->vref = vref;
  1507.     vmlist->length = length;
  1508.     memcpy((char *) (vmlist + 1), vmsptr(vref), length);
  1509.     *vmlslot = vmlref;
  1510. }
  1511.  
  1512. /* Save the virtual machine */
  1513.  
  1514. void vmsave(struct object *token)
  1515. {   struct vmframe *vmframe;
  1516.     if (istate.flags & intgraph) error(errundefined);
  1517.     if (vmnest == vmstacksize || gnest == gstacksize) error(errlimitcheck);
  1518.     gsave();
  1519.     vmframe = &vmstack[vmnest];
  1520.     token->type = typesave;
  1521.     token->flags = 0;
  1522.     token->length = vmnest;
  1523.     token->value.ival = vmframe->generation;
  1524.     vmnest++;
  1525.     vmframe++;
  1526.     vmframe->generation++;
  1527.     vmframe->gnest = gnest;
  1528.     vmframe->packing = packing;
  1529.     vmframe->vsegno = vmsegno;
  1530.     vmframe->vnext = vmnext[vmsegno];
  1531.     vmframe->vused = vmused;
  1532.     memset((char *)vmframe->hlist, 0, sizeof vmframe->hlist);
  1533. }
  1534.  
  1535. /* Restore the virtual machine */
  1536.  
  1537. void vmrest(int nest, int generation)
  1538. {   struct vmframe *vmframe;
  1539.     int vsegno, vnext, vused;
  1540.     if (istate.flags & intgraph) error(errundefined);
  1541.     if (nest < istate.vmbase ||
  1542.         nest >= vmnest ||
  1543.             (generation != -1 && generation != vmstack[nest].generation))
  1544.         error(errinvalidrestore);
  1545.     vmframe = &vmstack[nest + 1];
  1546.  
  1547.     /* Check the stacks */
  1548.  
  1549.     vmrestcheck(vmframe, operstack, opernest);
  1550.     vmrestcheck(vmframe, execstack, execnest);
  1551.     vmrestcheck(vmframe, dictstack, dictnest);
  1552.  
  1553.     gnest = vmframe->gnest;
  1554.     packing = vmframe->packing;
  1555.     vsegno = vmframe->vsegno;
  1556.     vnext = vmframe->vnext;
  1557.     vused = vmframe->vused;
  1558.  
  1559.     /* Restore file and name tables, the font cache, and the memory */
  1560.  
  1561.     vmrestfiles(nest);
  1562.     vmrestnames(vmframe);
  1563.     vmrestfont(vmframe);
  1564.     vmrestmem(nest);
  1565.  
  1566.     /* Clear the memory we have freed */
  1567.  
  1568.     memset(vmbeg[vsegno] + vnext, 0, vmnext[vsegno] - vnext);
  1569.     while (vmsegno > vsegno)
  1570.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1571.         vmsegno--;
  1572.     }
  1573.     vmnext[vmsegno] = vnext;
  1574.     vmused = vused;
  1575.  
  1576.     /* Restore the graphics state */
  1577.  
  1578.     grest();
  1579. }
  1580.  
  1581. /* Check a stack for objects refering to memory we are recovering */
  1582.  
  1583. void vmrestcheck(struct vmframe *vmframe,
  1584.                  struct object *stackptr, int stackcnt)
  1585. {   while (stackcnt--)
  1586.     {   if (stackptr->type == typestring ||
  1587.             stackptr->type == typearray ||
  1588.             stackptr->type == typepacked ||
  1589.             stackptr->type == typedict)
  1590.             if (vmscheck(vmframe, stackptr->value.vref))
  1591.                 error(errinvalidrestore);
  1592.         stackptr++;
  1593.     }
  1594. }
  1595.  
  1596. /* Restore the file table */
  1597.  
  1598. void vmrestfiles(int nest)
  1599. {   struct file *file = &filetable[3];
  1600.     int num = 3;
  1601.     while (num < filetablesize)
  1602.     {   if (file->open != 0 && file->saved > nest)
  1603.         {   fclose(file->fptr);
  1604.             file->fptr = NULL;
  1605.             file->generation++;
  1606.             file->open = 0;
  1607.         }
  1608.         file++;
  1609.         num++;
  1610.     }
  1611. }
  1612.  
  1613. /* Restore the name table */
  1614.  
  1615. void vmrestnames(struct vmframe *vmframe)
  1616. {   vmref *nslot1, *nslot2, nref;
  1617.     int i;
  1618.     nslot1 = &nametable[0];
  1619.     i = nametablesize;
  1620.  
  1621.     /* Scan each hash chain.  Unlink all the names more recent than the
  1622.      * save (the tail of the chain). */
  1623.  
  1624.     while (i--)
  1625.     {   nslot2 = nslot1;
  1626.         for (;;)
  1627.         {   nref = *nslot2;
  1628.             if (nref == 0)
  1629.                break;
  1630.             if (vmscheck(vmframe, nref))
  1631.             {   *nslot2 = 0;
  1632.                 break;
  1633.             }
  1634.             nslot2 = &(vmnptr(nref)->chain);
  1635.         }
  1636.         nslot1++;
  1637.     }
  1638. }
  1639.  
  1640. /* Restore the saved memory */
  1641.  
  1642. void vmrestmem(int nest)
  1643. {   struct vmframe *vmframe;
  1644.     struct vmlist *vmlist;
  1645.     vmref vmlref, *vmlslot;
  1646.     int i;
  1647.  
  1648.     vmframe = &vmstack[vmnest];
  1649.  
  1650.     do
  1651.     {   vmlslot = &(vmframe->hlist[0]);
  1652.         i = vmhashsize + 1;
  1653.         while (i--)
  1654.         {   vmlref = *vmlslot++;
  1655.             while (vmlref)
  1656.             {   vmlist = vmvptr(vmlref);
  1657.                 memcpy(vmsptr(vmlist->vref),
  1658.                        (char *)(vmlist + 1), vmlist->length);
  1659.                 vmlref = vmlist->chain;
  1660.             }
  1661.         }
  1662.         vmframe--;
  1663.         vmnest--;
  1664.     }   while (vmnest > nest);
  1665. }
  1666.  
  1667. /* Convert an object to a string */
  1668.  
  1669. int cvstring(struct object *token, char *sptr, int length)
  1670. {   struct name *nptr;
  1671.     char *buf;
  1672.     int len;
  1673.     switch (token->type)
  1674.     {   case typeint:
  1675.             buf = namebuf;
  1676.             len = sprintf(buf, "%d", token->value.ival);
  1677.             break;
  1678.  
  1679.         case typereal:
  1680.             buf = namebuf;
  1681.             len = sprintf(buf, "%g", token->value.rval);
  1682.             if (strchr(buf, '.') == NULL) buf[len++] = '.';
  1683.             break;
  1684.  
  1685.         case typebool:
  1686.             if (token->value.ival)
  1687.                 buf = "true";
  1688.             else
  1689.                 buf = "false";
  1690.             goto str;
  1691.  
  1692.         case typestring:
  1693.             if (token->flags & flagrprot) error(errinvalidaccess);
  1694.             len = token->length;
  1695.             buf = vmsptr(token->value.vref);
  1696.             break;
  1697.  
  1698.         case typename:
  1699.             nptr = vmnptr(token->value.vref);
  1700.             len = nptr->length;
  1701.             buf = nptr->string;
  1702.             break;
  1703.  
  1704.         case typeoper:
  1705.             buf = optable[token->value.ival].sptr;
  1706.             goto str;
  1707.  
  1708.         default:
  1709.             buf = "--nostringval--";
  1710. str:        len = strlen(buf);
  1711.     }
  1712.     if (len > length) error(errrangecheck);
  1713.     if (sptr != buf) memcpy(sptr, buf, len);
  1714.     return len;
  1715. }
  1716.  
  1717. /* Print an object in "=" style */
  1718.  
  1719. void printequals(FILE *fptr, struct object *token)
  1720. {   char *sptr;
  1721.     int length;
  1722.     if (token->type == typestring)
  1723.     {   if (token->flags & flagrprot)
  1724.         {   putstr(fptr, "--nostringval--");
  1725.             return;
  1726.         }
  1727.         length = token->length;
  1728.         sptr = vmsptr(token->value.vref);
  1729.     }
  1730.     else
  1731.         length = cvstring(token, sptr = namebuf, namebufsize);
  1732.     putmem(fptr, sptr, length);
  1733. }
  1734.  
  1735. /* Print an object in "==" style */
  1736.  
  1737. void printeqeq(FILE *fptr, struct object *token, int depth, int count)
  1738. {   struct object upelem, *element;
  1739.     char *sptr;
  1740.     int length;
  1741.     if (count != 0) putch(fptr, ' ');
  1742.     switch (token->type)
  1743.     {   case typenull:
  1744.         case typemark:
  1745.         case typesave:
  1746.         case typefile:
  1747.         case typedict:
  1748.         case typefont:
  1749. type:       putch(fptr, '-');
  1750.             putstr(fptr, typetable[token->type]);
  1751.             putch(fptr, '-');
  1752.             break;
  1753.  
  1754.         case typeoper:
  1755.             putstr(fptr, "--");
  1756.             putstr(fptr, optable[token->value.ival].sptr);
  1757.             putstr(fptr, "--");
  1758.             break;
  1759.  
  1760.         case typearray:
  1761.             if (!(token->flags & flagrprot) && depth < maxdepth)
  1762.             {   putch(fptr, (token->flags & flagexec) ? '{' : '[');
  1763.                 length = token->length;
  1764.                 element = vmaptr(token->value.vref);
  1765.                 while (length--)
  1766.                     printeqeq(fptr, element++, depth+1, ++count);
  1767.                 putch(fptr, ' ');
  1768.                 putch(fptr, (token->flags & flagexec) ? '}' : ']');
  1769.                 break;
  1770.             }
  1771.             goto type;
  1772.  
  1773.         case typepacked:
  1774.             if (!(token->flags & flagrprot) && depth < maxdepth)
  1775.             {   putch(fptr, (token->flags & flagexec) ? '{' : '[');
  1776.                 length = token->length;
  1777.                 sptr = vmsptr(token->value.vref);
  1778.                 while (length--)
  1779.                 {   sptr += unpack(&upelem, sptr);
  1780.                     printeqeq(fptr, &upelem, depth+1, ++count);
  1781.                 }
  1782.                 putch(fptr, ' ');
  1783.                 putch(fptr, (token->flags & flagexec) ? '}' : ']');
  1784.                 break;
  1785.             }
  1786.             goto type;
  1787.  
  1788.         case typestring:
  1789.             if (!(token->flags & flagrprot))
  1790.             {   putch(fptr, '(');
  1791.                 putcheck(fptr, vmsptr(token->value.vref), token->length);
  1792.                 putch(fptr, ')');
  1793.                 break;
  1794.             }
  1795.             goto type;
  1796.  
  1797.         case typename:
  1798.             if (!(token->flags & flagexec)) putch(fptr, '/');
  1799.         default:
  1800.             length = cvstring(token, namebuf, namebufsize);
  1801.             putcheck(fptr, namebuf, length);
  1802.             break;
  1803.     }
  1804. }
  1805.  
  1806. /* Test two objects for equality */
  1807.  
  1808. int equal(struct object *token1, struct object *token2)
  1809. {   struct object tokn1 = *token1, tokn2 = *token2;
  1810.     struct name *nptr;
  1811.     char *buf1, *buf2;
  1812.     if (tokn1.type == typeint && tokn2.type == typeint)
  1813.         return tokn1.value.ival == tokn2.value.ival;
  1814.     if (tokn1.type == typeint)
  1815.     {   tokn1.type = typereal;
  1816.         tokn1.value.rval = tokn1.value.ival;
  1817.     }
  1818.     if (tokn2.type == typeint)
  1819.     {   tokn2.type = typereal;
  1820.         tokn2.value.rval = tokn2.value.ival;
  1821.     }
  1822.     if (tokn1.type == typereal && tokn2.type == typereal)
  1823.         return tokn1.value.rval == tokn2.value.rval;
  1824.     if ((tokn1.flags & flagrprot) || (tokn2.flags & flagrprot))
  1825.             error(errinvalidaccess);
  1826.     if (tokn1.type == typestring)
  1827.         buf1 = vmsptr(tokn1.value.vref);
  1828.     if (tokn2.type == typestring)
  1829.         buf2 = vmsptr(tokn2.value.vref);
  1830.     if (tokn1.type == typename)
  1831.     {   nptr = vmnptr(tokn1.value.vref);
  1832.         tokn1.type = typestring;
  1833.         tokn1.length = nptr->length;
  1834.         buf1 = &nptr->string[0];
  1835.     }
  1836.     if (tokn2.type == typename)
  1837.     {   nptr = vmnptr(tokn2.value.vref);
  1838.         tokn2.type = typestring;
  1839.         tokn2.length = nptr->length;
  1840.         buf2 = &nptr->string[0];
  1841.     }
  1842.     if (tokn1.type == typestring && tokn2.type == typestring)
  1843.     {   if (tokn1.length != tokn2.length) return 0;
  1844.         return (memcmp(buf1, buf2, tokn1.length) == 0);
  1845.     }
  1846.     if (tokn1.type == tokn2.type &&
  1847.         tokn1.length == tokn2.length &&
  1848.         tokn1.value.ival == tokn2.value.ival)
  1849.         return 1;
  1850.     return 0;
  1851. }
  1852.  
  1853. /* Compare two objects */
  1854.  
  1855. int compare(struct object *token1, struct object *token2)
  1856. {   struct object tokn1 = *token1, tokn2 = *token2;
  1857.     unsigned char *sptr1, *sptr2;
  1858.     int length;
  1859.     if (tokn1.type == typeint && tokn2.type == typeint)
  1860.     {   if      (tokn1.value.ival == tokn2.value.ival)
  1861.             return  0;
  1862.         else if (tokn1.value.ival < tokn2.value.ival)
  1863.             return -1;
  1864.         else
  1865.             return  1;
  1866.     }
  1867.     if (tokn1.type == typeint)
  1868.     {   tokn1.type = typereal;
  1869.         tokn1.value.rval = tokn1.value.ival;
  1870.     }
  1871.     if (tokn2.type == typeint)
  1872.     {   tokn2.type = typereal;
  1873.         tokn2.value.rval = tokn2.value.ival;
  1874.     }
  1875.     if (tokn1.type == typereal && tokn2.type == typereal)
  1876.     {   if      (tokn1.value.rval == tokn2.value.rval)
  1877.             return  0;
  1878.         else if (tokn1.value.rval < tokn2.value.rval)
  1879.             return -1;
  1880.         else
  1881.             return  1;
  1882.     }
  1883.     if (tokn1.type == typestring && tokn2.type == typestring)
  1884.     {   if ((tokn1.flags & flagrprot) || (tokn2.flags & flagrprot))
  1885.             error(errinvalidaccess);
  1886.         length = (tokn1.length < tokn2.length) ?
  1887.                   tokn1.length : tokn2.length;
  1888.         sptr1 = (unsigned char *) vmsptr(tokn1.value.vref);
  1889.         sptr2 = (unsigned char *) vmsptr(tokn2.value.vref);
  1890.         while (length--)
  1891.         {   if (*sptr1 != *sptr2)  return (*sptr1 - *sptr2);
  1892.             sptr1++;
  1893.             sptr2++;
  1894.         }
  1895.         return (tokn1.length - tokn2.length);
  1896.     }
  1897.     error(errtypecheck);
  1898.     return 0;
  1899. }
  1900.  
  1901.  
  1902. /* Bind a procedure */
  1903.  
  1904. void bind(struct object *proc, int depth)
  1905. {   struct object token, *aptr;
  1906.     char *sptr;
  1907.     int length, len;
  1908.     length = proc->length;
  1909.  
  1910.     /* Array.  If not write protected, save it and scan looking up executable
  1911.      * names and replacing them if they are operators.  Recurse for embedded
  1912.      * procedures */
  1913.  
  1914.     if (proc->type == typearray)
  1915.     {   if (proc->flags & flagwprot) return;
  1916.         aptr = vmaptr(proc->value.vref);
  1917.         arraysave(proc->value.vref, length);
  1918.         while (length--)
  1919.         {   if (aptr->flags & flagexec)
  1920.                 if      (aptr->type == typename)
  1921.                 {   if (dictfind(aptr, &token) != -1)
  1922.                         if (token.type == typeoper) *aptr = token;
  1923.                 }
  1924.                 else if (aptr->type == typearray || aptr->type == typepacked)
  1925.                 {   if (depth == maxdepth) error(errlimitcheck);
  1926.                     bind(aptr, depth + 1);
  1927.                     aptr->flags |= flagwprot;
  1928.                 }
  1929.             aptr++;
  1930.         }
  1931.     }
  1932.  
  1933.     /* Packed array.  First unpack it to calculate the length to save.  Then
  1934.      * scan it unpacking sequentially.  Replace names with oper2 (same size).
  1935.      * Repack any elements we update */
  1936.  
  1937.     else
  1938.     {   sptr = vmsptr(proc->value.vref);
  1939.         len = 0;
  1940.         while (length--)
  1941.             len += unpack(&token, sptr + len);
  1942.         vmsavemem(proc->value.vref, len);
  1943.         length = proc->length;
  1944.         while (length--)
  1945.         {   len = unpack(&token, sptr);
  1946.             if (token.flags & flagexec)
  1947.                 if      (token.type == typename)
  1948.                 {   if (dictfind(&token, &token) != -1)
  1949.                         if (token.type == typeoper)
  1950.                         {   token.type = typeoper2;
  1951.                             pack(&token, sptr);
  1952.                         }
  1953.                 }
  1954.                 else if (token.type == typearray || token.type == typepacked)
  1955.                 {   if (depth == maxdepth) error(errlimitcheck);
  1956.                     bind(&token, depth + 1);
  1957.                     token.flags |= flagwprot;
  1958.                     pack(&token, sptr);
  1959.                 }
  1960.             sptr += len;
  1961.         }
  1962.     }
  1963. }
  1964.  
  1965. /* Estimate user (elapsed) time in milliseconds */
  1966.  
  1967. int usertime(void)
  1968. {   time(&time2);
  1969.     return (time2 - time1) * 1000;
  1970. }
  1971.  
  1972. /* Stop */
  1973.  
  1974. void stop(void)
  1975. {   struct object token, *token1;
  1976.     int nest = execnest;
  1977.     token1 = &execstack[nest];
  1978.  
  1979.     /* Search the execution stack for a "stopped".  Long jump if we find
  1980.      * one.  Close "run" files as we go. */
  1981.  
  1982.     while (nest)
  1983.     {   token1--;
  1984.         if      (token1->flags & flagrun)
  1985.             fileclose(token1 - 1);
  1986.         else if (token1->flags & flagstop)
  1987.         {   if (opernest == operstacksize) error(errstackoverflow);
  1988.             token.type = typebool;
  1989.             token.flags = 0;
  1990.             token.length = 0;
  1991.             token.value.ival = 1;
  1992.             operstack[opernest++] = token;
  1993.             execnest = nest - 2;
  1994.             errorjmp(token1->length, 1);
  1995.         }
  1996.         nest--;
  1997.     }
  1998. }
  1999.  
  2000. /* Error routine */
  2001.  
  2002. void error(int errnum)
  2003. {   struct object token;
  2004.     int nest;
  2005.  
  2006.     errornum = errnum;
  2007.     errorstring = errortable[errornum];
  2008.  
  2009.     /* Error during initialisation */
  2010.  
  2011.     if (errorflag == 0)
  2012.         nest = 0;
  2013.  
  2014.     /* Error trapping enabled */
  2015.  
  2016.     else
  2017.     {   flushlevel(0);
  2018.  
  2019.         /* Save the error name and command in memory */
  2020.  
  2021.         errdstoken[edserrorname] = errorname[errnum];
  2022.         errdstoken[edserrorname].flags = 0;
  2023.         errdstoken[edscommand] = *currtoken;
  2024.  
  2025.         /* If we are not already in the error handler, save the stacks too,
  2026.          * and call it if we can (and not killed) */
  2027.  
  2028.         if (errorflag == 2)
  2029.         {   errorflag = 1;
  2030.             errorarray(&token, operstack, opernest);
  2031.             errdstoken[edsostack] = token;
  2032.             errorarray(&token, execstack, execnest);
  2033.             errdstoken[edsestack] = token;
  2034.             errorarray(&token, dictstack, dictnest);
  2035.             errdstoken[edsdstack] = token;
  2036.             if (errnum != errkill)
  2037.             {   if (execnest < execstacksize &&
  2038.                     dictget(errordict.value.vref, &errorname[errnum],
  2039.                             &token, 0))
  2040.                 {   execstack[execnest++] = token;
  2041.                     errorflag = 2;
  2042.                 }
  2043.             }
  2044.         }
  2045.  
  2046.         /* Otherwise return to interactive or quit */
  2047.  
  2048.         if (errorflag != 2)
  2049.         {   errorflag = 2;
  2050.             errorexit();
  2051.             errormsg();
  2052.             nest = 0;
  2053.         }
  2054.         else
  2055.             nest = inest;
  2056.     }
  2057.  
  2058.     errorjmp(nest, 1);
  2059. }
  2060.  
  2061. /* Error save array, if there is enough memory */
  2062.  
  2063. void errorarray(struct object *token1, struct object *aptr, int length)
  2064. {   struct object token;
  2065.     if (vmused + length * sizeof (struct object) <= vmmax)
  2066.     {   token.type = typearray;
  2067.         token.flags = 0;
  2068.         token.length = length;
  2069.         token.value.vref = arrayalloc(length);
  2070.         arraycopy(vmaptr(token.value.vref), aptr, length);
  2071.     }
  2072.     else
  2073.     {   token.type = typenull;
  2074.         token.flags = 0;
  2075.         token.length = 0;
  2076.         token.value.ival = 0;
  2077.     }
  2078.     *token1 = token;
  2079. }
  2080.  
  2081. /* Error return to interactive mode or exit */
  2082.  
  2083. void errorexit(void)
  2084. {   struct file *file;
  2085.     FILE *fptr;
  2086.     if (prompting)
  2087.     {   execnest = 1;
  2088.         file = &filetable[0];
  2089.         file->emode = 0;
  2090.         fptr = file->fptr;
  2091.         while (file->ch != EOF && file->ch != '\n')
  2092.             file->ch = getf(file, fptr);
  2093.     }
  2094.     else
  2095.     {   execnest = 0;
  2096.         returncode = 10;
  2097.     }
  2098. }
  2099.  
  2100. /* Print an error message */
  2101.  
  2102. void errormsg(void)
  2103. {   if (sstderr)
  2104.     {   putstr(sstderr, "post: error: ");
  2105.         printequals(sstderr, &errdstoken[edserrorname]);
  2106.         putstr(sstderr, ", command ");
  2107.         printeqeq(sstderr, &errdstoken[edscommand], 0, 0);
  2108.         putch(sstderr, '\n');
  2109.     }
  2110. }
  2111.  
  2112. /* Long jump to the error jump buffer */
  2113.  
  2114. void errorjmp(int nest, int num)
  2115. {   while (nest < inest)
  2116.     {   if (istate.pfcrec)
  2117.             istate.pfcrec->count = 0;
  2118.         istate = istack[--inest];
  2119.     }
  2120.     longjmp(istate.errjmp, num);
  2121. }
  2122.  
  2123. /* End of file "postint.c" */
  2124.