/* ------------------------------------------------------------------------- */
/*   "files" : File handling for source code, the transcript file and the    */
/*             debugging information file; file handling and splicing of     */
/*             the output file.                                              */
/*                                                                           */
/*             Note that filenaming conventions are left to the top-level    */
/*             routines in "inform.c", since they are tied up with ICL       */
/*             settings and are very host OS-dependent.                      */
/*                                                                           */
/*   Part of Inform 6.41                                                     */
/*   copyright (c) Graham Nelson 1993 - 2022                                 */
/*                                                                           */
/* ------------------------------------------------------------------------- */

#include "header.h"

int total_files;                        /* Number of files so far, including 
                                           #include and #origsource files    */
int total_input_files;                  /* Number of source files so far
                                           (excludes #origsource)            */
int current_input_file;                 /* Most recently-opened source file  */
static int current_origsource_file;     /* Most recently-used #origsource    */

int32 total_chars_read;                 /* Characters read in (from all
                                           source files put together)        */

static int checksum_low_byte,           /* For calculating the Z-machine's   */
           checksum_high_byte;          /* "verify" checksum                 */

static int32 checksum_long;             /* For the Glulx checksum,           */
static int checksum_count;              /* similarly                         */

/* ------------------------------------------------------------------------- */
/*   Most of the information about source files is kept by "lexer.c"; this   */
/*   level is only concerned with file names and handles.                    */
/* ------------------------------------------------------------------------- */

FileId *InputFiles=NULL;                /*  Ids for all the source files
                                            Allocated to total_files         */
static memory_list InputFiles_memlist;

/* ------------------------------------------------------------------------- */
/*   When emitting debug information, we won't have addresses of routines,   */
/*   sequence points, Glulx objects (addresses of Z-machine objects aren't   */
/*   needed), globals, arrays, or grammar lines.  We only have their         */
/*   offsets from base addresses, which won't be known until the end of      */
/*   compilation.  Since everything else in the relevant debug records is    */
/*   known much earlier and is less convenient to store up, we emit the      */
/*   debug records with a placeholder value and then backpatch these         */
/*   placeholders.  The following structs each store either an offset or a   */
/*   symbol index and the point in the debug information file where the      */
/*   corresponding address should be written once the base address is known. */
/* ------------------------------------------------------------------------- */

#define INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION 65536

typedef struct value_and_backpatch_position_struct
{   int32 value;
    fpos_t backpatch_position;
} value_and_backpatch_position;

typedef struct debug_backpatch_accumulator_struct
{   int32 number_of_values_to_backpatch;
    int32 number_of_available_backpatches;
    value_and_backpatch_position *values_and_backpatch_positions;
    int32 (* backpatching_function)(int32);
} debug_backpatch_accumulator;

static debug_backpatch_accumulator object_backpatch_accumulator;
static debug_backpatch_accumulator packed_code_backpatch_accumulator;
static debug_backpatch_accumulator code_backpatch_accumulator;
static debug_backpatch_accumulator global_backpatch_accumulator;
static debug_backpatch_accumulator array_backpatch_accumulator;
static debug_backpatch_accumulator grammar_backpatch_accumulator;

/* ------------------------------------------------------------------------- */
/*   Opening and closing source code files                                   */
/* ------------------------------------------------------------------------- */

#if defined(PC_WIN32) && defined(HAS_REALPATH)
#include <windows.h>
char *realpath(const char *path, char *resolved_path)
{
  return GetFullPathNameA(path,PATHLEN,resolved_path,NULL) != 0 ? resolved_path : 0;
}
#endif

extern void load_sourcefile(char *filename_given, int same_directory_flag)
{
    /*  Meaning: open a new file of Inform source.  (The lexer picks up on
        this by noticing that input_file has increased.)                     */

    char name[PATHLEN];
#ifdef HAS_REALPATH
    char absolute_name[PATHLEN];
#endif
    int x = 0;
    FILE *handle;

    ensure_memory_list_available(&InputFiles_memlist, total_files+1);

    do
    {   x = translate_in_filename(x, name, filename_given, same_directory_flag,
                (total_files==0)?1:0);
        handle = fopen(name,"r");
    } while ((handle == NULL) && (x != 0));

    InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
    strcpy(InputFiles[total_files].filename, name);

    if (debugfile_switch)
    {   debug_file_printf("<source index=\"%d\">", total_files);
        debug_file_printf("<given-path>");
        debug_file_print_with_entities(filename_given);
        debug_file_printf("</given-path>");
#ifdef HAS_REALPATH
        if (realpath(name, absolute_name))
        {   debug_file_printf("<resolved-path>");
            debug_file_print_with_entities(absolute_name);
            debug_file_printf("</resolved-path>");
        }
#endif
        debug_file_printf("<language>Inform 6</language>");
        debug_file_printf("</source>");
    }

    InputFiles[total_files].handle = handle;
    if (InputFiles[total_files].handle==NULL)
        fatalerror_named("Couldn't open source file", name);

    InputFiles[total_files].is_input = TRUE;
    InputFiles[total_files].initial_buffering = TRUE;

    if (files_trace_setting > 0)
        printf("Opening file \"%s\"\n",name);

    total_files++;
    total_input_files++;
    current_input_file = total_files;
}

static void close_sourcefile(int file_number)
{
    if (InputFiles[file_number-1].handle == NULL) return;

    /*  Close this file. But keep the InputFiles entry around, including
        its filename. */

    if (ferror(InputFiles[file_number-1].handle))
        fatalerror_named("I/O failure: couldn't read from source file",
            InputFiles[file_number-1].filename);

    fclose(InputFiles[file_number-1].handle);

    InputFiles[file_number-1].handle = NULL;

    if (files_trace_setting > 0) {
        char *str = (InputFiles[file_number-1].initial_buffering ? " (in initial buffering)" : "");
        printf("Closing file \"%s\"%s\n", InputFiles[file_number-1].filename, str);
    }
}

extern void close_all_source(void)
{   int i;
    for (i=0; i<total_files; i++) close_sourcefile(i+1);
}

/* ------------------------------------------------------------------------- */
/*   Register an #origsource filename. This goes in the InputFiles table,    */
/*   but we do not open the file or advance current_input_file.              */
/* ------------------------------------------------------------------------- */

extern int register_orig_sourcefile(char *filename)
{
    int ix;
    char *name;

    /* If the filename has already been used as an origsource filename,
       return that entry. We check the most-recently-used file first, and
       then search the list. */
    if (current_origsource_file > 0 && current_origsource_file <= total_files) {
        if (!strcmp(filename, InputFiles[current_origsource_file-1].filename))
            return current_origsource_file;
    }

    for (ix=0; ix<total_files; ix++) {
        if (InputFiles[ix].is_input)
            continue;
        if (!strcmp(filename, InputFiles[ix].filename)) {
            current_origsource_file = ix+1;
            return current_origsource_file;
        }
    }

    /* This filename has never been used before. Allocate a new InputFiles
       entry. */

    name = filename; /* no translation */

    ensure_memory_list_available(&InputFiles_memlist, total_files+1);

    InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
    strcpy(InputFiles[total_files].filename, name);

    if (debugfile_switch)
    {   debug_file_printf("<source index=\"%d\">", total_files);
        debug_file_printf("<given-path>");
        debug_file_print_with_entities(filename);
        debug_file_printf("</given-path>");
        debug_file_printf("<language>Inform 7</language>");
        debug_file_printf("</source>");
    }

    InputFiles[total_files].handle = NULL;
    InputFiles[total_files].is_input = FALSE;
    InputFiles[total_files].initial_buffering = FALSE;

    total_files++;
    current_origsource_file = total_files;
    return current_origsource_file;
}

/* ------------------------------------------------------------------------- */
/*   Feeding source code up into the lexical analyser's buffer               */
/*   (see "lexer.c" for its specification)                                   */
/* ------------------------------------------------------------------------- */

extern int file_load_chars(int file_number, char *buffer, int length)
{
    int read_in; FILE *handle;

    if (file_number-1 > total_files)
    {   buffer[0] = 0; return 1; }

    handle = InputFiles[file_number-1].handle;
    if (handle == NULL)
    {   buffer[0] = 0; return 1; }

    read_in = fread(buffer, 1, length, handle);
    total_chars_read += read_in;

    if (read_in == length) return length;

    close_sourcefile(file_number);

    if (file_number == 1)
    {   buffer[read_in]   = 0;
        buffer[read_in+1] = 0;
        buffer[read_in+2] = 0;
        buffer[read_in+3] = 0;
    }
    else
    {   buffer[read_in]   = '\n';
        buffer[read_in+1] = ' ';
        buffer[read_in+2] = ' ';
        buffer[read_in+3] = ' ';
    }

    return(-(read_in+4));
}

/* ------------------------------------------------------------------------- */
/*   Final assembly and output of the story file.                            */
/* ------------------------------------------------------------------------- */

FILE *sf_handle;

static void sf_put(int c)
{
    if (!glulx_mode) {

      /*  The checksum is the unsigned sum mod 65536 of the bytes in the
          story file from 0x0040 (first byte after header) to the end.       */

      checksum_low_byte += c;
      if (checksum_low_byte>=256)
      {   checksum_low_byte-=256;
          if (++checksum_high_byte==256) checksum_high_byte=0;
      }

    }
    else {

      /*  The checksum is the unsigned 32-bit sum of the entire story file,
          considered as a list of 32-bit words, with the checksum field
          being zero. */

      switch (checksum_count) {
      case 0:
        checksum_long += (((int32)(c & 0xFF)) << 24);
        break;
      case 1:
        checksum_long += (((int32)(c & 0xFF)) << 16);
        break;
      case 2:
        checksum_long += (((int32)(c & 0xFF)) << 8);
        break;
      case 3:
        checksum_long += ((int32)(c & 0xFF));
        break;
      }
      
      checksum_count = (checksum_count+1) & 3;
      
    }

    fputc(c, sf_handle);
}

/* Recursive procedure to generate the Glulx compression table. */

static void output_compression(int entnum, int32 *size, int *count)
{
  huffentity_t *ent = &(huff_entities[entnum]);
  int32 val;
  char *cx;

  sf_put(ent->type);
  (*size)++;
  (*count)++;

  switch (ent->type) {
  case 0:
    val = Write_Strings_At + huff_entities[ent->u.branch[0]].addr;
    sf_put((val >> 24) & 0xFF);
    sf_put((val >> 16) & 0xFF);
    sf_put((val >> 8) & 0xFF);
    sf_put((val) & 0xFF);
    (*size) += 4;
    val = Write_Strings_At + huff_entities[ent->u.branch[1]].addr;
    sf_put((val >> 24) & 0xFF);
    sf_put((val >> 16) & 0xFF);
    sf_put((val >> 8) & 0xFF);
    sf_put((val) & 0xFF);
    (*size) += 4;
    output_compression(ent->u.branch[0], size, count);
    output_compression(ent->u.branch[1], size, count);
    break;
  case 1:
    /* no data */
    break;
  case 2:
    sf_put(ent->u.ch);
    (*size) += 1;
    break;
  case 3:
    cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
    while (*cx) {
      sf_put(*cx);
      cx++;
      (*size) += 1;  
    }
    sf_put('\0');
    (*size) += 1;  
    break;
  case 4:
    val = unicode_usage_entries[ent->u.val].ch;
    sf_put((val >> 24) & 0xFF);
    sf_put((val >> 16) & 0xFF);
    sf_put((val >> 8) & 0xFF);
    sf_put((val) & 0xFF);
    (*size) += 4;
    break;
  case 9:
    val = abbreviations_offset + 4 + ent->u.val*4;
    sf_put((val >> 24) & 0xFF);
    sf_put((val >> 16) & 0xFF);
    sf_put((val >> 8) & 0xFF);
    sf_put((val) & 0xFF);
    (*size) += 4;
    break;
  }
}

static void output_file_z(void)
{   char new_name[PATHLEN];
    int32 length, blanks=0, size, i, j, offset;
    uint32 code_length, size_before_code, next_cons_check;
    int use_function;

    ASSERT_ZCODE();

    /* At this point, construct_storyfile() has just been called. */

    /*  Enter the length information into the header.                        */

    length=((int32) Write_Strings_At) + static_strings_extent;

    while ((length%length_scale_factor)!=0) { length++; blanks++; }
    length=length/length_scale_factor;
    zmachine_paged_memory[26]=(length & 0xff00)/0x100;
    zmachine_paged_memory[27]=(length & 0xff);

    /*  To assist interpreters running a paged virtual memory system, Inform
        writes files which are padded with zeros to the next multiple of
        0.5K.  This calculates the number of bytes of padding needed:        */

    while (((length_scale_factor*length)+blanks-1)%512 != 511) blanks++;

    translate_out_filename(new_name, Code_Name);

    sf_handle = fopen(new_name,"wb");
    if (sf_handle == NULL)
        fatalerror_named("Couldn't open output file", new_name);

#ifdef MAC_MPW
    /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
        Z-code interpreter on the Macintosh  */

    fsetfileinfo(new_name, 'mxZR', 'ZCOD');
#endif

    /*  (1)  Output the paged memory.                                        */

    for (i=0;i<64;i++)
        fputc(zmachine_paged_memory[i], sf_handle);
    size = 64;
    checksum_low_byte = 0;
    checksum_high_byte = 0;

    for (i=64; i<Write_Code_At; i++)
    {   sf_put(zmachine_paged_memory[i]); size++;
    }

    /*  (2)  Output the compiled code area.                                  */

    if (!OMIT_UNUSED_ROUTINES) {
        /* This is the old-fashioned case, which is easy. All of zcode_area
           (zmachine_pc bytes) will be output. next_cons_check will be
           ignored, because j will never reach it. */
        code_length = zmachine_pc;
        use_function = TRUE;
        next_cons_check = code_length+1;
    }
    else {
        /* With dead function stripping, life is more complicated. 
           j will run from 0 to zmachine_pc, but only code_length of
           those should be output. next_cons_check is the location of
           the next function break; that's where we check whether
           we're in a live function or a dead one.
           (This logic is simplified by the assumption that a backpatch
           marker will never straddle a function break.) */
        if (zmachine_pc != df_total_size_before_stripping)
            compiler_error("Code size does not match (zmachine_pc and df_total_size).");
        code_length = df_total_size_after_stripping;
        use_function = TRUE;
        next_cons_check = 0;
        df_prepare_function_iterate();
    }
    size_before_code = size;

    j=0;
    for (i=0; i<zcode_backpatch_size; i=i+3)
    {   int long_flag = TRUE;
        offset
            = 256*zcode_backpatch_table[i+1]
              + zcode_backpatch_table[i+2];
        backpatch_error_flag = FALSE;
        backpatch_marker
            = zcode_backpatch_table[i];
        if (backpatch_marker >= 0x80) long_flag = FALSE;
        backpatch_marker &= 0x7f;
        offset = offset + (backpatch_marker/32)*0x10000;
        while (offset+0x30000 < j) {
            offset += 0x40000;
            long_flag = !long_flag;
        }
        backpatch_marker &= 0x1f;

        /* All code up until the next backpatch marker gets flushed out
           as-is. (Unless we're in a stripped-out function.) */
        while (j<offset) {
            if (!use_function) {
                while (j<offset && j<next_cons_check) {
                    j++;
                }
            }
            else {
                while (j<offset && j<next_cons_check) {
                    size++;
                    sf_put(zcode_area[j]);
                    j++;
                }
            }
            if (j == next_cons_check)
                next_cons_check = df_next_function_iterate(&use_function);
        }

        if (long_flag)
        {   int32 v = zcode_area[j];
            v = 256*v + (zcode_area[j+1]);
            j += 2;
            if (use_function) {
                v = backpatch_value(v);
                sf_put(v/256); sf_put(v%256);
                size += 2;
            }
        }
        else
        {   int32 v = zcode_area[j];
            j++;
            if (use_function) {
                v = backpatch_value(v);
                sf_put(v);
                size++;
            }
        }

        if (j > next_cons_check)
            compiler_error("Backpatch appears to straddle function break");

        if (backpatch_error_flag)
        {   printf("*** %s  zcode offset=%08lx  backpatch offset=%08lx ***\n",
                (long_flag)?"long":"short", (long int) j, (long int) i);
        }
    }

    /* Flush out the last bit of zcode_area, after the last backpatch
       marker. */
    offset = zmachine_pc;
    while (j<offset) {
        if (!use_function) {
            while (j<offset && j<next_cons_check) {
                j++;
            }
        }
        else {
            while (j<offset && j<next_cons_check) {
                size++;
                sf_put(zcode_area[j]);
                j++;
            }
        }
        if (j == next_cons_check)
            next_cons_check = df_next_function_iterate(&use_function);
    }

    if (size_before_code + code_length != size)
        compiler_error("Code output length did not match");

    /*  (3)  Output any null bytes (required to reach a packed address)
             before the strings area.                                        */

    while (size<Write_Strings_At) { sf_put(0); size++; }

    /*  (4)  Output the static strings area.                                 */

    for (i=0; i<static_strings_extent; i++) {
        sf_put(static_strings_area[i]);
        size++;
    }

    /*  (5)  When modules existed, we output link data here.                 */

    /*  (6)  Output null bytes to reach a multiple of 0.5K.                  */

    while (blanks>0) { sf_put(0); blanks--; }

    if (ferror(sf_handle))
        fatalerror("I/O failure: couldn't write to story file");

    fseek(sf_handle, 28, SEEK_SET);
    fputc(checksum_high_byte, sf_handle);
    fputc(checksum_low_byte, sf_handle);

    if (ferror(sf_handle))
      fatalerror("I/O failure: couldn't backtrack on story file for checksum");

    fclose(sf_handle);

    /*  Write a copy of the header into the debugging information file
        (mainly so that it can be used to identify which story file matches
        with which debugging info file).                                     */

    if (debugfile_switch)
    {   debug_file_printf("<story-file-prefix>");
        for (i = 0; i < 63; i += 3)
        {   if (i == 27)
            {   debug_file_print_base_64_triple
                    (zmachine_paged_memory[27],
                     checksum_high_byte,
                     checksum_low_byte);
            } else
            {   debug_file_print_base_64_triple
                    (zmachine_paged_memory[i],
                     zmachine_paged_memory[i + 1],
                     zmachine_paged_memory[i + 2]);
            }
        }
        debug_file_print_base_64_single(zmachine_paged_memory[63]);
        debug_file_printf("</story-file-prefix>");
    }

#ifdef ARCHIMEDES
    {   char settype_command[PATHLEN];
        sprintf(settype_command, "settype %s %s",
            new_name, riscos_file_type());
        system(settype_command);
    }
#endif
#ifdef MAC_FACE
    InformFiletypes (new_name, INF_ZCODE_TYPE);
#endif
}

static void output_file_g(void)
{   char new_name[PATHLEN];
    int32 size, i, j, offset;
    int32 VersionNum;
    uint32 code_length, size_before_code, next_cons_check;
    int use_function;
    int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;

    ASSERT_GLULX();

    /* At this point, construct_storyfile() has just been called. */

    translate_out_filename(new_name, Code_Name);

    sf_handle = fopen(new_name,"wb+");
    if (sf_handle == NULL)
        fatalerror_named("Couldn't open output file", new_name);

#ifdef MAC_MPW
    /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
        Z-code interpreter on the Macintosh  */

    fsetfileinfo(new_name, 'mxZR', 'GLUL');
#endif

    checksum_long = 0;
    checksum_count = 0;

    /* Determine the version number. */

    VersionNum = 0x00020000;

    /* Increase for various features the game may have used. */
    if (no_unicode_chars != 0 || (uses_unicode_features)) {
      VersionNum = 0x00030000;
    }
    if (uses_memheap_features) {
      VersionNum = 0x00030100;
    }
    if (uses_acceleration_features) {
      VersionNum = 0x00030101;
    }
    if (uses_float_features) {
      VersionNum = 0x00030102;
    }
    if (uses_double_features || uses_extundo_features) {
      VersionNum = 0x00030103;
    }

    /* And check if the user has requested a specific version. */
    if (requested_glulx_version) {
      if (requested_glulx_version < VersionNum) {
        static char error_message_buff[256];
        sprintf(error_message_buff, "Version 0x%08lx requested, but \
game features require version 0x%08lx", (long)requested_glulx_version, (long)VersionNum);
        warning(error_message_buff);
      }
      else {
        VersionNum = requested_glulx_version;
      }
    }

    /*  (1)  Output the header. We use sf_put here, instead of fputc,
        because the header is included in the checksum. */

    /* Magic number */
    sf_put('G');
    sf_put('l');
    sf_put('u');
    sf_put('l');
    /* Version number. */
    sf_put((VersionNum >> 24));
    sf_put((VersionNum >> 16));
    sf_put((VersionNum >> 8));
    sf_put((VersionNum));
    /* RAMSTART */
    sf_put((Write_RAM_At >> 24));
    sf_put((Write_RAM_At >> 16));
    sf_put((Write_RAM_At >> 8));
    sf_put((Write_RAM_At));
    /* EXTSTART, or game file size */
    sf_put((Out_Size >> 24));
    sf_put((Out_Size >> 16));
    sf_put((Out_Size >> 8));
    sf_put((Out_Size));
    /* ENDMEM, which the game file size plus MEMORY_MAP_EXTENSION */
    i = Out_Size + MEMORY_MAP_EXTENSION;
    sf_put((i >> 24));
    sf_put((i >> 16));
    sf_put((i >> 8));
    sf_put((i));
    /* STACKSIZE */
    sf_put((MAX_STACK_SIZE >> 24));
    sf_put((MAX_STACK_SIZE >> 16));
    sf_put((MAX_STACK_SIZE >> 8));
    sf_put((MAX_STACK_SIZE));
    /* Initial function to call. Inform sets things up so that this
       is the start of the executable-code area. */
    sf_put((Write_Code_At >> 24));
    sf_put((Write_Code_At >> 16));
    sf_put((Write_Code_At >> 8));
    sf_put((Write_Code_At));
    /* String-encoding table. */
    sf_put((Write_Strings_At >> 24));
    sf_put((Write_Strings_At >> 16));
    sf_put((Write_Strings_At >> 8));
    sf_put((Write_Strings_At));
    /* Checksum -- zero for the moment. */
    sf_put(0x00);
    sf_put(0x00);
    sf_put(0x00);
    sf_put(0x00);
    
    size = GLULX_HEADER_SIZE;

    /*  (1a) Output the eight-byte memory layout identifier. */

    sf_put('I'); sf_put('n'); sf_put('f'); sf_put('o');
    sf_put(0); sf_put(1); sf_put(0); sf_put(0);

    /*  (1b) Output the rest of the Inform-specific data. */

    /* Inform version number */
    sf_put('0' + ((RELEASE_NUMBER/100)%10));
    sf_put('.');
    sf_put('0' + ((RELEASE_NUMBER/10)%10));
    sf_put('0' + RELEASE_NUMBER%10);
    /* Glulx back-end version number */
    sf_put('0' + ((GLULX_RELEASE_NUMBER/100)%10));
    sf_put('.');
    sf_put('0' + ((GLULX_RELEASE_NUMBER/10)%10));
    sf_put('0' + GLULX_RELEASE_NUMBER%10);
    /* Game release number */
    sf_put((release_number>>8) & 0xFF);
    sf_put(release_number & 0xFF);
    /* Game serial number */
    {
      char serialnum[8];
      write_serial_number(serialnum);
      for (i=0; i<6; i++)
        sf_put(serialnum[i]);
    }
    size += GLULX_STATIC_ROM_SIZE;

    /*  (2)  Output the compiled code area. */

    if (!OMIT_UNUSED_ROUTINES) {
        /* This is the old-fashioned case, which is easy. All of zcode_area
           (zmachine_pc bytes) will be output. next_cons_check will be
           ignored, because j will never reach it. */
        code_length = zmachine_pc;
        use_function = TRUE;
        next_cons_check = code_length+1;
    }
    else {
        /* With dead function stripping, life is more complicated. 
           j will run from 0 to zmachine_pc, but only code_length of
           those should be output. next_cons_check is the location of
           the next function break; that's where we check whether
           we're in a live function or a dead one.
           (This logic is simplified by the assumption that a backpatch
           marker will never straddle a function break.) */
        if (zmachine_pc != df_total_size_before_stripping)
            compiler_error("Code size does not match (zmachine_pc and df_total_size).");
        code_length = df_total_size_after_stripping;
        use_function = TRUE;
        next_cons_check = 0;
        df_prepare_function_iterate();
    }
    size_before_code = size;

    j=0;
      for (i=0; i<zcode_backpatch_size; i=i+6) {
        int data_len;
        int32 v;
        offset = 
          (zcode_backpatch_table[i+2] << 24)
          | (zcode_backpatch_table[i+3] << 16)
          | (zcode_backpatch_table[i+4] << 8)
          | (zcode_backpatch_table[i+5]);
        backpatch_error_flag = FALSE;
        backpatch_marker =
          zcode_backpatch_table[i];
        data_len =
          zcode_backpatch_table[i+1];

        /* All code up until the next backpatch marker gets flushed out
           as-is. (Unless we're in a stripped-out function.) */
        while (j<offset) {
            if (!use_function) {
                while (j<offset && j<next_cons_check) {
                    j++;
                }
            }
            else {
                while (j<offset && j<next_cons_check) {
                    size++;
                    sf_put(zcode_area[j]);
                    j++;
                }
            }
            if (j == next_cons_check)
                next_cons_check = df_next_function_iterate(&use_function);
        }

        /* Write out the converted value of the backpatch marker.
           (Unless we're in a stripped-out function.) */
        switch (data_len) {

        case 4:
          v = (zcode_area[j]);
          v = (v << 8) | (zcode_area[j+1]);
          v = (v << 8) | (zcode_area[j+2]);
          v = (v << 8) | (zcode_area[j+3]);
          j += 4;
          if (!use_function)
              break;
          v = backpatch_value(v);
          sf_put((v >> 24) & 0xFF);
          sf_put((v >> 16) & 0xFF);
          sf_put((v >> 8) & 0xFF);
          sf_put((v) & 0xFF);
          size += 4;
          break;

        case 2:
          v = (zcode_area[j]);
          v = (v << 8) | (zcode_area[j+1]);
          j += 2;
          if (!use_function)
              break;
          v = backpatch_value(v);
          if (v >= 0x10000) {
            printf("*** backpatch value does not fit ***\n");
            backpatch_error_flag = TRUE;
          }
          sf_put((v >> 8) & 0xFF);
          sf_put((v) & 0xFF);
          size += 2;
          break;

        case 1:
          v = (zcode_area[j]);
          j += 1;
          if (!use_function)
              break;
          v = backpatch_value(v);
          if (v >= 0x100) {
            printf("*** backpatch value does not fit ***\n");
            backpatch_error_flag = TRUE;
          }
          sf_put((v) & 0xFF);
          size += 1;
          break;

        default:
          printf("*** unknown backpatch data len = %d ***\n",
            data_len);
          backpatch_error_flag = TRUE;
        }

        if (j > next_cons_check)
          compiler_error("Backpatch appears to straddle function break");

        if (backpatch_error_flag) {
          printf("*** %d bytes  zcode offset=%08lx  backpatch offset=%08lx ***\n",
            data_len, (long int) j, (long int) i);
        }
    }

    /* Flush out the last bit of zcode_area, after the last backpatch
       marker. */
    offset = zmachine_pc;
    while (j<offset) {
        if (!use_function) {
            while (j<offset && j<next_cons_check) {
                j++;
            }
        }
        else {
            while (j<offset && j<next_cons_check) {
                size++;
                sf_put(zcode_area[j]);
                j++;
            }
        }
        if (j == next_cons_check)
            next_cons_check = df_next_function_iterate(&use_function);
    }

    if (size_before_code + code_length != size)
        compiler_error("Code output length did not match");

    /*  (4)  Output the static strings area.                                 */

    {
      int32 ix, lx;
      int ch, jx, curbyte, bx;
      int depth, checkcount;
      huffbitlist_t *bits;
      int32 origsize;

      origsize = size;

      if (compression_switch) {

        /* The 12-byte table header. */
        lx = compression_table_size;
        sf_put((lx >> 24) & 0xFF);
        sf_put((lx >> 16) & 0xFF);
        sf_put((lx >> 8) & 0xFF);
        sf_put((lx) & 0xFF);
        size += 4;
        sf_put((no_huff_entities >> 24) & 0xFF);
        sf_put((no_huff_entities >> 16) & 0xFF);
        sf_put((no_huff_entities >> 8) & 0xFF);
        sf_put((no_huff_entities) & 0xFF);
        size += 4;
        lx = Write_Strings_At + 12;
        sf_put((lx >> 24) & 0xFF);
        sf_put((lx >> 16) & 0xFF);
        sf_put((lx >> 8) & 0xFF);
        sf_put((lx) & 0xFF);
        size += 4;

        checkcount = 0;
        output_compression(huff_entity_root, &size, &checkcount);
        if (checkcount != no_huff_entities)
          compiler_error("Compression table count mismatch.");
      }

      if (size - origsize != compression_table_size)
        compiler_error("Compression table size mismatch.");

      origsize = size;

      for (lx=0, ix=0; lx<no_strings; lx++) {
        int escapelen=0, escapetype=0;
        int done=FALSE;
        int32 escapeval=0;
        if (compression_switch)
          sf_put(0xE1); /* type byte -- compressed string */
        else
          sf_put(0xE0); /* type byte -- non-compressed string */
        size++;
        jx = 0; 
        curbyte = 0;
        while (!done) {
          ch = static_strings_area[ix];
          ix++;
          if (ix > static_strings_extent || ch < 0)
            compiler_error("Read too much not-yet-compressed text.");

          if (escapelen == -1) {
            escapelen = 0;
            if (ch == '@') {
              ch = '@';
            }
            else if (ch == '0') {
              ch = '\0';
            }
            else if (ch == 'A' || ch == 'D' || ch == 'U') {
              escapelen = 4;
              escapetype = ch;
              escapeval = 0;
              continue;
            }
            else {
              compiler_error("Strange @ escape in processed text.");
            }
          }
          else if (escapelen) {
            escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
            escapelen--;
            if (escapelen == 0) {
              if (escapetype == 'A') {
                ch = huff_abbrev_start+escapeval;
              }
              else if (escapetype == 'D') {
                ch = huff_dynam_start+escapeval;
              }
              else if (escapetype == 'U') {
                ch = huff_unicode_start+escapeval;
              }
              else {
                compiler_error("Strange @ escape in processed text.");
              }
            }
            else 
              continue;
          }
          else {
            if (ch == '@') {
              escapelen = -1;
              continue;
            }
            if (ch == 0) {
              ch = 256;
              done = TRUE;
            }
          }

          if (compression_switch) {
            bits = &(huff_entities[ch].bits);
            depth = huff_entities[ch].depth;
            for (bx=0; bx<depth; bx++) {
              if (bits->b[bx / 8] & (1 << (bx % 8)))
                curbyte |= (1 << jx);
              jx++;
              if (jx == 8) {
                sf_put(curbyte);
                size++;
                curbyte = 0;
                jx = 0;
              }
            }
          }
          else {
            if (ch >= huff_dynam_start) {
              sf_put(' '); sf_put(' '); sf_put(' ');
              size += 3;
            }
            else if (ch >= huff_abbrev_start) {
              /* nothing */
            }
            else {
              /* 256, the string terminator, comes out as zero */
              sf_put(ch & 0xFF);
              size++;
            }
          }
        }
        if (compression_switch && jx) {
          sf_put(curbyte);
          size++;
        }
      }
      
      if (size - origsize != compression_string_size)
        compiler_error("Compression string size mismatch.");

    }
    
    /*  (5)  Output static arrays (if any). */
    {
        /* We have to backpatch entries mentioned in staticarray_backpatch_table. */
        int32 size_before_arrays = size;
        int32 val, ix, jx;
        for (ix=0, jx=0; ix<staticarray_backpatch_size; ix += 5) {
            backpatch_error_flag = FALSE;
            backpatch_marker = staticarray_backpatch_table[ix];
            /* datalen is always 4 for array backpatching */
            offset = 
                (staticarray_backpatch_table[ix+1] << 24)
                | (staticarray_backpatch_table[ix+2] << 16)
                | (staticarray_backpatch_table[ix+3] << 8)
                | (staticarray_backpatch_table[ix+4]);
            while (jx<offset) {
                sf_put(static_array_area[jx]);
                size++;
                jx++;
            }

            /* Write out the converted value of the backpatch marker. */
            val = static_array_area[jx++];
            val = (val << 8) | static_array_area[jx++];
            val = (val << 8) | static_array_area[jx++];
            val = (val << 8) | static_array_area[jx++];
            val = backpatch_value(val);
            sf_put((val >> 24) & 0xFF);
            sf_put((val >> 16) & 0xFF);
            sf_put((val >> 8) & 0xFF);
            sf_put((val) & 0xFF);
            size += 4;
        }

        /* Flush out the last bit of static_array_area, after the last backpatch marker. */
        offset = static_array_area_size;
        while (jx<offset) {
            sf_put(static_array_area[jx]);
            size++;
            jx++;
        }

        if (size_before_arrays + static_array_area_size != size)
            compiler_error("Static array output length did not match");
    }

    /*  (5.5)  Output any null bytes (required to reach a GPAGESIZE address)
             before RAMSTART. */

    while (size % GPAGESIZE) { sf_put(0); size++; }

    /*  (6)  Output RAM. */

    for (i=0; i<RAM_Size; i++)
    {   sf_put(zmachine_paged_memory[i]); size++;
    }

    if (ferror(sf_handle))
        fatalerror("I/O failure: couldn't write to story file");

    fseek(sf_handle, 32, SEEK_SET);
    fputc((checksum_long >> 24) & 0xFF, sf_handle);
    fputc((checksum_long >> 16) & 0xFF, sf_handle);
    fputc((checksum_long >> 8) & 0xFF, sf_handle);
    fputc((checksum_long) & 0xFF, sf_handle);

    if (ferror(sf_handle))
      fatalerror("I/O failure: couldn't backtrack on story file for checksum");

    /*  Write a copy of the first 64 bytes into the debugging information file
        (mainly so that it can be used to identify which story file matches with
        which debugging info file).  */

    if (debugfile_switch)
    {   fseek(sf_handle, 0L, SEEK_SET);
        debug_file_printf("<story-file-prefix>");
        for (i = 0; i < 63; i += 3)
        {   first_byte_of_triple = fgetc(sf_handle);
            second_byte_of_triple = fgetc(sf_handle);
            third_byte_of_triple = fgetc(sf_handle);
            debug_file_print_base_64_triple
                (first_byte_of_triple,
                 second_byte_of_triple,
                 third_byte_of_triple);
        }
        debug_file_print_base_64_single(fgetc(sf_handle));
        debug_file_printf("</story-file-prefix>");
    }

    fclose(sf_handle);

#ifdef ARCHIMEDES
    {   char settype_command[PATHLEN];
        sprintf(settype_command, "settype %s %s",
            new_name, riscos_file_type());
        system(settype_command);
    }
#endif
#ifdef MAC_FACE
    InformFiletypes (new_name, INF_GLULX_TYPE);
#endif
}

extern void output_file(void)
{
  if (!glulx_mode)
    output_file_z();
  else
    output_file_g();
}

/* ------------------------------------------------------------------------- */
/*   Output the text transcript file (only called if there is to be one).    */
/* ------------------------------------------------------------------------- */

FILE *transcript_file_handle; int transcript_open;

extern void write_to_transcript_file(char *text, int linetype)
{
    if (TRANSCRIPT_FORMAT == 1) {
        char ch = '?';
        switch (linetype) {
            case STRCTX_INFO:
                ch = 'I'; break;
            case STRCTX_GAME:
                ch = 'G'; break;
            case STRCTX_GAMEOPC:
                ch = 'H'; break;
            case STRCTX_VENEER:
                ch = 'V'; break;
            case STRCTX_VENEEROPC:
                ch = 'W'; break;
            case STRCTX_LOWSTRING:
                ch = 'L'; break;
            case STRCTX_ABBREV:
                ch = 'A'; break;
            case STRCTX_DICT:
                ch = 'D'; break;
            case STRCTX_OBJNAME:
                ch = 'O'; break;
            case STRCTX_SYMBOL:
                ch = 'S'; break;
            case STRCTX_INFIX:
                ch = 'X'; break;
        }
        fputc(ch, transcript_file_handle);
        fputs(": ", transcript_file_handle);
    }
    fputs(text, transcript_file_handle);
    fputc('\n', transcript_file_handle);
}

extern void open_transcript_file(char *what_of)
{   char topline_buffer[256];

    transcript_file_handle = fopen(Transcript_Name,"w");
    if (transcript_file_handle==NULL)
        fatalerror_named("Couldn't open transcript file",
        Transcript_Name);

    transcript_open = TRUE;

    sprintf(topline_buffer, "Transcript of the text of \"%s\"", what_of);
    write_to_transcript_file(topline_buffer, STRCTX_INFO);
    sprintf(topline_buffer, "[From %s]", banner_line);
    write_to_transcript_file(topline_buffer, STRCTX_INFO);
    if (TRANSCRIPT_FORMAT == 1) {
        write_to_transcript_file("[I:info, G:game text, V:veneer text, L:lowmem string, A:abbreviation, D:dict word, O:object name, S:symbol, X:infix]", STRCTX_INFO);
        if (!glulx_mode)
            write_to_transcript_file("[H:game text inline in opcode, W:veneer text inline in opcode]", STRCTX_INFO);
    }
    write_to_transcript_file("",  STRCTX_INFO);
}

extern void abort_transcript_file(void)
{   if (transcript_switch && transcript_open)
        fclose(transcript_file_handle);
    transcript_open = FALSE;
}

extern void close_transcript_file(void)
{   char botline_buffer[256];
    char sn_buffer[7];

    write_serial_number(sn_buffer);
    sprintf(botline_buffer, "[End of transcript: release %d, serial %s]",
        release_number, sn_buffer);
    write_to_transcript_file("",  STRCTX_INFO);
    write_to_transcript_file(botline_buffer, STRCTX_INFO);
    write_to_transcript_file("",  STRCTX_INFO);

    if (ferror(transcript_file_handle))
        fatalerror("I/O failure: couldn't write to transcript file");
    fclose(transcript_file_handle);
    transcript_open = FALSE;

#ifdef ARCHIMEDES
    {   char settype_command[PATHLEN];
        sprintf(settype_command, "settype %s text",
            Transcript_Name);
        system(settype_command);
    }
#endif
#ifdef MAC_FACE
    InformFiletypes (Transcript_Name, INF_TEXT_TYPE);
#endif
}

/* ------------------------------------------------------------------------- */
/*   Access to the debugging information file.                               */
/* ------------------------------------------------------------------------- */

static FILE *Debug_fp;                 /* Handle of debugging info file      */

static void open_debug_file(void)
{   Debug_fp=fopen(Debugging_Name,"wb");
    if (Debug_fp==NULL)
       fatalerror_named("Couldn't open debugging information file",
           Debugging_Name);
}

extern void nullify_debug_file_position(maybe_file_position *position) {
    position->valid = 0;
}

static void close_debug_file(void)
{   fclose(Debug_fp);
#ifdef MAC_FACE
    InformFiletypes (Debugging_Name, INF_DEBUG_TYPE);
#endif
}

extern void begin_debug_file(void)
{   open_debug_file();

    debug_file_printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
    debug_file_printf("<inform-story-file version=\"1.0\" ");
    debug_file_printf("content-creator=\"Inform\" ");
    debug_file_printf
        ("content-creator-version=\"%d.%d%d\">",
         (VNUMBER / 100) % 10,
         (VNUMBER / 10) % 10,
         VNUMBER % 10);
}

extern void debug_file_printf(const char*format, ...)
{   va_list argument_pointer;
    va_start(argument_pointer, format);
    vfprintf(Debug_fp, format, argument_pointer);
    va_end(argument_pointer);
    if (ferror(Debug_fp))
    {   fatalerror("I/O failure: can't write to debugging information file");
    }
}

extern void debug_file_print_with_entities(const char*string)
{   int index = 0;
    char character;
    for (character = string[index]; character; character = string[++index])
    {   switch(character)
        {   case '"':
                debug_file_printf("&quot;");
                break;
            case '&':
                debug_file_printf("&amp;");
                break;
            case '\'':
                debug_file_printf("&apos;");
                break;
            case '<':
                debug_file_printf("&lt;");
                break;
            case '>':
                debug_file_printf("&gt;");
                break;
            default:
                debug_file_printf("%c", character);
                break;
        }
    }
}

static char base_64_digits[] =
  { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
    'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 
    'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
    't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9', '+', '/' };

extern void debug_file_print_base_64_triple
    (uchar first, uchar second, uchar third)
{   debug_file_printf
        ("%c%c%c%c",
         base_64_digits[first >> 2],
         base_64_digits[((first & 3) << 4) | (second >> 4)],
         base_64_digits[((second & 15) << 2) | (third >> 6)],
         base_64_digits[third & 63]);
}

extern void debug_file_print_base_64_pair(uchar first, uchar second)
{   debug_file_printf
        ("%c%c%c=",
         base_64_digits[first >> 2],
         base_64_digits[((first & 3) << 4) | (second >> 4)],
         base_64_digits[(second & 15) << 2]);
}

extern void debug_file_print_base_64_single(uchar first)
{   debug_file_printf
        ("%c%c==",
         base_64_digits[first >> 2],
         base_64_digits[(first & 3) << 4]);
}

static void write_debug_location_internals(debug_location location)
{   debug_file_printf("<file-index>%d</file-index>", location.file_index - 1);
    debug_file_printf
        ("<file-position>%d</file-position>", location.beginning_byte_index);
    debug_file_printf
        ("<line>%d</line>", location.beginning_line_number);
    debug_file_printf
        ("<character>%d</character>", location.beginning_character_number);
    if (location.beginning_byte_index != location.end_byte_index ||
        location.beginning_line_number != location.end_line_number ||
        location.beginning_character_number != location.end_character_number)
    {   debug_file_printf
            ("<end-file-position>%d</end-file-position>",
             location.end_byte_index);
        debug_file_printf
            ("<end-line>%d</end-line>", location.end_line_number);
        debug_file_printf
            ("<end-character>%d</end-character>",
             location.end_character_number);
    }
}

static void write_debug_location_origsource_internals(debug_location location)
{   debug_file_printf
        ("<file-index>%d</file-index>", location.orig_file_index - 1);
    if (location.orig_beg_line_number)
        debug_file_printf
            ("<line>%d</line>", location.orig_beg_line_number);
    if (location.orig_beg_char_number)
        debug_file_printf
            ("<character>%d</character>", location.orig_beg_char_number);
}

extern void write_debug_location(debug_location location)
{   if (location.file_index && location.file_index != 255)
    {   debug_file_printf("<source-code-location>");
        write_debug_location_internals(location);
        debug_file_printf("</source-code-location>");
    }
    if (location.orig_file_index)
    {   debug_file_printf("<source-code-location>");
        write_debug_location_origsource_internals(location);
        debug_file_printf("</source-code-location>");
    }
}

extern void write_debug_locations(debug_locations locations)
{   if (locations.next)
    {   const debug_locations*current = &locations;
        unsigned int index = 0;
        for (; current; current = current->next, ++index)
        {   debug_file_printf("<source-code-location index=\"%d\">", index);
            write_debug_location_internals(current->location);
            debug_file_printf("</source-code-location>");
        }
        if (locations.location.orig_file_index)
        {   debug_file_printf("<source-code-location>");
            write_debug_location_origsource_internals(locations.location);
            debug_file_printf("</source-code-location>");
        }
    }
    else
    {   write_debug_location(locations.location);
    }
}

extern void write_debug_optional_identifier(int32 symbol_index)
{   if (symbols[symbol_index].type != ROUTINE_T)
    {   compiler_error
            ("Attempt to write a replaceable identifier for a non-routine");
    }
    if (symbol_debug_info[symbol_index].replacement_backpatch_pos.valid)
    {   if (fsetpos
                (Debug_fp,
                 &symbol_debug_info[symbol_index].replacement_backpatch_pos.position))
        {   fatalerror("I/O failure: can't seek in debugging information file");
        }
        debug_file_printf
            ("<identifier artificial=\"true\">%s "
                 "(superseded replacement)</identifier>",
             symbols[symbol_index].name);
        if (fseek(Debug_fp, 0L, SEEK_END))
        {   fatalerror("I/O failure: can't seek in debugging information file");
        }
    }
    fgetpos
      (Debug_fp, &symbol_debug_info[symbol_index].replacement_backpatch_pos.position);
    symbol_debug_info[symbol_index].replacement_backpatch_pos.valid = TRUE;
    debug_file_printf("<identifier>%s</identifier>", symbols[symbol_index].name);
    /* Space for:       artificial="true" (superseded replacement) */
    debug_file_printf("                                           ");
}

extern void write_debug_symbol_backpatch(int32 symbol_index)
{   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
        compiler_error("Symbol entry incorrectly reused in debug information "
                       "file backpatching");
    }
    fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
    symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
    /* Reserve space for up to 10 digits plus a negative sign. */
    debug_file_printf("*BACKPATCH*");
}

extern void write_debug_symbol_optional_backpatch(int32 symbol_index)
{   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
        compiler_error("Symbol entry incorrectly reused in debug information "
                       "file backpatching");
    }
    /* Reserve space for open and close value tags and up to 10 digits plus a
       negative sign, but take the backpatch position just inside the element,
       so that we'll be in the same case as above if the symbol is eventually
       defined. */
    debug_file_printf("<value>");
    fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
    symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
    debug_file_printf("*BACKPATCH*</value>");
}

static void write_debug_backpatch
    (debug_backpatch_accumulator *accumulator, int32 value)
{   if (accumulator->number_of_values_to_backpatch ==
        accumulator->number_of_available_backpatches)
    {   my_realloc(&accumulator->values_and_backpatch_positions,
                   sizeof(value_and_backpatch_position) *
                       accumulator->number_of_available_backpatches,
                   2 * sizeof(value_and_backpatch_position) *
                       accumulator->number_of_available_backpatches,
                   "values and debug information backpatch positions");
        accumulator->number_of_available_backpatches *= 2;
    }
    accumulator->values_and_backpatch_positions
        [accumulator->number_of_values_to_backpatch].value = value;
    fgetpos
        (Debug_fp,
         &accumulator->values_and_backpatch_positions
             [accumulator->number_of_values_to_backpatch].backpatch_position);
    ++(accumulator->number_of_values_to_backpatch);
    /* Reserve space for up to 10 digits plus a negative sign. */
    debug_file_printf("*BACKPATCH*");
}

extern void write_debug_object_backpatch(int32 object_number)
{   if (glulx_mode)
    {   write_debug_backpatch(&object_backpatch_accumulator, object_number - 1);
    }
    else
    {   debug_file_printf("%d", object_number);
    }
}

static int32 backpatch_object_address(int32 index)
{   return object_tree_offset + OBJECT_BYTE_LENGTH * index;
}

extern void write_debug_packed_code_backpatch(int32 offset)
{   write_debug_backpatch(&packed_code_backpatch_accumulator, offset);
}

static int32 backpatch_packed_code_address(int32 offset)
{
    if (OMIT_UNUSED_ROUTINES) {
        int stripped;
        offset = df_stripped_offset_for_code_offset(offset, &stripped);
        if (stripped)
            return 0;
    }
    return (code_offset + offset) / scale_factor;
}

extern void write_debug_code_backpatch(int32 offset)
{   write_debug_backpatch(&code_backpatch_accumulator, offset);
}

static int32 backpatch_code_address(int32 offset)
{
    if (OMIT_UNUSED_ROUTINES) {
        int stripped;
        offset = df_stripped_offset_for_code_offset(offset, &stripped);
        if (stripped)
            return 0;
    }
    return code_offset + offset;
}

extern void write_debug_global_backpatch(int32 offset)
{   write_debug_backpatch(&global_backpatch_accumulator, offset);
}

static int32 backpatch_global_address(int32 offset)
{   return variables_offset + WORDSIZE * (offset - MAX_LOCAL_VARIABLES);
}

extern void write_debug_array_backpatch(int32 offset)
{   write_debug_backpatch(&array_backpatch_accumulator, offset);
}

static int32 backpatch_array_address(int32 offset)
{   return (glulx_mode ? arrays_offset : variables_offset) + offset;
}

extern void write_debug_grammar_backpatch(int32 offset)
{   write_debug_backpatch(&grammar_backpatch_accumulator, offset);
}

static int32 backpatch_grammar_address(int32 offset)
{   return grammar_table_offset + offset;
}

extern void begin_writing_debug_sections()
{   debug_file_printf("<story-file-section>");
    debug_file_printf("<type>header</type>");
    debug_file_printf("<address>0</address>");
}

extern void write_debug_section(const char*name, int32 beginning_address)
{   debug_file_printf("<end-address>%d</end-address>", beginning_address);
    debug_file_printf("</story-file-section>");
    debug_file_printf("<story-file-section>");
    debug_file_printf("<type>");
    debug_file_print_with_entities(name);
    debug_file_printf("</type>");
    debug_file_printf("<address>%d</address>", beginning_address);
}

extern void end_writing_debug_sections(int32 end_address)
{   debug_file_printf("<end-address>%d</end-address>", end_address);
    debug_file_printf("</story-file-section>");
}

extern void write_debug_undef(int32 symbol_index)
{   if (!symbol_debug_info[symbol_index].backpatch_pos.valid)
    {   compiler_error
            ("Attempt to erase debugging information never written or since "
                "erased");
    }
    if (symbols[symbol_index].type != CONSTANT_T)
    {   compiler_error
            ("Attempt to erase debugging information for a non-constant "
             "because of an #undef");
    }
    if (fsetpos
         (Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position))
    {   fatalerror("I/O failure: can't seek in debugging information file");
    }
    /* There are 7 characters in ``<value>''. */
    if (fseek(Debug_fp, -7L, SEEK_CUR))
    {   fatalerror("I/O failure: can't seek in debugging information file");
    }
    /* Overwrite:      <value>*BACKPATCH*</value> */
    debug_file_printf("                          ");
    nullify_debug_file_position
        (&symbol_debug_info[symbol_index].backpatch_pos);
    if (fseek(Debug_fp, 0L, SEEK_END))
    {   fatalerror("I/O failure: can't seek in debugging information file");
    }
}

static void apply_debug_information_backpatches
    (debug_backpatch_accumulator *accumulator)
{   int32 backpatch_index, backpatch_value;
    for (backpatch_index = accumulator->number_of_values_to_backpatch;
         backpatch_index--;)
    {   if (fsetpos
                (Debug_fp,
                 &accumulator->values_and_backpatch_positions
                     [backpatch_index].backpatch_position))
        {   fatalerror
                ("I/O failure: can't seek in debugging information file");
        }
        backpatch_value =
            (*accumulator->backpatching_function)
                (accumulator->values_and_backpatch_positions
                    [backpatch_index].value);
        debug_file_printf
            ("%11d", /* Space for up to 10 digits plus a negative sign. */
             backpatch_value);
    }
}

static void apply_debug_information_symbol_backpatches()
{   int backpatch_symbol;
    for (backpatch_symbol = no_symbols; backpatch_symbol--;)
    {   if (symbol_debug_info[backpatch_symbol].backpatch_pos.valid)
        {   if (fsetpos(Debug_fp,
                        &symbol_debug_info[backpatch_symbol].backpatch_pos.position))
            {   fatalerror
                    ("I/O failure: can't seek in debugging information file");
            }
            debug_file_printf("%11d", symbols[backpatch_symbol].value);
        }
    }
}

static void write_debug_system_constants()
{   int *system_constant_list =
        glulx_mode ? glulx_system_constant_list : z_system_constant_list;
    int system_constant_index = 0;

    /* Store system constants. */
    for (; system_constant_list[system_constant_index] != -1;
         ++system_constant_index)
    {   int system_constant = system_constant_list[system_constant_index];
        debug_file_printf("<constant>");
        debug_file_printf
            ("<identifier>#%s</identifier>",
             system_constants.keywords[system_constant]);
        debug_file_printf
            ("<value>%d</value>",
             value_of_system_constant(system_constant));
        debug_file_printf("</constant>");
    }
}

extern void end_debug_file()
{   write_debug_system_constants();
    debug_file_printf("</inform-story-file>\n");

    if (glulx_mode)
    {   apply_debug_information_backpatches(&object_backpatch_accumulator);
    } else
    {   apply_debug_information_backpatches(&packed_code_backpatch_accumulator);
    }
    apply_debug_information_backpatches(&code_backpatch_accumulator);
    apply_debug_information_backpatches(&global_backpatch_accumulator);
    apply_debug_information_backpatches(&array_backpatch_accumulator);
    apply_debug_information_backpatches(&grammar_backpatch_accumulator);

    apply_debug_information_symbol_backpatches();

    close_debug_file();
}

/* ========================================================================= */
/*   Data structure management routines                                      */
/* ------------------------------------------------------------------------- */

extern void init_files_vars(void)
{   malloced_bytes = 0;
    checksum_low_byte = 0; /* Z-code */
    checksum_high_byte = 0;
    checksum_long = 0; /* Glulx */
    checksum_count = 0;
    transcript_open = FALSE;
}

extern void files_begin_prepass(void)
{   
    total_files = 0;
    total_input_files = 0;
    current_input_file = 0;
    current_origsource_file = 0;
}

extern void files_begin_pass(void)
{   total_chars_read=0;
}

static void initialise_accumulator
    (debug_backpatch_accumulator *accumulator,
     int32 (* backpatching_function)(int32))
{   accumulator->number_of_values_to_backpatch = 0;
    accumulator->number_of_available_backpatches =
        INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION;
    accumulator->values_and_backpatch_positions =
        my_malloc
            (sizeof(value_and_backpatch_position) *
                 accumulator->number_of_available_backpatches,
             "values and debug information backpatch positions");
    accumulator->backpatching_function = backpatching_function;
}

extern void files_allocate_arrays(void)
{
    initialise_memory_list(&InputFiles_memlist,
        sizeof(FileId), 16, (void**)&InputFiles,
        "input file storage");
    if (debugfile_switch)
    {   if (glulx_mode)
        {   initialise_accumulator
                (&object_backpatch_accumulator, &backpatch_object_address);
        } else
        {   initialise_accumulator
                (&packed_code_backpatch_accumulator,
                 &backpatch_packed_code_address);
        }
        initialise_accumulator
            (&code_backpatch_accumulator, &backpatch_code_address);
        initialise_accumulator
            (&global_backpatch_accumulator, &backpatch_global_address);
        initialise_accumulator
            (&array_backpatch_accumulator, &backpatch_array_address);
        initialise_accumulator
            (&grammar_backpatch_accumulator, &backpatch_grammar_address);
    }
}

static void tear_down_accumulator(debug_backpatch_accumulator *accumulator)
{   my_free
        (&(accumulator->values_and_backpatch_positions),
         "values and debug information backpatch positions");
}

extern void files_free_arrays(void)
{
    int ix;
    for (ix=0; ix<total_files; ix++)
    {
        my_free(&InputFiles[ix].filename, "filename storage");
    }
    deallocate_memory_list(&InputFiles_memlist);
    
    if (debugfile_switch)
    {   if (!glulx_mode)
        {   tear_down_accumulator(&object_backpatch_accumulator);
        } else
        {   tear_down_accumulator(&packed_code_backpatch_accumulator);
        }
        tear_down_accumulator(&code_backpatch_accumulator);
        tear_down_accumulator(&global_backpatch_accumulator);
        tear_down_accumulator(&array_backpatch_accumulator);
        tear_down_accumulator(&grammar_backpatch_accumulator);
    }
}

/* ========================================================================= */