#include <string.h>
#include <stdio.h>
#include <stdlib.h>

typedef enum { false, true } bool;


#define STACK_SIZE 255
#define TEXT_LEN 60
#define MAX_CODE 256000

char text1 [TEXT_LEN + 1];
char text2 [TEXT_LEN + 1];
bool item_has_stack;
char stack [STACK_SIZE + 1];
unsigned int stack_top;
unsigned char code [MAX_CODE];
unsigned long code_len;
bool new_runtime;
unsigned long proc_tbl;

#define ADDR 'a'
#define WORD 'w'
#define LONG 'l'
#define REAL 'r'
#define STR  's'
#define ANY  0
#define TYPECODES "wlrs"
#define DATAFILE  "ABCD"

typedef struct
{
    char type;
    unsigned int xref_proc;
    unsigned int xref_proc_end;
    unsigned long proc_offset;
    unsigned int xref_parms;
    unsigned int n_parms;
    unsigned long parm_table;
    unsigned int xref_globals;
    unsigned int n_globals;
    unsigned long global_table;
}
procinfo;


void load_code (void);
void dump_header (void);
void dump_body (void);
void dump_proc (unsigned long p, procinfo *proc);
void dump_code (unsigned long p, unsigned int p_end, procinfo *proc);
unsigned int dump_qcode (unsigned long p, procinfo *proc);
unsigned int open_file (unsigned long p, char *name);
unsigned int generic_opcode (unsigned long p, unsigned int opcode);
unsigned int opcode_57 (unsigned long p);
void new_item (bool stack);
void print_item (unsigned long addr, unsigned int len);
void show_stack (void);
void clear_stack (void);
void flush_stack (void);
char *ext_ref (unsigned int xref, procinfo *proc);
void push (char c);
void pop (char c);
unsigned int peekb (unsigned long offset);
unsigned int peekw (unsigned long offset);
long peekws (unsigned long offset);
unsigned long peekl (unsigned long offset);
char *peeks (unsigned long offset);
char *type_code (unsigned int t);


int main (int argc, char *argv [])
{
    if (argc > 1)
    {
        if (freopen (argv [1], "rb", stdin) == NULL)
        {
            fprintf (stderr, "Cannot open file %s\n", argv [1]);
            exit (1);
        }
    }
    load_code ();
    dump_header ();
    dump_body ();
    return 0;
}


void load_code (void)
{
    unsigned long i = 0;
    int c;

    while (c = getchar (), c != EOF && i < MAX_CODE)
        code [i++] = c;
    code_len = i;
}


void dump_header (void)
{
    unsigned long p;

    printf ("Headers\n");

    /* First header */

    if (strcmp (code, "OPLObjectFile**") != 0)
    {
        printf ("*** Wrong signature\n");
        exit (1);
    }
    new_item (false);
    strcat (text1, "Signature: ");
    strcat (text1, code);
    print_item (0ul, 16u);
    new_item (false);
    sprintf (text1, "Format version %u", peekw (16ul));
    print_item (16ul, 2u);
    new_item (false);
    p = peekw (18ul);
    sprintf (text1, "Offset of second header: $%4.4x", p);
    print_item (18ul, 2u);
    new_item (false);
    strcat (text1, "Source file: ");
    strncat (text1, peeks (20ul), TEXT_LEN - strlen (text1));
    print_item (20ul, peekb (20ul) + 1);

    /* Second header */

    printf ("\n");
    new_item (false);
    sprintf (text1, "File length: %lu ($%lX)", peekl (p), peekl (p));
    print_item (p, 4);
    p += 4;
    new_item (false);
    sprintf (text1, "Translator version %4.4X, runtime version %4.4X",
             peekw (p), peekw (p + 2));
    new_runtime = peekw (p + 2) >= 0x1110;
    print_item (p, 4);
    p += 4;
    new_item (false);
    proc_tbl = peekl (p);
    sprintf (text1, "Procedure table at: $%4.4lX", proc_tbl);
    print_item (p, 4);

    /* Embedded files */

    p -= 8;
    if (p != 21 + peekb (20ul))
    {
        unsigned long pp = 21ul + peekb (20ul);

        printf ("\nEmbedded files\n");
        while (pp < p)
        {
            unsigned int len = peekw (pp);

            new_item (false);
            sprintf (text1, "File length %u ($%x)", len, len);
            print_item (pp, 2);
            pp += 2;
            if (len == 36)
            {
                new_item (false);
                sprintf (text1, "Name/ext: %.14s", code + pp);
                print_item (pp, 14u);
                new_item (false);
                sprintf (text1, "Path: %.20s", code + pp + 14);
                print_item (pp + 14, 20u);
                new_item (false);
                sprintf (text1, "Type $%4.4X", peekw (pp + 34));
                print_item (pp + 34, 2u);
            }
            else
            {
                new_item (false);
                strcat (text1, "(file contents)");
                print_item (pp, len);
            }
            pp += len;
        }
    }

    printf ("\n");
}


void dump_body (void)
{
    unsigned long p = proc_tbl;
    procinfo proc;

    while (peekb (p) != 0)
    {
        unsigned int tc;

        printf ("==== Procedure %.12s ====\n\n", peeks (p));

        tc = peekb (p + peekb (p));
        proc.type = tc == '%' ? WORD : tc == '&' ? LONG :
                    tc == '$' ? STR  : REAL;

        /* Table entry */

        new_item (false);
        sprintf (text1, "Procedure %.12s", peeks (p));
        print_item (p, peekb (p) + 1);
        p += peekb (p) + 1;
        new_item (false);
        sprintf (text1, "File offset $%4.4lX", peekl (p));
        print_item (p, 4u);
        new_item (false);
        sprintf (text1, "Line number %u", peekw (p + 4) + 1);
        print_item (p + 4, 2u);
        dump_proc (peekl (p), &proc);
        p += 6;
        printf ("\n");
    }
}


void dump_proc (unsigned long p, procinfo *proc)
{
    unsigned int u, uu;
    unsigned long pp, qlen;
    unsigned int xref = 18;

    printf ("\n");
    if (new_runtime)
    {
        new_item (false);
        sprintf (text1, "Optimisation value %u", peekw (p));
        print_item (p, 2u);
        p += 2;
    }

    /* Space control */

    new_item (false);
    sprintf (text1, "Stack frame %u bytes, %u dynamic bytes used",
             peekw (p), peekw (p + 4));
    qlen = peekw (p + 2);
    sprintf (text2, "Q-code %u bytes", qlen);
    print_item (p, 6u);
    p += 6;

    /* Parameters */

    new_item (false);
    u = peekb (p);
    sprintf (text1, "%u parameters:", u);
    proc->n_parms = u;
    proc->parm_table = p + 1;
    for (uu = 0; uu < u; uu++)
    {
        strcat (text1, " ");
        strcat (text1, type_code (peekb (p + u - uu)));
    }
    print_item (p, u + 1);
    p += u + 1;

    /* Global declarations */

    pp = p + peekw (p) + 2;
    new_item (false);
    strcpy (text1, "Global declarations");
    print_item (p, 2u);
    p += 2;
    xref += pp - p;
    while (p < pp)
    {
        unsigned int len = peekb (p);

        new_item (false);
        sprintf (text1, "  Global %s", peeks (p));
        strcpy (text2, "    Type: ");
        strcat (text2, type_code (peekb (p + len + 1)));
        print_item (p, len + 2u);
        p += len + 2;
        new_item (false);
        sprintf (text1, "    Stack offset %u ($%X)",
                 peekw (p), peekw (p));
        print_item (p, 2u);
        p += 2;
    }

    /* Called procedures */

    pp = p + peekw (p) + 2;
    new_item (false);
    strcpy (text1, "Called procedures");
    print_item (p, 2u);
    p += 2;
    proc->xref_proc = xref;
    xref += pp - p;
    proc->xref_parms = proc->xref_proc_end = xref;
    proc->proc_offset = p - proc->xref_proc;
    while (p < pp)
    {
        unsigned int len = peekb (p);

        new_item (false);
        sprintf (text1, "  calls %s", peeks (p));
        sprintf (text2, "    %u arguments", peekb (p + len + 1));
        print_item (p, len + 2u);
        p += len + 2;
    }

    /* Global references */

    xref += 2 * proc->n_parms;
    proc->xref_globals = xref;
    proc->global_table = p;
    while (peekb (p) != 0)
    {
        unsigned int len = peekb (p);

        new_item (false);
        sprintf (text1, "Global reference %s", peeks (p));
        sprintf (text2, "  Type: %s", type_code (peekb (p + len + 1)));
        print_item (p, len + 2u);
        p += len + 2;
        xref += 2;
    }
    new_item (false);
    strcpy (text1, "End of global references");
    print_item (p++, 1u);
    proc->n_globals = (xref - proc->xref_globals) / 2;

    /* String control */

    while (peekw (p) != 0)
    {
        new_item (false);
        sprintf (text1, "String at %2u ($%2X) length %u",
                 peekw (p), peekw (p), peekb (p + 2));
        print_item (p, 3u);
        p += 3;
    }
    new_item (false);
    strcpy (text1, "End of string control");
    print_item (p, 2u);
    p += 2;

    /* Array control */

    while (peekw (p) != 0)
    {
        new_item (false);
        sprintf (text1, "Array at %2u ($%2X) size %u",
                 peekw (p), peekw (p), peekw (p + 2));
        print_item (p, 4u);
        p += 4;
    }
    new_item (false);
    strcpy (text1, "End of array control");
    print_item (p, 2u);
    p += 2;

    dump_code (p, p + qlen, proc);
}


void dump_code (unsigned long p, unsigned int p_end, procinfo *proc)
{
    printf ("\n");

    clear_stack ();
    while (p < p_end)
        p += dump_qcode (p, proc);
    flush_stack ();
    printf ("\n");
}


unsigned int dump_qcode (unsigned long p, procinfo *proc)
{
    unsigned int len = 1;
    unsigned int op = peekb (p);
    unsigned int opbase = op & ~3, optype = op & 3;
    char type = TYPECODES [optype];
    unsigned int v;

    new_item (true);

    switch (op)
    {
    case 0x00: case 0x01: case 0x02: case 0x03:
    case 0x10: case 0x11: case 0x12: case 0x13:
        len = 3;
        sprintf (text1, "PUSH%c local %u", type, peekw (p + 1));
        if (op >= 0x10)
            pop (WORD), strcat (text1, " array element");
        push (type);
        break;

    case 0x04: case 0x05: case 0x06: case 0x07:
    case 0x14: case 0x15: case 0x16: case 0x17:
        len = 3;
        sprintf (text1, "PUSH ADDR%c local %u", type, peekw (p + 1));
        if (op >= 0x10)
            pop (WORD), strcat (text1, " array element");
        push (ADDR);
        break;

    case 0x08: case 0x09: case 0x0A: case 0x0B:
    case 0x18: case 0x19: case 0x1A: case 0x1B:
        len = 3;
        sprintf (text1, "PUSH%c %s", type, ext_ref (peekw (p + 1), proc));
        if (op >= 0x10)
            pop (WORD), strcat (text1, " array element");
        push (type);
        break;

    case 0x0C: case 0x0D: case 0x0E: case 0x0F:
    case 0x1C: case 0x1D: case 0x1E: case 0x1F:
        len = 3;
        sprintf (text1, "PUSH ADDR%c %s", type, ext_ref (peekw (p + 1), proc));
        if (op >= 0x10)
            pop (WORD), strcat (text1, " array element");
        push (ADDR);
        break;

    case 0x20: case 0x21: case 0x22: case 0x23:
        len = 2;
        pop (STR);
        sprintf (text1, "PUSH%c field %c.pops",
                 type, DATAFILE [peekb (p + 1)]);
        push (type);
        break;

    case 0x24: case 0x25: case 0x26: case 0x27:
        len = 2;
        pop (STR);
        sprintf (text1, "PUSH ADDR%c field %c.pops",
                 type, DATAFILE [peekb (p + 1)]);
        push (ADDR);
        break;

    case 0x28:
        len = 3;
        push (type);
        sprintf (text1, "PUSH%c %ld", type, peekws (p + 1));
        break;

    case 0x29:
        len = 5;
        push (type);
        sprintf (text1, "PUSH%c %lu", type, peekl (p + 1));
        break;

    case 0x2A:
        len = 9;
        push (type);
        sprintf (text1, "PUSH%c [omitted]", type);
        break;

    case 0x2B:
        len = 2 + peekb (p + 1);
        push (type);
        sprintf (text1, "PUSH%c %s", type, peeks (p + 1));
        break;

    /* 0x2C to 0x2F are not used */

    case 0x30: case 0x31: case 0x32: case 0x33:
    case 0x34: case 0x35: case 0x36: case 0x37:
    case 0x38: case 0x39: case 0x3A: case 0x3B:
    case 0x3C: case 0x3D: case 0x3E: case 0x3F:
    case 0x40: case 0x41: case 0x42: case 0x43:
    case 0x44: case 0x45: case 0x46: case 0x47:
    case 0x48: case 0x49: case 0x4A: case 0x4B:
    case 0x4C: case 0x4D: case 0x4E:
    case 0x50: case 0x51: case 0x52:
    case 0x54: case 0x55: case 0x56:
    case 0x58: case 0x59: case 0x5A:
    case 0x5C: case 0x5D: case 0x5E:
    case 0x60: case 0x61: case 0x62:
        pop (type); pop (type);
        push ((char) (op <= 0x47 || op >= 0x5C ? WORD : type));
        sprintf (text1, "OP[%s]%c",
                 opbase == 0x30 ? "<"  :
                 opbase == 0x34 ? "<=" :
                 opbase == 0x38 ? ">"  :
                 opbase == 0x3C ? ">=" :
                 opbase == 0x40 ? "="  :
                 opbase == 0x44 ? "<>" :
                 opbase == 0x48 ? "+"  :
                 opbase == 0x4C ? "-"  :
                 opbase == 0x50 ? "*"  :
                 opbase == 0x54 ? "/"  :
                 opbase == 0x58 ? "**" :
                 opbase == 0x5C ? "AND" :
                 opbase == 0x60 ? "OR" :
                 "?", type);
        break;

    case 0x4F:
        len = 2;
        v = peekb (p + 1);
        sprintf (text1, "PUSHw %d", (int) (v < 0x80 ? v : v - 0x100));
        push (WORD);
        break;

    case 0x53:
        len = 3;
        v = peekw (p + 1);
        if (v >= proc->xref_proc && v < proc->xref_proc_end)
        {
            unsigned long pp = proc->proc_offset + v;
            unsigned int i, n;

            sprintf (text1, "Call %s:", peeks (pp));
            n = peekb (pp + peekb (pp) + 1);
            for (i = 0; i < n; i++)
                pop (WORD), pop (ANY);
            n = peekb (pp + peekb (pp));
            push ((char) (n == '%' ? WORD : n == '&' ? LONG :
                          n == '$' ? STR  : REAL));
        }
        else
            sprintf (text1, "Call external %u", v);
        break;

    case 0x57:
        len = opcode_57 (p + 1);
        break;

    case 0x5B:
        len = 3;
        pop (WORD);
        sprintf (text1, "Jump if zero to %6.4lX", p + peekws (p + 1));
        break;

    case 0x5F:
        len = 2;
        v = peekb (p + 1);
        sprintf (text1, "PUSHl %d", (int) (v < 0x80 ? v : v - 0x100));
        push (LONG);
        break;

    case 0x63:
        len = 3;
        sprintf (text1, "PUSHl %ld", peekws (p + 1));
        push (LONG);
        break;

    case 0x64: case 0x65: case 0x66:
        strcpy (text1, "NOT");
        pop (type);
        push (WORD);
        break;

    /* 0x67 not used */

    case 0x68: case 0x69: case 0x6A:
        strcpy (text1, "Negate");
        pop (type);
        push (type);
        break;

    case 0x6B:
        len = 3;
        {
            int n = peekb (p + 1), i;
            char t = peekb (p + 2);

            strcpy (text1, "Call indirect @");
            if (t != 0)
                strcat (text1, "@"), text1 [strlen (text1) - 1] = t;
            sprintf (text2, "(%d arguments)", n);
            strcat (text1, text2);
            text2 [0] = 0;
            for (i = 0; i < n; i++)
                pop (WORD), pop (ANY);
            pop (STR);
            push ((char) (t == '%' ? WORD : t == '&' ? LONG :
                          t == '$' ? STR  : REAL));
        }
        break;

    case 0x6C: case 0x6D: case 0x6E: case 0x6F:
    case 0x70: case 0x71:
        pop (REAL); pop (REAL); push (REAL);
        sprintf (text1, "OP[%c%%]", "<>+-*/"[opbase - 0x6C]);
        break;

    /* 0x72 and 0x73 not used */

    case 0x74: case 0x75: case 0x76: case 0x77:
        strcpy (text1, "RETURN");
        break;

    case 0x78: case 0x79: case 0x7A: case 0x7B: case 0x7C: case 0x7D:
        strcpy (text1, "Convert top of stack");
        pop  ((op - 0x78) ["lrrwwl"]);
        push ((op - 0x78) ["wwllrr"]);
        break;

    /* 0x7E and 0x7F not used */

    case 0x80: case 0x81: case 0x82: case 0x83:
        pop (type);
        sprintf (text1, "POP%c and discard", type);
        break;

    case 0x84: case 0x85: case 0x86: case 0x87:
        pop (type); pop (ADDR);
        sprintf (text1, "STORE%c from stack", type);
        break;

    case 0x88: case 0x89: case 0x8A: case 0x8B:
    case 0x8C: case 0x8D: case 0x8E: case 0x8F:
        pop (type);
        sprintf (text1, "%sPRINT%c from stack",
                 opbase >= 0x8C ? "L" : "", type);
        break;

    case 0x90: strcpy (text1, "PRINT separator");  break;
    case 0x91: strcpy (text1, "LPRINT separator"); break;
    case 0x92: strcpy (text1, "PRINT line end");   break;
    case 0x93: strcpy (text1, "LPRINT line end");  break;

    case 0x94: case 0x95: case 0x96: case 0x97:
        pop (ADDR);
        sprintf (text1, "INPUT%c", type);
        break;

    /* All remaining opcodes (0xA4 to 0xFF) are generic */

    case 0xA5:
        len = open_file (p, "CREATE");
        break;

    case 0xB1:
        len = 3;
        sprintf (text1, "ONERR %6.4lX", p + peekws (p + 1));
        break;

    case 0xB4:
        len = open_file (p, "OPEN");
        break;

    case 0xBE:
        len = 2;
        sprintf (text1, "USE %c", DATAFILE [peekb (p + 1)]);
        break;

    case 0xBF:
        len = 3;
        sprintf (text1, "GOTO %6.4lX", p + peekws (p + 1));
        break;

    case 0xC0:
        pop (proc->type);
        strcpy (text1, "RETURN top of stack");
        break;

    case 0xC4:
        len = open_file (p, "OPENR");
        break;

    /* 0xDC, 0xDD, 0xFD, 0xFE are not used */

    /* Opcodes with various special cases */
    case 0xA6: case 0xE3: case 0xC5: case 0xF0:
    /* 2 byte opcodes */
    case 0xED: case 0xFF:
        len = 2 + generic_opcode (p + 2, (op << 8) + peekb (p + 1));
        break;

    case 0xF6: case 0xF7:
        len = 2;
        type = op == 0xF6 ? REAL : ADDR;
        v = peekb (p + 1);
        sprintf (text1, "PUSH%c calculator memory %d", type, v);
        push (type);
        break;

    default:
        len = 1 + generic_opcode (p + 1, op);
        break;
    }

    print_item (p, len);
    return len;
}


unsigned int open_file (unsigned long p, char *name)
{
    unsigned long pp = p + 2;
    unsigned int t;

    pop (STR);
    sprintf (text1, "%s %c,", name, DATAFILE [peekb (p + 1)]);
    while (t = peekb (pp++), t != 0xFF)
    {
        unsigned int len = peekb (pp);

        if (strlen (text1) + len < 40)
            strcat (text1, ","), strcat (text1, peeks (pp));
        else if (strlen (text2) + len < 40)
            strcat (text2, ","), strcat (text2, peeks (pp));
        pp += len + 1;
    }
    return pp - p;
}


unsigned int generic_opcode (unsigned long p, unsigned int opcode)
{
    unsigned int xlen = 0;
    static struct opinfo
    {
        char *name;
        unsigned int opcode;
        enum { NP, CP, DA, GP, ONW, ONX, NW, MC, DB, AS, CS, DT, VC } parmtype;
        unsigned int n_parms;
        unsigned int parm [8];
    }
    info_table [] =
    {
      { "POKEW",        0x98,   NP, 2, { 0, 0 } },
      { "POKEL",        0x99,   NP, 2, { 0, 1 } },
      { "POKEF",        0x9a,   NP, 2, { 0, 2 } },
      { "POKE$",        0x9b,   NP, 2, { 0, 3 } },
      { "POKEB",        0x9c,   NP, 2, { 0, 0 } },
      { "APPEND",       0x9d,   NP, 0 },
      { "AT",           0x9e,   NP, 2, { 0, 0 } },
      { "BACK",         0x9f,   NP, 0 },
      { "BEEP",         0xa0,   NP, 2, { 0, 0 } },
      { "CLOSE",        0xa1,   NP, 0 },
      { "CLS",          0xa2,   NP, 0 },
      { "COMPRESS",     0xa3,   NP, 2, { 3, 3 } },
      { "COPY",         0xa4,   NP, 2, { 3, 3 } },
      { "CURSOR OFF",   0xa600, NP, 0 },
      { "CURSOR ON",    0xa601, NP, 0 },
      { "CURSOR",       0xa602, NP, 1, { 0 } },
      { "CURSOR",       0xa603, NP, 4, { 0, 0, 0, 0 } },
      { "CURSOR",       0xa604, NP, 5, { 0, 0, 0, 0, 0 } },
      { "DELETE",       0xa7,   NP, 1, { 3 } },
      { "ERASE",        0xa8,   NP, 0 },
      { "ESCAPE",       0xa9,   ONW },
      { "FIRST",        0xaa,   NP, 0 },
      { "VECTOR",       0xab,   VC },
      { "LAST",         0xac,   NP, 0 },
      { "LCLOSE",       0xad,   NP, 0 },
      { "LOADM",        0xae,   NP, 1, { 3 } },
      { "LOPEN",        0xaf,   NP, 1, { 3 } },
      { "NEXT",         0xb0,   NP, 0 },
      { "OFF",          0xb2,   NP, 0 },
      { "OFF",          0xb3,   NP, 1, { 0 } },
      { "PAUSE",        0xb5,   NP, 1, { 0 } },
      { "POSITION",     0xb6,   NP, 1, { 0 } },
      { "IOSIGNAL",     0xb7,   NP, 0 },
      { "RAISE",        0xb8,   NP, 1, { 0 } },
      { "RANDOMIZE",    0xb9,   NP, 1, { 1 } },
      { "RENAME",       0xba,   NP, 2, { 3, 3 } },
      { "STOP",         0xbb,   NP, 0 },
      { "TRAP",         0xbc,   NP, 0 },
      { "UPDATE",       0xbd,   NP, 0 },
      { "UNLOADM",      0xc1,   NP, 1, { 3 } },
      { "EDIT",         0xc2,   NP, 1, { 3 } },
      { "SCREEN",       0xc3,   NP, 2, { 0, 0 } },
      { "gSAVEBIT",     0xc500, NP, 1, { 3 } },
      { "gSAVEBIT",     0xc501, NP, 3, { 3, 0, 0 } },
      { "gCLOSE",       0xc6,   NP, 1, { 0 } },
      { "gUSE",         0xc7,   NP, 1, { 0 } },
      { "gSETWIN",      0xc8,   NW },
      { "gVISIBLE",     0xc9,   ONW },
      { "gFONT",        0xca,   NP, 1, { 0 } },
      { "gUNLOADFONT",  0xcb,   NP, 1, { 0 } },
      { "gGMODE",       0xcc,   NP, 1, { 0 } },
      { "gTMODE",       0xcd,   NP, 1, { 0 } },
      { "gSTYLE",       0xce,   NP, 1, { 0 } },
      { "gORDER",       0xcf,   NP, 2, { 0, 0 } },
      { "gINFO",        0xd0,   NP, 1, { 5 } },
      { "gCLS",         0xd1,   NP, 0 },
      { "gAT",          0xd2,   NP, 2, { 0, 0 } },
      { "gMOVE",        0xd3,   NP, 2, { 0, 0 } },
      { "gPRINT word",  0xd4,   NP, 1, { 0 } },
      { "gPRINT long",  0xd5,   NP, 1, { 1 } },
      { "gPRINT real",  0xd6,   NP, 1, { 2 } },
      { "gPRINT str",   0xd7,   NP, 1, { 3 } },
      { "gPRINT field", 0xd8,   NP, 0 },
      { "gPRINTB",      0xd9,   GP },
      { "gLINEBY",      0xda,   NP, 2, { 0, 0 } },
      { "gBOX",         0xdb,   NP, 2, { 0, 0 } },
      { "gPOLY",        0xde,   NP, 1, { 5 } },
      { "gFILL",        0xdf,   NP, 3, { 0, 0, 0 } },
      { "gPATT",        0xe0,   NP, 4, { 0, 0, 0, 0 } },
      { "gCOPY",        0xe1,   NP, 6, { 0, 0, 0, 0, 0, 0 } },
      { "gSCROLL",      0xe2,   NW },
      { "gUPDATE OFF",  0xe300, NP, 0 },
      { "gUPDATE ON",   0xe301, NP, 0 },
      { "gUPDATE",      0xe3ff, NP, 0 },
      { "GETEVENT",     0xe4,   NP, 1, { 5 } },
      { "gLINETO",      0xe5,   NP, 2, { 0, 0 } },
      { "gPEEKLINE",    0xe6,   NP, 5, { 0, 0, 0, 5, 0 } },
      { "SCREEN",       0xe7,   NP, 4, { 0, 0, 0, 0 } },
      { "IOWAITSTAT",   0xe8,   NP, 1, { 5 } },
      { "IOYIELD",      0xe9,   NP, 0 },
      { "mINIT",        0xea,   NP, 0 },
      { "mCARD",        0xeb,   MC },
      { "dINIT",        0xec,   CP, 2, { 3, 0 } },
      { "dTEXT",        0xed00, DT },
      { "dCHOICE",      0xed01, NP, 3, { 4, 3, 3 } },
      { "dLONG",        0xed02, NP, 4, { 4, 3, 1, 1 } },
      { "dFLOAT",       0xed03, NP, 4, { 4, 3, 2, 2 } },
      { "dTIME",        0xed04, NP, 5, { 4, 3, 0, 1, 1 } },
      { "dDATE",        0xed05, NP, 4, { 4, 3, 1, 1 } },
      { "dEDIT",        0xed06, NP, 2, { 4, 3 } },
      { "dEDIT",        0xed07, NP, 3, { 4, 3, 0 } },
      { "dXINPUT",      0xed08, NP, 2, { 4, 3 } },
      { "dFILE",        0xed09, NP, 3, { 4, 3, 0 } },
      { "dBUTTONS",     0xed0a, DB },
      { "dPOSITION",    0xed0b, NP, 2, { 0, 0 } },
      { "SETNAME",      0xee,   NP, 1, { 3 } },
      { "STATUSWIN",    0xef,   ONX },
      { "BUSY OFF",     0xf000, NP, 0 },
      { "BUSY",         0xf001, NP, 1, { 3 } },
      { "BUSY",         0xf002, NP, 2, { 3, 0 } },
      { "BUSY",         0xf003, NP, 3, { 3, 0, 0 } },
      { "LOCK",         0xf1,   ONW },
      { "gINVERT",      0xf2,   NP, 2, { 0, 0 } },
      { "gXPRINT",      0xf3,   NP, 2, { 3, 0 } },
      { "gBORDER",      0xf4,   NW },
      { "gCLOCK",       0xf5,   ONX },
      { "MKDIR",        0xf8,   NP, 1, { 3 } },
      { "RMDIR",        0xf9,   NP, 1, { 3 } },
      { "SETPATH",      0xfa,   NP, 1, { 3 } },
      { "SECSTODATE",   0xfb,   NP, 8, { 1, 5, 5, 5, 5, 5, 5, 5 } },
      { "GIPRINT",      0xfc,   GP },
      { "gGREY",        0xff00, NP, 1, { 0 } },
      { "DEFAULTWIN",   0xff01, NP, 1, { 0 } },
      { "DIAMINIT",     0xff02, DA },
      { "DIAMPOS",      0xff03, NP, 1, { 0 } },
      { "FONT",         0xff04, NP, 2, { 0, 0 } },
      { "STYLE",        0xff05, NP, 1, { 0 } },
      { "USESPRITE",    0xff06, NP, 1, { 0 } },
      { "APPENDSPRITE", 0xff07, AS },
      { "DRAWSPRITE",   0xff08, NP, 2, { 0, 0 } },
      { "CHANGESPRITE", 0xff09, CS },
      { "POSSPRITE",    0xff0a, NP, 2, { 0, 0 } },
      { "CLOSESPRITE",  0xff0b, NP, 1, { 0 } },
      { "FREEALLOC",    0xff0c, NP, 1, { 0 } },
      { "LINKLIB",      0xff0d, NP, 1, { 0 } },
      { "CACHE",        0xff0e, ONW },
      { "gBUTTON",      0xff0f, NP, 5, { 3, 0, 0, 0, 0 } },
      { "gXBORDER",     0xff10, NW },
      { "gDRAWOBJECT",  0xff11, NP, 4, { 0, 0, 0, 0 } },
      { "ODBINFO",      0xff12, NP, 1, { 5 } },
      { "CACHETIDY",    0xff13, NP, 0 },
      { "SCREENINFO",   0xff14, NP, 1, { 5 } },
      { "CACHEHDR",     0xff15, NP, 1, { 0 } },
      { "CACHEREC",     0xff16, NP, 2, { 0, 0 } },
      { "dINITS",       0xff17, CP, 1, { 3 } },
    };
    struct opinfo *info;
    unsigned int n_opcodes = sizeof info_table / sizeof info_table [0];

    for (info = info_table; info->name != NULL; info++)
        if (opcode == info->opcode)
            break;
    if (info->name == NULL)
    {
        sprintf (text1, "*** Unknown opcode 0x%X", opcode);
        return 0;
    }
    strcpy (text1, info->name);

    switch (info->parmtype)
    {
        unsigned int np;

    case NP:
        np = info->n_parms;
        while (np-- != 0)
        {
            unsigned int pt = info->parm [np];

            pop ((char) (pt < 4 ? TYPECODES [pt] : pt == 4 ? ADDR : WORD));
        }
        break;

    case CP:
        xlen = 1;
        np = peekb (p);
        if (np > info->n_parms)
            strcat (text1, " *** too many arguments");
        else
        {
            char na [] = " [@@@ arguments]";

            sprintf (na, " [%d arguments]", np);
            strcat (text1, na);
            while (np-- != 0)
            {
                unsigned int pt = info->parm [np];

                pop ((char) (pt < 4 ? TYPECODES [pt] : pt == 4 ? ADDR : WORD));
            }
        }
        break;

    case DA:
        /* Code: number of arguments (first is word, rest string) */
        /* DIAMINIT */
        xlen = 1;
        np = peekb (p);
        if (np-- != 0)
        {
            while (np-- != 0)
                pop (STR);
            pop (WORD);
        }
        break;

    case GP:
        /* Code: number of word arguments after the string argument */
        xlen = 1;
        np = peekb (p);
        while (np-- != 0)
            pop (WORD);
        pop (STR);
        break;

    case ONW:
        /* Code: 0 = OFF, 1 = ON, else number of word arguments */
        /* ESCAPE, gVISIBLE, LOCK, CACHE */
        xlen = 1;
        np = peekb (p);
        switch (np)
        {
        case    0: strcat (text1, " OFF"); break;
        case    1: strcat (text1, " ON");  break;

        default:
            while (np-- != 0)
                pop (WORD);
            break;
        }
        break;

    case ONX:
        /* Code: 0 = OFF, 1 = ON, else ON + n-1 arguments */
        /* STATUSWIN, gCLOCK */
        xlen = 1;
        np = peekb (p);
        switch (np)
        {
        case 6: pop (WORD); /* fall through to: */
        case 5: pop (WORD); /* fall through to: */
        case 4: pop (STR ); /* fall through to: */
        case 3: pop (WORD); /* fall through to: */
        case 2: 
            pop (WORD);
            strcat (text1, " ON,[@");
            text1 [strlen (text1) - 1] = '0' + np - 1;
            strcat (text2, " arguments]");
            break;

        case 1: strcat (text1, " ON");  break;
        case 0: strcat (text1, " OFF"); break;
        }
        break;

    case NW:
        /* Code: number of word arguments */
        /* gSETWIN, gSCROLL, gBORDER, gXBORDER */
        xlen = 1;
        np = peekb (p);
        while (np-- != 0)
            pop (WORD);
        break;

    case MC:
        /* Special handling */
        /* mCARD */
    case DB:
        /* Special handling */
        /* dBUTTONS */
        xlen = 1;
        np = peekb (p);
        while (np-- != 0)
        {
            pop (WORD);
            pop (STR);
        }
        if (info->parmtype == MC)
            pop (STR);
        break;

    case AS:
        /* Special handling */
        /* APPENDSPRITE */
        xlen = 1;
        pop (WORD);
        pop (WORD);
        if (peekb (p) == 1)
        {
            pop (WORD);
            pop (WORD);
        }
        break;

    case CS:
        /* Special handling */
        /* CHANGESPRITE */
        xlen = 1;
        pop (WORD);
        pop (WORD);
        pop (WORD);
        if (peekb (p) == 1)
        {
            pop (WORD);
            pop (WORD);
        }
        break;

    case DT:
        /* Special handling */
        /* dTEXT */
        xlen = 1;
        if (peekb (p) == 1)
            pop (WORD);
        pop (STR);
        pop (STR);
        break;

    case VC:
        /* Special handling */
        /* VECTOR */
        pop (WORD);
        np = peekb (p);
        xlen = 2 * np + 1;
        {
            unsigned int i;

            for (i = 0; i < np; i++)
            {
                long dest = p + peekws (p + 1 + 2 * i) - 1;
                char buff [] = " AAAAAA";

                sprintf (buff, "%c%6.4lX", i == 0 ? ' ' : ',', dest);
                if (strlen (text1) < TEXT_LEN - 7)
                    strcat (text1, buff);
                else if (strlen (text2) < TEXT_LEN - 7)
                    strcat (text2, buff);
            }
        }
        break;

    default:
        strcat (text1, " *** argument handling wrong");
        xlen = 1;
        break;
    }

    return xlen;
}


unsigned int opcode_57 (unsigned long p)
{
    unsigned int opcode = peekb (p);
    static struct opinfo
    {
        char *name;
        unsigned int opcode;
        unsigned int type;
        enum { FP, VP, LP } parmtype;
        unsigned int n_parms;
        unsigned int parm [6];
    }
    info_table [] =
    {
      { "ADDR",         0x00, 0, FP, 1, { 0x5 } },
      { "ASC",          0x01, 0, FP, 1, { 0x3 } },
      { "CALL",         0x02, 0, VP, 6, { 0, 0, 0, 0, 0, 0 } },
      { "COUNT",        0x03, 0, FP, 0 },
      { "DAY",          0x04, 0, FP, 0 },
      { "DOW",          0x05, 0, FP, 3, { 0x0, 0x0, 0x0 } },
      { "EOF",          0x06, 0, FP, 0 },
      { "ERR",          0x07, 0, FP, 0 },
      { "EXIST",        0x08, 0, FP, 1, { 0x3 } },
      { "FIND",         0x09, 0, FP, 1, { 0x3 } },
      { "GET",          0x0A, 0, FP, 0 },
      { "IOA",          0x0B, 0, FP, 5, { 0x0, 0x0, 0x6, 0xA, 0xA } },
      { "IOW",          0x0C, 0, FP, 4, { 0x0, 0x0, 0xA, 0xA, 0x0 } },
      { "IOOPEN",       0x0D, 0, FP, 3, { 0x6, 0x3, 0x0 } },
      { "IOWRITE",      0x0E, 0, FP, 3, { 0x0, 0x4, 0x0 } },
      { "IOREAD",       0x0F, 0, FP, 3, { 0x0, 0x4, 0x0 } },
      { "IOCLOSE",      0x10, 0, FP, 1, { 0x0 } },
      { "IOWAIT",       0x11, 0, FP, 0 },
      { "HOUR",         0x12, 0, FP, 0 },
      { "KEY",          0x13, 0, FP, 0 },
      { "LEN",          0x14, 0, FP, 1, { 0x3 } },
      { "LOC",          0x15, 0, FP, 2, { 0x3, 0x3, 0x0 } },
      { "MINUTE",       0x16, 0, FP, 0 },
      { "MONTH",        0x17, 0, FP, 0 },
      { "PEEKB",        0x18, 0, FP, 1, { 0x4 } },
      { "PEEKW",        0x19, 0, FP, 1, { 0x4 } },
      { "POS",          0x1A, 0, FP, 0 },
      { "RECSIZE",      0x1B, 0, FP, 0 },
      { "SECOND",       0x1C, 0, FP, 0 },
      { "USR",          0x1D, 0, FP, 5, { 0x4, 0x4, 0x4, 0x4, 0x4 } },
      { "YEAR",         0x1E, 0, FP, 0 },
      { "ADDR",         0x1F, 0, FP, 1, { 0x5 } },
      { "WEEK",         0x20, 0, FP, 3, { 0x0, 0x0, 0x0 } },
      { "IOSEEK",       0x21, 0, FP, 3, { 0x0, 0x0, 0x7 } },
      { "KMOD",         0x22, 0, FP, 0 },
      { "KEYA",         0x23, 0, FP, 2, { 0x6, 0x6, 0x0 } },
      { "KEYC",         0x24, 0, FP, 1, { 0x6 } },
      { "IOOPEN",       0x25, 0, FP, 3, { 0x6, 0x4, 0x0 } },
      { "GCREATE",      0x26, 0, FP, 5, { 0x0, 0x0, 0x0, 0x0, 0x0 } },
      { "GCREATEBIT",   0x27, 0, FP, 2, { 0x0, 0x0, 0x0 } },
      { "GLOADBIT",     0x28, 0, VP, 3, { 0x3, 0x0, 0x0 } },
      { "GLOADFONT",    0x29, 0, FP, 1, { 0x3 } },
      { "GRANK",        0x2A, 0, FP, 0 },
      { "GIDENTITY",    0x2B, 0, FP, 0 },
      { "GX",           0x2C, 0, FP, 0 },
      { "GY",           0x2D, 0, FP, 0 },
      { "GWIDTH",       0x2E, 0, FP, 0 },
      { "GHEIGHT",      0x2F, 0, FP, 0 },
      { "GORIGINX",     0x30, 0, FP, 0 },
      { "GORIGINY",     0x31, 0, FP, 0 },
      { "GTWIDTH",      0x32, 0, FP, 1, { 0x3 } },
      { "GPRINTCLIP",   0x33, 0, FP, 2, { 0x3, 0x0, 0x0 } },
      { "TESTEVENT",    0x34, 0, FP, 0 },
      { "OS",           0x35, 0, VP, 3, { 0x0, 0x0, 0x0 } },
      { "MENU",         0x36, 0, FP, 0 },
      { "DIALOG",       0x37, 0, FP, 0 },
      { "ALERT",        0x38, 0, VP, 6, { 0x3, 0x3, 0x3, 0x3, 0x3 } },
      { "GCREATE",      0x39, 0, FP, 6, { 0x0, 0x0, 0x0, 0x0, 0x0, 0x0 } },
      { "MENU",         0x3A, 0, FP, 1, { 0x6 } },
      { "CREATESPRITE", 0x3B, 0, FP, 0 },
      { "LOADLIB",      0x3C, 0, FP, 3, { 0x6, 0x3, 0x0 } },
      { "UNLOADLIB",    0x3D, 0, FP, 1, { 0x0 } },
      { "FINDLIB",      0x3E, 0, FP, 2, { 0x6, 0x3, 0x0 } },
      { "GETLIBH",      0x3F, 0, FP, 1, { 0x0 } },
      { "DAYS",         0x40, 1, FP, 3, { 0x0, 0x0, 0x0 } },
      { "IABS",         0x41, 1, FP, 1, { 0x1 } },
      { "INT",          0x42, 1, FP, 1, { 0x2 } },
      { "PEEKL",        0x43, 1, FP, 1, { 0x4 } },
      { "SPACE",        0x44, 1, FP, 0 },
      { "DATETOSECS",   0x45, 1, FP, 6, { 0x0, 0x0, 0x0, 0x0, 0x0, 0x0 } },
      { "NEWOBJ",       0x46, 0, FP, 2, { 0x0, 0x0, 0x0 } },
      { "NEWOBJH",      0x47, 0, FP, 2, { 0x0, 0x0, 0x0 } },
      { "SEND",         0x48, 0, VP, 6, { 0x0, 0x0, 0xA, 0xA, 0xA, 0x0 } },
      { "ENTERSEND",    0x49, 0, VP, 6, { 0x0, 0x0, 0xA, 0xA, 0xA, 0x0 } },
      { "ENTERSEND0",   0x4A, 0, VP, 6, { 0x0, 0x0, 0xA, 0xA, 0xA, 0x0 } },
      { "ALLOC",        0x4B, 0, FP, 1, { 0x4 } },
      { "REALLOC",      0x4C, 0, FP, 2, { 0x0, 0x4, 0x0 } },
      { "ADJUSTALLOC",  0x4D, 0, FP, 3, { 0x0, 0x0, 0x0 } },
      { "LENALLOC",     0x4E, 0, FP, 1, { 0x0 } },
      { "IOC",          0x4F, 0, VP, 6, { 0x0, 0x0, 0xA, 0xA, 0xA, 0x0 } },
      { "UADD",         0x50, 0, FP, 2, { 0x4, 0x0, 0x0 } },
      { "USUB",         0x51, 0, FP, 2, { 0x4, 0x0, 0x0 } },
      { "IOCANCEL",     0x52, 0, FP, 1, { 0x0 } },
      { "STATWININFO",  0x53, 0, FP, 2, { 0x0, 0x6, 0x0 } },
      { "FINDFIELD",    0x54, 0, FP, 4, { 0x3, 0x0, 0x0, 0x0, 0x0 } },
      { "ABS",          0x80, 2, FP, 1, { 0x2 } },
      { "ACOS",         0x81, 2, FP, 1, { 0x2 } },
      { "ASIN",         0x82, 2, FP, 1, { 0x2 } },
      { "ATAN",         0x83, 2, FP, 1, { 0x2 } },
      { "COS",          0x84, 2, FP, 1, { 0x2 } },
      { "DEG",          0x85, 2, FP, 1, { 0x2 } },
      { "EXP",          0x86, 2, FP, 1, { 0x2 } },
      { "FLT",          0x87, 2, FP, 1, { 0x1 } },
      { "INTF",         0x88, 2, FP, 1, { 0x2 } },
      { "LN",           0x89, 2, FP, 1, { 0x2 } },
      { "LOG",          0x8A, 2, FP, 1, { 0x2 } },
      { "PEEKF",        0x8B, 2, FP, 1, { 0x4 } },
      { "PI",           0x8C, 2, FP, 0 },
      { "RAD",          0x8D, 2, FP, 1, { 0x2 } },
      { "RND",          0x8E, 2, FP, 0 },
      { "SIN",          0x8F, 2, FP, 1, { 0x2 } },
      { "SQR",          0x90, 2, FP, 1, { 0x2 } },
      { "TAN",          0x91, 2, FP, 1, { 0x2 } },
      { "VAL",          0x92, 2, FP, 1, { 0x3 } },
      { "MAX",          0x93, 2, LP },
      { "MEAN",         0x94, 2, LP },
      { "MIN",          0x95, 2, LP },
      { "STD",          0x96, 2, LP },
      { "SUM",          0x97, 2, LP },
      { "VAR",          0x98, 2, LP },
      { "EVAL",         0x99, 2, FP, 1, { 0x3 } },
      { "CHR$",         0xC0, 3, FP, 1, { 0x0 } },
      { "DATIM$",       0xC1, 3, FP, 0 },
      { "DAYNAME$",     0xC2, 3, FP, 1, { 0x0 } },
      { "DIR$",         0xC3, 3, FP, 1, { 0x3 } },
      { "ERR$",         0xC4, 3, FP, 1, { 0x0 } },
      { "FIX$",         0xC5, 3, FP, 3, { 0x2, 0x0, 0x0 } },
      { "GEN$",         0xC6, 3, FP, 2, { 0x2, 0x0, 0x0 } },
      { "GET$",         0xC7, 3, FP, 0 },
      { "HEX$",         0xC8, 3, FP, 1, { 0x1 } },
      { "KEY$",         0xC9, 3, FP, 0 },
      { "LEFT$",        0xCA, 3, FP, 2, { 0x3, 0x0, 0x0 } },
      { "LOWER$",       0xCB, 3, FP, 1, { 0x3 } },
      { "MID$",         0xCC, 3, FP, 3, { 0x3, 0x0, 0x0 } },
      { "MONTH$",       0xCD, 3, FP, 1, { 0x0 } },
      { "NUM$",         0xCE, 3, FP, 2, { 0x2, 0x0, 0x0 } },
      { "PEEK$",        0xCF, 3, FP, 1, { 0x4 } },
      { "REPT$",        0xD0, 3, FP, 2, { 0x3, 0x0, 0x0 } },
      { "RIGHT$",       0xD1, 3, FP, 2, { 0x3, 0x0, 0x0 } },
      { "SCI$",         0xD2, 3, FP, 3, { 0x2, 0x0, 0x0 } },
      { "UPPER$",       0xD3, 3, FP, 1, { 0x3 } },
      { "USR$",         0xD4, 3, FP, 5, { 0x4, 0x4, 0x4, 0x4, 0x4 } },
      { "GETCMD$",      0xD5, 3, FP, 0 },
      { "CMD$",         0xD6, 3, FP, 1, { 0x0 } },
      { "PARSE$",       0xD7, 3, FP, 3, { 0x3, 0x3, 0x6 } },
      { NULL }
    };
    struct opinfo *info;
    unsigned int n_opcodes = sizeof info_table / sizeof info_table [0];

    for (info = info_table; info->name != NULL; info++)
        if (opcode == info->opcode)
            break;
    if (info->name == NULL)
    {
        sprintf (text1, "*** Unknown opcode 57 %u", opcode);
        return 2;
    }
    strcpy (text1, info->name);

    /* Do the parameters */

    if (info->parmtype == LP)
    {
        unsigned int np = peekb (p + 1);

        if (np == 0)
            pop (ADDR), pop (WORD);
        else while (np-- != 0)
            pop (REAL);
    }
    else
    {
        unsigned int np;

        if (info->parmtype == VP)
        {
            np = peekb (p + 1);
            if (np == 0 || np > info->n_parms)
                strcat (text1, " *** Bad argument count");
        }
        else
            np = info->n_parms;

        while (np-- != 0)
        {
            unsigned int pt = info->parm [np];

            pop ((char) (pt < 4 ? TYPECODES [pt] : pt == 5 ? ADDR : WORD));
        }
    }

    push (TYPECODES [info->type]);

    return info->parmtype == FP ? 2 : 3;
}


void new_item (bool stack)
{
    item_has_stack = stack;
    text1 [0] = text2 [0] = 0;
}


void print_item (unsigned long addr, unsigned int len)
{
    bool line2 = len > 5 || text2 [0] != 0;
    unsigned int i;
    char *text_fmt = item_has_stack ? "%.42s\n" : "%.50s\n";

    printf ("%6.4lX  ", addr);
    for (i = 0; i < 5; i++)
        printf (i < len ? "%2.2X " : "   ", code [addr + i]);
    if (item_has_stack)
        show_stack ();
    printf (text_fmt, text1);
    if (!line2)
        return;

    printf ("        ");
    for (i = 5; i < 8; i++)
        printf (i < len ? "%2.2X " : "   ", code [addr + i]);
    if (len > 10)
        printf ("...   ");
    else if (len == 10)
        printf ("%2.2X %2.2X ", code [addr + 8], code [addr + 9]);
    else if (len == 9)
        printf ("%2.2X    ", code [addr + 8]);
    else
        printf ("      ");
    if (item_has_stack)
        printf ("            ");
    printf (text_fmt, text2);
}


void show_stack (void)
{
    unsigned int i;

    if (stack_top == 0)
        printf (" empty      ");
    else if (stack_top < 6)
        for (i = 0; i < 6; i++)   /* 6 is correct */
            printf (i < stack_top ? " %c" : "  ", stack [i]);
    else
        printf ("<< %c %c %c %c  ",
                stack [stack_top - 4], stack [stack_top - 3],
                stack [stack_top - 2], stack [stack_top - 1]);
}


void clear_stack (void)
{
    stack_top = 0;
}


void flush_stack (void)
{
    unsigned int i;

    if (stack_top == 0)
        return;
    printf ("           *** STACK HOLDS %u ITEMS ****", stack_top);
    for (i = 0; i < stack_top; i++)
    {
        if (i % 10 == 0)
            printf ("\n            ");
        printf (" %c", stack [i]);
    }
    printf ("\n");
}


char *ext_ref (unsigned int xref, procinfo *proc)
{
    static char s [256];
    unsigned int p = xref - proc->xref_parms;
    unsigned int g = xref - proc->xref_globals;

    if (p < 2 * proc->n_parms && p % 2 == 0)
    {
        p = p / 2 + 1;
        sprintf (s, "parameter %u (%s)", p,
                 type_code (peekb (proc->parm_table + proc->n_parms - p)));
    }
    else if (g < 2 * proc->n_globals && g % 2 == 0)
    {
        unsigned long t = proc->global_table;

        for ( ; g != 0; g -= 2)
            t += peekb (t) + 2;
        sprintf (s, "global %s", peeks (t));
    }
    else
        sprintf (s, "external %u", xref);
    return s;
}


void push (char c)
{
    if (stack_top == STACK_SIZE)
        printf ("           *** STACK OVERFLOW PUSHING %c\n", c);
    else
        stack [stack_top++] = c;
}


void pop (char c)
{
    if (stack_top == 0)
        printf ("           *** STACK UNDERFLOW POPPING %c\n", c);
    else if (stack [--stack_top] != c && c != ANY)
        printf ("           *** STACK MISMATCH POPPING %c\n", c);
}


unsigned int peekb (unsigned long offset)
{
    return code [offset];
}


unsigned int peekw (unsigned long offset)
{
    return code [offset] + (code [offset + 1] << 8);
}


long peekws (unsigned long offset)
{
    long w = peekw (offset);

    return w >= 0x8000 ? w - 0x10000 : w;
}


unsigned long peekl (unsigned long offset)
{
    unsigned long v = 0;
    unsigned int i;

    for (i = 0; i < 4; i++)
        v += code [offset + i] << 8 * i;
    return v;
}


char *peeks (unsigned long offset)
{
    static char s [256];

    s [0] = '"';
    memcpy (s + 1, code + offset + 1, 255);
    strcpy (s + code [offset] + 1, "\"");
    return s;
}


char *type_code (unsigned int t)
{
    static char s [100];

    strcpy (s, (t & 0x7F) == 0 ? "W%" : (t & 0x7F) == 1 ? "L&" :
               (t & 0x7F) == 2 ? "Re" : (t & 0x7F) == 3 ? "S$" : "Unkn");
    if (t & 0x80)
        strcat (s, "()");
    return s;
}