Array zmem_copy -> MEM_MAX_SIZE;
Array zstack_copy --> STACK_SIZE;

Global quetzal_len;
Global restore_pc;
Global restore_fp;
Global restore_sp;

/* unimplemented, for now */
Global read_auth;
Global read_anno;
Global read_copyright;
Global read_intd;


[init_quetzal;
    /* for the moment, we will ignore a number of chunks */
    read_auth = read_anno = read_copyright = read_intd = read_unknown;
];

[read_quetzal orig_file save_file orig_in in pos done_ifhd done_mem done_stks
    done_intd orig_len a b c d;

    /* get the file streams */
    in = glk($0042, save_file, $02, 0); 
    orig_in = glk($0042, orig_file, $02, 0);
    
    /* get the length of the orig file */
    glk($0045, orig_in, 0, 2);
    orig_len = glk($0046, orig_in);
    glk($0045, orig_in, 0, 0);

    /* is_queztal will read the FORM header and return the position of
     the stream, or -1 to indicate the the file is not a valid
     quetzal file */
    pos = is_quetzal(in);
    
    /* not a quetzal file, or it is corrupt */
    if (pos < 0)
        return -1;

    while (pos < quetzal_len + 8)
    {
        a = glk($0090, in);
        b = glk($0090, in);
        c = glk($0090, in);
        d = glk($0090, in);
        pos = pos + 4;

        if (a == 'A' && b == 'U' && c == 'T' && d == 'H')
        {
            pos = read_auth(in, pos);
        }
        else if (a == '(' && b == 'c' && c == ')' && d == ' ')
        {
            pos = read_copyright(in, pos);
        }
        else if (a == 'A' && b == 'N' && c == 'N' && d == 'O')
        {
            pos = read_anno(in, pos);
        }
        else if (a == 'I' && b == 'F' && c == 'h' && d == 'd')
        {
            if (done_ifhd)
                return -1;
            
            pos = read_ifhd(in, pos);
            done_ifhd = true;
        }
        else if (a == 'C' && b == 'M' && c == 'e' && d == 'm')
        {
            if (done_mem || (~~ done_ifhd))
                return -1;
            
            pos = read_cmem(in, pos, orig_in);
            done_mem = true;
        }
        else if (a == 'U' && b == 'M' && c == 'e' && d == 'm')
        {
            if (done_mem || (~~ done_ifhd))
                return -1;
            
            pos = read_umem(in, pos, orig_in);
            done_mem = true;
        }
        else if (a == 'I' && b == 'n' && c == 't' && d == 'D')
        {
            if (done_intd)
                return -1;

            pos = read_intd(in, pos);
            done_intd = true;
        }
        else if (a == 'S' && b == 't' && c == 'k' && d == 's')
        {
            pos = read_stks(in, pos);
            done_stks = true;
        }
        else
        {
            pos = read_unknown(in, pos);
        }

        
        if (pos < 0)
            return -1;

        /* if a chunk is odd, it is followed by a zero byte */
        if (pos % 2 ~= 0)
        {
            glk($0090, in);
            pos = pos + 1;
        }
    }

    /* close the streams */
    glk($0044, in, 0);
    glk($0044, orig_in, 0);

    return 1;
];

[read_unknown in pos len;
    len = read32(in);
    pos = pos + 4;

    if (len < 0)
        return -1;

    glk($0045, in, len, 1);
    return pos + len;
];

[get_dyn_mem_size orig_in a b;
    glk($0045, orig_in, $0e, 0);
    a = glk($0090, orig_in);
    b = glk($0090, orig_in);
    @shiftl a 8 a;
    return a | b;    
];

[read_stks in pos len limit a b c opc ofp do_store store_var num_args
    num_locals eval_size is_dummy;

    is_dummy = true;
    
    len = read32(in);
    pos = pos + 4;

    if (len < 0)
        return -1;

    restore_sp = 0;
    ofp = 0;
    limit = pos + len;

    while (pos < limit)
    {
        /* read a frame */

        /* first the old pc */
        a = glk($0090, in);
        b = glk($0090, in);
        c = glk($0090, in);        
        pos = pos + 3;

        @shiftl a 16 a;
        @shiftl b 8 b;
        opc = a | b | c;

        /* next, the "flags" */
        a = glk($0090, in);
        pos = pos + 1;
        do_store = ((a & $$00010000) ~= $$00010000);
        num_locals = a & $$00001111;

        /* next the store variable */
        store_var = glk($0090, in);
        pos = pos + 1;
        
        /* next, the supplied args
         as far as I can tell, there is no way to supply arguments
         to a Z-Machine function, except *in order* */
        a = glk($0090, in);
        pos = pos + 1;

        switch (a)
        {
         $$01111111: num_args = 7;
         $$00111111: num_args = 6;
         $$00011111: num_args = 5;
         $$00001111: num_args = 4;
         $$00000111: num_args = 3;
         $$00000011: num_args = 2;
         $$00000001: num_args = 1;
         $$00000000: num_args = 0;
        }

        /* next, the size of the eval stack */
        a = glk($0090, in);
        b = glk($0090, in);
        pos = pos + 2;

        @shiftl a 8 a;
        eval_size = a | b;

        /* okay, now we should actually set up the "negative" part of
         the stack frame *if* this is not the dummy */
        if (~~ is_dummy)
        {
            zstack_copy-->restore_sp++ = ofp;
            zstack_copy-->restore_sp++ = opc;
            if (~~ do_store)
                zstack_copy-->restore_sp++ = -1;
            else
                zstack_copy-->restore_sp++ = store_var;
            zstack_copy-->restore_sp++ = num_args;
            zstack_copy-->restore_sp++ = num_locals;
            
            ofp = restore_sp;
        }
        else
        {
            is_dummy = false;
        }
        
        
        /* now the locals */
        for (c = 0 : c < num_locals : c++)
        {
            a = glk($0090, in);
            b = glk($0090, in);
            pos = pos + 2;
            
            @shiftl a 8 a;
            zstack_copy-->restore_sp++ = a | b;
        }

        /* now the eval stack */
        for (c = 0 : c < eval_size : c++)
        {
            a = glk($0090, in);
            b = glk($0090, in);
            pos = pos + 2;
            
            @shiftl a 8 a;
            zstack_copy-->restore_sp++ = a | b;
        }
    }
    restore_fp = ofp;
    
    return pos;
];


[read_umem in pos orig_in dyn_mem_size len;
    len = read32(in);
    pos = pos + 4;
    
    if (len < 0)
        return -1;

    /* find the size of dynamic memory */
    dyn_mem_size = get_dyn_mem_size(orig_in);
    
    if (dyn_mem_size ~= len)
        return -1;
    
    /* copy dyn_mem_size bytes from in into zmem_copy */
    glk($0092, in, zmem_copy, dyn_mem_size);
    pos = pos + dyn_mem_size;

    /* copy the rest of the bytes from orig_in */
    glk($0045, orig_in, dyn_mem_size, 0);
    glk($0092, orig_in, zmem_copy + dyn_mem_size, MEM_MAX_SIZE);

    return pos + len;
];
    
    
[read_cmem in pos orig_in len dyn_mem_size a b j loc xor limit;
    len = read32(in);
    pos = pos + 4;

    if (len < 0)
        return -1;

    /* find the size of dynamic memory */
    dyn_mem_size = get_dyn_mem_size(orig_in);
    
    /* reset orig_in */
    glk($0045, orig_in, 0, 0);
    
    loc = 0;
    limit = pos + len;
    
    while (pos < limit)
    {
        a = glk($0090, in);
        pos = pos + 1;
        
        if (a == 0)
        {
            zmem_copy->loc++ = glk($0090, orig_in);
            b = glk($0090, in);
            pos = pos + 1;
            
            for (j = 0 : j < b : j++)
                zmem_copy->loc++ = glk($0090, orig_in);
        }
        else
        {
            b = glk($0090, orig_in);
            @bitxor a b xor;
            zmem_copy->loc++ = xor;
        }
    }

    while (loc < dyn_mem_size)
    {
        b = glk($0090, orig_in);
        zmem_copy->loc++ = b;
    }

    /* copy the rest of the bytes from orig_in */
    glk($0045, orig_in, dyn_mem_size, 0);
    glk($0092, orig_in, zmem_copy + dyn_mem_size, MEM_MAX_SIZE);

    return pos;
];
            

[read_ifhd in pos len a b c d e f;
    /* len has to be 13 */
    len = read32(in);
    pos = pos + 4;
    
    if (len ~= 13)
        return -1;

    /* release number */
    a = glk($0090, in);
    b = glk($0090, in);
    pos = pos + 2;
    
    if (a ~= zmem->$02 || b ~= zmem->$03)
        return -2;

    /* serial number */
    a = glk($0090, in);
    b = glk($0090, in);
    c = glk($0090, in);
    d = glk($0090, in);
    e = glk($0090, in);
    f = glk($0090, in);
    pos = pos + 6;
    
    if (a ~= zmem->$12 || b ~= zmem->$13 || c ~= zmem->$14 ||
        d ~= zmem->$15 || e ~= zmem->$16 || f ~= zmem->$17)
        return -2;

    /* checksum */
    a = glk($0090, in);
    b = glk($0090, in);
    pos = pos + 2;
    
    if (a ~= zmem->$1c || b ~= zmem->$1d)
        return -2;

    /* restore pc */
    a = glk($0090, in);
    b = glk($0090, in);
    c = glk($0090, in);
    pos = pos + 3;
    
    @shiftl a 16 a;
    @shiftl b 8 b;
    restore_pc = (a | b | c);

    return pos;
];

    
[read32 in a b c d;
    a = glk($0090, in);
    b = glk($0090, in);
    c = glk($0090, in);
    d = glk($0090, in);

    @shiftl a 24 a;
    @shiftl b 16 b;
    @shiftl c 8 c;

    return (a | b | c | d);
];

    
[is_quetzal in a b c d len;
    a = glk($0090, in);
    b = glk($0090, in);
    c = glk($0090, in);
    d = glk($0090, in);

    if (a == 'F' && b == 'O' && c == 'R' && d == 'M')
    {
        len = read32(in);
        if (len > 0)
        {
            quetzal_len = len;
            
            a = glk($0090, in);
            b = glk($0090, in);
            c = glk($0090, in);
            d = glk($0090, in);

            if (a == 'I' && b == 'F' && c == 'Z' && d == 'S')
                return 12;
        }
    }
    return -1;
];


[write_quetzal save_file out size datasize a b c;

    /* we will write the info out to zmem_copy before writing it to a file */
    size = 0;
    zmem_copy->size++ = 'F';
    zmem_copy->size++ = 'O';
    zmem_copy->size++ = 'R';
    zmem_copy->size++ = 'M';
    /* skip the data len; fill it in at the end */
    size = size + 4;
    zmem_copy->size++ = 'I';
    zmem_copy->size++ = 'F';
    zmem_copy->size++ = 'Z';
    zmem_copy->size++ = 'S';

    size = write_ifhd(size);
    /* add zero byte, since size of ifhd is always odd (13) */
    zmem_copy->size++ = 0;
    size = write_cmem(size);
    if (size % 2 ~= 0)
        zmem_copy->size++ = 0;
    size = write_stks(size);
    if (size % 2 ~= 0)
        zmem_copy->size++ = 0;

    /* fill in the size */
    datasize = size - 8;
    @ushiftr datasize 24 a;
    @ushiftr datasize 16 b;
    @ushiftr datasize 8 c;
    zmem_copy->4 = a & $ff;
    zmem_copy->5 = b & $ff;
    zmem_copy->6 = c & $ff;
    zmem_copy->7 = datasize & $ff;

    /* save out the file, then close the stream and file reference */
    save_file = glk($0062, fileusage_BinaryMode, filemode_Write, 0);
    if (save_file == 0)
        return -1;
    
    out = glk($0042, save_file, filemode_Write, 0);
    glk($0085, out, zmem_copy, size);
    glk($0044, out, 0);
    glk($0063, save_file);
    return 1;
];

[write_ifhd size a b;
    zmem_copy->size++ = 'I';
    zmem_copy->size++ = 'F';
    zmem_copy->size++ = 'h';
    zmem_copy->size++ = 'd';

 /*    !! size is 13 always */
    zmem_copy->size++ = 0;
    zmem_copy->size++ = 0;
    zmem_copy->size++ = 0;
    zmem_copy->size++ = $0d;

/*     !! release number */
    zmem_copy->size++ = zmem->$02;
    zmem_copy->size++ = zmem->$03;

/*     !! serial number */
    zmem_copy->size++ = zmem->$12;
    zmem_copy->size++ = zmem->$13;
    zmem_copy->size++ = zmem->$14;
    zmem_copy->size++ = zmem->$15;
    zmem_copy->size++ = zmem->$16;
    zmem_copy->size++ = zmem->$17;

/*     !! checksum */
    zmem_copy->size++ = zmem->$1c;
    zmem_copy->size++ = zmem->$1d;

/*     !! initial pc */
    @ushiftr pc 16 a;
    @ushiftr pc 8 b;

    zmem_copy->size++ = a & $ff;
    zmem_copy->size++ = b & $ff;
    zmem_copy->size++ = pc & $ff;

    return size;
];

[write_cmem size orig_file in dyn_mem_size i a b c xor mark runlen startsize;

    zmem_copy->size++ = 'C';
    zmem_copy->size++ = 'M';
    zmem_copy->size++ = 'e';
    zmem_copy->size++ = 'm';
    size = size + 4;
    startsize = size;
    
    orig_file = ZMachine.ref;
    in = glk($0042, orig_file, $02, 0); 
    dyn_mem_size = get_dyn_mem_size(in);
    
/*     !! reset in */
    glk($0045, in, 0, 0);

    mark = 0;
    i = 0;
    while (i < dyn_mem_size)
    {
        a = glk($0090, in);
        b = zmem->i;
        
        if (a ~= b)
        {
            @bitxor a b xor;
            runlen = i - mark;

            while (runlen > 256)
            {
                zmem_copy->size++ = 0;
                zmem_copy->size++ = $ff;
                runlen = runlen - 256;
            }
            if (runlen > 0)
            {
                zmem_copy->size++ = 0;
                zmem_copy->size++ = (runlen - 1);
            }
            
            zmem_copy->size++ = xor;
            mark = i + 1;
        }
        i++;
    }
/*     !! we don't have to worry about a run that extends to the end of */
/*     !! dynamic memory, as per the spec */

    mark = size - startsize;
    @ushiftr mark 24 a;
    @ushiftr mark 16 b;
    @ushiftr mark 8 c;
    zmem_copy->(startsize - 4) = a & $ff;
    zmem_copy->(startsize - 3) = b & $ff;
    zmem_copy->(startsize - 2) = c & $ff;
    zmem_copy->(startsize - 1) = mark & $ff;
   
    return size;
];

[get_next_fp ofp cfp;
    if (fp == ofp)
        return -1;

    cfp = fp;
    while (zstack-->(cfp - 5) ~= ofp)
        cfp = zstack-->(cfp - 5);

    return cfp;
];


[write_stks size startsize cfp pfp i a b c csp num_locals eval_size alocal;
    zmem_copy->size++ = 'S';
    zmem_copy->size++ = 't';
    zmem_copy->size++ = 'k';
    zmem_copy->size++ = 's';
    size = size + 4;

    startsize = size;

/*     !! write the dummy frame */
/*     !! the dummy return pc */
    zmem_copy->size++ = 0;
    zmem_copy->size++ = 0;
    zmem_copy->size++ = 0;
/*     !! the dummy flags */
    zmem_copy->size++ = 0;
/*     !! dummy var num */
    zmem_copy->size++ = 0;
/*     !! dummy args */
    zmem_copy->size++ = 0;


/*     !! there are no dummy locals, so go for the eval info */
/*     !! first find the bottom of the first frame */
    cfp = get_next_fp(0);
    if (cfp == -1)
    {
        @ushiftr sp 8 a;
        zmem_copy->size++ = a & $ff;
        zmem_copy->size++ = sp & $ff;
        
        for (i = 0 : i < sp : i++)
        {
            a = zstack-->i;
            @ushiftr a 8 b;
            zmem_copy->size++ = b & $ff;
            zmem_copy->size++ = a & $ff;
        }
    }
    else
    {
        a = cfp - 5;
        if (a < 0)
        {
            zmem_copy->size++ = 0;
            zmem_copy->size++ = 0;
        }
        else
        {
            @ushiftr a 8 b;
            zmem_copy->size++ = b & $ff;
            zmem_copy->size++ = a & $ff;
        }
            
        for (i = 0 : i < a : i++)
        {
            alocal = zstack-->i;
            @ushiftr alocal 8 b;
            zmem_copy->size++ = b & $ff;
            zmem_copy->size++ = alocal & $ff;
        }

/*         !! okay...now that we've done the dummy, do the real stuff in a */
/*         !! loop.  first, locate the first real frame pointer */
        while (cfp >= 0)
        {
            /* !! return pc */
            alocal = zstack-->(cfp - 4);
            @ushiftr alocal 16 a;
            @ushiftr alocal 8 b;
            zmem_copy->size++ = a & $ff;
            zmem_copy->size++ = b & $ff;
            zmem_copy->size++ = alocal & $ff;
            /* !! flags and store var */
            num_locals = zstack-->(cfp - 1);
            if (zstack-->(cfp - 3) >= 0)
            {
                zmem_copy->size++ = num_locals;
                zmem_copy->size++ = zstack-->(cfp - 3);
            }
            else
            {
                zmem_copy->size++ = num_locals | $$00010000;
                zmem_copy->size++ = 0;
            }
            /* !! arg map */
            switch (zstack-->(cfp - 2))
            {
             0: zmem_copy->size++ = $$00000000;
             1: zmem_copy->size++ = $$00000001;
             2: zmem_copy->size++ = $$00000011;
             3: zmem_copy->size++ = $$00000111;
             4: zmem_copy->size++ = $$00001111;
             5: zmem_copy->size++ = $$00011111;
             6: zmem_copy->size++ = $$00111111;
             7: zmem_copy->size++ = $$01111111;
            }
            pfp = get_next_fp(cfp);
            if (pfp == -1)
                csp = sp;
            else
                csp = pfp - 5;

            /* !! eval size */
            eval_size = csp - (cfp + num_locals);
            
            @ushiftr eval_size 8 a;
            zmem_copy->size++ = a & $ff;
            zmem_copy->size++ = eval_size & $ff;
            
            /* !! locals */
            for (i = 0 : i < num_locals : i++)
            {
                alocal = zstack-->(cfp + i);
                @ushiftr alocal 8 a;
                zmem_copy->size++ = a & $ff;
                zmem_copy->size++ = alocal & $ff;
            }

            /* !! eval */
            for (i = cfp + num_locals : i < csp : i++)
            {
                alocal = zstack-->i;
                @ushiftr alocal 8 a;
                zmem_copy->size++ = a & $ff;
                zmem_copy->size++ = alocal & $ff;
            }

            if (pfp == -1)
                cfp = -1;
            else
                cfp = pfp;
        }
    }

    alocal = size - startsize;
    @ushiftr alocal 24 a;
    @ushiftr alocal 16 b;
    @ushiftr alocal 8 c;
    zmem_copy->(startsize - 4) = a & $ff;
    zmem_copy->(startsize - 3) = b & $ff;
    zmem_copy->(startsize - 2) = c & $ff;
    zmem_copy->(startsize - 1) = alocal & $ff;

    return size;
];