1 files changed, 771 insertions, 0 deletions

diff --git a/lua.stx b/lua.stx
new file mode 100644
index 00000000..dc44cc12
--- /dev/null
+++ b/lua.stx
@@ -0,0 +1,771 @@
+%{
+
+char *rcs_luastx = "$Id: $";
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "lua.h"
+
+#ifndef ALIGNMENT
+#define ALIGNMENT       (sizeof(void *))
+#endif
+
+#ifndef MAXCODE
+#define MAXCODE 1024
+#endif
+static long   buffer[MAXCODE];
+static Byte  *code = (Byte *)buffer;
+static long   mainbuffer[MAXCODE];
+static Byte  *maincode = (Byte *)mainbuffer;
+static Byte  *basepc;
+static Byte  *pc;
+
+#define MAXVAR 32
+static long    varbuffer[MAXVAR];
+static Byte    nvarbuffer=0;         /* number of variables at a list */
+
+static Word    localvar[STACKGAP];
+static Byte    nlocalvar=0;          /* number of local variables */
+static int     ntemp;                /* number of temporary var into stack */
+static int     err;                  /* flag to indicate error */
+
+/* Internal functions */
+#define align(n)  align_n(sizeof(n))
+
+static void code_byte (Byte c)
+{
+ if (pc-basepc>MAXCODE-1)
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *pc++ = c;
+}
+
+static void code_word (Word n)
+{
+ if (pc-basepc>MAXCODE-sizeof(Word))
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *((Word *)pc) = n;
+ pc += sizeof(Word);
+}
+
+static void code_float (float n)
+{
+ if (pc-basepc>MAXCODE-sizeof(float))
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *((float *)pc) = n;
+ pc += sizeof(float);
+}
+
+static void incr_ntemp (void)
+{
+ if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
+  ntemp++;
+ else
+ {
+  lua_error ("stack overflow");
+  err = 1;
+ }
+}
+
+static void add_nlocalvar (int n)
+{
+ if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
+  nlocalvar += n;
+ else
+ {
+  lua_error ("too many local variables or expression too complicate");
+  err = 1;
+ }
+}
+
+static void incr_nvarbuffer (void)
+{
+ if (nvarbuffer < MAXVAR-1)
+  nvarbuffer++;
+ else
+ {
+  lua_error ("variable buffer overflow");
+  err = 1;
+ }
+}
+
+static void align_n (unsigned size)
+{
+ if (size > ALIGNMENT) size = ALIGNMENT;
+ while (((pc+1-code)%size) != 0)        /* +1 to include BYTECODE */
+  code_byte (NOP);
+}
+
+static void code_number (float f)
+{ int i = f;
+  if (f == i)  /* f has an integer value */
+  {
+   if (i <= 2) code_byte(PUSH0 + i);
+   else if (i <= 255)
+   {
+    code_byte(PUSHBYTE);
+    code_byte(i);
+   }
+   else
+   {
+    align(Word);
+    code_byte(PUSHWORD);
+    code_word(i);
+   }
+  }
+  else
+  {
+   align(float);
+   code_byte(PUSHFLOAT);
+   code_float(f);
+  }
+  incr_ntemp();
+}
+
+%}
+
+
+%union 
+{
+ int   vInt;
+ long  vLong;
+ float vFloat;
+ Word  vWord;
+ Byte *pByte;
+}
+
+%start functionlist
+
+%token NIL
+%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
+%token RETURN
+%token LOCAL
+%token <vFloat> NUMBER
+%token <vWord>  FUNCTION NAME STRING
+%token <vInt>   DEBUG
+
+%type <pByte> PrepJump
+%type <vInt>  expr, exprlist, exprlist1, varlist1, typeconstructor
+%type <vInt>  fieldlist, localdeclist
+%type <vInt>  ffieldlist, ffieldlist1
+%type <vInt>  lfieldlist, lfieldlist1
+%type <vLong> var, objectname
+
+
+%left AND OR
+%left '=' NE '>' '<' LE GE
+%left CONC
+%left '+' '-'
+%left '*' '/'
+%left UNARY NOT
+
+
+%% /* beginning of rules section */
+
+
+functionlist : /* empty */
+             | functionlist {pc=basepc=maincode; nlocalvar=0;} stat sc {maincode=pc;}
+             | functionlist function
+             | functionlist setdebug
+             ;
+             
+function     : FUNCTION NAME {pc=basepc=code; nlocalvar=0;} '(' parlist ')' 
+               {
+                if (lua_debug)
+                {
+                 align(Word);
+                 code_byte(SETFUNCTION); 
+                 code_word($1);
+                 code_word($2);
+                }
+                lua_codeadjust (0);
+               }
+               block
+               END       
+               { 
+                if (lua_debug) code_byte(RESET); 
+                code_byte(RETCODE); code_byte(nlocalvar);
+                s_tag($2) = T_FUNCTION;
+                s_bvalue($2) = calloc (pc-code, sizeof(Byte));
+                memcpy (s_bvalue($2), code, (pc-code)*sizeof(Byte));
+               }
+               ;
+
+statlist : /* empty */
+         | statlist stat sc
+         ;
+
+stat     : {
+            ntemp = 0; 
+            if (lua_debug)
+            {
+             align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+            }
+           }
+           stat1
+                
+sc       : /* empty */ | ';' ;
+
+
+stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
+       {
+        {
+         Byte *elseinit = $6 + sizeof(Word)+1;
+         if (pc - elseinit == 0)                /* no else */
+         {
+          pc -= sizeof(Word)+1;
+         /* if (*(pc-1) == NOP) --pc; */
+          elseinit = pc;
+         }
+         else
+         {
+          *($6) = JMP;
+          *((Word *)($6+1)) = pc - elseinit;
+         }
+         *($4) = IFFJMP;
+         *((Word *)($4+1)) = elseinit - ($4 + sizeof(Word)+1);
+        }
+       }
+     
+       | WHILE {$<pByte>$ = pc;} expr1 DO PrepJump block PrepJump END
+        
+       {
+        *($5) = IFFJMP;
+        *((Word *)($5+1)) = pc - ($5 + sizeof(Word)+1);
+        
+        *($7) = UPJMP;
+        *((Word *)($7+1)) = pc - $<pByte>2;
+       }
+     
+       | REPEAT {$<pByte>$ = pc;} block UNTIL expr1 PrepJump
+        
+       {
+        *($6) = IFFUPJMP;
+        *((Word *)($6+1)) = pc - $<pByte>2;
+       }
+
+
+       | varlist1 '=' exprlist1
+       {
+        {
+         int i;
+         if ($3 == 0 || nvarbuffer != ntemp - $1 * 2)
+          lua_codeadjust ($1 * 2 + nvarbuffer);
+         for (i=nvarbuffer-1; i>=0; i--)
+          lua_codestore (i);
+         if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
+          lua_codeadjust (0);
+        }
+       } 
+       | functioncall                   { lua_codeadjust (0); }
+       | typeconstructor                { lua_codeadjust (0); }
+       | LOCAL localdeclist decinit   { add_nlocalvar($2); lua_codeadjust (0); }
+       ;
+
+elsepart : /* empty */
+         | ELSE block
+         | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
+         {
+          {
+           Byte *elseinit = $6 + sizeof(Word)+1;
+           if (pc - elseinit == 0)              /* no else */
+           {
+            pc -= sizeof(Word)+1;
+            /* if (*(pc-1) == NOP) --pc; */
+            elseinit = pc;
+           }
+           else
+           {
+            *($6) = JMP;
+            *((Word *)($6+1)) = pc - elseinit;
+           }
+           *($4) = IFFJMP;
+           *((Word *)($4+1)) = elseinit - ($4 + sizeof(Word)+1);
+          }  
+         }   
+         ;
+     
+block    : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret 
+         {
+          if (nlocalvar != $<vInt>1)
+          {
+           nlocalvar = $<vInt>1;
+           lua_codeadjust (0);
+          }
+         }
+         ;
+
+ret     : /* empty */
+        | { if (lua_debug){align(Word);code_byte(SETLINE);code_word(lua_linenumber);}}
+          RETURN  exprlist sc   
+          { 
+           if (lua_debug) code_byte(RESET); 
+           code_byte(RETCODE); code_byte(nlocalvar);
+          }
+        ;
+
+PrepJump : /* empty */
+         { 
+          align(Word); 
+          $$ = pc;
+          code_byte(0);         /* open space */
+          code_word (0);
+         }
+           
+expr1    : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}}
+         ;
+                                
+expr :  '(' expr ')'    { $$ = $2; }
+     |  expr1 '=' expr1 { code_byte(EQOP);   $$ = 1; ntemp--;}
+     |  expr1 '<' expr1 { code_byte(LTOP);   $$ = 1; ntemp--;}
+     |  expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |  expr1 NE  expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |  expr1 LE  expr1 { code_byte(LEOP);   $$ = 1; ntemp--;}
+     |  expr1 GE  expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |  expr1 '+' expr1 { code_byte(ADDOP);  $$ = 1; ntemp--;}
+     |  expr1 '-' expr1 { code_byte(SUBOP);  $$ = 1; ntemp--;}
+     |  expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;}
+     |  expr1 '/' expr1 { code_byte(DIVOP);  $$ = 1; ntemp--;}
+     |  expr1 CONC expr1 { code_byte(CONCOP);  $$ = 1; ntemp--;}
+     |  '+' expr1 %prec UNARY   { $$ = 1; }
+     |  '-' expr1 %prec UNARY   { code_byte(MINUSOP); $$ = 1;}
+     | typeconstructor { $$ = $1; }
+     |  '@' '(' dimension ')'
+     { 
+      code_byte(CREATEARRAY);
+      $$ = 1;
+     }
+     |  var             { lua_pushvar ($1); $$ = 1;}
+     |  NUMBER          { code_number($1); $$ = 1; }
+     |  STRING
+     {
+      align(Word);
+      code_byte(PUSHSTRING);
+      code_word($1);
+      $$ = 1;
+      incr_ntemp();
+     }
+     |  NIL             {code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
+     |  functioncall
+     {
+      $$ = 0;
+      if (lua_debug)
+      {
+       align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+      }
+     }
+     |  NOT expr1       { code_byte(NOTOP);  $$ = 1;}
+     |  expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1
+     { 
+      *($3) = ONFJMP;
+      *((Word *)($3+1)) = pc - ($3 + sizeof(Word)+1);
+      $$ = 1;
+     }
+     |  expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1      
+     { 
+      *($3) = ONTJMP;
+      *((Word *)($3+1)) = pc - ($3 + sizeof(Word)+1);
+      $$ = 1;
+     }
+     ;
+
+typeconstructor: '@'  
+     {
+      code_byte(PUSHBYTE);
+      $<pByte>$ = pc; code_byte(0);
+      incr_ntemp();
+      code_byte(CREATEARRAY);
+     }
+      objectname fieldlist 
+     {
+      *($<pByte>2) = $4; 
+      if ($3 < 0)       /* there is no function to be called */
+      {
+       $$ = 1;
+      }
+      else
+      {
+       lua_pushvar ($3+1);
+       code_byte(PUSHMARK);
+       incr_ntemp();
+       code_byte(PUSHOBJECT);
+       incr_ntemp();
+       code_byte(CALLFUNC); 
+       ntemp -= 4;
+       $$ = 0;
+       if (lua_debug)
+       {
+        align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+       }
+      }
+     }
+         ;
+
+dimension    : /* empty */      { code_byte(PUSHNIL); incr_ntemp();}
+             | expr1
+             ;
+             
+functioncall : functionvalue  {code_byte(PUSHMARK); $<vInt>$ = ntemp; incr_ntemp();}
+                '(' exprlist ')' { code_byte(CALLFUNC); ntemp = $<vInt>2-1;}
+
+functionvalue : var {lua_pushvar ($1); } 
+              ;
+                
+exprlist  :     /* empty */             { $$ = 1; }
+          |     exprlist1               { $$ = $1; }
+          ;
+                
+exprlist1 :     expr                    { $$ = $1; }
+          |     exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}} 
+                 expr {$$ = $4;}
+          ;
+
+parlist  :      /* empty */
+          |     parlist1
+          ;
+                
+parlist1 :      NAME              {localvar[nlocalvar]=$1; add_nlocalvar(1);}
+          |     parlist1 ',' NAME {localvar[nlocalvar]=$3; add_nlocalvar(1);}
+          ;
+                
+objectname :    /* empty */     {$$=-1;}
+           |    NAME            {$$=$1;}
+           ;
+           
+fieldlist  : '{' ffieldlist '}'  { $$ = $2; }
+           | '[' lfieldlist ']'  { $$ = $2; }
+           ;
+
+ffieldlist : /* empty */   { $$ = 0; }
+           | ffieldlist1   { $$ = $1; }
+           ;
+
+ffieldlist1 : ffield                    {$$=1;}
+           | ffieldlist1 ',' ffield     {$$=$1+1;}
+           ; 
+
+ffield      : NAME 
+           {
+            align(Word); 
+            code_byte(PUSHSTRING);
+            code_word(lua_findconstant (s_name($1)));
+            incr_ntemp();
+           }
+            '=' expr1
+           {
+            code_byte(STOREFIELD);
+            ntemp-=2;
+           }
+           ;
+
+lfieldlist : /* empty */   { $$ = 0; }
+           | lfieldlist1   { $$ = $1; }
+           ;
+
+lfieldlist1 : { code_number(1); } lfield  {$$=1;}
+            | lfieldlist1 ',' { code_number($1+1); } lfield
+              {$$=$1+1;}
+            ;
+
+lfield      : expr1
+           {
+            code_byte(STOREFIELD);
+            ntemp-=2;
+           }
+           ;
+                
+varlist1  :     var                     
+          {
+           nvarbuffer = 0; 
+           varbuffer[nvarbuffer] = $1; incr_nvarbuffer();
+           $$ = ($1 == 0) ? 1 : 0;
+          }
+          |     varlist1 ',' var        
+          { 
+           varbuffer[nvarbuffer] = $3; incr_nvarbuffer();
+           $$ = ($3 == 0) ? $1 + 1 : $1;
+          }
+          ;
+                
+var       :     NAME
+          { 
+           int local = lua_localname ($1);
+           if (local == -1)     /* global var */
+            $$ = $1 + 1;                /* return positive value */
+           else
+            $$ = -(local+1);            /* return negative value */
+          }
+          
+          |     var {lua_pushvar ($1);} '[' expr1 ']' 
+          {
+           $$ = 0;              /* indexed variable */
+          }
+          |     var {lua_pushvar ($1);} '.' NAME
+          {
+           align(Word);
+           code_byte(PUSHSTRING);
+           code_word(lua_findconstant (s_name($4))); incr_ntemp();
+           $$ = 0;              /* indexed variable */
+          }
+          ;
+                
+localdeclist      : NAME {localvar[nlocalvar]=$1; $$ = 1;}
+          | localdeclist ',' NAME {localvar[nlocalvar+$1]=$3; $$ = $1+1;}
+          ;
+                
+decinit   : /* empty */
+          | '=' exprlist1
+          ;
+          
+setdebug  : DEBUG {lua_debug = $1;}
+
+%%
+
+/*
+** Search a local name and if find return its index. If do not find return -1
+*/
+static int lua_localname (Word n)
+{
+ int i;
+ for (i=nlocalvar-1; i >= 0; i--)
+  if (n == localvar[i]) return i;       /* local var */
+ return -1;                     /* global var */
+}
+
+/*
+** Push a variable given a number. If number is positive, push global variable
+** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
+** Otherwise, if zero, push indexed variable (record).
+*/
+static void lua_pushvar (long number)
+{ 
+ if (number > 0)        /* global var */
+ {
+  align(Word);
+  code_byte(PUSHGLOBAL);
+  code_word(number-1);
+  incr_ntemp();
+ }
+ else if (number < 0)   /* local var */
+ {
+  number = (-number) - 1;
+  if (number < 10) code_byte(PUSHLOCAL0 + number);
+  else
+  {
+   code_byte(PUSHLOCAL);
+   code_byte(number);
+  }
+  incr_ntemp();
+ }
+ else
+ {
+  code_byte(PUSHINDEXED);
+  ntemp--;
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ code_byte(ADJUST);
+ code_byte(n + nlocalvar);
+}
+
+static void lua_codestore (int i)
+{
+ if (varbuffer[i] > 0)          /* global var */
+ {
+  align(Word);
+  code_byte(STOREGLOBAL);
+  code_word(varbuffer[i]-1);
+ }
+ else if (varbuffer[i] < 0)      /* local var */
+ {
+  int number = (-varbuffer[i]) - 1;
+  if (number < 10) code_byte(STORELOCAL0 + number);
+  else
+  {
+   code_byte(STORELOCAL);
+   code_byte(number);
+  }
+ }
+ else                             /* indexed var */
+ {
+  int j;
+  int upper=0;          /* number of indexed variables upper */
+  int param;            /* number of itens until indexed expression */
+  for (j=i+1; j <nvarbuffer; j++)
+   if (varbuffer[j] == 0) upper++;
+  param = upper*2 + i;
+  if (param == 0)
+   code_byte(STOREINDEXED0);
+  else
+  {
+   code_byte(STOREINDEXED);
+   code_byte(param);
+  }
+ }
+}
+
+void yyerror (char *s)
+{
+ static char msg[256];
+ sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
+          s, lua_lasttext (), lua_linenumber, lua_filename());
+ lua_error (msg);
+ err = 1;
+}
+
+int yywrap (void)
+{
+ return 1;
+}
+
+
+/*
+** Parse LUA code and execute global statement.
+** Return 0 on success or 1 on error.
+*/
+int lua_parse (void)
+{
+ Byte *initcode = maincode;
+ err = 0;
+ if (yyparse () || (err==1)) return 1;
+ *maincode++ = HALT;
+ if (lua_execute (initcode)) return 1;
+ maincode = initcode;
+ return 0;
+}
+
+
+#if 0
+
+static void PrintCode (void)
+{
+ Byte *p = code;
+ printf ("\n\nCODE\n");
+ while (p != pc)
+ {
+  switch ((OpCode)*p)
+  {
+   case NOP:            printf ("%d    NOP\n", (p++)-code); break;
+   case PUSHNIL:        printf ("%d    PUSHNIL\n", (p++)-code); break;
+   case PUSH0: case PUSH1: case PUSH2:
+                        printf ("%d    PUSH%c\n", p-code, *p-PUSH0+'0');
+                        p++;
+                        break;
+   case PUSHBYTE:
+                        printf ("%d    PUSHBYTE   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   case PUSHWORD:
+                        printf ("%d    PUSHWORD   %d\n", p-code, *((Word *)(p+1)));
+                        p += 1 + sizeof(Word);
+                        break;
+   case PUSHFLOAT:
+                        printf ("%d    PUSHFLOAT  %f\n", p-code, *((float *)(p+1)));
+                        p += 1 + sizeof(float);
+                        break;
+   case PUSHSTRING:
+                        printf ("%d    PUSHSTRING   %d\n", p-code, *((Word *)(p+1)));
+                        p += 1 + sizeof(Word);
+                        break;
+   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
+   case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
+   case PUSHLOCAL8: case PUSHLOCAL9:
+                        printf ("%d    PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
+                        p++;
+                        break;
+   case PUSHLOCAL:      printf ("%d    PUSHLOCAL   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   case PUSHGLOBAL:
+                        printf ("%d    PUSHGLOBAL   %d\n", p-code, *((Word *)(p+1)));
+                        p += 1 + sizeof(Word);
+                        break;
+   case PUSHINDEXED:    printf ("%d    PUSHINDEXED\n", (p++)-code); break;
+   case PUSHMARK:       printf ("%d    PUSHMARK\n", (p++)-code); break;
+   case PUSHOBJECT:     printf ("%d    PUSHOBJECT\n", (p++)-code); break;
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
+   case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
+   case STORELOCAL8: case STORELOCAL9:
+                        printf ("%d    STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
+                        p++;
+                        break;
+   case STORELOCAL:
+                        printf ("%d    STORELOCAK   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   case STOREGLOBAL:
+                        printf ("%d    STOREGLOBAL   %d\n", p-code, *((Word *)(p+1)));
+                        p += 1 + sizeof(Word);
+                        break;
+   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
+   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   case STOREFIELD:     printf ("%d    STOREFIELD\n", (p++)-code); break;
+   case ADJUST:
+                        printf ("%d    ADJUST   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   case CREATEARRAY:    printf ("%d    CREATEARRAY\n", (p++)-code); break;
+   case EQOP:           printf ("%d    EQOP\n", (p++)-code); break;
+   case LTOP:           printf ("%d    LTOP\n", (p++)-code); break;
+   case LEOP:           printf ("%d    LEOP\n", (p++)-code); break;
+   case ADDOP:          printf ("%d    ADDOP\n", (p++)-code); break;
+   case SUBOP:          printf ("%d    SUBOP\n", (p++)-code); break;
+   case MULTOP:         printf ("%d    MULTOP\n", (p++)-code); break;
+   case DIVOP:          printf ("%d    DIVOP\n", (p++)-code); break;
+   case CONCOP:         printf ("%d    CONCOP\n", (p++)-code); break;
+   case MINUSOP:        printf ("%d    MINUSOP\n", (p++)-code); break;
+   case NOTOP:          printf ("%d    NOTOP\n", (p++)-code); break;
+   case ONTJMP:    
+                        printf ("%d    ONTJMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case ONFJMP:    
+                        printf ("%d    ONFJMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case JMP:       
+                        printf ("%d    JMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case UPJMP:
+                        printf ("%d    UPJMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case IFFJMP:
+                        printf ("%d    IFFJMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case IFFUPJMP:
+                        printf ("%d    IFFUPJMP  %d\n", p-code, *((Word *)(p+1)));
+                        p += sizeof(Word) + 1;
+                        break;
+   case POP:            printf ("%d    POP\n", (p++)-code); break;
+   case CALLFUNC:       printf ("%d    CALLFUNC\n", (p++)-code); break;
+   case RETCODE:
+                        printf ("%d    RETCODE   %d\n", p-code, *(++p));
+                        p++;
+                        break;
+   default:             printf ("%d    Cannot happen\n", (p++)-code); break;
+  }
+ }
+}
+#endif
+