src/files.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "files" : File handling for source code, the transcript file and the    */
   3 /*             debugging information file; file handling and splicing of     */
   4 /*             the output file.                                              */
   5 /*                                                                           */
   6 /*             Note that filenaming conventions are left to the top-level    */
   7 /*             routines in "inform.c", since they are tied up with ICL       */
   8 /*             settings and are very host OS-dependent.                      */
   9 /*                                                                           */
  10 /*   Part of Inform 6.42                                                     */
  11 /*   copyright (c) Graham Nelson 1993 - 2024                                 */
  12 /*                                                                           */
  13 /* Inform is free software: you can redistribute it and/or modify            */
  14 /* it under the terms of the GNU General Public License as published by      */
  15 /* the Free Software Foundation, either version 3 of the License, or         */
  16 /* (at your option) any later version.                                       */
  17 /*                                                                           */
  18 /* Inform is distributed in the hope that it will be useful,                 */
  19 /* but WITHOUT ANY WARRANTY; without even the implied warranty of            */
  20 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the              */
  21 /* GNU General Public License for more details.                              */
  22 /*                                                                           */
  23 /* You should have received a copy of the GNU General Public License         */
  24 /* along with Inform. If not, see https://gnu.org/licenses/                  */
  25 /*                                                                           */
  26 /* ------------------------------------------------------------------------- */
  27
  28 #include "header.h"
  29
  30 int total_files;                        /* Number of files so far, including
  31                                            #include and #origsource files    */
  32 int total_input_files;                  /* Number of source files so far
  33                                            (excludes #origsource)            */
  34 int current_input_file;                 /* Most recently-opened source file  */
  35 static int current_origsource_file;     /* Most recently-used #origsource    */
  36
  37 int32 total_chars_read;                 /* Characters read in (from all
  38                                            source files put together)        */
  39
  40 static int checksum_low_byte,           /* For calculating the Z-machine's   */
  41            checksum_high_byte;          /* "verify" checksum                 */
  42
  43 static uint32 checksum_long;             /* For the Glulx checksum,          */
  44 static int checksum_count;              /* similarly                         */
  45
  46 /* ------------------------------------------------------------------------- */
  47 /*   Most of the information about source files is kept by "lexer.c"; this   */
  48 /*   level is only concerned with file names and handles.                    */
  49 /* ------------------------------------------------------------------------- */
  50
  51 FileId *InputFiles=NULL;                /*  Ids for all the source files
  52                                             Allocated to total_files         */
  53 static memory_list InputFiles_memlist;
  54
  55 /* ------------------------------------------------------------------------- */
  56 /*   When emitting debug information, we won't have addresses of routines,   */
  57 /*   sequence points, Glulx objects (addresses of Z-machine objects aren't   */
  58 /*   needed), globals, arrays, or grammar lines.  We only have their         */
  59 /*   offsets from base addresses, which won't be known until the end of      */
  60 /*   compilation.  Since everything else in the relevant debug records is    */
  61 /*   known much earlier and is less convenient to store up, we emit the      */
  62 /*   debug records with a placeholder value and then backpatch these         */
  63 /*   placeholders.  The following structs each store either an offset or a   */
  64 /*   symbol index and the point in the debug information file where the      */
  65 /*   corresponding address should be written once the base address is known. */
  66 /* ------------------------------------------------------------------------- */
  67
  68 #define INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION 65536
  69
  70 typedef struct value_and_backpatch_position_struct
  71 {   int32 value;
  72     fpos_t backpatch_position;
  73 } value_and_backpatch_position;
  74
  75 typedef struct debug_backpatch_accumulator_struct
  76 {   int32 number_of_values_to_backpatch;
  77     int32 number_of_available_backpatches;
  78     value_and_backpatch_position *values_and_backpatch_positions;
  79     int32 (* backpatching_function)(int32);
  80 } debug_backpatch_accumulator;
  81
  82 static debug_backpatch_accumulator object_backpatch_accumulator;
  83 static debug_backpatch_accumulator packed_code_backpatch_accumulator;
  84 static debug_backpatch_accumulator code_backpatch_accumulator;
  85 static debug_backpatch_accumulator global_backpatch_accumulator;
  86 static debug_backpatch_accumulator array_backpatch_accumulator;
  87 static debug_backpatch_accumulator grammar_backpatch_accumulator;
  88
  89 /* ------------------------------------------------------------------------- */
  90 /*   Opening and closing source code files                                   */
  91 /* ------------------------------------------------------------------------- */
  92
  93 #if defined(PC_WIN32) && defined(HAS_REALPATH)
  94 #include <windows.h>
  95 char *realpath(const char *path, char *resolved_path)
  96 {
  97   return GetFullPathNameA(path,PATHLEN,resolved_path,NULL) != 0 ? resolved_path : 0;
  98 }
  99 #endif
 100
 101 extern void load_sourcefile(char *filename_given, int same_directory_flag)
 102 {
 103     /*  Meaning: open a new file of Inform source.  (The lexer picks up on
 104         this by noticing that input_file has increased.)                     */
 105
 106     char name[PATHLEN];
 107 #ifdef HAS_REALPATH
 108     char absolute_name[PATHLEN];
 109 #endif
 110     int x = 0;
 111     FILE *handle;
 112
 113     ensure_memory_list_available(&InputFiles_memlist, total_files+1);
 114
 115     do
 116     {   x = translate_in_filename(x, name, filename_given, same_directory_flag,
 117                 (total_files==0)?1:0);
 118         handle = fopen(name,"rb");
 119     } while ((handle == NULL) && (x != 0));
 120
 121     InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
 122     strcpy(InputFiles[total_files].filename, name);
 123
 124     if (debugfile_switch)
 125     {   debug_file_printf("<source index=\"%d\">", total_files);
 126         debug_file_printf("<given-path>");
 127         debug_file_print_with_entities(filename_given);
 128         debug_file_printf("</given-path>");
 129 #ifdef HAS_REALPATH
 130         if (realpath(name, absolute_name))
 131         {   debug_file_printf("<resolved-path>");
 132             debug_file_print_with_entities(absolute_name);
 133             debug_file_printf("</resolved-path>");
 134         }
 135 #endif
 136         debug_file_printf("<language>Inform 6</language>");
 137         debug_file_printf("</source>");
 138     }
 139
 140     InputFiles[total_files].handle = handle;
 141     if (InputFiles[total_files].handle==NULL)
 142         fatalerror_named("Couldn't open source file", name);
 143
 144     InputFiles[total_files].is_input = TRUE;
 145     InputFiles[total_files].initial_buffering = TRUE;
 146
 147     if (files_trace_setting > 0)
 148         printf("Opening file \"%s\"\n",name);
 149
 150     total_files++;
 151     total_input_files++;
 152     current_input_file = total_files;
 153 }
 154
 155 static void close_sourcefile(int file_number)
 156 {
 157     if (InputFiles[file_number-1].handle == NULL) return;
 158
 159     /*  Close this file. But keep the InputFiles entry around, including
 160         its filename. */
 161
 162     if (ferror(InputFiles[file_number-1].handle))
 163         fatalerror_named("I/O failure: couldn't read from source file",
 164             InputFiles[file_number-1].filename);
 165
 166     fclose(InputFiles[file_number-1].handle);
 167
 168     InputFiles[file_number-1].handle = NULL;
 169
 170     if (files_trace_setting > 0) {
 171         char *str = (InputFiles[file_number-1].initial_buffering ? " (in initial buffering)" : "");
 172         printf("Closing file \"%s\"%s\n", InputFiles[file_number-1].filename, str);
 173     }
 174 }
 175
 176 extern void close_all_source(void)
 177 {   int i;
 178     for (i=0; i<total_files; i++) close_sourcefile(i+1);
 179 }
 180
 181 /* ------------------------------------------------------------------------- */
 182 /*   Register an #origsource filename. This goes in the InputFiles table,    */
 183 /*   but we do not open the file or advance current_input_file.              */
 184 /* ------------------------------------------------------------------------- */
 185
 186 extern int register_orig_sourcefile(char *filename)
 187 {
 188     int ix;
 189     char *name;
 190
 191     /* If the filename has already been used as an origsource filename,
 192        return that entry. We check the most-recently-used file first, and
 193        then search the list. */
 194     if (current_origsource_file > 0 && current_origsource_file <= total_files) {
 195         if (!strcmp(filename, InputFiles[current_origsource_file-1].filename))
 196             return current_origsource_file;
 197     }
 198
 199     for (ix=0; ix<total_files; ix++) {
 200         if (InputFiles[ix].is_input)
 201             continue;
 202         if (!strcmp(filename, InputFiles[ix].filename)) {
 203             current_origsource_file = ix+1;
 204             return current_origsource_file;
 205         }
 206     }
 207
 208     /* This filename has never been used before. Allocate a new InputFiles
 209        entry. */
 210
 211     name = filename; /* no translation */
 212
 213     ensure_memory_list_available(&InputFiles_memlist, total_files+1);
 214
 215     InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
 216     strcpy(InputFiles[total_files].filename, name);
 217
 218     if (debugfile_switch)
 219     {   debug_file_printf("<source index=\"%d\">", total_files);
 220         debug_file_printf("<given-path>");
 221         debug_file_print_with_entities(filename);
 222         debug_file_printf("</given-path>");
 223         debug_file_printf("<language>Inform 7</language>");
 224         debug_file_printf("</source>");
 225     }
 226
 227     InputFiles[total_files].handle = NULL;
 228     InputFiles[total_files].is_input = FALSE;
 229     InputFiles[total_files].initial_buffering = FALSE;
 230
 231     total_files++;
 232     current_origsource_file = total_files;
 233     return current_origsource_file;
 234 }
 235
 236 /* ------------------------------------------------------------------------- */
 237 /*   Feeding source code up into the lexical analyser's buffer               */
 238 /*   (see "lexer.c" for its specification)                                   */
 239 /* ------------------------------------------------------------------------- */
 240
 241 extern int file_load_chars(int file_number, char *buffer, int length)
 242 {
 243     int read_in; FILE *handle;
 244
 245     if (file_number-1 > total_files)
 246     {   buffer[0] = 0; return 1; }
 247
 248     handle = InputFiles[file_number-1].handle;
 249     if (handle == NULL)
 250     {   buffer[0] = 0; return 1; }
 251
 252     read_in = fread(buffer, 1, length, handle);
 253     total_chars_read += read_in;
 254
 255     if (read_in == length) return length;
 256
 257     close_sourcefile(file_number);
 258
 259     if (file_number == 1)
 260     {   buffer[read_in]   = 0;
 261         buffer[read_in+1] = 0;
 262         buffer[read_in+2] = 0;
 263         buffer[read_in+3] = 0;
 264     }
 265     else
 266     {   buffer[read_in]   = '\n';
 267         buffer[read_in+1] = ' ';
 268         buffer[read_in+2] = ' ';
 269         buffer[read_in+3] = ' ';
 270     }
 271
 272     return(-(read_in+4));
 273 }
 274
 275 /* ------------------------------------------------------------------------- */
 276 /*   Final assembly and output of the story file.                            */
 277 /* ------------------------------------------------------------------------- */
 278
 279 FILE *sf_handle;
 280
 281 static void sf_put(int c)
 282 {
 283     if (!glulx_mode) {
 284
 285       /*  The checksum is the unsigned sum mod 65536 of the bytes in the
 286           story file from 0x0040 (first byte after header) to the end.       */
 287
 288       checksum_low_byte += c;
 289       if (checksum_low_byte>=256)
 290       {   checksum_low_byte-=256;
 291           if (++checksum_high_byte==256) checksum_high_byte=0;
 292       }
 293
 294     }
 295     else {
 296
 297       /*  The checksum is the unsigned 32-bit sum of the entire story file,
 298           considered as a list of 32-bit words, with the checksum field
 299           being zero. */
 300
 301       switch (checksum_count) {
 302       case 0:
 303         checksum_long += (((uint32)(c & 0xFF)) << 24);
 304         break;
 305       case 1:
 306         checksum_long += (((uint32)(c & 0xFF)) << 16);
 307         break;
 308       case 2:
 309         checksum_long += (((uint32)(c & 0xFF)) << 8);
 310         break;
 311       case 3:
 312         checksum_long += ((uint32)(c & 0xFF));
 313         break;
 314       }
 315
 316       checksum_count = (checksum_count+1) & 3;
 317
 318     }
 319
 320     fputc(c, sf_handle);
 321 }
 322
 323 /* Recursive procedure to generate the Glulx compression table. */
 324
 325 static void output_compression(int entnum, int32 *size, int *count)
 326 {
 327   huffentity_t *ent = &(huff_entities[entnum]);
 328   int32 val;
 329   char *cx;
 330
 331   sf_put(ent->type);
 332   (*size)++;
 333   (*count)++;
 334
 335   switch (ent->type) {
 336   case 0:
 337     val = Write_Strings_At + huff_entities[ent->u.branch[0]].addr;
 338     sf_put((val >> 24) & 0xFF);
 339     sf_put((val >> 16) & 0xFF);
 340     sf_put((val >> 8) & 0xFF);
 341     sf_put((val) & 0xFF);
 342     (*size) += 4;
 343     val = Write_Strings_At + huff_entities[ent->u.branch[1]].addr;
 344     sf_put((val >> 24) & 0xFF);
 345     sf_put((val >> 16) & 0xFF);
 346     sf_put((val >> 8) & 0xFF);
 347     sf_put((val) & 0xFF);
 348     (*size) += 4;
 349     output_compression(ent->u.branch[0], size, count);
 350     output_compression(ent->u.branch[1], size, count);
 351     break;
 352   case 1:
 353     /* no data */
 354     break;
 355   case 2:
 356     sf_put(ent->u.ch);
 357     (*size) += 1;
 358     break;
 359   case 3:
 360     cx = abbreviation_text(ent->u.val);
 361     while (*cx) {
 362       sf_put(*cx);
 363       cx++;
 364       (*size) += 1;
 365     }
 366     sf_put('\0');
 367     (*size) += 1;
 368     break;
 369   case 4:
 370     val = unicode_usage_entries[ent->u.val].ch;
 371     sf_put((val >> 24) & 0xFF);
 372     sf_put((val >> 16) & 0xFF);
 373     sf_put((val >> 8) & 0xFF);
 374     sf_put((val) & 0xFF);
 375     (*size) += 4;
 376     break;
 377   case 9:
 378     val = abbreviations_offset + 4 + ent->u.val*4;
 379     sf_put((val >> 24) & 0xFF);
 380     sf_put((val >> 16) & 0xFF);
 381     sf_put((val >> 8) & 0xFF);
 382     sf_put((val) & 0xFF);
 383     (*size) += 4;
 384     break;
 385   }
 386 }
 387
 388 static void output_file_z(void)
 389 {   char new_name[PATHLEN];
 390     int32 length, blanks=0, size, i, j, offset;
 391     uint32 code_length, size_before_code, next_cons_check;
 392     int use_function;
 393
 394     ASSERT_ZCODE();
 395
 396     /* At this point, construct_storyfile() has just been called. */
 397
 398     /*  Enter the length information into the header.                        */
 399
 400     length=((int32) Write_Strings_At) + static_strings_extent;
 401
 402     while ((length%length_scale_factor)!=0) { length++; blanks++; }
 403     length=length/length_scale_factor;
 404     zmachine_paged_memory[26]=(length & 0xff00)/0x100;
 405     zmachine_paged_memory[27]=(length & 0xff);
 406
 407     /*  To assist interpreters running a paged virtual memory system, Inform
 408         writes files which are padded with zeros to the next multiple of
 409         0.5K.  This calculates the number of bytes of padding needed:        */
 410
 411     while (((length_scale_factor*length)+blanks-1)%512 != 511) blanks++;
 412
 413     translate_out_filename(new_name, Code_Name);
 414
 415     sf_handle = fopen(new_name,"wb");
 416     if (sf_handle == NULL)
 417         fatalerror_named("Couldn't open output file", new_name);
 418
 419 #ifdef MAC_MPW
 420     /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
 421         Z-code interpreter on the Macintosh  */
 422
 423     fsetfileinfo(new_name, 'mxZR', 'ZCOD');
 424 #endif
 425
 426     /*  (1)  Output the paged memory.                                        */
 427
 428     for (i=0;i<64;i++)
 429         fputc(zmachine_paged_memory[i], sf_handle);
 430     size = 64;
 431     checksum_low_byte = 0;
 432     checksum_high_byte = 0;
 433
 434     for (i=64; i<Write_Code_At; i++)
 435     {   sf_put(zmachine_paged_memory[i]); size++;
 436     }
 437
 438     /*  (2)  Output the compiled code area.                                  */
 439
 440     if (!OMIT_UNUSED_ROUTINES) {
 441         /* This is the old-fashioned case, which is easy. All of zcode_area
 442            (zmachine_pc bytes) will be output. next_cons_check will be
 443            ignored, because j will never reach it. */
 444         code_length = zmachine_pc;
 445         use_function = TRUE;
 446         next_cons_check = code_length+1;
 447     }
 448     else {
 449         /* With dead function stripping, life is more complicated.
 450            j will run from 0 to zmachine_pc, but only code_length of
 451            those should be output. next_cons_check is the location of
 452            the next function break; that's where we check whether
 453            we're in a live function or a dead one.
 454            (This logic is simplified by the assumption that a backpatch
 455            marker will never straddle a function break.) */
 456         if (zmachine_pc != df_total_size_before_stripping)
 457             compiler_error("Code size does not match (zmachine_pc and df_total_size).");
 458         code_length = df_total_size_after_stripping;
 459         use_function = TRUE;
 460         next_cons_check = 0;
 461         df_prepare_function_iterate();
 462     }
 463     size_before_code = size;
 464
 465     j=0;
 466     for (i=0; i<zcode_backpatch_size; i=i+3)
 467     {   int long_flag = TRUE;
 468         offset
 469             = 256*zcode_backpatch_table[i+1]
 470               + zcode_backpatch_table[i+2];
 471         backpatch_error_flag = FALSE;
 472         backpatch_marker
 473             = zcode_backpatch_table[i];
 474         if (backpatch_marker >= 0x80) long_flag = FALSE;
 475         backpatch_marker &= 0x7f;
 476         offset = offset + (backpatch_marker/32)*0x10000;
 477         while (offset+0x30000 < j) {
 478             offset += 0x40000;
 479             long_flag = !long_flag;
 480         }
 481         backpatch_marker &= 0x1f;
 482
 483         /* All code up until the next backpatch marker gets flushed out
 484            as-is. (Unless we're in a stripped-out function.) */
 485         while (j<offset) {
 486             if (!use_function) {
 487                 while (j<offset && j<next_cons_check) {
 488                     j++;
 489                 }
 490             }
 491             else {
 492                 while (j<offset && j<next_cons_check) {
 493                     size++;
 494                     sf_put(zcode_area[j]);
 495                     j++;
 496                 }
 497             }
 498             if (j == next_cons_check)
 499                 next_cons_check = df_next_function_iterate(&use_function);
 500         }
 501
 502         if (long_flag)
 503         {   int32 v = zcode_area[j];
 504             v = 256*v + (zcode_area[j+1]);
 505             j += 2;
 506             if (use_function) {
 507                 v = backpatch_value(v);
 508                 sf_put(v/256); sf_put(v%256);
 509                 size += 2;
 510             }
 511         }
 512         else
 513         {   int32 v = zcode_area[j];
 514             j++;
 515             if (use_function) {
 516                 v = backpatch_value(v);
 517                 sf_put(v);
 518                 size++;
 519             }
 520         }
 521
 522         if (j > next_cons_check)
 523             compiler_error("Backpatch appears to straddle function break");
 524
 525         if (backpatch_error_flag)
 526         {   printf("*** %s  zcode offset=%08lx  backpatch offset=%08lx ***\n",
 527                 (long_flag)?"long":"short", (long int) j, (long int) i);
 528         }
 529     }
 530
 531     /* Flush out the last bit of zcode_area, after the last backpatch
 532        marker. */
 533     offset = zmachine_pc;
 534     while (j<offset) {
 535         if (!use_function) {
 536             while (j<offset && j<next_cons_check) {
 537                 j++;
 538             }
 539         }
 540         else {
 541             while (j<offset && j<next_cons_check) {
 542                 size++;
 543                 sf_put(zcode_area[j]);
 544                 j++;
 545             }
 546         }
 547         if (j == next_cons_check)
 548             next_cons_check = df_next_function_iterate(&use_function);
 549     }
 550
 551     if (size_before_code + code_length != size)
 552         compiler_error("Code output length did not match");
 553
 554     /*  (3)  Output any null bytes (required to reach a packed address)
 555              before the strings area.                                        */
 556
 557     while (size<Write_Strings_At) { sf_put(0); size++; }
 558
 559     /*  (4)  Output the static strings area.                                 */
 560
 561     for (i=0; i<static_strings_extent; i++) {
 562         sf_put(static_strings_area[i]);
 563         size++;
 564     }
 565
 566     /*  (5)  When modules existed, we output link data here.                 */
 567
 568     /*  (6)  Output null bytes to reach a multiple of 0.5K.                  */
 569
 570     while (blanks>0) { sf_put(0); blanks--; }
 571
 572     if (ferror(sf_handle))
 573         fatalerror("I/O failure: couldn't write to story file");
 574
 575     fseek(sf_handle, 28, SEEK_SET);
 576     fputc(checksum_high_byte, sf_handle);
 577     fputc(checksum_low_byte, sf_handle);
 578
 579     if (ferror(sf_handle))
 580       fatalerror("I/O failure: couldn't backtrack on story file for checksum");
 581
 582     fclose(sf_handle);
 583
 584     /*  Write a copy of the header into the debugging information file
 585         (mainly so that it can be used to identify which story file matches
 586         with which debugging info file).                                     */
 587
 588     if (debugfile_switch)
 589     {   debug_file_printf("<story-file-prefix>");
 590         for (i = 0; i < 63; i += 3)
 591         {   if (i == 27)
 592             {   debug_file_print_base_64_triple
 593                     (zmachine_paged_memory[27],
 594                      checksum_high_byte,
 595                      checksum_low_byte);
 596             } else
 597             {   debug_file_print_base_64_triple
 598                     (zmachine_paged_memory[i],
 599                      zmachine_paged_memory[i + 1],
 600                      zmachine_paged_memory[i + 2]);
 601             }
 602         }
 603         debug_file_print_base_64_single(zmachine_paged_memory[63]);
 604         debug_file_printf("</story-file-prefix>");
 605     }
 606
 607 #ifdef ARCHIMEDES
 608     {   char settype_command[PATHLEN];
 609         sprintf(settype_command, "settype %s %s",
 610             new_name, riscos_file_type());
 611         system(settype_command);
 612     }
 613 #endif
 614 #ifdef MAC_FACE
 615     InformFiletypes (new_name, INF_ZCODE_TYPE);
 616 #endif
 617 }
 618
 619 static void output_file_g(void)
 620 {   char new_name[PATHLEN];
 621     int32 size, i, j, offset;
 622     uint32 code_length, size_before_code, next_cons_check;
 623     int use_function;
 624     int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;
 625
 626     ASSERT_GLULX();
 627
 628     /* At this point, construct_storyfile() has just been called. */
 629
 630     translate_out_filename(new_name, Code_Name);
 631
 632     sf_handle = fopen(new_name,"wb+");
 633     if (sf_handle == NULL)
 634         fatalerror_named("Couldn't open output file", new_name);
 635
 636 #ifdef MAC_MPW
 637     /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
 638         Z-code interpreter on the Macintosh  */
 639
 640     fsetfileinfo(new_name, 'mxZR', 'GLUL');
 641 #endif
 642
 643     checksum_long = 0;
 644     checksum_count = 0;
 645
 646     /* Determine the version number. */
 647
 648     final_glulx_version = 0x00020000;
 649
 650     /* Increase for various features the game may have used. */
 651     if (no_unicode_chars != 0 || (uses_unicode_features)) {
 652       final_glulx_version = 0x00030000;
 653     }
 654     if (uses_memheap_features) {
 655       final_glulx_version = 0x00030100;
 656     }
 657     if (uses_acceleration_features) {
 658       final_glulx_version = 0x00030101;
 659     }
 660     if (uses_float_features) {
 661       final_glulx_version = 0x00030102;
 662     }
 663     if (uses_double_features || uses_extundo_features) {
 664       final_glulx_version = 0x00030103;
 665     }
 666
 667     /* And check if the user has requested a specific version. */
 668     if (requested_glulx_version) {
 669       if (requested_glulx_version < final_glulx_version) {
 670         warning_fmt("Version 0x%08lx requested, but game features require version 0x%08lx",
 671                     (long)requested_glulx_version, (long)final_glulx_version);
 672       }
 673       else {
 674         final_glulx_version = requested_glulx_version;
 675       }
 676     }
 677
 678     /*  (1)  Output the header. We use sf_put here, instead of fputc,
 679         because the header is included in the checksum. */
 680
 681     /* Magic number */
 682     sf_put('G');
 683     sf_put('l');
 684     sf_put('u');
 685     sf_put('l');
 686     /* Version number. */
 687     sf_put((final_glulx_version >> 24));
 688     sf_put((final_glulx_version >> 16));
 689     sf_put((final_glulx_version >> 8));
 690     sf_put((final_glulx_version));
 691     /* RAMSTART */
 692     sf_put((Write_RAM_At >> 24));
 693     sf_put((Write_RAM_At >> 16));
 694     sf_put((Write_RAM_At >> 8));
 695     sf_put((Write_RAM_At));
 696     /* EXTSTART, or game file size */
 697     sf_put((Out_Size >> 24));
 698     sf_put((Out_Size >> 16));
 699     sf_put((Out_Size >> 8));
 700     sf_put((Out_Size));
 701     /* ENDMEM, which the game file size plus MEMORY_MAP_EXTENSION */
 702     i = Out_Size + MEMORY_MAP_EXTENSION;
 703     sf_put((i >> 24));
 704     sf_put((i >> 16));
 705     sf_put((i >> 8));
 706     sf_put((i));
 707     /* STACKSIZE */
 708     sf_put((MAX_STACK_SIZE >> 24));
 709     sf_put((MAX_STACK_SIZE >> 16));
 710     sf_put((MAX_STACK_SIZE >> 8));
 711     sf_put((MAX_STACK_SIZE));
 712     /* Initial function to call. Inform sets things up so that this
 713        is the start of the executable-code area. */
 714     sf_put((Write_Code_At >> 24));
 715     sf_put((Write_Code_At >> 16));
 716     sf_put((Write_Code_At >> 8));
 717     sf_put((Write_Code_At));
 718     /* String-encoding table. */
 719     sf_put((Write_Strings_At >> 24));
 720     sf_put((Write_Strings_At >> 16));
 721     sf_put((Write_Strings_At >> 8));
 722     sf_put((Write_Strings_At));
 723     /* Checksum -- zero for the moment. */
 724     sf_put(0x00);
 725     sf_put(0x00);
 726     sf_put(0x00);
 727     sf_put(0x00);
 728
 729     size = GLULX_HEADER_SIZE;
 730
 731     /*  (1a) Output the eight-byte memory layout identifier. */
 732
 733     sf_put('I'); sf_put('n'); sf_put('f'); sf_put('o');
 734     sf_put(0); sf_put(1); sf_put(0); sf_put(0);
 735
 736     /*  (1b) Output the rest of the Inform-specific data. */
 737
 738     /* Inform version number */
 739     sf_put('0' + ((RELEASE_NUMBER/100)%10));
 740     sf_put('.');
 741     sf_put('0' + ((RELEASE_NUMBER/10)%10));
 742     sf_put('0' + RELEASE_NUMBER%10);
 743     /* Glulx back-end version number */
 744     sf_put('0' + ((GLULX_RELEASE_NUMBER/100)%10));
 745     sf_put('.');
 746     sf_put('0' + ((GLULX_RELEASE_NUMBER/10)%10));
 747     sf_put('0' + GLULX_RELEASE_NUMBER%10);
 748     /* Game release number */
 749     sf_put((release_number>>8) & 0xFF);
 750     sf_put(release_number & 0xFF);
 751     /* Game serial number */
 752     {
 753       char serialnum[8];
 754       write_serial_number(serialnum);
 755       for (i=0; i<6; i++)
 756         sf_put(serialnum[i]);
 757     }
 758     size += GLULX_STATIC_ROM_SIZE;
 759
 760     /*  (2)  Output the compiled code area. */
 761
 762     if (!OMIT_UNUSED_ROUTINES) {
 763         /* This is the old-fashioned case, which is easy. All of zcode_area
 764            (zmachine_pc bytes) will be output. next_cons_check will be
 765            ignored, because j will never reach it. */
 766         code_length = zmachine_pc;
 767         use_function = TRUE;
 768         next_cons_check = code_length+1;
 769     }
 770     else {
 771         /* With dead function stripping, life is more complicated.
 772            j will run from 0 to zmachine_pc, but only code_length of
 773            those should be output. next_cons_check is the location of
 774            the next function break; that's where we check whether
 775            we're in a live function or a dead one.
 776            (This logic is simplified by the assumption that a backpatch
 777            marker will never straddle a function break.) */
 778         if (zmachine_pc != df_total_size_before_stripping)
 779             compiler_error("Code size does not match (zmachine_pc and df_total_size).");
 780         code_length = df_total_size_after_stripping;
 781         use_function = TRUE;
 782         next_cons_check = 0;
 783         df_prepare_function_iterate();
 784     }
 785     size_before_code = size;
 786
 787     j=0;
 788       for (i=0; i<zcode_backpatch_size; i=i+6) {
 789         int data_len;
 790         int32 v;
 791         offset =
 792           (zcode_backpatch_table[i+2] << 24)
 793           | (zcode_backpatch_table[i+3] << 16)
 794           | (zcode_backpatch_table[i+4] << 8)
 795           | (zcode_backpatch_table[i+5]);
 796         backpatch_error_flag = FALSE;
 797         backpatch_marker =
 798           zcode_backpatch_table[i];
 799         data_len =
 800           zcode_backpatch_table[i+1];
 801
 802         /* All code up until the next backpatch marker gets flushed out
 803            as-is. (Unless we're in a stripped-out function.) */
 804         while (j<offset) {
 805             if (!use_function) {
 806                 while (j<offset && j<next_cons_check) {
 807                     j++;
 808                 }
 809             }
 810             else {
 811                 while (j<offset && j<next_cons_check) {
 812                     size++;
 813                     sf_put(zcode_area[j]);
 814                     j++;
 815                 }
 816             }
 817             if (j == next_cons_check)
 818                 next_cons_check = df_next_function_iterate(&use_function);
 819         }
 820
 821         /* Write out the converted value of the backpatch marker.
 822            (Unless we're in a stripped-out function.) */
 823         switch (data_len) {
 824
 825         case 4:
 826           v = (zcode_area[j]);
 827           v = (v << 8) | (zcode_area[j+1]);
 828           v = (v << 8) | (zcode_area[j+2]);
 829           v = (v << 8) | (zcode_area[j+3]);
 830           j += 4;
 831           if (!use_function)
 832               break;
 833           v = backpatch_value(v);
 834           sf_put((v >> 24) & 0xFF);
 835           sf_put((v >> 16) & 0xFF);
 836           sf_put((v >> 8) & 0xFF);
 837           sf_put((v) & 0xFF);
 838           size += 4;
 839           break;
 840
 841         case 2:
 842           v = (zcode_area[j]);
 843           v = (v << 8) | (zcode_area[j+1]);
 844           j += 2;
 845           if (!use_function)
 846               break;
 847           v = backpatch_value(v);
 848           if (v >= 0x10000) {
 849             printf("*** backpatch value does not fit ***\n");
 850             backpatch_error_flag = TRUE;
 851           }
 852           sf_put((v >> 8) & 0xFF);
 853           sf_put((v) & 0xFF);
 854           size += 2;
 855           break;
 856
 857         case 1:
 858           v = (zcode_area[j]);
 859           j += 1;
 860           if (!use_function)
 861               break;
 862           v = backpatch_value(v);
 863           if (v >= 0x100) {
 864             printf("*** backpatch value does not fit ***\n");
 865             backpatch_error_flag = TRUE;
 866           }
 867           sf_put((v) & 0xFF);
 868           size += 1;
 869           break;
 870
 871         default:
 872           printf("*** unknown backpatch data len = %d ***\n",
 873             data_len);
 874           backpatch_error_flag = TRUE;
 875         }
 876
 877         if (j > next_cons_check)
 878           compiler_error("Backpatch appears to straddle function break");
 879
 880         if (backpatch_error_flag) {
 881           printf("*** %d bytes  zcode offset=%08lx  backpatch offset=%08lx ***\n",
 882             data_len, (long int) j, (long int) i);
 883         }
 884     }
 885
 886     /* Flush out the last bit of zcode_area, after the last backpatch
 887        marker. */
 888     offset = zmachine_pc;
 889     while (j<offset) {
 890         if (!use_function) {
 891             while (j<offset && j<next_cons_check) {
 892                 j++;
 893             }
 894         }
 895         else {
 896             while (j<offset && j<next_cons_check) {
 897                 size++;
 898                 sf_put(zcode_area[j]);
 899                 j++;
 900             }
 901         }
 902         if (j == next_cons_check)
 903             next_cons_check = df_next_function_iterate(&use_function);
 904     }
 905
 906     if (size_before_code + code_length != size)
 907         compiler_error("Code output length did not match");
 908
 909     /*  (4)  Output the static strings area.                                 */
 910
 911     {
 912       int32 ix, lx;
 913       int ch, jx, curbyte, bx;
 914       int depth, checkcount;
 915       huffbitlist_t *bits;
 916       int32 origsize;
 917
 918       origsize = size;
 919
 920       if (compression_switch) {
 921
 922         /* The 12-byte table header. */
 923         lx = compression_table_size;
 924         sf_put((lx >> 24) & 0xFF);
 925         sf_put((lx >> 16) & 0xFF);
 926         sf_put((lx >> 8) & 0xFF);
 927         sf_put((lx) & 0xFF);
 928         size += 4;
 929         sf_put((no_huff_entities >> 24) & 0xFF);
 930         sf_put((no_huff_entities >> 16) & 0xFF);
 931         sf_put((no_huff_entities >> 8) & 0xFF);
 932         sf_put((no_huff_entities) & 0xFF);
 933         size += 4;
 934         lx = Write_Strings_At + 12;
 935         sf_put((lx >> 24) & 0xFF);
 936         sf_put((lx >> 16) & 0xFF);
 937         sf_put((lx >> 8) & 0xFF);
 938         sf_put((lx) & 0xFF);
 939         size += 4;
 940
 941         checkcount = 0;
 942         output_compression(huff_entity_root, &size, &checkcount);
 943         if (checkcount != no_huff_entities)
 944           compiler_error("Compression table count mismatch.");
 945       }
 946
 947       if (size - origsize != compression_table_size)
 948         compiler_error("Compression table size mismatch.");
 949
 950       origsize = size;
 951
 952       for (lx=0, ix=0; lx<no_strings; lx++) {
 953         int escapelen=0, escapetype=0;
 954         int done=FALSE;
 955         int32 escapeval=0;
 956         if (compression_switch)
 957           sf_put(0xE1); /* type byte -- compressed string */
 958         else
 959           sf_put(0xE0); /* type byte -- non-compressed string */
 960         size++;
 961         jx = 0;
 962         curbyte = 0;
 963         while (!done) {
 964           ch = static_strings_area[ix];
 965           ix++;
 966           if (ix > static_strings_extent || ch < 0)
 967             compiler_error("Read too much not-yet-compressed text.");
 968
 969           if (escapelen == -1) {
 970             escapelen = 0;
 971             if (ch == '@') {
 972               ch = '@';
 973             }
 974             else if (ch == '0') {
 975               ch = '\0';
 976             }
 977             else if (ch == 'A' || ch == 'D' || ch == 'U') {
 978               escapelen = 4;
 979               escapetype = ch;
 980               escapeval = 0;
 981               continue;
 982             }
 983             else {
 984               compiler_error("Strange @ escape in processed text.");
 985             }
 986           }
 987           else if (escapelen) {
 988             escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
 989             escapelen--;
 990             if (escapelen == 0) {
 991               if (escapetype == 'A') {
 992                 ch = huff_abbrev_start+escapeval;
 993               }
 994               else if (escapetype == 'D') {
 995                 ch = huff_dynam_start+escapeval;
 996               }
 997               else if (escapetype == 'U') {
 998                 ch = huff_unicode_start+escapeval;
 999               }
1000               else {
1001                 compiler_error("Strange @ escape in processed text.");
1002               }
1003             }
1004             else
1005               continue;
1006           }
1007           else {
1008             if (ch == '@') {
1009               escapelen = -1;
1010               continue;
1011             }
1012             if (ch == 0) {
1013               ch = 256;
1014               done = TRUE;
1015             }
1016           }
1017
1018           if (compression_switch) {
1019             bits = &(huff_entities[ch].bits);
1020             depth = huff_entities[ch].depth;
1021             for (bx=0; bx<depth; bx++) {
1022               if (bits->b[bx / 8] & (1 << (bx % 8)))
1023                 curbyte |= (1 << jx);
1024               jx++;
1025               if (jx == 8) {
1026                 sf_put(curbyte);
1027                 size++;
1028                 curbyte = 0;
1029                 jx = 0;
1030               }
1031             }
1032           }
1033           else {
1034             if (ch >= huff_dynam_start) {
1035               sf_put(' '); sf_put(' '); sf_put(' ');
1036               size += 3;
1037             }
1038             else if (ch >= huff_abbrev_start) {
1039               /* nothing */
1040             }
1041             else {
1042               /* 256, the string terminator, comes out as zero */
1043               sf_put(ch & 0xFF);
1044               size++;
1045             }
1046           }
1047         }
1048         if (compression_switch && jx) {
1049           sf_put(curbyte);
1050           size++;
1051         }
1052       }
1053
1054       if (size - origsize != compression_string_size)
1055         compiler_error("Compression string size mismatch.");
1056
1057     }
1058
1059     /*  (5)  Output static arrays (if any). */
1060     {
1061         /* We have to backpatch entries mentioned in staticarray_backpatch_table. */
1062         int32 size_before_arrays = size;
1063         int32 val, ix, jx;
1064         for (ix=0, jx=0; ix<staticarray_backpatch_size; ix += 5) {
1065             backpatch_error_flag = FALSE;
1066             backpatch_marker = staticarray_backpatch_table[ix];
1067             /* datalen is always 4 for array backpatching */
1068             offset =
1069                 (staticarray_backpatch_table[ix+1] << 24)
1070                 | (staticarray_backpatch_table[ix+2] << 16)
1071                 | (staticarray_backpatch_table[ix+3] << 8)
1072                 | (staticarray_backpatch_table[ix+4]);
1073             while (jx<offset) {
1074                 sf_put(static_array_area[jx]);
1075                 size++;
1076                 jx++;
1077             }
1078
1079             /* Write out the converted value of the backpatch marker. */
1080             val = static_array_area[jx++];
1081             val = (val << 8) | static_array_area[jx++];
1082             val = (val << 8) | static_array_area[jx++];
1083             val = (val << 8) | static_array_area[jx++];
1084             val = backpatch_value(val);
1085             sf_put((val >> 24) & 0xFF);
1086             sf_put((val >> 16) & 0xFF);
1087             sf_put((val >> 8) & 0xFF);
1088             sf_put((val) & 0xFF);
1089             size += 4;
1090         }
1091
1092         /* Flush out the last bit of static_array_area, after the last backpatch marker. */
1093         offset = static_array_area_size;
1094         while (jx<offset) {
1095             sf_put(static_array_area[jx]);
1096             size++;
1097             jx++;
1098         }
1099
1100         if (size_before_arrays + static_array_area_size != size)
1101             compiler_error("Static array output length did not match");
1102     }
1103
1104     /*  (5.5)  Output any null bytes (required to reach a GPAGESIZE address)
1105              before RAMSTART. */
1106
1107     while (size % GPAGESIZE) { sf_put(0); size++; }
1108
1109     /*  (6)  Output RAM. */
1110
1111     for (i=0; i<RAM_Size; i++)
1112     {   sf_put(zmachine_paged_memory[i]); size++;
1113     }
1114
1115     if (ferror(sf_handle))
1116         fatalerror("I/O failure: couldn't write to story file");
1117
1118     fseek(sf_handle, 32, SEEK_SET);
1119     fputc((checksum_long >> 24) & 0xFF, sf_handle);
1120     fputc((checksum_long >> 16) & 0xFF, sf_handle);
1121     fputc((checksum_long >> 8) & 0xFF, sf_handle);
1122     fputc((checksum_long) & 0xFF, sf_handle);
1123
1124     if (ferror(sf_handle))
1125       fatalerror("I/O failure: couldn't backtrack on story file for checksum");
1126
1127     /*  Write a copy of the first 64 bytes into the debugging information file
1128         (mainly so that it can be used to identify which story file matches with
1129         which debugging info file).  */
1130
1131     if (debugfile_switch)
1132     {   fseek(sf_handle, 0L, SEEK_SET);
1133         debug_file_printf("<story-file-prefix>");
1134         for (i = 0; i < 63; i += 3)
1135         {   first_byte_of_triple = fgetc(sf_handle);
1136             second_byte_of_triple = fgetc(sf_handle);
1137             third_byte_of_triple = fgetc(sf_handle);
1138             debug_file_print_base_64_triple
1139                 (first_byte_of_triple,
1140                  second_byte_of_triple,
1141                  third_byte_of_triple);
1142         }
1143         debug_file_print_base_64_single(fgetc(sf_handle));
1144         debug_file_printf("</story-file-prefix>");
1145     }
1146
1147     fclose(sf_handle);
1148
1149 #ifdef ARCHIMEDES
1150     {   char settype_command[PATHLEN];
1151         sprintf(settype_command, "settype %s %s",
1152             new_name, riscos_file_type());
1153         system(settype_command);
1154     }
1155 #endif
1156 #ifdef MAC_FACE
1157     InformFiletypes (new_name, INF_GLULX_TYPE);
1158 #endif
1159 }
1160
1161 extern void output_file(void)
1162 {
1163   if (!glulx_mode)
1164     output_file_z();
1165   else
1166     output_file_g();
1167 }
1168
1169 /* ------------------------------------------------------------------------- */
1170 /*   Output the text transcript file (only called if there is to be one).    */
1171 /* ------------------------------------------------------------------------- */
1172
1173 FILE *transcript_file_handle; int transcript_open;
1174
1175 extern void write_to_transcript_file(char *text, int linetype)
1176 {
1177     if (TRANSCRIPT_FORMAT == 1) {
1178         char ch = '?';
1179         switch (linetype) {
1180             case STRCTX_INFO:
1181                 ch = 'I'; break;
1182             case STRCTX_GAME:
1183                 ch = 'G'; break;
1184             case STRCTX_GAMEOPC:
1185                 ch = 'H'; break;
1186             case STRCTX_VENEER:
1187                 ch = 'V'; break;
1188             case STRCTX_VENEEROPC:
1189                 ch = 'W'; break;
1190             case STRCTX_LOWSTRING:
1191                 ch = 'L'; break;
1192             case STRCTX_ABBREV:
1193                 ch = 'A'; break;
1194             case STRCTX_DICT:
1195                 ch = 'D'; break;
1196             case STRCTX_OBJNAME:
1197                 ch = 'O'; break;
1198             case STRCTX_SYMBOL:
1199                 ch = 'S'; break;
1200             case STRCTX_INFIX:
1201                 ch = 'X'; break;
1202         }
1203         fputc(ch, transcript_file_handle);
1204         fputs(": ", transcript_file_handle);
1205     }
1206     fputs(text, transcript_file_handle);
1207     fputc('\n', transcript_file_handle);
1208 }
1209
1210 extern void open_transcript_file(char *what_of)
1211 {   char topline_buffer[256];
1212
1213     transcript_file_handle = fopen(Transcript_Name,"w");
1214     if (transcript_file_handle==NULL)
1215         fatalerror_named("Couldn't open transcript file",
1216         Transcript_Name);
1217
1218     transcript_open = TRUE;
1219
1220     snprintf(topline_buffer, 256, "Transcript of the text of \"%s\"", what_of);
1221     write_to_transcript_file(topline_buffer, STRCTX_INFO);
1222     snprintf(topline_buffer, 256, "[From %s]", banner_line);
1223     write_to_transcript_file(topline_buffer, STRCTX_INFO);
1224     if (TRANSCRIPT_FORMAT == 1) {
1225         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);
1226         if (!glulx_mode)
1227             write_to_transcript_file("[H:game text inline in opcode, W:veneer text inline in opcode]", STRCTX_INFO);
1228     }
1229     write_to_transcript_file("",  STRCTX_INFO);
1230 }
1231
1232 extern void abort_transcript_file(void)
1233 {   if (transcript_switch && transcript_open)
1234         fclose(transcript_file_handle);
1235     transcript_open = FALSE;
1236 }
1237
1238 extern void close_transcript_file(void)
1239 {   char botline_buffer[256];
1240     char sn_buffer[7];
1241
1242     write_to_transcript_file("",  STRCTX_INFO);
1243
1244     if (!glulx_mode) {
1245         snprintf(botline_buffer, 256, "[Compiled Z-machine version %d]", version_number);
1246     }
1247     else {
1248         int32 major = (final_glulx_version >> 16) & 0xFFFF;
1249         int32 minor = (final_glulx_version >> 8) & 0xFF;
1250         int32 patch = final_glulx_version & 0xFF;
1251         snprintf(botline_buffer, 256, "[Compiled Glulx version %d.%d.%d]", major, minor, patch);
1252     }
1253     write_to_transcript_file(botline_buffer, STRCTX_INFO);
1254
1255     write_serial_number(sn_buffer);
1256     snprintf(botline_buffer, 256, "[End of transcript: release %d, serial %s]",
1257         release_number, sn_buffer);
1258     write_to_transcript_file(botline_buffer, STRCTX_INFO);
1259     write_to_transcript_file("",  STRCTX_INFO);
1260
1261     if (ferror(transcript_file_handle))
1262         fatalerror("I/O failure: couldn't write to transcript file");
1263     fclose(transcript_file_handle);
1264     transcript_open = FALSE;
1265
1266 #ifdef ARCHIMEDES
1267     {   char settype_command[PATHLEN];
1268         sprintf(settype_command, "settype %s text",
1269             Transcript_Name);
1270         system(settype_command);
1271     }
1272 #endif
1273 #ifdef MAC_FACE
1274     InformFiletypes (Transcript_Name, INF_TEXT_TYPE);
1275 #endif
1276 }
1277
1278 /* ------------------------------------------------------------------------- */
1279 /*   Access to the debugging information file.                               */
1280 /* ------------------------------------------------------------------------- */
1281
1282 static FILE *Debug_fp;                 /* Handle of debugging info file      */
1283
1284 static void open_debug_file(void)
1285 {   Debug_fp=fopen(Debugging_Name,"wb");
1286     if (Debug_fp==NULL)
1287        fatalerror_named("Couldn't open debugging information file",
1288            Debugging_Name);
1289 }
1290
1291 extern void nullify_debug_file_position(maybe_file_position *position) {
1292     position->valid = 0;
1293 }
1294
1295 static void close_debug_file(void)
1296 {   fclose(Debug_fp);
1297 #ifdef MAC_FACE
1298     InformFiletypes (Debugging_Name, INF_DEBUG_TYPE);
1299 #endif
1300 }
1301
1302 extern void begin_debug_file(void)
1303 {   open_debug_file();
1304
1305     debug_file_printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
1306     debug_file_printf("<inform-story-file version=\"1.0\" ");
1307     debug_file_printf("content-creator=\"Inform\" ");
1308     debug_file_printf
1309         ("content-creator-version=\"%d.%d%d\">",
1310          (VNUMBER / 100) % 10,
1311          (VNUMBER / 10) % 10,
1312          VNUMBER % 10);
1313 }
1314
1315 extern void debug_file_printf(const char*format, ...)
1316 {   va_list argument_pointer;
1317     va_start(argument_pointer, format);
1318     vfprintf(Debug_fp, format, argument_pointer);
1319     va_end(argument_pointer);
1320     if (ferror(Debug_fp))
1321     {   fatalerror("I/O failure: can't write to debugging information file");
1322     }
1323 }
1324
1325 extern void debug_file_print_with_entities(const char*string)
1326 {   int index = 0;
1327     char character;
1328     for (character = string[index]; character; character = string[++index])
1329     {   switch(character)
1330         {   case '"':
1331                 debug_file_printf("&quot;");
1332                 break;
1333             case '&':
1334                 debug_file_printf("&amp;");
1335                 break;
1336             case '\'':
1337                 debug_file_printf("&apos;");
1338                 break;
1339             case '<':
1340                 debug_file_printf("&lt;");
1341                 break;
1342             case '>':
1343                 debug_file_printf("&gt;");
1344                 break;
1345             default:
1346                 debug_file_printf("%c", character);
1347                 break;
1348         }
1349     }
1350 }
1351
1352 static char base_64_digits[] =
1353   { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
1354     'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',
1355     'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
1356     't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
1357     '8', '9', '+', '/' };
1358
1359 extern void debug_file_print_base_64_triple
1360     (uchar first, uchar second, uchar third)
1361 {   debug_file_printf
1362         ("%c%c%c%c",
1363          base_64_digits[first >> 2],
1364          base_64_digits[((first & 3) << 4) | (second >> 4)],
1365          base_64_digits[((second & 15) << 2) | (third >> 6)],
1366          base_64_digits[third & 63]);
1367 }
1368
1369 extern void debug_file_print_base_64_pair(uchar first, uchar second)
1370 {   debug_file_printf
1371         ("%c%c%c=",
1372          base_64_digits[first >> 2],
1373          base_64_digits[((first & 3) << 4) | (second >> 4)],
1374          base_64_digits[(second & 15) << 2]);
1375 }
1376
1377 extern void debug_file_print_base_64_single(uchar first)
1378 {   debug_file_printf
1379         ("%c%c==",
1380          base_64_digits[first >> 2],
1381          base_64_digits[(first & 3) << 4]);
1382 }
1383
1384 static void write_debug_location_internals(debug_location location)
1385 {   debug_file_printf("<file-index>%d</file-index>", location.file_index - 1);
1386     debug_file_printf
1387         ("<file-position>%d</file-position>", location.beginning_byte_index);
1388     debug_file_printf
1389         ("<line>%d</line>", location.beginning_line_number);
1390     debug_file_printf
1391         ("<character>%d</character>", location.beginning_character_number);
1392     if (location.beginning_byte_index != location.end_byte_index ||
1393         location.beginning_line_number != location.end_line_number ||
1394         location.beginning_character_number != location.end_character_number)
1395     {   debug_file_printf
1396             ("<end-file-position>%d</end-file-position>",
1397              location.end_byte_index);
1398         debug_file_printf
1399             ("<end-line>%d</end-line>", location.end_line_number);
1400         debug_file_printf
1401             ("<end-character>%d</end-character>",
1402              location.end_character_number);
1403     }
1404 }
1405
1406 static void write_debug_location_origsource_internals(debug_location location)
1407 {   debug_file_printf
1408         ("<file-index>%d</file-index>", location.orig_file_index - 1);
1409     if (location.orig_beg_line_number)
1410         debug_file_printf
1411             ("<line>%d</line>", location.orig_beg_line_number);
1412     if (location.orig_beg_char_number)
1413         debug_file_printf
1414             ("<character>%d</character>", location.orig_beg_char_number);
1415 }
1416
1417 extern void write_debug_location(debug_location location)
1418 {   if (location.file_index && location.file_index != 255)
1419     {   debug_file_printf("<source-code-location>");
1420         write_debug_location_internals(location);
1421         debug_file_printf("</source-code-location>");
1422     }
1423     if (location.orig_file_index)
1424     {   debug_file_printf("<source-code-location>");
1425         write_debug_location_origsource_internals(location);
1426         debug_file_printf("</source-code-location>");
1427     }
1428 }
1429
1430 extern void write_debug_locations(debug_locations locations)
1431 {   if (locations.next)
1432     {   const debug_locations*current = &locations;
1433         unsigned int index = 0;
1434         for (; current; current = current->next, ++index)
1435         {   debug_file_printf("<source-code-location index=\"%d\">", index);
1436             write_debug_location_internals(current->location);
1437             debug_file_printf("</source-code-location>");
1438         }
1439         if (locations.location.orig_file_index)
1440         {   debug_file_printf("<source-code-location>");
1441             write_debug_location_origsource_internals(locations.location);
1442             debug_file_printf("</source-code-location>");
1443         }
1444     }
1445     else
1446     {   write_debug_location(locations.location);
1447     }
1448 }
1449
1450 extern void write_debug_optional_identifier(int32 symbol_index)
1451 {   if (symbols[symbol_index].type != ROUTINE_T)
1452     {   compiler_error
1453             ("Attempt to write a replaceable identifier for a non-routine");
1454     }
1455     if (symbol_debug_info[symbol_index].replacement_backpatch_pos.valid)
1456     {   if (fsetpos
1457                 (Debug_fp,
1458                  &symbol_debug_info[symbol_index].replacement_backpatch_pos.position))
1459         {   fatalerror("I/O failure: can't seek in debugging information file");
1460         }
1461         debug_file_printf
1462             ("<identifier artificial=\"true\">%s "
1463                  "(superseded replacement)</identifier>",
1464              symbols[symbol_index].name);
1465         if (fseek(Debug_fp, 0L, SEEK_END))
1466         {   fatalerror("I/O failure: can't seek in debugging information file");
1467         }
1468     }
1469     fgetpos
1470       (Debug_fp, &symbol_debug_info[symbol_index].replacement_backpatch_pos.position);
1471     symbol_debug_info[symbol_index].replacement_backpatch_pos.valid = TRUE;
1472     debug_file_printf("<identifier>%s</identifier>", symbols[symbol_index].name);
1473     /* Space for:       artificial="true" (superseded replacement) */
1474     debug_file_printf("                                           ");
1475 }
1476
1477 extern void write_debug_symbol_backpatch(int32 symbol_index)
1478 {   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
1479         compiler_error("Symbol entry incorrectly reused in debug information "
1480                        "file backpatching");
1481     }
1482     fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
1483     symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
1484     /* Reserve space for up to 10 digits plus a negative sign. */
1485     debug_file_printf("*BACKPATCH*");
1486 }
1487
1488 extern void write_debug_symbol_optional_backpatch(int32 symbol_index)
1489 {   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
1490         compiler_error("Symbol entry incorrectly reused in debug information "
1491                        "file backpatching");
1492     }
1493     /* Reserve space for open and close value tags and up to 10 digits plus a
1494        negative sign, but take the backpatch position just inside the element,
1495        so that we'll be in the same case as above if the symbol is eventually
1496        defined. */
1497     debug_file_printf("<value>");
1498     fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
1499     symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
1500     debug_file_printf("*BACKPATCH*</value>");
1501 }
1502
1503 static void write_debug_backpatch
1504     (debug_backpatch_accumulator *accumulator, int32 value)
1505 {   if (accumulator->number_of_values_to_backpatch ==
1506         accumulator->number_of_available_backpatches)
1507     {   my_realloc(&accumulator->values_and_backpatch_positions,
1508                    sizeof(value_and_backpatch_position) *
1509                        accumulator->number_of_available_backpatches,
1510                    2 * sizeof(value_and_backpatch_position) *
1511                        accumulator->number_of_available_backpatches,
1512                    "values and debug information backpatch positions");
1513         accumulator->number_of_available_backpatches *= 2;
1514     }
1515     accumulator->values_and_backpatch_positions
1516         [accumulator->number_of_values_to_backpatch].value = value;
1517     fgetpos
1518         (Debug_fp,
1519          &accumulator->values_and_backpatch_positions
1520              [accumulator->number_of_values_to_backpatch].backpatch_position);
1521     ++(accumulator->number_of_values_to_backpatch);
1522     /* Reserve space for up to 10 digits plus a negative sign. */
1523     debug_file_printf("*BACKPATCH*");
1524 }
1525
1526 extern void write_debug_object_backpatch(int32 object_number)
1527 {   if (glulx_mode)
1528     {   write_debug_backpatch(&object_backpatch_accumulator, object_number - 1);
1529     }
1530     else
1531     {   debug_file_printf("%d", object_number);
1532     }
1533 }
1534
1535 static int32 backpatch_object_address(int32 index)
1536 {   return object_tree_offset + OBJECT_BYTE_LENGTH * index;
1537 }
1538
1539 extern void write_debug_packed_code_backpatch(int32 offset)
1540 {   write_debug_backpatch(&packed_code_backpatch_accumulator, offset);
1541 }
1542
1543 static int32 backpatch_packed_code_address(int32 offset)
1544 {
1545     if (OMIT_UNUSED_ROUTINES) {
1546         int stripped;
1547         offset = df_stripped_offset_for_code_offset(offset, &stripped);
1548         if (stripped)
1549             return 0;
1550     }
1551     return (code_offset + offset) / scale_factor;
1552 }
1553
1554 extern void write_debug_code_backpatch(int32 offset)
1555 {   write_debug_backpatch(&code_backpatch_accumulator, offset);
1556 }
1557
1558 static int32 backpatch_code_address(int32 offset)
1559 {
1560     if (OMIT_UNUSED_ROUTINES) {
1561         int stripped;
1562         offset = df_stripped_offset_for_code_offset(offset, &stripped);
1563         if (stripped)
1564             return 0;
1565     }
1566     return code_offset + offset;
1567 }
1568
1569 extern void write_debug_global_backpatch(int32 offset)
1570 {   write_debug_backpatch(&global_backpatch_accumulator, offset);
1571 }
1572
1573 static int32 backpatch_global_address(int32 offset)
1574 {   return variables_offset + WORDSIZE * (offset - MAX_LOCAL_VARIABLES);
1575 }
1576
1577 extern void write_debug_array_backpatch(int32 offset)
1578 {   write_debug_backpatch(&array_backpatch_accumulator, offset);
1579 }
1580
1581 static int32 backpatch_array_address(int32 offset)
1582 {   return (glulx_mode ? arrays_offset : variables_offset) + offset;
1583 }
1584
1585 extern void write_debug_grammar_backpatch(int32 offset)
1586 {   write_debug_backpatch(&grammar_backpatch_accumulator, offset);
1587 }
1588
1589 static int32 backpatch_grammar_address(int32 offset)
1590 {   return grammar_table_offset + offset;
1591 }
1592
1593 extern void begin_writing_debug_sections()
1594 {   debug_file_printf("<story-file-section>");
1595     debug_file_printf("<type>header</type>");
1596     debug_file_printf("<address>0</address>");
1597 }
1598
1599 extern void write_debug_section(const char*name, int32 beginning_address)
1600 {   debug_file_printf("<end-address>%d</end-address>", beginning_address);
1601     debug_file_printf("</story-file-section>");
1602     debug_file_printf("<story-file-section>");
1603     debug_file_printf("<type>");
1604     debug_file_print_with_entities(name);
1605     debug_file_printf("</type>");
1606     debug_file_printf("<address>%d</address>", beginning_address);
1607 }
1608
1609 extern void end_writing_debug_sections(int32 end_address)
1610 {   debug_file_printf("<end-address>%d</end-address>", end_address);
1611     debug_file_printf("</story-file-section>");
1612 }
1613
1614 extern void write_debug_undef(int32 symbol_index)
1615 {   if (!symbol_debug_info[symbol_index].backpatch_pos.valid)
1616     {   compiler_error
1617             ("Attempt to erase debugging information never written or since "
1618                 "erased");
1619     }
1620     if (symbols[symbol_index].type != CONSTANT_T)
1621     {   compiler_error
1622             ("Attempt to erase debugging information for a non-constant "
1623              "because of an #undef");
1624     }
1625     if (fsetpos
1626          (Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position))
1627     {   fatalerror("I/O failure: can't seek in debugging information file");
1628     }
1629     /* There are 7 characters in ``<value>''. */
1630     if (fseek(Debug_fp, -7L, SEEK_CUR))
1631     {   fatalerror("I/O failure: can't seek in debugging information file");
1632     }
1633     /* Overwrite:      <value>*BACKPATCH*</value> */
1634     debug_file_printf("                          ");
1635     nullify_debug_file_position
1636         (&symbol_debug_info[symbol_index].backpatch_pos);
1637     if (fseek(Debug_fp, 0L, SEEK_END))
1638     {   fatalerror("I/O failure: can't seek in debugging information file");
1639     }
1640 }
1641
1642 static void apply_debug_information_backpatches
1643     (debug_backpatch_accumulator *accumulator)
1644 {   int32 backpatch_index, backpatch_value;
1645     for (backpatch_index = accumulator->number_of_values_to_backpatch;
1646          backpatch_index--;)
1647     {   if (fsetpos
1648                 (Debug_fp,
1649                  &accumulator->values_and_backpatch_positions
1650                      [backpatch_index].backpatch_position))
1651         {   fatalerror
1652                 ("I/O failure: can't seek in debugging information file");
1653         }
1654         backpatch_value =
1655             (*accumulator->backpatching_function)
1656                 (accumulator->values_and_backpatch_positions
1657                     [backpatch_index].value);
1658         debug_file_printf
1659             ("%11d", /* Space for up to 10 digits plus a negative sign. */
1660              backpatch_value);
1661     }
1662 }
1663
1664 static void apply_debug_information_symbol_backpatches()
1665 {   int backpatch_symbol;
1666     for (backpatch_symbol = no_symbols; backpatch_symbol--;)
1667     {   if (symbol_debug_info[backpatch_symbol].backpatch_pos.valid)
1668         {   if (fsetpos(Debug_fp,
1669                         &symbol_debug_info[backpatch_symbol].backpatch_pos.position))
1670             {   fatalerror
1671                     ("I/O failure: can't seek in debugging information file");
1672             }
1673             debug_file_printf("%11d", symbols[backpatch_symbol].value);
1674         }
1675     }
1676 }
1677
1678 static void write_debug_system_constants()
1679 {   int *system_constant_list =
1680         glulx_mode ? glulx_system_constant_list : z_system_constant_list;
1681     int system_constant_index = 0;
1682
1683     /* Store system constants. */
1684     for (; system_constant_list[system_constant_index] != -1;
1685          ++system_constant_index)
1686     {   int system_constant = system_constant_list[system_constant_index];
1687         debug_file_printf("<constant>");
1688         debug_file_printf
1689             ("<identifier>#%s</identifier>",
1690              system_constants.keywords[system_constant]);
1691         debug_file_printf
1692             ("<value>%d</value>",
1693              value_of_system_constant(system_constant));
1694         debug_file_printf("</constant>");
1695     }
1696 }
1697
1698 extern void end_debug_file()
1699 {   write_debug_system_constants();
1700     debug_file_printf("</inform-story-file>\n");
1701
1702     if (glulx_mode)
1703     {   apply_debug_information_backpatches(&object_backpatch_accumulator);
1704     } else
1705     {   apply_debug_information_backpatches(&packed_code_backpatch_accumulator);
1706     }
1707     apply_debug_information_backpatches(&code_backpatch_accumulator);
1708     apply_debug_information_backpatches(&global_backpatch_accumulator);
1709     apply_debug_information_backpatches(&array_backpatch_accumulator);
1710     apply_debug_information_backpatches(&grammar_backpatch_accumulator);
1711
1712     apply_debug_information_symbol_backpatches();
1713
1714     close_debug_file();
1715 }
1716
1717 /* ========================================================================= */
1718 /*   Data structure management routines                                      */
1719 /* ------------------------------------------------------------------------- */
1720
1721 extern void init_files_vars(void)
1722 {   malloced_bytes = 0;
1723     checksum_low_byte = 0; /* Z-code */
1724     checksum_high_byte = 0;
1725     checksum_long = 0; /* Glulx */
1726     checksum_count = 0;
1727     transcript_open = FALSE;
1728 }
1729
1730 extern void files_begin_prepass(void)
1731 {
1732     total_files = 0;
1733     total_input_files = 0;
1734     current_input_file = 0;
1735     current_origsource_file = 0;
1736 }
1737
1738 extern void files_begin_pass(void)
1739 {   total_chars_read=0;
1740 }
1741
1742 static void initialise_accumulator
1743     (debug_backpatch_accumulator *accumulator,
1744      int32 (* backpatching_function)(int32))
1745 {   accumulator->number_of_values_to_backpatch = 0;
1746     accumulator->number_of_available_backpatches =
1747         INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION;
1748     accumulator->values_and_backpatch_positions =
1749         my_malloc
1750             (sizeof(value_and_backpatch_position) *
1751                  accumulator->number_of_available_backpatches,
1752              "values and debug information backpatch positions");
1753     accumulator->backpatching_function = backpatching_function;
1754 }
1755
1756 extern void files_allocate_arrays(void)
1757 {
1758     initialise_memory_list(&InputFiles_memlist,
1759         sizeof(FileId), 16, (void**)&InputFiles,
1760         "input file storage");
1761     if (debugfile_switch)
1762     {   if (glulx_mode)
1763         {   initialise_accumulator
1764                 (&object_backpatch_accumulator, &backpatch_object_address);
1765         } else
1766         {   initialise_accumulator
1767                 (&packed_code_backpatch_accumulator,
1768                  &backpatch_packed_code_address);
1769         }
1770         initialise_accumulator
1771             (&code_backpatch_accumulator, &backpatch_code_address);
1772         initialise_accumulator
1773             (&global_backpatch_accumulator, &backpatch_global_address);
1774         initialise_accumulator
1775             (&array_backpatch_accumulator, &backpatch_array_address);
1776         initialise_accumulator
1777             (&grammar_backpatch_accumulator, &backpatch_grammar_address);
1778     }
1779 }
1780
1781 static void tear_down_accumulator(debug_backpatch_accumulator *accumulator)
1782 {   my_free
1783         (&(accumulator->values_and_backpatch_positions),
1784          "values and debug information backpatch positions");
1785 }
1786
1787 extern void files_free_arrays(void)
1788 {
1789     int ix;
1790     for (ix=0; ix<total_files; ix++)
1791     {
1792         my_free(&InputFiles[ix].filename, "filename storage");
1793     }
1794     deallocate_memory_list(&InputFiles_memlist);
1795
1796     if (debugfile_switch)
1797     {   if (!glulx_mode)
1798         {   tear_down_accumulator(&object_backpatch_accumulator);
1799         } else
1800         {   tear_down_accumulator(&packed_code_backpatch_accumulator);
1801         }
1802         tear_down_accumulator(&code_backpatch_accumulator);
1803         tear_down_accumulator(&global_backpatch_accumulator);
1804         tear_down_accumulator(&array_backpatch_accumulator);
1805         tear_down_accumulator(&grammar_backpatch_accumulator);
1806     }
1807 }
1808
1809 /* ========================================================================= */