home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / pascal / px / interp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-16  |  40.4 KB  |  1,936 lines
  1. /*-
  2.  * Copyright (c) 1991 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * Redistribution and use in source and binary forms, with or without
  6.  * modification, are permitted provided that the following conditions
  7.  * are met:
  8.  * 1. Redistributions of source code must retain the above copyright
  9.  *    notice, this list of conditions and the following disclaimer.
  10.  * 2. Redistributions in binary form must reproduce the above copyright
  11.  *    notice, this list of conditions and the following disclaimer in the
  12.  *    documentation and/or other materials provided with the distribution.
  13.  * 3. All advertising materials mentioning features or use of this software
  14.  *    must display the following acknowledgement:
  15.  *    This product includes software developed by the University of
  16.  *    California, Berkeley and its contributors.
  17.  * 4. Neither the name of the University nor the names of its contributors
  18.  *    may be used to endorse or promote products derived from this software
  19.  *    without specific prior written permission.
  20.  *
  21.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  22.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  25.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31.  * SUCH DAMAGE.
  32.  */
  33.  
  34. #ifndef lint
  35. static char sccsid[] = "@(#)interp.c    5.8 (Berkeley) 4/16/91";
  36. #endif /* not lint */
  37.  
  38. #include <math.h>
  39. #include <signal.h>
  40. #include "whoami.h"
  41. #include "vars.h"
  42. #include "objfmt.h"
  43. #include "h02opcs.h"
  44. #include "machdep.h"
  45. #include "libpc.h"
  46.  
  47. /*
  48.  * program variables
  49.  */
  50. union display _display;
  51. struct dispsave    *_dp;
  52. long    _lino = 0;
  53. int    _argc;
  54. char    **_argv;
  55. long    _mode;
  56. long    _runtst = (long)TRUE;
  57. bool    _nodump = FALSE;
  58. long    _stlim = 500000;
  59. long    _stcnt = 0;
  60. long    _seed = 1;
  61. #ifdef ADDR32
  62. char    *_minptr = (char *)0x7fffffff;
  63. #endif ADDR32
  64. #ifdef ADDR16
  65. char    *_minptr = (char *)0xffff;
  66. #endif ADDR16
  67. char    *_maxptr = (char *)0;
  68. long    *_pcpcount = (long *)0;
  69. long    _cntrs = 0;
  70. long    _rtns = 0;
  71.  
  72. /*
  73.  * standard files
  74.  */
  75. char        _inwin, _outwin, _errwin;
  76. struct iorechd    _err = {
  77.     &_errwin,        /* fileptr */
  78.     0,            /* lcount  */
  79.     0x7fffffff,        /* llimit  */
  80.     stderr,            /* fbuf    */
  81.     FILNIL,            /* fchain  */
  82.     STDLVL,            /* flev    */
  83.     "Message file",        /* pfname  */
  84.     FTEXT | FWRITE | EOFF,    /* funit   */
  85.     2,            /* fblk    */
  86.     1            /* fsize   */
  87. };
  88. struct iorechd    output = {
  89.     &_outwin,        /* fileptr */
  90.     0,            /* lcount  */
  91.     0x7fffffff,        /* llimit  */
  92.     stdout,            /* fbuf    */
  93.     ERR,            /* fchain  */
  94.     STDLVL,            /* flev    */
  95.     "standard output",    /* pfname  */
  96.     FTEXT | FWRITE | EOFF,    /* funit   */
  97.     1,            /* fblk    */
  98.     1            /* fsize   */
  99. };
  100. struct iorechd    input = {
  101.     &_inwin,        /* fileptr */
  102.     0,            /* lcount  */
  103.     0x7fffffff,        /* llimit  */
  104.     stdin,            /* fbuf    */
  105.     OUTPUT,            /* fchain  */
  106.     STDLVL,            /* flev    */
  107.     "standard input",    /* pfname  */
  108.     FTEXT|FREAD|SYNC|EOLN,    /* funit   */
  109.     0,            /* fblk    */
  110.     1            /* fsize   */
  111. };
  112.  
  113. /*
  114.  * file record variables
  115.  */
  116. long        _filefre = PREDEF;
  117. struct iorechd    _fchain = {
  118.     0, 0, 0, 0,        /* only use fchain field */
  119.     INPUT            /* fchain  */
  120. };
  121. struct iorec    *_actfile[MAXFILES] = {
  122.     INPUT,
  123.     OUTPUT,
  124.     ERR
  125. };
  126.  
  127. /*
  128.  * stuff for pdx to watch what the interpreter is doing.
  129.  * The .globl is #ifndef DBX since it breaks DBX to have a global
  130.  * asm label in the middle of a function (see _loopaddr: below).
  131.  */
  132.  
  133. union progcntr pdx_pc;
  134. #ifndef DBX
  135. asm(".globl _loopaddr");
  136. #endif DBX
  137.  
  138. /*
  139.  * Px profile array
  140.  */
  141. #ifdef PROFILE
  142. long _profcnts[NUMOPS];
  143. #endif PROFILE
  144.  
  145. /*
  146.  * debugging variables
  147.  */
  148. #ifdef PXDEBUG
  149. char opc[10];
  150. long opcptr = 9;
  151. #endif PXDEBUG
  152.  
  153. void
  154. interpreter(base)
  155.     char *base;
  156. {
  157.     /* register */ union progcntr pc;    /* interpreted program cntr */
  158.     struct iorec *curfile;        /* active file */
  159.     register struct blockmark *stp;    /* active stack frame ptr */
  160.     /*
  161.      * the following variables are used as scratch
  162.      */
  163.     register char *tcp;
  164.     register short *tsp;
  165.     register long tl, tl1, tl2, tl3;
  166.     char *tcp2;
  167.     long tl4;
  168.     double td, td1;
  169.     struct sze8 t8;
  170.     register short *tsp1;
  171.     long *tlp;
  172.     char *tcp1;
  173.     bool tb;
  174.     struct blockmark *tstp;
  175.     register struct formalrtn *tfp;
  176.     struct iorec **ip;
  177.     int mypid;
  178.     int ti, ti2;
  179.     short ts;
  180.     FILE *tf;
  181.     /* register */ union progcntr stack;    /* Interpreted stack */
  182.  
  183.     mypid = getpid();
  184.  
  185.     /*
  186.      * Setup sets up any hardware specific parameters before
  187.      * starting the interpreter. Typically this is macro- or inline-
  188.      * replaced by "machdep.h" or interp.sed.
  189.      */
  190.     setup();
  191.     /*
  192.      * necessary only on systems which do not initialize
  193.      * memory to zero
  194.      */
  195.     for (ip = &_actfile[3]; ip < &_actfile[MAXFILES]; *ip++ = FILNIL)
  196.         /* void */;
  197.     /*
  198.      * set up global environment, then ``call'' the main program
  199.      */
  200.     STACKALIGN(tl, 2 * sizeof(struct iorec *));
  201.     _display.frame[0].locvars = pushsp(tl);
  202.     _display.frame[0].locvars += 2 * sizeof(struct iorec *);
  203.     *(struct iorec **)(_display.frame[0].locvars + OUTPUT_OFF) = OUTPUT;
  204.     *(struct iorec **)(_display.frame[0].locvars + INPUT_OFF) = INPUT;
  205.     STACKALIGN(tl, sizeof(struct blockmark));
  206.     stp = (struct blockmark *)pushsp(tl);
  207.     _dp = &_display.frame[0];
  208.     pc.cp = base;
  209.  
  210.     for(;;) {
  211. #        ifdef PXDEBUG
  212.         if (++opcptr == 10)
  213.             opcptr = 0;
  214.         opc[opcptr] = *pc.ucp;
  215. #        endif PXDEBUG
  216. #        ifdef PROFILE
  217.         _profcnts[*pc.ucp]++;
  218. #        endif PROFILE
  219.  
  220.         /*
  221.          * Save away the program counter to a fixed location for pdx.
  222.          */
  223.         pdx_pc = pc;
  224.  
  225.         /*
  226.          * Having the label below makes dbx not work
  227.          * to debug this interpreter,
  228.          * since it thinks a new function called loopaddr()
  229.          * has started here, and it won't display the local
  230.          * variables of interpreter().  You have to compile
  231.          * -DDBX to avoid this problem...
  232.          */
  233. #        ifndef DBX
  234.     ;asm("_loopaddr:");
  235. #        endif DBX
  236.  
  237.         switch (*pc.ucp++) {
  238.         case O_BPT:            /* breakpoint trap */
  239.             PFLUSH();
  240.             kill(mypid, SIGILL);
  241.             pc.ucp--;
  242.             continue;
  243.         case O_NODUMP:
  244.             _nodump = TRUE;
  245.             /* and fall through */
  246.         case O_BEG:
  247.             _dp += 1;        /* enter local scope */
  248.             stp->odisp = *_dp;    /* save old display value */
  249.             tl = *pc.ucp++;        /* tl = name size */
  250.             stp->entry = pc.hdrp;    /* pointer to entry info */
  251.             tl1 = pc.hdrp->framesze;/* tl1 = size of frame */
  252.             _lino = pc.hdrp->offset;
  253.             _runtst = pc.hdrp->tests;
  254.             disableovrflo();
  255.             if (_runtst)
  256.                 enableovrflo();
  257.             pc.cp += (int)tl;    /* skip over proc hdr info */
  258.             stp->file = curfile;    /* save active file */
  259.             STACKALIGN(tl2, tl1);
  260.             tcp = pushsp(tl2);    /* tcp = new top of stack */
  261.             if (_runtst)        /* zero stack frame */
  262.                 blkclr(tcp, tl1);
  263.             tcp += (int)tl1;    /* offsets of locals are neg */
  264.             _dp->locvars = tcp;    /* set new display pointer */
  265.             _dp->stp = stp;
  266.             stp->tos = pushsp((long)0); /* set tos pointer */
  267.             continue;
  268.         case O_END:
  269.             PCLOSE(_dp->locvars);    /* flush & close local files */
  270.             stp = _dp->stp;
  271.             curfile = stp->file;    /* restore old active file */
  272.             *_dp = stp->odisp;    /* restore old display entry */
  273.             if (_dp == &_display.frame[1])
  274.                 return;        /* exiting main proc ??? */
  275.             _lino = stp->lino;    /* restore lino, pc, dp */
  276.             pc.cp = stp->pc;
  277.             _dp = stp->dp;
  278.             _runtst = stp->entry->tests;
  279.             disableovrflo();
  280.             if (_runtst)
  281.                 enableovrflo();
  282.             STACKALIGN(tl, stp->entry->framesze);
  283.             STACKALIGN(tl1, sizeof(struct blockmark));
  284.             popsp(tl +        /* pop local vars */
  285.                  tl1 +        /* pop stack frame */
  286.                  stp->entry->nargs);/* pop parms */
  287.             continue;
  288.         case O_CALL:
  289.             tl = *pc.cp++;
  290.             PCLONGVAL(tl1);
  291.             tcp = base + tl1 + sizeof(short);/* new entry point */
  292.             GETLONGVAL(tl1, tcp);
  293.             tcp = base + tl1;
  294.             STACKALIGN(tl1, sizeof(struct blockmark));
  295.             stp = (struct blockmark *)pushsp(tl1);
  296.             stp->lino = _lino;    /* save lino, pc, dp */
  297.             stp->pc = pc.cp;
  298.             stp->dp = _dp;
  299.             _dp = &_display.frame[tl]; /* set up new display ptr */
  300.             pc.cp = tcp;
  301.             continue;
  302.         case O_FCALL:
  303.             pc.cp++;
  304.              tcp = popaddr(); /* ptr to display save area */
  305.             tfp = (struct formalrtn *)popaddr();
  306.             STACKALIGN(tl, sizeof(struct blockmark));
  307.             stp = (struct blockmark *)pushsp(tl);
  308.             stp->lino = _lino;    /* save lino, pc, dp */
  309.             stp->pc = pc.cp;
  310.             stp->dp = _dp;
  311.             pc.cp = (char *)(tfp->fentryaddr);/* new entry point */
  312.             _dp = &_display.frame[tfp->fbn];/* new display ptr */
  313.              blkcpy(&_display.frame[1], tcp,
  314.                 tfp->fbn * sizeof(struct dispsave));
  315.             blkcpy(&tfp->fdisp[0], &_display.frame[1],
  316.                 tfp->fbn * sizeof(struct dispsave));
  317.             continue;
  318.         case O_FRTN:
  319.             tl = *pc.cp++;        /* tl = size of return obj */
  320.             if (tl == 0)
  321.                 tl = *pc.usp++;
  322.             tcp = pushsp((long)(0));
  323.             tfp = *(struct formalrtn **)(tcp + tl);
  324.              tcp1 = *(char **)
  325.                  (tcp + tl + sizeof(struct formalrtn *));
  326.             if (tl != 0) {
  327.                 blkcpy(tcp, tcp + sizeof(struct formalrtn *)
  328.                     + sizeof(char *), tl);
  329.             }
  330.             STACKALIGN(tl,
  331.                 sizeof(struct formalrtn *) + sizeof (char *));
  332.              popsp(tl);
  333.              blkcpy(tcp1, &_display.frame[1],
  334.                 tfp->fbn * sizeof(struct dispsave));
  335.             continue;
  336.         case O_FSAV:
  337.             tfp = (struct formalrtn *)popaddr();
  338.             tfp->fbn = *pc.cp++;    /* blk number of routine */
  339.             PCLONGVAL(tl);
  340.             tcp = base + tl + sizeof(short);/* new entry point */
  341.             GETLONGVAL(tl, tcp);
  342.             tfp->fentryaddr = (long (*)())(base + tl);
  343.             blkcpy(&_display.frame[1], &tfp->fdisp[0],
  344.                 tfp->fbn * sizeof(struct dispsave));
  345.             pushaddr(tfp);
  346.             continue;
  347.         case O_SDUP2:
  348.             pc.cp++;
  349.             tl = pop2();
  350.             push2((short)(tl));
  351.             push2((short)(tl));
  352.             continue;
  353.         case O_SDUP4:
  354.             pc.cp++;
  355.             tl = pop4();
  356.             push4(tl);
  357.             push4(tl);
  358.             continue;
  359.         case O_TRA:
  360.             pc.cp++;
  361.             pc.cp += *pc.sp;
  362.             continue;
  363.         case O_TRA4:
  364.             pc.cp++;
  365.             PCLONGVAL(tl);
  366.             pc.cp = base + tl;
  367.             continue;
  368.         case O_GOTO:
  369.             tstp = _display.frame[*pc.cp++].stp; /* ptr to
  370.                                 exit frame */
  371.             PCLONGVAL(tl);
  372.             pc.cp = base + tl;
  373.             stp = _dp->stp;
  374.             while (tstp != stp) {
  375.                 if (_dp == &_display.frame[1])
  376.                     ERROR("Active frame not found in non-local goto\n", 0); /* exiting prog ??? */
  377.                 PCLOSE(_dp->locvars); /* close local files */
  378.                 curfile = stp->file;  /* restore active file */
  379.                 *_dp = stp->odisp;    /* old display entry */
  380.                 _dp = stp->dp;          /* restore dp */
  381.                 stp = _dp->stp;
  382.             }
  383.             /* pop locals, stack frame, parms, and return values */
  384.             popsp((long)(stp->tos - pushsp((long)(0))));
  385.             continue;
  386.         case O_LINO:
  387.             if (_dp->stp->tos != pushsp((long)(0)))
  388.                 ERROR("Panic: stack not empty between statements\n");
  389.             _lino = *pc.cp++;    /* set line number */
  390.             if (_lino == 0)
  391.                 _lino = *pc.sp++;
  392.             if (_runtst) {
  393.                 LINO();        /* inc statement count */
  394.                 continue;
  395.             }
  396.             _stcnt++;
  397.             continue;
  398.         case O_PUSH:
  399.             tl = *pc.cp++;
  400.             if (tl == 0)
  401.                 PCLONGVAL(tl);
  402.             STACKALIGN(tl1, -tl);
  403.             tcp = pushsp(tl1);
  404.             if (_runtst)
  405.                 blkclr(tcp, tl1);
  406.             continue;
  407.         case O_IF:
  408.             pc.cp++;
  409.             if (pop2()) {
  410.                 pc.sp++;
  411.                 continue;
  412.             }
  413.             pc.cp += *pc.sp;
  414.             continue;
  415.         case O_REL2:
  416.             tl = pop2();
  417.             tl1 = pop2();
  418.             goto cmplong;
  419.         case O_REL24:
  420.             tl = pop2();
  421.             tl1 = pop4();
  422.             goto cmplong;
  423.         case O_REL42:
  424.             tl = pop4();
  425.             tl1 = pop2();
  426.             goto cmplong;
  427.         case O_REL4:
  428.             tl = pop4();
  429.             tl1 = pop4();
  430.         cmplong:
  431.             switch (*pc.cp++) {
  432.             case releq:
  433.                 push2(tl1 == tl);
  434.                 continue;
  435.             case relne:
  436.                 push2(tl1 != tl);
  437.                 continue;
  438.             case rellt:
  439.                 push2(tl1 < tl);
  440.                 continue;
  441.             case relgt:
  442.                 push2(tl1 > tl);
  443.                 continue;
  444.             case relle:
  445.                 push2(tl1 <= tl);
  446.                 continue;
  447.             case relge:
  448.                 push2(tl1 >= tl);
  449.                 continue;
  450.             default:
  451.                 ERROR("Panic: bad relation %d to REL4*\n",
  452.                     *(pc.cp - 1));
  453.                 continue;
  454.             }
  455.         case O_RELG:
  456.             tl2 = *pc.cp++;        /* tc has jump opcode */
  457.             tl = *pc.usp++;        /* tl has comparison length */
  458.             STACKALIGN(tl1, tl);    /* tl1 has arg stack length */
  459.             tcp = pushsp((long)(0));/* tcp pts to first arg */
  460.             switch (tl2) {
  461.             case releq:
  462.                 tb = RELEQ(tl, tcp + tl1, tcp);
  463.                 break;
  464.             case relne:
  465.                 tb = RELNE(tl, tcp + tl1, tcp);
  466.                 break;
  467.             case rellt:
  468.                 tb = RELSLT(tl, tcp + tl1, tcp);
  469.                 break;
  470.             case relgt:
  471.                 tb = RELSGT(tl, tcp + tl1, tcp);
  472.                 break;
  473.             case relle:
  474.                 tb = RELSLE(tl, tcp + tl1, tcp);
  475.                 break;
  476.             case relge:
  477.                 tb = RELSGE(tl, tcp + tl1, tcp);
  478.                 break;
  479.             default:
  480.                 ERROR("Panic: bad relation %d to RELG*\n", tl2);
  481.                 break;
  482.             }
  483.             popsp(tl1 << 1);
  484.             push2((short)(tb));
  485.             continue;
  486.         case O_RELT:
  487.             tl2 = *pc.cp++;        /* tc has jump opcode */
  488.             tl1 = *pc.usp++;    /* tl1 has comparison length */
  489.             tcp = pushsp((long)(0));/* tcp pts to first arg */
  490.             switch (tl2) {
  491.             case releq:
  492.                 tb = RELEQ(tl1, tcp + tl1, tcp);
  493.                 break;
  494.             case relne:
  495.                 tb = RELNE(tl1, tcp + tl1, tcp);
  496.                 break;
  497.             case rellt:
  498.                 tb = RELTLT(tl1, tcp + tl1, tcp);
  499.                 break;
  500.             case relgt:
  501.                 tb = RELTGT(tl1, tcp + tl1, tcp);
  502.                 break;
  503.             case relle:
  504.                 tb = RELTLE(tl1, tcp + tl1, tcp);
  505.                 break;
  506.             case relge:
  507.                 tb = RELTGE(tl1, tcp + tl1, tcp);
  508.                 break;
  509.             default:
  510.                 ERROR("Panic: bad relation %d to RELT*\n", tl2);
  511.                 break;
  512.             }
  513.             STACKALIGN(tl, tl1);
  514.             popsp(tl << 1);
  515.             push2((short)(tb));
  516.             continue;
  517.         case O_REL28:
  518.             td = pop2();
  519.             td1 = pop8();
  520.             goto cmpdbl;
  521.         case O_REL48:
  522.             td = pop4();
  523.             td1 = pop8();
  524.             goto cmpdbl;
  525.         case O_REL82:
  526.             td = pop8();
  527.             td1 = pop2();
  528.             goto cmpdbl;
  529.         case O_REL84:
  530.             td = pop8();
  531.             td1 = pop4();
  532.             goto cmpdbl;
  533.         case O_REL8:
  534.             td = pop8();
  535.             td1 = pop8();
  536.         cmpdbl:
  537.             switch (*pc.cp++) {
  538.             case releq:
  539.                 push2(td1 == td);
  540.                 continue;
  541.             case relne:
  542.                 push2(td1 != td);
  543.                 continue;
  544.             case rellt:
  545.                 push2(td1 < td);
  546.                 continue;
  547.             case relgt:
  548.                 push2(td1 > td);
  549.                 continue;
  550.             case relle:
  551.                 push2(td1 <= td);
  552.                 continue;
  553.             case relge:
  554.                 push2(td1 >= td);
  555.                 continue;
  556.             default:
  557.                 ERROR("Panic: bad relation %d to REL8*\n",
  558.                     *(pc.cp - 1));
  559.                 continue;
  560.             }
  561.         case O_AND:
  562.             pc.cp++;
  563.             tl = pop2();
  564.             tl1 = pop2();
  565.             push2(tl1 & tl);
  566.             continue;
  567.         case O_OR:
  568.             pc.cp++;
  569.             tl = pop2();
  570.             tl1 = pop2();
  571.             push2(tl1 | tl);
  572.             continue;
  573.         case O_NOT:
  574.             pc.cp++;
  575.             tl = pop2();
  576.             push2(tl ^ 1);
  577.             continue;
  578.         case O_AS2:
  579.             pc.cp++;
  580.             tl = pop2();
  581.             *(short *)popaddr() = tl;
  582.             continue;
  583.         case O_AS4:
  584.             pc.cp++;
  585.             tl = pop4();
  586.             *(long *)popaddr() = tl;
  587.             continue;
  588.         case O_AS24:
  589.             pc.cp++;
  590.             tl = pop2();
  591.             *(long *)popaddr() = tl;
  592.             continue;
  593.         case O_AS42:
  594.             pc.cp++;
  595.             tl = pop4();
  596.             *(short *)popaddr() = tl;
  597.             continue;
  598.         case O_AS21:
  599.             pc.cp++;
  600.             tl = pop2();
  601.             *popaddr() = tl;
  602.             continue;
  603.         case O_AS41:
  604.             pc.cp++;
  605.             tl = pop4();
  606.             *popaddr() = tl;
  607.             continue;
  608.         case O_AS28:
  609.             pc.cp++;
  610.             tl = pop2();
  611.             *(double *)popaddr() = tl;
  612.             continue;
  613.         case O_AS48:
  614.             pc.cp++;
  615.             tl = pop4();
  616.             *(double *)popaddr() = tl;
  617.             continue;
  618.         case O_AS8:
  619.             pc.cp++;
  620.             t8 = popsze8();
  621.             *(struct sze8 *)popaddr() = t8;
  622.             continue;
  623.         case O_AS:
  624.             tl = *pc.cp++;
  625.             if (tl == 0)
  626.                 tl = *pc.usp++;
  627.             STACKALIGN(tl1, tl);
  628.             tcp = pushsp((long)(0));
  629.             blkcpy(tcp, *(char **)(tcp + tl1), tl);
  630.             popsp(tl1 + sizeof(char *));
  631.             continue;
  632.         case O_VAS:
  633.             pc.cp++;
  634.             tl = pop4();
  635.             tcp1 = popaddr();
  636.             tcp = popaddr();
  637.             blkcpy(tcp1, tcp, tl);
  638.             continue;
  639.         case O_INX2P2:
  640.             tl = *pc.cp++;        /* tl has shift amount */
  641.             tl1 = pop2();
  642.             tl1 = (tl1 - *pc.sp++) << tl;
  643.             tcp = popaddr();
  644.             pushaddr(tcp + tl1);
  645.             continue;
  646.         case O_INX4P2:
  647.             tl = *pc.cp++;        /* tl has shift amount */
  648.             tl1 = pop4();
  649.             tl1 = (tl1 - *pc.sp++) << tl;
  650.             tcp = popaddr();
  651.             pushaddr(tcp + tl1);
  652.             continue;
  653.         case O_INX2:
  654.             tl = *pc.cp++;        /* tl has element size */
  655.             if (tl == 0)
  656.                 tl = *pc.usp++;
  657.             tl1 = pop2();        /* index */
  658.             tl2 = *pc.sp++;
  659.             tcp = popaddr();
  660.             pushaddr(tcp + (tl1 - tl2) * tl);
  661.             tl = *pc.usp++;
  662.             if (_runtst)
  663.                 SUBSC(tl1, tl2, tl); /* range check */
  664.             continue;
  665.         case O_INX4:
  666.             tl = *pc.cp++;        /* tl has element size */
  667.             if (tl == 0)
  668.                 tl = *pc.usp++;
  669.             tl1 = pop4();        /* index */
  670.             tl2 = *pc.sp++;
  671.             tcp = popaddr();
  672.             pushaddr(tcp + (tl1 - tl2) * tl);
  673.             tl = *pc.usp++;
  674.             if (_runtst)
  675.                 SUBSC(tl1, tl2, tl); /* range check */
  676.             continue;
  677.         case O_VINX2:
  678.             pc.cp++;
  679.             tl = pop2();        /* tl has element size */
  680.             tl1 = pop2();        /* upper bound */
  681.             tl2 = pop2();        /* lower bound */
  682.             tl3 = pop2();        /* index */
  683.             tcp = popaddr();
  684.             pushaddr(tcp + (tl3 - tl2) * tl);
  685.             if (_runtst)
  686.                 SUBSC(tl3, tl2, tl1); /* range check */
  687.             continue;
  688.         case O_VINX24:
  689.             pc.cp++;
  690.             tl = pop2();        /* tl has element size */
  691.             tl1 = pop2();        /* upper bound */
  692.             tl2 = pop2();        /* lower bound */
  693.             tl3 = pop4();        /* index */
  694.             tcp = popaddr();
  695.             pushaddr(tcp + (tl3 - tl2) * tl);
  696.             if (_runtst)
  697.                 SUBSC(tl3, tl2, tl1); /* range check */
  698.             continue;
  699.         case O_VINX42:
  700.             pc.cp++;
  701.             tl = pop4();        /* tl has element size */
  702.             tl1 = pop4();        /* upper bound */
  703.             tl2 = pop4();        /* lower bound */
  704.             tl3 = pop2();        /* index */
  705.             tcp = popaddr();
  706.             pushaddr(tcp + (tl3 - tl2) * tl);
  707.             if (_runtst)
  708.                 SUBSC(tl3, tl2, tl1); /* range check */
  709.             continue;
  710.         case O_VINX4:
  711.             pc.cp++;
  712.             tl = pop4();        /* tl has element size */
  713.             tl1 = pop4();        /* upper bound */
  714.             tl2 = pop4();        /* lower bound */
  715.             tl3 = pop4();        /* index */
  716.             tcp = popaddr();
  717.             pushaddr(tcp + (tl3 - tl2) * tl);
  718.             if (_runtst)
  719.                 SUBSC(tl3, tl2, tl1); /* range check */
  720.             continue;
  721.         case O_OFF:
  722.             tl = *pc.cp++;
  723.             if (tl == 0)
  724.                 tl = *pc.usp++;
  725.             tcp = popaddr();
  726.             pushaddr(tcp + tl);
  727.             continue;
  728.         case O_NIL:
  729.             pc.cp++;
  730.             tcp = popaddr();
  731.             NIL(tcp);
  732.             pushaddr(tcp);
  733.             continue;
  734.         case O_ADD2:
  735.             pc.cp++;
  736.             tl = pop2();
  737.             tl1 = pop2();
  738.             push4(tl1 + tl);
  739.             continue;
  740.         case O_ADD4:
  741.             pc.cp++;
  742.             tl = pop4();
  743.             tl1 = pop4();
  744.             push4(tl1 + tl);
  745.             continue;
  746.         case O_ADD24:
  747.             pc.cp++;
  748.             tl = pop2();
  749.             tl1 = pop4();
  750.             push4(tl1 + tl);
  751.             continue;
  752.         case O_ADD42:
  753.             pc.cp++;
  754.             tl = pop4();
  755.             tl1 = pop2();
  756.             push4(tl1 + tl);
  757.             continue;
  758.         case O_ADD28:
  759.             pc.cp++;
  760.             tl = pop2();
  761.             td = pop8();
  762.             push8(td + tl);
  763.             continue;
  764.         case O_ADD48:
  765.             pc.cp++;
  766.             tl = pop4();
  767.             td = pop8();
  768.             push8(td + tl);
  769.             continue;
  770.         case O_ADD82:
  771.             pc.cp++;
  772.             td = pop8();
  773.             td1 = pop2();
  774.             push8(td1 + td);
  775.             continue;
  776.         case O_ADD84:
  777.             pc.cp++;
  778.             td = pop8();
  779.             td1 = pop4();
  780.             push8(td1 + td);
  781.             continue;
  782.         case O_SUB2:
  783.             pc.cp++;
  784.             tl = pop2();
  785.             tl1 = pop2();
  786.             push4(tl1 - tl);
  787.             continue;
  788.         case O_SUB4:
  789.             pc.cp++;
  790.             tl = pop4();
  791.             tl1 = pop4();
  792.             push4(tl1 - tl);
  793.             continue;
  794.         case O_SUB24:
  795.             pc.cp++;
  796.             tl = pop2();
  797.             tl1 = pop4();
  798.             push4(tl1 - tl);
  799.             continue;
  800.         case O_SUB42:
  801.             pc.cp++;
  802.             tl = pop4();
  803.             tl1 = pop2();
  804.             push4(tl1 - tl);
  805.             continue;
  806.         case O_SUB28:
  807.             pc.cp++;
  808.             tl = pop2();
  809.             td = pop8();
  810.             push8(td - tl);
  811.             continue;
  812.         case O_SUB48:
  813.             pc.cp++;
  814.             tl = pop4();
  815.             td = pop8();
  816.             push8(td - tl);
  817.             continue;
  818.         case O_SUB82:
  819.             pc.cp++;
  820.             td = pop8();
  821.             td1 = pop2();
  822.             push8(td1 - td);
  823.             continue;
  824.         case O_SUB84:
  825.             pc.cp++;
  826.             td = pop8();
  827.             td1 = pop4();
  828.             push8(td1 - td);
  829.             continue;
  830.         case O_MUL2:
  831.             pc.cp++;
  832.             tl = pop2();
  833.             tl1 = pop2();
  834.             push4(tl1 * tl);
  835.             continue;
  836.         case O_MUL4:
  837.             pc.cp++;
  838.             tl = pop4();
  839.             tl1 = pop4();
  840.             push4(tl1 * tl);
  841.             continue;
  842.         case O_MUL24:
  843.             pc.cp++;
  844.             tl = pop2();
  845.             tl1 = pop4();
  846.             push4(tl1 * tl);
  847.             continue;
  848.         case O_MUL42:
  849.             pc.cp++;
  850.             tl = pop4();
  851.             tl1 = pop2();
  852.             push4(tl1 * tl);
  853.             continue;
  854.         case O_MUL28:
  855.             pc.cp++;
  856.             tl = pop2();
  857.             td = pop8();
  858.             push8(td * tl);
  859.             continue;
  860.         case O_MUL48:
  861.             pc.cp++;
  862.             tl = pop4();
  863.             td = pop8();
  864.             push8(td * tl);
  865.             continue;
  866.         case O_MUL82:
  867.             pc.cp++;
  868.             td = pop8();
  869.             td1 = pop2();
  870.             push8(td1 * td);
  871.             continue;
  872.         case O_MUL84:
  873.             pc.cp++;
  874.             td = pop8();
  875.             td1 = pop4();
  876.             push8(td1 * td);
  877.             continue;
  878.         case O_ABS2:
  879.         case O_ABS4:
  880.             pc.cp++;
  881.             tl = pop4();
  882.             push4(tl >= 0 ? tl : -tl);
  883.             continue;
  884.         case O_ABS8:
  885.             pc.cp++;
  886.             td = pop8();
  887.             push8(td >= 0.0 ? td : -td);
  888.             continue;
  889.         case O_NEG2:
  890.             pc.cp++;
  891.             ts = -pop2();
  892.             push4((long)ts);
  893.             continue;
  894.         case O_NEG4:
  895.             pc.cp++;
  896.             tl = -pop4();
  897.             push4(tl);
  898.             continue;
  899.         case O_NEG8:
  900.             pc.cp++;
  901.             td = -pop8();
  902.             push8(td);
  903.             continue;
  904.         case O_DIV2:
  905.             pc.cp++;
  906.             tl = pop2();
  907.             tl1 = pop2();
  908.             push4(tl1 / tl);
  909.             continue;
  910.         case O_DIV4:
  911.             pc.cp++;
  912.             tl = pop4();
  913.             tl1 = pop4();
  914.             push4(tl1 / tl);
  915.             continue;
  916.         case O_DIV24:
  917.             pc.cp++;
  918.             tl = pop2();
  919.             tl1 = pop4();
  920.             push4(tl1 / tl);
  921.             continue;
  922.         case O_DIV42:
  923.             pc.cp++;
  924.             tl = pop4();
  925.             tl1 = pop2();
  926.             push4(tl1 / tl);
  927.             continue;
  928.         case O_MOD2:
  929.             pc.cp++;
  930.             tl = pop2();
  931.             tl1 = pop2();
  932.             push4(tl1 % tl);
  933.             continue;
  934.         case O_MOD4:
  935.             pc.cp++;
  936.             tl = pop4();
  937.             tl1 = pop4();
  938.             push4(tl1 % tl);
  939.             continue;
  940.         case O_MOD24:
  941.             pc.cp++;
  942.             tl = pop2();
  943.             tl1 = pop4();
  944.             push4(tl1 % tl);
  945.             continue;
  946.         case O_MOD42:
  947.             pc.cp++;
  948.             tl = pop4();
  949.             tl1 = pop2();
  950.             push4(tl1 % tl);
  951.             continue;
  952.         case O_ADD8:
  953.             pc.cp++;
  954.             td = pop8();
  955.             td1 = pop8();
  956.             push8(td1 + td);
  957.             continue;
  958.         case O_SUB8:
  959.             pc.cp++;
  960.             td = pop8();
  961.             td1 = pop8();
  962.             push8(td1 - td);
  963.             continue;
  964.         case O_MUL8:
  965.             pc.cp++;
  966.             td = pop8();
  967.             td1 = pop8();
  968.             push8(td1 * td);
  969.             continue;
  970.         case O_DVD8:
  971.             pc.cp++;
  972.             td = pop8();
  973.             td1 = pop8();
  974.             push8(td1 / td);
  975.             continue;
  976.         case O_STOI:
  977.             pc.cp++;
  978.             ts = pop2();
  979.             push4((long)ts);
  980.             continue;
  981.         case O_STOD:
  982.             pc.cp++;
  983.             td = pop2();
  984.             push8(td);
  985.             continue;
  986.         case O_ITOD:
  987.             pc.cp++;
  988.             td = pop4();
  989.             push8(td);
  990.             continue;
  991.         case O_ITOS:
  992.             pc.cp++;
  993.             tl = pop4();
  994.             push2((short)tl);
  995.             continue;
  996.         case O_DVD2:
  997.             pc.cp++;
  998.             td = pop2();
  999.             td1 = pop2();
  1000.             push8(td1 / td);
  1001.             continue;
  1002.         case O_DVD4:
  1003.             pc.cp++;
  1004.             td = pop4();
  1005.             td1 = pop4();
  1006.             push8(td1 / td);
  1007.             continue;
  1008.         case O_DVD24:
  1009.             pc.cp++;
  1010.             td = pop2();
  1011.             td1 = pop4();
  1012.             push8(td1 / td);
  1013.             continue;
  1014.         case O_DVD42:
  1015.             pc.cp++;
  1016.             td = pop4();
  1017.             td1 = pop2();
  1018.             push8(td1 / td);
  1019.             continue;
  1020.         case O_DVD28:
  1021.             pc.cp++;
  1022.             td = pop2();
  1023.             td1 = pop8();
  1024.             push8(td1 / td);
  1025.             continue;
  1026.         case O_DVD48:
  1027.             pc.cp++;
  1028.             td = pop4();
  1029.             td1 = pop8();
  1030.             push8(td1 / td);
  1031.             continue;
  1032.         case O_DVD82:
  1033.             pc.cp++;
  1034.             td = pop8();
  1035.             td1 = pop2();
  1036.             push8(td1 / td);
  1037.             continue;
  1038.         case O_DVD84:
  1039.             pc.cp++;
  1040.             td = pop8();
  1041.             td1 = pop4();
  1042.             push8(td1 / td);
  1043.             continue;
  1044.         case O_RV1:
  1045.             tcp = _display.raw[*pc.ucp++];
  1046.             push2((short)(*(tcp + *pc.sp++)));
  1047.             continue;
  1048.         case O_RV14:
  1049.             tcp = _display.raw[*pc.ucp++];
  1050.             push4((long)(*(tcp + *pc.sp++)));
  1051.             continue;
  1052.         case O_RV2:
  1053.             tcp = _display.raw[*pc.ucp++];
  1054.             push2(*(short *)(tcp + *pc.sp++));
  1055.             continue;
  1056.         case O_RV24:
  1057.             tcp = _display.raw[*pc.ucp++];
  1058.             push4((long)(*(short *)(tcp + *pc.sp++)));
  1059.             continue;
  1060.         case O_RV4:
  1061.             tcp = _display.raw[*pc.ucp++];
  1062.             push4(*(long *)(tcp + *pc.sp++));
  1063.             continue;
  1064.         case O_RV8:
  1065.             tcp = _display.raw[*pc.ucp++];
  1066.             pushsze8(*(struct sze8 *)(tcp + *pc.sp++));
  1067.             continue;
  1068.         case O_RV:
  1069.             tcp = _display.raw[*pc.ucp++];
  1070.             tcp += *pc.sp++;
  1071.             tl = *pc.usp++;
  1072.             STACKALIGN(tl1, tl);
  1073.             tcp1 = pushsp(tl1);
  1074.             blkcpy(tcp, tcp1, tl);
  1075.             continue;
  1076.         case O_LV:
  1077.             tcp = _display.raw[*pc.ucp++];
  1078.             pushaddr(tcp + *pc.sp++);
  1079.             continue;
  1080.         case O_LRV1:
  1081.             tcp = _display.raw[*pc.ucp++];
  1082.             PCLONGVAL(tl);
  1083.             push2((short)(*(tcp + tl)));
  1084.             continue;
  1085.         case O_LRV14:
  1086.             tcp = _display.raw[*pc.ucp++];
  1087.             PCLONGVAL(tl);
  1088.             push4((long)(*(tcp + tl)));
  1089.             continue;
  1090.         case O_LRV2:
  1091.             tcp = _display.raw[*pc.ucp++];
  1092.             PCLONGVAL(tl);
  1093.             push2(*(short *)(tcp + tl));
  1094.             continue;
  1095.         case O_LRV24:
  1096.             tcp = _display.raw[*pc.ucp++];
  1097.             PCLONGVAL(tl);
  1098.             push4((long)(*(short *)(tcp + tl)));
  1099.             continue;
  1100.         case O_LRV4:
  1101.             tcp = _display.raw[*pc.ucp++];
  1102.             PCLONGVAL(tl);
  1103.             push4(*(long *)(tcp + tl));
  1104.             continue;
  1105.         case O_LRV8:
  1106.             tcp = _display.raw[*pc.ucp++];
  1107.             PCLONGVAL(tl);
  1108.             pushsze8(*(struct sze8 *)(tcp + tl));
  1109.             continue;
  1110.         case O_LRV:
  1111.             tcp = _display.raw[*pc.ucp++];
  1112.             PCLONGVAL(tl);
  1113.             tcp += tl;
  1114.             tl = *pc.usp++;
  1115.             STACKALIGN(tl1, tl);
  1116.             tcp1 = pushsp(tl1);
  1117.             blkcpy(tcp, tcp1, tl);
  1118.             continue;
  1119.         case O_LLV:
  1120.             tcp = _display.raw[*pc.ucp++];
  1121.             PCLONGVAL(tl);
  1122.             pushaddr(tcp + tl);
  1123.             continue;
  1124.         case O_IND1:
  1125.             pc.cp++;
  1126.             ts = *popaddr();
  1127.             push2(ts);
  1128.             continue;
  1129.         case O_IND14:
  1130.             pc.cp++;
  1131.             ti = *popaddr();
  1132.             push4((long)ti);
  1133.             continue;
  1134.         case O_IND2:
  1135.             pc.cp++;
  1136.             ts = *(short *)(popaddr());
  1137.             push2(ts);
  1138.             continue;
  1139.         case O_IND24:
  1140.             pc.cp++;
  1141.             ts = *(short *)(popaddr());
  1142.             push4((long)ts);
  1143.             continue;
  1144.         case O_IND4:
  1145.             pc.cp++;
  1146.             tl = *(long *)(popaddr());
  1147.             push4(tl);
  1148.             continue;
  1149.         case O_IND8:
  1150.             pc.cp++;
  1151.             t8 = *(struct sze8 *)(popaddr());
  1152.             pushsze8(t8);
  1153.             continue;
  1154.         case O_IND:
  1155.             tl = *pc.cp++;
  1156.             if (tl == 0)
  1157.                 tl = *pc.usp++;
  1158.             tcp = popaddr();
  1159.             STACKALIGN(tl1, tl);
  1160.             tcp1 = pushsp(tl1);
  1161.             blkcpy(tcp, tcp1, tl);
  1162.             continue;
  1163.         case O_CON1:
  1164.             push2((short)(*pc.cp++));
  1165.             continue;
  1166.         case O_CON14:
  1167.             push4((long)(*pc.cp++));
  1168.             continue;
  1169.         case O_CON2:
  1170.             pc.cp++;
  1171.             push2(*pc.sp++);
  1172.             continue;
  1173.         case O_CON24:
  1174.             pc.cp++;
  1175.             push4((long)(*pc.sp++));
  1176.             continue;
  1177.         case O_CON4:
  1178.             pc.cp++;
  1179.             PCLONGVAL(tl);
  1180.             push4(tl);
  1181.             continue;
  1182.         case O_CON8:
  1183.             pc.cp++;
  1184.             tcp = pushsp(sizeof(double));
  1185.             blkcpy(pc.cp, tcp, sizeof(double));
  1186.             pc.dbp++;
  1187.             continue;
  1188.         case O_CON:
  1189.             tl = *pc.cp++;
  1190.             if (tl == 0)
  1191.                 tl = *pc.usp++;
  1192.             STACKALIGN(tl1, tl);
  1193.             tcp = pushsp(tl1);
  1194.             blkcpy(pc.cp, tcp, tl);
  1195.             pc.cp += (int)tl;
  1196.             continue;
  1197.         case O_CONG:
  1198.             tl = *pc.cp++;
  1199.             if (tl == 0)
  1200.                 tl = *pc.usp++;
  1201.             STACKALIGN(tl1, tl);
  1202.             tcp = pushsp(tl1);
  1203.             blkcpy(pc.cp, tcp, tl1);
  1204.             pc.cp += (int)((tl + 2) & ~1);
  1205.             continue;
  1206.         case O_LVCON:
  1207.             tl = *pc.cp++;
  1208.             if (tl == 0)
  1209.                 tl = *pc.usp++;
  1210.             pushaddr(pc.cp);
  1211.             tl = (tl + 1) & ~1;
  1212.             pc.cp += (int)tl;
  1213.             continue;
  1214.         case O_RANG2:
  1215.             tl = *pc.cp++;
  1216.             if (tl == 0)
  1217.                 tl = *pc.sp++;
  1218.             tl1 = pop2();
  1219.             push2((short)(RANG4(tl1, tl, (long)(*pc.sp++))));
  1220.             continue;
  1221.         case O_RANG42:
  1222.             tl = *pc.cp++;
  1223.             if (tl == 0)
  1224.                 tl = *pc.sp++;
  1225.             tl1 = pop4();
  1226.             push4(RANG4(tl1, tl, (long)(*pc.sp++)));
  1227.             continue;
  1228.         case O_RSNG2:
  1229.             tl = *pc.cp++;
  1230.             if (tl == 0)
  1231.                 tl = *pc.sp++;
  1232.             tl1 = pop2();
  1233.             push2((short)(RSNG4(tl1, tl)));
  1234.             continue;
  1235.         case O_RSNG42:
  1236.             tl = *pc.cp++;
  1237.             if (tl == 0)
  1238.                 tl = *pc.sp++;
  1239.             tl1 = pop4();
  1240.             push4(RSNG4(tl1, tl));
  1241.             continue;
  1242.         case O_RANG4:
  1243.             tl = *pc.cp++;
  1244.             if (tl == 0)
  1245.                 PCLONGVAL(tl);
  1246.             tl1 = pop4();
  1247.             PCLONGVAL(tl2);
  1248.             push4(RANG4(tl1, tl, tl2));
  1249.             continue;
  1250.         case O_RANG24:
  1251.             tl = *pc.cp++;
  1252.             if (tl == 0)
  1253.                 PCLONGVAL(tl);
  1254.             tl1 = pop2();
  1255.             PCLONGVAL(tl2);
  1256.             push2((short)(RANG4(tl1, tl, tl2)));
  1257.             continue;
  1258.         case O_RSNG4:
  1259.             tl = *pc.cp++;
  1260.             if (tl == 0)
  1261.                 PCLONGVAL(tl);
  1262.             tl1 = pop4();
  1263.             push4(RSNG4(tl1, tl));
  1264.             continue;
  1265.         case O_RSNG24:
  1266.             tl = *pc.cp++;
  1267.             if (tl == 0)
  1268.                 PCLONGVAL(tl);
  1269.             tl1 = pop2();
  1270.             push2((short)(RSNG4(tl1, tl)));
  1271.             continue;
  1272.         case O_STLIM:
  1273.             pc.cp++;
  1274.             tl = pop4();
  1275.             STLIM(tl);
  1276.             continue;
  1277.         case O_LLIMIT:
  1278.             pc.cp++;
  1279.             tcp = popaddr();
  1280.             tl = pop4();
  1281.             LLIMIT(tcp, tl);
  1282.             continue;
  1283.         case O_BUFF:
  1284.             BUFF((long)(*pc.cp++));
  1285.             continue;
  1286.         case O_HALT:
  1287.             pc.cp++;
  1288.             if (_nodump == TRUE)
  1289.                 psexit(0);
  1290.             fputs("\nCall to procedure halt\n", stderr);
  1291.             backtrace("Halted");
  1292.             psexit(0);
  1293.             continue;
  1294.         case O_PXPBUF:
  1295.             pc.cp++;
  1296.             PCLONGVAL(tl);
  1297.             _cntrs = tl;
  1298.             PCLONGVAL(tl);
  1299.             _rtns = tl;
  1300.             NEW(&_pcpcount, (_cntrs + 1) * sizeof(long));
  1301.             blkclr(_pcpcount, (_cntrs + 1) * sizeof(long));
  1302.             continue;
  1303.         case O_COUNT:
  1304.             pc.cp++;
  1305.             _pcpcount[*pc.usp++]++;
  1306.             continue;
  1307.         case O_CASE1OP:
  1308.             tl = *pc.cp++;        /* tl = number of cases */
  1309.             if (tl == 0)
  1310.                 tl = *pc.usp++;
  1311.             tsp = pc.sp + tl;    /* ptr to end of jump table */
  1312.             tcp = (char *)tsp;    /* tcp = ptr to case values */
  1313.             tl1 = pop2();        /* tl1 = element to find */
  1314.             for(; tl > 0; tl--)    /* look for element */
  1315.                 if (tl1 == *tcp++)
  1316.                     break;
  1317.             if (tl == 0)        /* default case => error */
  1318.                 CASERNG(tl1);
  1319.             pc.cp += *(tsp - tl);
  1320.             continue;
  1321.         case O_CASE2OP:
  1322.             tl = *pc.cp++;        /* tl = number of cases */
  1323.             if (tl == 0)
  1324.                 tl = *pc.usp++;
  1325.             tsp = pc.sp + tl;    /* ptr to end of jump table */
  1326.             tsp1 = tsp;        /* tsp1 = ptr to case values */
  1327.             tl1 = (unsigned short)pop2();/* tl1 = element to find */
  1328.             for(; tl > 0; tl--)    /* look for element */
  1329.                 if (tl1 == *tsp++)
  1330.                     break;
  1331.             if (tl == 0)        /* default case => error */
  1332.                 CASERNG(tl1);
  1333.             pc.cp += *(tsp1 - tl);
  1334.             continue;
  1335.         case O_CASE4OP:
  1336.             tl = *pc.cp++;        /* tl = number of cases */
  1337.             if (tl == 0)
  1338.                 tl = *pc.usp++;
  1339.             tsp1 = pc.sp + tl;    /* ptr to end of jump table */
  1340.             tlp = (long *)tsp1;    /* tlp = ptr to case values */
  1341.             tl1 = pop4();        /* tl1 = element to find */
  1342.             for(; tl > 0; tl--) {    /* look for element */
  1343.                 GETLONGVAL(tl2, tlp++);
  1344.                 if (tl1 == tl2)
  1345.                     break;
  1346.             }
  1347.             if (tl == 0)        /* default case => error */
  1348.                 CASERNG(tl1);
  1349.             pc.cp += *(tsp1 - tl);
  1350.             continue;
  1351.         case O_ADDT:
  1352.             tl = *pc.cp++;        /* tl has comparison length */
  1353.             if (tl == 0)
  1354.                 tl = *pc.usp++;
  1355.             tcp = pushsp((long)(0));/* tcp pts to first arg */
  1356.             ADDT(tcp + tl, tcp + tl, tcp, tl >> 2);
  1357.             popsp(tl);
  1358.             continue;
  1359.         case O_SUBT:
  1360.             tl = *pc.cp++;        /* tl has comparison length */
  1361.             if (tl == 0)
  1362.                 tl = *pc.usp++;
  1363.             tcp = pushsp((long)(0));/* tcp pts to first arg */
  1364.             SUBT(tcp + tl, tcp + tl, tcp, tl >> 2);
  1365.             popsp(tl);
  1366.             continue;
  1367.         case O_MULT:
  1368.             tl = *pc.cp++;        /* tl has comparison length */
  1369.             if (tl == 0)
  1370.                 tl = *pc.usp++;
  1371.             tcp = pushsp((long)(0));/* tcp pts to first arg */
  1372.             MULT(tcp + tl, tcp + tl, tcp, tl >> 2);
  1373.             popsp(tl);
  1374.             continue;
  1375.         case O_INCT:
  1376.             tl = *pc.cp++;        /* tl has number of args */
  1377.             if (tl == 0)
  1378.                 tl = *pc.usp++;
  1379.             tb = INCT();
  1380.             popsp(tl*sizeof(long));
  1381.             push2((short)(tb));
  1382.             continue;
  1383.         case O_CTTOT:
  1384.             tl = *pc.cp++;        /* tl has number of args */
  1385.             if (tl == 0)
  1386.                 tl = *pc.usp++;
  1387.             tl1 = tl * sizeof(long);    /* Size of all args */
  1388.             tcp = pushsp((long)(0)) + tl1; /* tcp pts to result */
  1389.             tl1 = pop4();        /* Pop the 4 fixed args */
  1390.             tl2 = pop4();
  1391.             tl3 = pop4();
  1392.             tl4 = pop4();
  1393.             tcp2 = pushsp((long)0);    /* tcp2 -> data values */
  1394.             CTTOTA(tcp, tl1, tl2, tl3, tl4, tcp2);
  1395.             popsp(tl*sizeof(long) - 4*sizeof(long)); /* Pop data */
  1396.             continue;
  1397.         case O_CARD:
  1398.             tl = *pc.cp++;        /* tl has comparison length */
  1399.             if (tl == 0)
  1400.                 tl = *pc.usp++;
  1401.             tcp = pushsp((long)(0));/* tcp pts to set */
  1402.             tl1 = CARD(tcp, tl);
  1403.             popsp(tl);
  1404.             push2((short)(tl1));
  1405.             continue;
  1406.         case O_IN:
  1407.             tl = *pc.cp++;        /* tl has comparison length */
  1408.             if (tl == 0)
  1409.                 tl = *pc.usp++;
  1410.             tl1 = pop4();        /* tl1 is the element */
  1411.             tcp = pushsp((long)(0));/* tcp pts to set */
  1412.             tl2 = *pc.sp++;    /* lower bound */
  1413.             tb = IN(tl1, tl2, (long)(*pc.usp++), tcp);
  1414.             popsp(tl);
  1415.             push2((short)(tb));
  1416.             continue;
  1417.         case O_ASRT:
  1418.             pc.cp++;
  1419.             tl = pop4();
  1420.             tcp = popaddr();
  1421.             ASRTS(tl, tcp);
  1422.             continue;
  1423.         case O_FOR1U:
  1424.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1425.             if (tl1 == 0)
  1426.                 tl1 = *pc.sp++;
  1427.             tcp = popaddr();    /* tcp = ptr to index var */
  1428.             tl = pop4();        /* tl upper bound */
  1429.             if (*tcp == tl)        /* loop is done, fall through */
  1430.                 continue;
  1431.             *tcp += 1;        /* inc index var */
  1432.             pc.cp += tl1;        /* return to top of loop */
  1433.             continue;
  1434.         case O_FOR2U:
  1435.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1436.             if (tl1 == 0)
  1437.                 tl1 = *pc.sp++;
  1438.             tsp = (short *)popaddr(); /* tsp = ptr to index var */
  1439.             tl = pop4();        /* tl upper bound */
  1440.             if (*tsp == tl)        /* loop is done, fall through */
  1441.                 continue;
  1442.             *tsp += 1;        /* inc index var */
  1443.             pc.cp += tl1;        /* return to top of loop */
  1444.             continue;
  1445.         case O_FOR4U:
  1446.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1447.             if (tl1 == 0)
  1448.                 tl1 = *pc.sp++;
  1449.             tlp = (long *)popaddr(); /* tlp = ptr to index var */
  1450.             tl = pop4();        /* tl upper bound */
  1451.             if (*tlp == tl)        /* loop is done, fall through */
  1452.                 continue;
  1453.             *tlp += 1;        /* inc index var */
  1454.             pc.cp += tl1;        /* return to top of loop */
  1455.             continue;
  1456.         case O_FOR1D:
  1457.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1458.             if (tl1 == 0)
  1459.                 tl1 = *pc.sp++;
  1460.             tcp = popaddr();    /* tcp = ptr to index var */
  1461.             tl = pop4();        /* tl upper bound */
  1462.             if (*tcp == tl)        /* loop is done, fall through */
  1463.                 continue;
  1464.             *tcp -= 1;        /* dec index var */
  1465.             pc.cp += tl1;        /* return to top of loop */
  1466.             continue;
  1467.         case O_FOR2D:
  1468.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1469.             if (tl1 == 0)
  1470.                 tl1 = *pc.sp++;
  1471.             tsp = (short *)popaddr(); /* tsp = ptr to index var */
  1472.             tl = pop4();        /* tl upper bound */
  1473.             if (*tsp == tl)        /* loop is done, fall through */
  1474.                 continue;
  1475.             *tsp -= 1;        /* dec index var */
  1476.             pc.cp += tl1;        /* return to top of loop */
  1477.             continue;
  1478.         case O_FOR4D:
  1479.             tl1 = *pc.cp++;        /* tl1 loop branch */
  1480.             if (tl1 == 0)
  1481.                 tl1 = *pc.sp++;
  1482.             tlp = (long *)popaddr(); /* tlp = ptr to index var */
  1483.             tl = pop4();        /* tl upper bound */
  1484.             if (*tlp == tl)        /* loop is done, fall through */
  1485.                 continue;
  1486.             *tlp -= 1;        /* dec index var */
  1487.             pc.cp += tl1;        /* return to top of loop */
  1488.             continue;
  1489.         case O_READE:
  1490.             pc.cp++;
  1491.             PCLONGVAL(tl);
  1492.             push2((short)(READE(curfile, base + tl)));
  1493.             continue;
  1494.         case O_READ4:
  1495.             pc.cp++;
  1496.             push4(READ4(curfile));
  1497.             continue;
  1498.         case O_READC:
  1499.             pc.cp++;
  1500.             push2((short)(READC(curfile)));
  1501.             continue;
  1502.         case O_READ8:
  1503.             pc.cp++;
  1504.             push8(READ8(curfile));
  1505.             continue;
  1506.         case O_READLN:
  1507.             pc.cp++;
  1508.             READLN(curfile);
  1509.             continue;
  1510.         case O_EOF:
  1511.             pc.cp++;
  1512.             tcp = popaddr();
  1513.             push2((short)(TEOF(tcp)));
  1514.             continue;
  1515.         case O_EOLN:
  1516.             pc.cp++;
  1517.             tcp = popaddr();
  1518.             push2((short)(TEOLN(tcp)));
  1519.             continue;
  1520.         case O_WRITEC:
  1521.             pc.cp++;
  1522.             ti = popint();
  1523.             tf = popfile();
  1524.             if (_runtst) {
  1525.                 WRITEC(curfile, ti, tf);
  1526.                 continue;
  1527.             }
  1528.             fputc(ti, tf);
  1529.             continue;
  1530.         case O_WRITES:
  1531.             pc.cp++;        /* Skip arg size */
  1532.             tf = popfile();
  1533.             ti = popint();
  1534.             ti2 = popint();
  1535.             tcp2 = popaddr();
  1536.             if (_runtst) {
  1537.                 WRITES(curfile, tf, ti, ti2, tcp2);
  1538.                 continue;
  1539.             }
  1540.             fwrite(tf, ti, ti2, tcp2);
  1541.             continue;
  1542.         case O_WRITEF:
  1543.             tf = popfile();
  1544.             tcp = popaddr();
  1545.             tcp2 = pushsp((long)0);    /* Addr of printf's args */
  1546.             if (_runtst) {
  1547.                 VWRITEF(curfile, tf, tcp, tcp2);
  1548.             } else {
  1549.                 vfprintf(tf, tcp, tcp2);
  1550.             }
  1551.             popsp((long)
  1552.                 (*pc.cp++) - (sizeof (FILE *)) - sizeof (char *));
  1553.             continue;
  1554.         case O_WRITLN:
  1555.             pc.cp++;
  1556.             if (_runtst) {
  1557.                 WRITLN(curfile);
  1558.                 continue;
  1559.             }
  1560.             fputc('\n', ACTFILE(curfile));
  1561.             continue;
  1562.         case O_PAGE:
  1563.             pc.cp++;
  1564.             if (_runtst) {
  1565.                 PAGE(curfile);
  1566.                 continue;
  1567.             }
  1568.             fputc(' ', ACTFILE(curfile));
  1569.             continue;
  1570.         case O_NAM:
  1571.             pc.cp++;
  1572.             tl = pop4();
  1573.             PCLONGVAL(tl1);
  1574.             pushaddr(NAM(tl, base + tl1));
  1575.             continue;
  1576.         case O_MAX:
  1577.             tl = *pc.cp++;
  1578.             if (tl == 0)
  1579.                 tl = *pc.usp++;
  1580.             tl1 = pop4();
  1581.             if (_runtst) {
  1582.                 push4(MAX(tl1, tl, (long)(*pc.usp++)));
  1583.                 continue;
  1584.             }
  1585.             tl1 -= tl;
  1586.             tl = *pc.usp++;
  1587.             push4(tl1 > tl ? tl1 : tl);
  1588.             continue;
  1589.         case O_MIN:
  1590.             tl = *pc.cp++;
  1591.             if (tl == 0)
  1592.                 tl = *pc.usp++;
  1593.             tl1 = pop4();
  1594.             push4(tl1 < tl ? tl1 : tl);
  1595.             continue;
  1596.         case O_UNIT:
  1597.             pc.cp++;
  1598.             curfile = UNIT(popaddr());
  1599.             continue;
  1600.         case O_UNITINP:
  1601.             pc.cp++;
  1602.             curfile = INPUT;
  1603.             continue;
  1604.         case O_UNITOUT:
  1605.             pc.cp++;
  1606.             curfile = OUTPUT;
  1607.             continue;
  1608.         case O_MESSAGE:
  1609.             pc.cp++;
  1610.             PFLUSH();
  1611.             curfile = ERR;
  1612.             continue;
  1613.         case O_PUT:
  1614.             pc.cp++;
  1615.             PUT(curfile);
  1616.             continue;
  1617.         case O_GET:
  1618.             pc.cp++;
  1619.             GET(curfile);
  1620.             continue;
  1621.         case O_FNIL:
  1622.             pc.cp++;
  1623.             tcp = popaddr();
  1624.             pushaddr(FNIL(tcp));
  1625.             continue;
  1626.         case O_DEFNAME:
  1627.             pc.cp++;
  1628.             tcp2 = popaddr();
  1629.             tcp = popaddr();
  1630.             tl = pop4();
  1631.             tl2 = pop4();
  1632.             DEFNAME((struct iorec *)tcp2, tcp, tl, tl2);
  1633.             continue;
  1634.         case O_RESET:
  1635.             pc.cp++;
  1636.             tcp2 = popaddr();
  1637.             tcp = popaddr();
  1638.             tl = pop4();
  1639.             tl2 = pop4();
  1640.             RESET((struct iorec *)tcp2, tcp, tl, tl2);
  1641.             continue;
  1642.         case O_REWRITE:
  1643.             pc.cp++;
  1644.             tcp2 = popaddr();
  1645.             tcp = popaddr();
  1646.             tl = pop4();
  1647.             tl2 = pop4();
  1648.             REWRITE((struct iorec *)tcp2, tcp, tl, tl2);
  1649.             continue;
  1650.         case O_FILE:
  1651.             pc.cp++;
  1652.             pushaddr(ACTFILE(curfile));
  1653.             continue;
  1654.         case O_REMOVE:
  1655.             pc.cp++;
  1656.             tcp = popaddr();
  1657.             tl = pop4();
  1658.             REMOVE(tcp, tl);
  1659.             continue;
  1660.         case O_FLUSH:
  1661.             pc.cp++;
  1662.             tcp = popaddr();
  1663.             FLUSH((struct iorec *)tcp);
  1664.             continue;
  1665.         case O_PACK:
  1666.             pc.cp++;
  1667.             tl = pop4();
  1668.             tcp = popaddr();
  1669.             tcp2 = popaddr();
  1670.             tl1 = pop4();
  1671.             tl2 = pop4();
  1672.             tl3 = pop4();
  1673.             tl4 = pop4();
  1674.             PACK(tl, tcp, tcp2, tl1, tl2, tl3, tl4);
  1675.             continue;
  1676.         case O_UNPACK:
  1677.             pc.cp++;
  1678.             tl = pop4();
  1679.             tcp = popaddr();
  1680.             tcp2 = popaddr();
  1681.             tl1 = pop4();
  1682.             tl2 = pop4();
  1683.             tl3 = pop4();
  1684.             tl4 = pop4();
  1685.             UNPACK(tl, tcp, tcp2, tl1, tl2, tl3, tl4);
  1686.             continue;
  1687.         case O_ARGC:
  1688.             pc.cp++;
  1689.             push4((long)_argc);
  1690.             continue;
  1691.         case O_ARGV:
  1692.             tl = *pc.cp++;        /* tl = size of char array */
  1693.             if (tl == 0)
  1694.                 tl = *pc.usp++;
  1695.             tcp = popaddr();    /* tcp = addr of char array */
  1696.             tl1 = pop4();        /* tl1 = argv subscript */
  1697.             ARGV(tl1, tcp, tl);
  1698.             continue;
  1699.         case O_CLCK:
  1700.             pc.cp++;
  1701.             push4(CLCK());
  1702.             continue;
  1703.         case O_WCLCK:
  1704.             pc.cp++;
  1705.             push4(time(0));
  1706.             continue;
  1707.         case O_SCLCK:
  1708.             pc.cp++;
  1709.             push4(SCLCK());
  1710.             continue;
  1711.         case O_NEW:
  1712.             tl = *pc.cp++;        /* tl = size being new'ed */
  1713.             if (tl == 0)
  1714.                 tl = *pc.usp++;
  1715.             tcp = popaddr();    /* ptr to ptr being new'ed */
  1716.             NEW(tcp, tl);
  1717.             if (_runtst) {
  1718.                 blkclr(*((char **)(tcp)), tl);
  1719.             }
  1720.             continue;
  1721.         case O_DISPOSE:
  1722.             tl = *pc.cp++;        /* tl = size being disposed */
  1723.             if (tl == 0)
  1724.                 tl = *pc.usp++;
  1725.             tcp = popaddr();    /* ptr to ptr being disposed */
  1726.             DISPOSE(tcp, tl);
  1727.             *(char **)tcp = (char *)0;
  1728.             continue;
  1729.         case O_DFDISP:
  1730.             tl = *pc.cp++;        /* tl = size being disposed */
  1731.             if (tl == 0)
  1732.                 tl = *pc.usp++;
  1733.             tcp = popaddr();    /* ptr to ptr being disposed */
  1734.             DFDISPOSE(tcp, tl);
  1735.             *(char **)tcp = (char *)0;
  1736.             continue;
  1737.         case O_DATE:
  1738.             pc.cp++;
  1739.             DATE(popaddr());
  1740.             continue;
  1741.         case O_TIME:
  1742.             pc.cp++;
  1743.             TIME(popaddr());
  1744.             continue;
  1745.         case O_UNDEF:
  1746.             pc.cp++;
  1747.             td = pop8();
  1748.             push2((short)(0));
  1749.             continue;
  1750.         case O_ATAN:
  1751.             pc.cp++;
  1752.             td = pop8();
  1753.             if (_runtst) {
  1754.                 push8(ATAN(td));
  1755.                 continue;
  1756.             }
  1757.             push8(atan(td));
  1758.             continue;
  1759.         case O_COS:
  1760.             pc.cp++;
  1761.             td = pop8();
  1762.             if (_runtst) {
  1763.                 push8(COS(td));
  1764.                 continue;
  1765.             }
  1766.             push8(cos(td));
  1767.             continue;
  1768.         case O_EXP:
  1769.             pc.cp++;
  1770.             td = pop8();
  1771.             if (_runtst) {
  1772.                 push8(EXP(td));
  1773.                 continue;
  1774.             }
  1775.             push8(exp(td));
  1776.             continue;
  1777.         case O_LN:
  1778.             pc.cp++;
  1779.             td = pop8();
  1780.             if (_runtst) {
  1781.                 push8(LN(td));
  1782.                 continue;
  1783.             }
  1784.             push8(log(td));
  1785.             continue;
  1786.         case O_SIN:
  1787.             pc.cp++;
  1788.             td = pop8();
  1789.             if (_runtst) {
  1790.                 push8(SIN(td));
  1791.                 continue;
  1792.             }
  1793.             push8(sin(td));
  1794.             continue;
  1795.         case O_SQRT:
  1796.             pc.cp++;
  1797.             td = pop8();
  1798.             if (_runtst) {
  1799.                 push8(SQRT(td));
  1800.                 continue;
  1801.             }
  1802.             push8(sqrt(td));
  1803.             continue;
  1804.         case O_CHR2:
  1805.         case O_CHR4:
  1806.             pc.cp++;
  1807.             tl = pop4();
  1808.             if (_runtst) {
  1809.                 push2((short)(CHR(tl)));
  1810.                 continue;
  1811.             }
  1812.             push2((short)tl);
  1813.             continue;
  1814.         case O_ODD2:
  1815.         case O_ODD4:
  1816.             pc.cp++;
  1817.             tl = pop4();
  1818.             push2((short)(tl & 1));
  1819.             continue;
  1820.         case O_SUCC2:
  1821.             tl = *pc.cp++;
  1822.             if (tl == 0)
  1823.                 tl = *pc.sp++;
  1824.             tl1 = pop4();
  1825.             if (_runtst) {
  1826.                 push2((short)(SUCC(tl1, tl, (long)(*pc.sp++))));
  1827.                 continue;
  1828.             }
  1829.             push2((short)(tl1 + 1));
  1830.             pc.sp++;
  1831.             continue;
  1832.         case O_SUCC24:
  1833.             tl = *pc.cp++;
  1834.             if (tl == 0)
  1835.                 tl = *pc.sp++;
  1836.             tl1 = pop4();
  1837.             if (_runtst) {
  1838.                 push4(SUCC(tl1, tl, (long)(*pc.sp++)));
  1839.                 continue;
  1840.             }
  1841.             push4(tl1 + 1);
  1842.             pc.sp++;
  1843.             continue;
  1844.         case O_SUCC4:
  1845.             tl = *pc.cp++;
  1846.             if (tl == 0)
  1847.                 PCLONGVAL(tl);
  1848.             tl1 = pop4();
  1849.             if (_runtst) {
  1850.                 PCLONGVAL(tl2);
  1851.                 push4(SUCC(tl1, tl, (long)(tl2)));
  1852.                 continue;
  1853.             }
  1854.             push4(tl1 + 1);
  1855.             pc.lp++;
  1856.             continue;
  1857.         case O_PRED2:
  1858.             tl = *pc.cp++;
  1859.             if (tl == 0)
  1860.                 tl = *pc.sp++;
  1861.             tl1 = pop4();
  1862.             if (_runtst) {
  1863.                 push2((short)(PRED(tl1, tl, (long)(*pc.sp++))));
  1864.                 continue;
  1865.             }
  1866.             push2((short)(tl1 - 1));
  1867.             pc.sp++;
  1868.             continue;
  1869.         case O_PRED24:
  1870.             tl = *pc.cp++;
  1871.             if (tl == 0)
  1872.                 tl = *pc.sp++;
  1873.             tl1 = pop4();
  1874.             if (_runtst) {
  1875.                 push4(PRED(tl1, tl, (long)(*pc.sp++)));
  1876.                 continue;
  1877.             }
  1878.             push4(tl1 - 1);
  1879.             pc.sp++;
  1880.             continue;
  1881.         case O_PRED4:
  1882.             tl = *pc.cp++;
  1883.             if (tl == 0)
  1884.                 PCLONGVAL(tl);
  1885.             tl1 = pop4();
  1886.             if (_runtst) {
  1887.                 PCLONGVAL(tl2);
  1888.                 push4(PRED(tl1, tl, (long)(tl2)));
  1889.                 continue;
  1890.             }
  1891.             push4(tl1 - 1);
  1892.             pc.lp++;
  1893.             continue;
  1894.         case O_SEED:
  1895.             pc.cp++;
  1896.             tl = pop4();
  1897.             push4(SEED(tl));
  1898.             continue;
  1899.         case O_RANDOM:
  1900.             pc.cp++;
  1901.             td = pop8();        /* Argument is ignored */
  1902.             push8(RANDOM());
  1903.             continue;
  1904.         case O_EXPO:
  1905.             pc.cp++;
  1906.             td = pop8();
  1907.             push4(EXPO(td));
  1908.             continue;
  1909.         case O_SQR2:
  1910.         case O_SQR4:
  1911.             pc.cp++;
  1912.             tl = pop4();
  1913.             push4(tl * tl);
  1914.             continue;
  1915.         case O_SQR8:
  1916.             pc.cp++;
  1917.             td = pop8();
  1918.             push8(td * td);
  1919.             continue;
  1920.         case O_ROUND:
  1921.             pc.cp++;
  1922.             td = pop8();
  1923.             push4(ROUND(td));
  1924.             continue;
  1925.         case O_TRUNC:
  1926.             pc.cp++;
  1927.             td = pop8();
  1928.             push4(TRUNC(td));
  1929.             continue;
  1930.         default:
  1931.             ERROR("Panic: bad op code\n");
  1932.             continue;
  1933.         }
  1934.     }
  1935. }
  1936.