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.41                                                     */
  11 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
  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 int32 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,"r");
 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 += (((int32)(c & 0xFF)) << 24);
 304         break;
 305       case 1:
 306         checksum_long += (((int32)(c & 0xFF)) << 16);
 307         break;
 308       case 2:
 309         checksum_long += (((int32)(c & 0xFF)) << 8);
 310         break;
 311       case 3:
 312         checksum_long += ((int32)(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 = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
 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     int32 VersionNum;
 623     uint32 code_length, size_before_code, next_cons_check;
 624     int use_function;
 625     int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;
 626
 627     ASSERT_GLULX();
 628
 629     /* At this point, construct_storyfile() has just been called. */
 630
 631     translate_out_filename(new_name, Code_Name);
 632
 633     sf_handle = fopen(new_name,"wb+");
 634     if (sf_handle == NULL)
 635         fatalerror_named("Couldn't open output file", new_name);
 636
 637 #ifdef MAC_MPW
 638     /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
 639         Z-code interpreter on the Macintosh  */
 640
 641     fsetfileinfo(new_name, 'mxZR', 'GLUL');
 642 #endif
 643
 644     checksum_long = 0;
 645     checksum_count = 0;
 646
 647     /* Determine the version number. */
 648
 649     VersionNum = 0x00020000;
 650
 651     /* Increase for various features the game may have used. */
 652     if (no_unicode_chars != 0 || (uses_unicode_features)) {
 653       VersionNum = 0x00030000;
 654     }
 655     if (uses_memheap_features) {
 656       VersionNum = 0x00030100;
 657     }
 658     if (uses_acceleration_features) {
 659       VersionNum = 0x00030101;
 660     }
 661     if (uses_float_features) {
 662       VersionNum = 0x00030102;
 663     }
 664     if (uses_double_features || uses_extundo_features) {
 665       VersionNum = 0x00030103;
 666     }
 667
 668     /* And check if the user has requested a specific version. */
 669     if (requested_glulx_version) {
 670       if (requested_glulx_version < VersionNum) {
 671         static char error_message_buff[256];
 672         sprintf(error_message_buff, "Version 0x%08lx requested, but \
 673 game features require version 0x%08lx", (long)requested_glulx_version, (long)VersionNum);
 674         warning(error_message_buff);
 675       }
 676       else {
 677         VersionNum = requested_glulx_version;
 678       }
 679     }
 680
 681     /*  (1)  Output the header. We use sf_put here, instead of fputc,
 682         because the header is included in the checksum. */
 683
 684     /* Magic number */
 685     sf_put('G');
 686     sf_put('l');
 687     sf_put('u');
 688     sf_put('l');
 689     /* Version number. */
 690     sf_put((VersionNum >> 24));
 691     sf_put((VersionNum >> 16));
 692     sf_put((VersionNum >> 8));
 693     sf_put((VersionNum));
 694     /* RAMSTART */
 695     sf_put((Write_RAM_At >> 24));
 696     sf_put((Write_RAM_At >> 16));
 697     sf_put((Write_RAM_At >> 8));
 698     sf_put((Write_RAM_At));
 699     /* EXTSTART, or game file size */
 700     sf_put((Out_Size >> 24));
 701     sf_put((Out_Size >> 16));
 702     sf_put((Out_Size >> 8));
 703     sf_put((Out_Size));
 704     /* ENDMEM, which the game file size plus MEMORY_MAP_EXTENSION */
 705     i = Out_Size + MEMORY_MAP_EXTENSION;
 706     sf_put((i >> 24));
 707     sf_put((i >> 16));
 708     sf_put((i >> 8));
 709     sf_put((i));
 710     /* STACKSIZE */
 711     sf_put((MAX_STACK_SIZE >> 24));
 712     sf_put((MAX_STACK_SIZE >> 16));
 713     sf_put((MAX_STACK_SIZE >> 8));
 714     sf_put((MAX_STACK_SIZE));
 715     /* Initial function to call. Inform sets things up so that this
 716        is the start of the executable-code area. */
 717     sf_put((Write_Code_At >> 24));
 718     sf_put((Write_Code_At >> 16));
 719     sf_put((Write_Code_At >> 8));
 720     sf_put((Write_Code_At));
 721     /* String-encoding table. */
 722     sf_put((Write_Strings_At >> 24));
 723     sf_put((Write_Strings_At >> 16));
 724     sf_put((Write_Strings_At >> 8));
 725     sf_put((Write_Strings_At));
 726     /* Checksum -- zero for the moment. */
 727     sf_put(0x00);
 728     sf_put(0x00);
 729     sf_put(0x00);
 730     sf_put(0x00);
 731
 732     size = GLULX_HEADER_SIZE;
 733
 734     /*  (1a) Output the eight-byte memory layout identifier. */
 735
 736     sf_put('I'); sf_put('n'); sf_put('f'); sf_put('o');
 737     sf_put(0); sf_put(1); sf_put(0); sf_put(0);
 738
 739     /*  (1b) Output the rest of the Inform-specific data. */
 740
 741     /* Inform version number */
 742     sf_put('0' + ((RELEASE_NUMBER/100)%10));
 743     sf_put('.');
 744     sf_put('0' + ((RELEASE_NUMBER/10)%10));
 745     sf_put('0' + RELEASE_NUMBER%10);
 746     /* Glulx back-end version number */
 747     sf_put('0' + ((GLULX_RELEASE_NUMBER/100)%10));
 748     sf_put('.');
 749     sf_put('0' + ((GLULX_RELEASE_NUMBER/10)%10));
 750     sf_put('0' + GLULX_RELEASE_NUMBER%10);
 751     /* Game release number */
 752     sf_put((release_number>>8) & 0xFF);
 753     sf_put(release_number & 0xFF);
 754     /* Game serial number */
 755     {
 756       char serialnum[8];
 757       write_serial_number(serialnum);
 758       for (i=0; i<6; i++)
 759         sf_put(serialnum[i]);
 760     }
 761     size += GLULX_STATIC_ROM_SIZE;
 762
 763     /*  (2)  Output the compiled code area. */
 764
 765     if (!OMIT_UNUSED_ROUTINES) {
 766         /* This is the old-fashioned case, which is easy. All of zcode_area
 767            (zmachine_pc bytes) will be output. next_cons_check will be
 768            ignored, because j will never reach it. */
 769         code_length = zmachine_pc;
 770         use_function = TRUE;
 771         next_cons_check = code_length+1;
 772     }
 773     else {
 774         /* With dead function stripping, life is more complicated.
 775            j will run from 0 to zmachine_pc, but only code_length of
 776            those should be output. next_cons_check is the location of
 777            the next function break; that's where we check whether
 778            we're in a live function or a dead one.
 779            (This logic is simplified by the assumption that a backpatch
 780            marker will never straddle a function break.) */
 781         if (zmachine_pc != df_total_size_before_stripping)
 782             compiler_error("Code size does not match (zmachine_pc and df_total_size).");
 783         code_length = df_total_size_after_stripping;
 784         use_function = TRUE;
 785         next_cons_check = 0;
 786         df_prepare_function_iterate();
 787     }
 788     size_before_code = size;
 789
 790     j=0;
 791       for (i=0; i<zcode_backpatch_size; i=i+6) {
 792         int data_len;
 793         int32 v;
 794         offset =
 795           (zcode_backpatch_table[i+2] << 24)
 796           | (zcode_backpatch_table[i+3] << 16)
 797           | (zcode_backpatch_table[i+4] << 8)
 798           | (zcode_backpatch_table[i+5]);
 799         backpatch_error_flag = FALSE;
 800         backpatch_marker =
 801           zcode_backpatch_table[i];
 802         data_len =
 803           zcode_backpatch_table[i+1];
 804
 805         /* All code up until the next backpatch marker gets flushed out
 806            as-is. (Unless we're in a stripped-out function.) */
 807         while (j<offset) {
 808             if (!use_function) {
 809                 while (j<offset && j<next_cons_check) {
 810                     j++;
 811                 }
 812             }
 813             else {
 814                 while (j<offset && j<next_cons_check) {
 815                     size++;
 816                     sf_put(zcode_area[j]);
 817                     j++;
 818                 }
 819             }
 820             if (j == next_cons_check)
 821                 next_cons_check = df_next_function_iterate(&use_function);
 822         }
 823
 824         /* Write out the converted value of the backpatch marker.
 825            (Unless we're in a stripped-out function.) */
 826         switch (data_len) {
 827
 828         case 4:
 829           v = (zcode_area[j]);
 830           v = (v << 8) | (zcode_area[j+1]);
 831           v = (v << 8) | (zcode_area[j+2]);
 832           v = (v << 8) | (zcode_area[j+3]);
 833           j += 4;
 834           if (!use_function)
 835               break;
 836           v = backpatch_value(v);
 837           sf_put((v >> 24) & 0xFF);
 838           sf_put((v >> 16) & 0xFF);
 839           sf_put((v >> 8) & 0xFF);
 840           sf_put((v) & 0xFF);
 841           size += 4;
 842           break;
 843
 844         case 2:
 845           v = (zcode_area[j]);
 846           v = (v << 8) | (zcode_area[j+1]);
 847           j += 2;
 848           if (!use_function)
 849               break;
 850           v = backpatch_value(v);
 851           if (v >= 0x10000) {
 852             printf("*** backpatch value does not fit ***\n");
 853             backpatch_error_flag = TRUE;
 854           }
 855           sf_put((v >> 8) & 0xFF);
 856           sf_put((v) & 0xFF);
 857           size += 2;
 858           break;
 859
 860         case 1:
 861           v = (zcode_area[j]);
 862           j += 1;
 863           if (!use_function)
 864               break;
 865           v = backpatch_value(v);
 866           if (v >= 0x100) {
 867             printf("*** backpatch value does not fit ***\n");
 868             backpatch_error_flag = TRUE;
 869           }
 870           sf_put((v) & 0xFF);
 871           size += 1;
 872           break;
 873
 874         default:
 875           printf("*** unknown backpatch data len = %d ***\n",
 876             data_len);
 877           backpatch_error_flag = TRUE;
 878         }
 879
 880         if (j > next_cons_check)
 881           compiler_error("Backpatch appears to straddle function break");
 882
 883         if (backpatch_error_flag) {
 884           printf("*** %d bytes  zcode offset=%08lx  backpatch offset=%08lx ***\n",
 885             data_len, (long int) j, (long int) i);
 886         }
 887     }
 888
 889     /* Flush out the last bit of zcode_area, after the last backpatch
 890        marker. */
 891     offset = zmachine_pc;
 892     while (j<offset) {
 893         if (!use_function) {
 894             while (j<offset && j<next_cons_check) {
 895                 j++;
 896             }
 897         }
 898         else {
 899             while (j<offset && j<next_cons_check) {
 900                 size++;
 901                 sf_put(zcode_area[j]);
 902                 j++;
 903             }
 904         }
 905         if (j == next_cons_check)
 906             next_cons_check = df_next_function_iterate(&use_function);
 907     }
 908
 909     if (size_before_code + code_length != size)
 910         compiler_error("Code output length did not match");
 911
 912     /*  (4)  Output the static strings area.                                 */
 913
 914     {
 915       int32 ix, lx;
 916       int ch, jx, curbyte, bx;
 917       int depth, checkcount;
 918       huffbitlist_t *bits;
 919       int32 origsize;
 920
 921       origsize = size;
 922
 923       if (compression_switch) {
 924
 925         /* The 12-byte table header. */
 926         lx = compression_table_size;
 927         sf_put((lx >> 24) & 0xFF);
 928         sf_put((lx >> 16) & 0xFF);
 929         sf_put((lx >> 8) & 0xFF);
 930         sf_put((lx) & 0xFF);
 931         size += 4;
 932         sf_put((no_huff_entities >> 24) & 0xFF);
 933         sf_put((no_huff_entities >> 16) & 0xFF);
 934         sf_put((no_huff_entities >> 8) & 0xFF);
 935         sf_put((no_huff_entities) & 0xFF);
 936         size += 4;
 937         lx = Write_Strings_At + 12;
 938         sf_put((lx >> 24) & 0xFF);
 939         sf_put((lx >> 16) & 0xFF);
 940         sf_put((lx >> 8) & 0xFF);
 941         sf_put((lx) & 0xFF);
 942         size += 4;
 943
 944         checkcount = 0;
 945         output_compression(huff_entity_root, &size, &checkcount);
 946         if (checkcount != no_huff_entities)
 947           compiler_error("Compression table count mismatch.");
 948       }
 949
 950       if (size - origsize != compression_table_size)
 951         compiler_error("Compression table size mismatch.");
 952
 953       origsize = size;
 954
 955       for (lx=0, ix=0; lx<no_strings; lx++) {
 956         int escapelen=0, escapetype=0;
 957         int done=FALSE;
 958         int32 escapeval=0;
 959         if (compression_switch)
 960           sf_put(0xE1); /* type byte -- compressed string */
 961         else
 962           sf_put(0xE0); /* type byte -- non-compressed string */
 963         size++;
 964         jx = 0;
 965         curbyte = 0;
 966         while (!done) {
 967           ch = static_strings_area[ix];
 968           ix++;
 969           if (ix > static_strings_extent || ch < 0)
 970             compiler_error("Read too much not-yet-compressed text.");
 971
 972           if (escapelen == -1) {
 973             escapelen = 0;
 974             if (ch == '@') {
 975               ch = '@';
 976             }
 977             else if (ch == '0') {
 978               ch = '\0';
 979             }
 980             else if (ch == 'A' || ch == 'D' || ch == 'U') {
 981               escapelen = 4;
 982               escapetype = ch;
 983               escapeval = 0;
 984               continue;
 985             }
 986             else {
 987               compiler_error("Strange @ escape in processed text.");
 988             }
 989           }
 990           else if (escapelen) {
 991             escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
 992             escapelen--;
 993             if (escapelen == 0) {
 994               if (escapetype == 'A') {
 995                 ch = huff_abbrev_start+escapeval;
 996               }
 997               else if (escapetype == 'D') {
 998                 ch = huff_dynam_start+escapeval;
 999               }
1000               else if (escapetype == 'U') {
1001                 ch = huff_unicode_start+escapeval;
1002               }
1003               else {
1004                 compiler_error("Strange @ escape in processed text.");
1005               }
1006             }
1007             else
1008               continue;
1009           }
1010           else {
1011             if (ch == '@') {
1012               escapelen = -1;
1013               continue;
1014             }
1015             if (ch == 0) {
1016               ch = 256;
1017               done = TRUE;
1018             }
1019           }
1020
1021           if (compression_switch) {
1022             bits = &(huff_entities[ch].bits);
1023             depth = huff_entities[ch].depth;
1024             for (bx=0; bx<depth; bx++) {
1025               if (bits->b[bx / 8] & (1 << (bx % 8)))
1026                 curbyte |= (1 << jx);
1027               jx++;
1028               if (jx == 8) {
1029                 sf_put(curbyte);
1030                 size++;
1031                 curbyte = 0;
1032                 jx = 0;
1033               }
1034             }
1035           }
1036           else {
1037             if (ch >= huff_dynam_start) {
1038               sf_put(' '); sf_put(' '); sf_put(' ');
1039               size += 3;
1040             }
1041             else if (ch >= huff_abbrev_start) {
1042               /* nothing */
1043             }
1044             else {
1045               /* 256, the string terminator, comes out as zero */
1046               sf_put(ch & 0xFF);
1047               size++;
1048             }
1049           }
1050         }
1051         if (compression_switch && jx) {
1052           sf_put(curbyte);
1053           size++;
1054         }
1055       }
1056
1057       if (size - origsize != compression_string_size)
1058         compiler_error("Compression string size mismatch.");
1059
1060     }
1061
1062     /*  (5)  Output static arrays (if any). */
1063     {
1064         /* We have to backpatch entries mentioned in staticarray_backpatch_table. */
1065         int32 size_before_arrays = size;
1066         int32 val, ix, jx;
1067         for (ix=0, jx=0; ix<staticarray_backpatch_size; ix += 5) {
1068             backpatch_error_flag = FALSE;
1069             backpatch_marker = staticarray_backpatch_table[ix];
1070             /* datalen is always 4 for array backpatching */
1071             offset =
1072                 (staticarray_backpatch_table[ix+1] << 24)
1073                 | (staticarray_backpatch_table[ix+2] << 16)
1074                 | (staticarray_backpatch_table[ix+3] << 8)
1075                 | (staticarray_backpatch_table[ix+4]);
1076             while (jx<offset) {
1077                 sf_put(static_array_area[jx]);
1078                 size++;
1079                 jx++;
1080             }
1081
1082             /* Write out the converted value of the backpatch marker. */
1083             val = static_array_area[jx++];
1084             val = (val << 8) | static_array_area[jx++];
1085             val = (val << 8) | static_array_area[jx++];
1086             val = (val << 8) | static_array_area[jx++];
1087             val = backpatch_value(val);
1088             sf_put((val >> 24) & 0xFF);
1089             sf_put((val >> 16) & 0xFF);
1090             sf_put((val >> 8) & 0xFF);
1091             sf_put((val) & 0xFF);
1092             size += 4;
1093         }
1094
1095         /* Flush out the last bit of static_array_area, after the last backpatch marker. */
1096         offset = static_array_area_size;
1097         while (jx<offset) {
1098             sf_put(static_array_area[jx]);
1099             size++;
1100             jx++;
1101         }
1102
1103         if (size_before_arrays + static_array_area_size != size)
1104             compiler_error("Static array output length did not match");
1105     }
1106
1107     /*  (5.5)  Output any null bytes (required to reach a GPAGESIZE address)
1108              before RAMSTART. */
1109
1110     while (size % GPAGESIZE) { sf_put(0); size++; }
1111
1112     /*  (6)  Output RAM. */
1113
1114     for (i=0; i<RAM_Size; i++)
1115     {   sf_put(zmachine_paged_memory[i]); size++;
1116     }
1117
1118     if (ferror(sf_handle))
1119         fatalerror("I/O failure: couldn't write to story file");
1120
1121     fseek(sf_handle, 32, SEEK_SET);
1122     fputc((checksum_long >> 24) & 0xFF, sf_handle);
1123     fputc((checksum_long >> 16) & 0xFF, sf_handle);
1124     fputc((checksum_long >> 8) & 0xFF, sf_handle);
1125     fputc((checksum_long) & 0xFF, sf_handle);
1126
1127     if (ferror(sf_handle))
1128       fatalerror("I/O failure: couldn't backtrack on story file for checksum");
1129
1130     /*  Write a copy of the first 64 bytes into the debugging information file
1131         (mainly so that it can be used to identify which story file matches with
1132         which debugging info file).  */
1133
1134     if (debugfile_switch)
1135     {   fseek(sf_handle, 0L, SEEK_SET);
1136         debug_file_printf("<story-file-prefix>");
1137         for (i = 0; i < 63; i += 3)
1138         {   first_byte_of_triple = fgetc(sf_handle);
1139             second_byte_of_triple = fgetc(sf_handle);
1140             third_byte_of_triple = fgetc(sf_handle);
1141             debug_file_print_base_64_triple
1142                 (first_byte_of_triple,
1143                  second_byte_of_triple,
1144                  third_byte_of_triple);
1145         }
1146         debug_file_print_base_64_single(fgetc(sf_handle));
1147         debug_file_printf("</story-file-prefix>");
1148     }
1149
1150     fclose(sf_handle);
1151
1152 #ifdef ARCHIMEDES
1153     {   char settype_command[PATHLEN];
1154         sprintf(settype_command, "settype %s %s",
1155             new_name, riscos_file_type());
1156         system(settype_command);
1157     }
1158 #endif
1159 #ifdef MAC_FACE
1160     InformFiletypes (new_name, INF_GLULX_TYPE);
1161 #endif
1162 }
1163
1164 extern void output_file(void)
1165 {
1166   if (!glulx_mode)
1167     output_file_z();
1168   else
1169     output_file_g();
1170 }
1171
1172 /* ------------------------------------------------------------------------- */
1173 /*   Output the text transcript file (only called if there is to be one).    */
1174 /* ------------------------------------------------------------------------- */
1175
1176 FILE *transcript_file_handle; int transcript_open;
1177
1178 extern void write_to_transcript_file(char *text, int linetype)
1179 {
1180     if (TRANSCRIPT_FORMAT == 1) {
1181         char ch = '?';
1182         switch (linetype) {
1183             case STRCTX_INFO:
1184                 ch = 'I'; break;
1185             case STRCTX_GAME:
1186                 ch = 'G'; break;
1187             case STRCTX_GAMEOPC:
1188                 ch = 'H'; break;
1189             case STRCTX_VENEER:
1190                 ch = 'V'; break;
1191             case STRCTX_VENEEROPC:
1192                 ch = 'W'; break;
1193             case STRCTX_LOWSTRING:
1194                 ch = 'L'; break;
1195             case STRCTX_ABBREV:
1196                 ch = 'A'; break;
1197             case STRCTX_DICT:
1198                 ch = 'D'; break;
1199             case STRCTX_OBJNAME:
1200                 ch = 'O'; break;
1201             case STRCTX_SYMBOL:
1202                 ch = 'S'; break;
1203             case STRCTX_INFIX:
1204                 ch = 'X'; break;
1205         }
1206         fputc(ch, transcript_file_handle);
1207         fputs(": ", transcript_file_handle);
1208     }
1209     fputs(text, transcript_file_handle);
1210     fputc('\n', transcript_file_handle);
1211 }
1212
1213 extern void open_transcript_file(char *what_of)
1214 {   char topline_buffer[256];
1215
1216     transcript_file_handle = fopen(Transcript_Name,"w");
1217     if (transcript_file_handle==NULL)
1218         fatalerror_named("Couldn't open transcript file",
1219         Transcript_Name);
1220
1221     transcript_open = TRUE;
1222
1223     sprintf(topline_buffer, "Transcript of the text of \"%s\"", what_of);
1224     write_to_transcript_file(topline_buffer, STRCTX_INFO);
1225     sprintf(topline_buffer, "[From %s]", banner_line);
1226     write_to_transcript_file(topline_buffer, STRCTX_INFO);
1227     if (TRANSCRIPT_FORMAT == 1) {
1228         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);
1229         if (!glulx_mode)
1230             write_to_transcript_file("[H:game text inline in opcode, W:veneer text inline in opcode]", STRCTX_INFO);
1231     }
1232     write_to_transcript_file("",  STRCTX_INFO);
1233 }
1234
1235 extern void abort_transcript_file(void)
1236 {   if (transcript_switch && transcript_open)
1237         fclose(transcript_file_handle);
1238     transcript_open = FALSE;
1239 }
1240
1241 extern void close_transcript_file(void)
1242 {   char botline_buffer[256];
1243     char sn_buffer[7];
1244
1245     write_serial_number(sn_buffer);
1246     sprintf(botline_buffer, "[End of transcript: release %d, serial %s]",
1247         release_number, sn_buffer);
1248     write_to_transcript_file("",  STRCTX_INFO);
1249     write_to_transcript_file(botline_buffer, STRCTX_INFO);
1250     write_to_transcript_file("",  STRCTX_INFO);
1251
1252     if (ferror(transcript_file_handle))
1253         fatalerror("I/O failure: couldn't write to transcript file");
1254     fclose(transcript_file_handle);
1255     transcript_open = FALSE;
1256
1257 #ifdef ARCHIMEDES
1258     {   char settype_command[PATHLEN];
1259         sprintf(settype_command, "settype %s text",
1260             Transcript_Name);
1261         system(settype_command);
1262     }
1263 #endif
1264 #ifdef MAC_FACE
1265     InformFiletypes (Transcript_Name, INF_TEXT_TYPE);
1266 #endif
1267 }
1268
1269 /* ------------------------------------------------------------------------- */
1270 /*   Access to the debugging information file.                               */
1271 /* ------------------------------------------------------------------------- */
1272
1273 static FILE *Debug_fp;                 /* Handle of debugging info file      */
1274
1275 static void open_debug_file(void)
1276 {   Debug_fp=fopen(Debugging_Name,"wb");
1277     if (Debug_fp==NULL)
1278        fatalerror_named("Couldn't open debugging information file",
1279            Debugging_Name);
1280 }
1281
1282 extern void nullify_debug_file_position(maybe_file_position *position) {
1283     position->valid = 0;
1284 }
1285
1286 static void close_debug_file(void)
1287 {   fclose(Debug_fp);
1288 #ifdef MAC_FACE
1289     InformFiletypes (Debugging_Name, INF_DEBUG_TYPE);
1290 #endif
1291 }
1292
1293 extern void begin_debug_file(void)
1294 {   open_debug_file();
1295
1296     debug_file_printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
1297     debug_file_printf("<inform-story-file version=\"1.0\" ");
1298     debug_file_printf("content-creator=\"Inform\" ");
1299     debug_file_printf
1300         ("content-creator-version=\"%d.%d%d\">",
1301          (VNUMBER / 100) % 10,
1302          (VNUMBER / 10) % 10,
1303          VNUMBER % 10);
1304 }
1305
1306 extern void debug_file_printf(const char*format, ...)
1307 {   va_list argument_pointer;
1308     va_start(argument_pointer, format);
1309     vfprintf(Debug_fp, format, argument_pointer);
1310     va_end(argument_pointer);
1311     if (ferror(Debug_fp))
1312     {   fatalerror("I/O failure: can't write to debugging information file");
1313     }
1314 }
1315
1316 extern void debug_file_print_with_entities(const char*string)
1317 {   int index = 0;
1318     char character;
1319     for (character = string[index]; character; character = string[++index])
1320     {   switch(character)
1321         {   case '"':
1322                 debug_file_printf("&quot;");
1323                 break;
1324             case '&':
1325                 debug_file_printf("&amp;");
1326                 break;
1327             case '\'':
1328                 debug_file_printf("&apos;");
1329                 break;
1330             case '<':
1331                 debug_file_printf("&lt;");
1332                 break;
1333             case '>':
1334                 debug_file_printf("&gt;");
1335                 break;
1336             default:
1337                 debug_file_printf("%c", character);
1338                 break;
1339         }
1340     }
1341 }
1342
1343 static char base_64_digits[] =
1344   { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
1345     'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',
1346     'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
1347     't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
1348     '8', '9', '+', '/' };
1349
1350 extern void debug_file_print_base_64_triple
1351     (uchar first, uchar second, uchar third)
1352 {   debug_file_printf
1353         ("%c%c%c%c",
1354          base_64_digits[first >> 2],
1355          base_64_digits[((first & 3) << 4) | (second >> 4)],
1356          base_64_digits[((second & 15) << 2) | (third >> 6)],
1357          base_64_digits[third & 63]);
1358 }
1359
1360 extern void debug_file_print_base_64_pair(uchar first, uchar second)
1361 {   debug_file_printf
1362         ("%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]);
1366 }
1367
1368 extern void debug_file_print_base_64_single(uchar first)
1369 {   debug_file_printf
1370         ("%c%c==",
1371          base_64_digits[first >> 2],
1372          base_64_digits[(first & 3) << 4]);
1373 }
1374
1375 static void write_debug_location_internals(debug_location location)
1376 {   debug_file_printf("<file-index>%d</file-index>", location.file_index - 1);
1377     debug_file_printf
1378         ("<file-position>%d</file-position>", location.beginning_byte_index);
1379     debug_file_printf
1380         ("<line>%d</line>", location.beginning_line_number);
1381     debug_file_printf
1382         ("<character>%d</character>", location.beginning_character_number);
1383     if (location.beginning_byte_index != location.end_byte_index ||
1384         location.beginning_line_number != location.end_line_number ||
1385         location.beginning_character_number != location.end_character_number)
1386     {   debug_file_printf
1387             ("<end-file-position>%d</end-file-position>",
1388              location.end_byte_index);
1389         debug_file_printf
1390             ("<end-line>%d</end-line>", location.end_line_number);
1391         debug_file_printf
1392             ("<end-character>%d</end-character>",
1393              location.end_character_number);
1394     }
1395 }
1396
1397 static void write_debug_location_origsource_internals(debug_location location)
1398 {   debug_file_printf
1399         ("<file-index>%d</file-index>", location.orig_file_index - 1);
1400     if (location.orig_beg_line_number)
1401         debug_file_printf
1402             ("<line>%d</line>", location.orig_beg_line_number);
1403     if (location.orig_beg_char_number)
1404         debug_file_printf
1405             ("<character>%d</character>", location.orig_beg_char_number);
1406 }
1407
1408 extern void write_debug_location(debug_location location)
1409 {   if (location.file_index && location.file_index != 255)
1410     {   debug_file_printf("<source-code-location>");
1411         write_debug_location_internals(location);
1412         debug_file_printf("</source-code-location>");
1413     }
1414     if (location.orig_file_index)
1415     {   debug_file_printf("<source-code-location>");
1416         write_debug_location_origsource_internals(location);
1417         debug_file_printf("</source-code-location>");
1418     }
1419 }
1420
1421 extern void write_debug_locations(debug_locations locations)
1422 {   if (locations.next)
1423     {   const debug_locations*current = &locations;
1424         unsigned int index = 0;
1425         for (; current; current = current->next, ++index)
1426         {   debug_file_printf("<source-code-location index=\"%d\">", index);
1427             write_debug_location_internals(current->location);
1428             debug_file_printf("</source-code-location>");
1429         }
1430         if (locations.location.orig_file_index)
1431         {   debug_file_printf("<source-code-location>");
1432             write_debug_location_origsource_internals(locations.location);
1433             debug_file_printf("</source-code-location>");
1434         }
1435     }
1436     else
1437     {   write_debug_location(locations.location);
1438     }
1439 }
1440
1441 extern void write_debug_optional_identifier(int32 symbol_index)
1442 {   if (symbols[symbol_index].type != ROUTINE_T)
1443     {   compiler_error
1444             ("Attempt to write a replaceable identifier for a non-routine");
1445     }
1446     if (symbol_debug_info[symbol_index].replacement_backpatch_pos.valid)
1447     {   if (fsetpos
1448                 (Debug_fp,
1449                  &symbol_debug_info[symbol_index].replacement_backpatch_pos.position))
1450         {   fatalerror("I/O failure: can't seek in debugging information file");
1451         }
1452         debug_file_printf
1453             ("<identifier artificial=\"true\">%s "
1454                  "(superseded replacement)</identifier>",
1455              symbols[symbol_index].name);
1456         if (fseek(Debug_fp, 0L, SEEK_END))
1457         {   fatalerror("I/O failure: can't seek in debugging information file");
1458         }
1459     }
1460     fgetpos
1461       (Debug_fp, &symbol_debug_info[symbol_index].replacement_backpatch_pos.position);
1462     symbol_debug_info[symbol_index].replacement_backpatch_pos.valid = TRUE;
1463     debug_file_printf("<identifier>%s</identifier>", symbols[symbol_index].name);
1464     /* Space for:       artificial="true" (superseded replacement) */
1465     debug_file_printf("                                           ");
1466 }
1467
1468 extern void write_debug_symbol_backpatch(int32 symbol_index)
1469 {   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
1470         compiler_error("Symbol entry incorrectly reused in debug information "
1471                        "file backpatching");
1472     }
1473     fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
1474     symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
1475     /* Reserve space for up to 10 digits plus a negative sign. */
1476     debug_file_printf("*BACKPATCH*");
1477 }
1478
1479 extern void write_debug_symbol_optional_backpatch(int32 symbol_index)
1480 {   if (symbol_debug_info[symbol_index].backpatch_pos.valid) {
1481         compiler_error("Symbol entry incorrectly reused in debug information "
1482                        "file backpatching");
1483     }
1484     /* Reserve space for open and close value tags and up to 10 digits plus a
1485        negative sign, but take the backpatch position just inside the element,
1486        so that we'll be in the same case as above if the symbol is eventually
1487        defined. */
1488     debug_file_printf("<value>");
1489     fgetpos(Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position);
1490     symbol_debug_info[symbol_index].backpatch_pos.valid = TRUE;
1491     debug_file_printf("*BACKPATCH*</value>");
1492 }
1493
1494 static void write_debug_backpatch
1495     (debug_backpatch_accumulator *accumulator, int32 value)
1496 {   if (accumulator->number_of_values_to_backpatch ==
1497         accumulator->number_of_available_backpatches)
1498     {   my_realloc(&accumulator->values_and_backpatch_positions,
1499                    sizeof(value_and_backpatch_position) *
1500                        accumulator->number_of_available_backpatches,
1501                    2 * sizeof(value_and_backpatch_position) *
1502                        accumulator->number_of_available_backpatches,
1503                    "values and debug information backpatch positions");
1504         accumulator->number_of_available_backpatches *= 2;
1505     }
1506     accumulator->values_and_backpatch_positions
1507         [accumulator->number_of_values_to_backpatch].value = value;
1508     fgetpos
1509         (Debug_fp,
1510          &accumulator->values_and_backpatch_positions
1511              [accumulator->number_of_values_to_backpatch].backpatch_position);
1512     ++(accumulator->number_of_values_to_backpatch);
1513     /* Reserve space for up to 10 digits plus a negative sign. */
1514     debug_file_printf("*BACKPATCH*");
1515 }
1516
1517 extern void write_debug_object_backpatch(int32 object_number)
1518 {   if (glulx_mode)
1519     {   write_debug_backpatch(&object_backpatch_accumulator, object_number - 1);
1520     }
1521     else
1522     {   debug_file_printf("%d", object_number);
1523     }
1524 }
1525
1526 static int32 backpatch_object_address(int32 index)
1527 {   return object_tree_offset + OBJECT_BYTE_LENGTH * index;
1528 }
1529
1530 extern void write_debug_packed_code_backpatch(int32 offset)
1531 {   write_debug_backpatch(&packed_code_backpatch_accumulator, offset);
1532 }
1533
1534 static int32 backpatch_packed_code_address(int32 offset)
1535 {
1536     if (OMIT_UNUSED_ROUTINES) {
1537         int stripped;
1538         offset = df_stripped_offset_for_code_offset(offset, &stripped);
1539         if (stripped)
1540             return 0;
1541     }
1542     return (code_offset + offset) / scale_factor;
1543 }
1544
1545 extern void write_debug_code_backpatch(int32 offset)
1546 {   write_debug_backpatch(&code_backpatch_accumulator, offset);
1547 }
1548
1549 static int32 backpatch_code_address(int32 offset)
1550 {
1551     if (OMIT_UNUSED_ROUTINES) {
1552         int stripped;
1553         offset = df_stripped_offset_for_code_offset(offset, &stripped);
1554         if (stripped)
1555             return 0;
1556     }
1557     return code_offset + offset;
1558 }
1559
1560 extern void write_debug_global_backpatch(int32 offset)
1561 {   write_debug_backpatch(&global_backpatch_accumulator, offset);
1562 }
1563
1564 static int32 backpatch_global_address(int32 offset)
1565 {   return variables_offset + WORDSIZE * (offset - MAX_LOCAL_VARIABLES);
1566 }
1567
1568 extern void write_debug_array_backpatch(int32 offset)
1569 {   write_debug_backpatch(&array_backpatch_accumulator, offset);
1570 }
1571
1572 static int32 backpatch_array_address(int32 offset)
1573 {   return (glulx_mode ? arrays_offset : variables_offset) + offset;
1574 }
1575
1576 extern void write_debug_grammar_backpatch(int32 offset)
1577 {   write_debug_backpatch(&grammar_backpatch_accumulator, offset);
1578 }
1579
1580 static int32 backpatch_grammar_address(int32 offset)
1581 {   return grammar_table_offset + offset;
1582 }
1583
1584 extern void begin_writing_debug_sections()
1585 {   debug_file_printf("<story-file-section>");
1586     debug_file_printf("<type>header</type>");
1587     debug_file_printf("<address>0</address>");
1588 }
1589
1590 extern void write_debug_section(const char*name, int32 beginning_address)
1591 {   debug_file_printf("<end-address>%d</end-address>", beginning_address);
1592     debug_file_printf("</story-file-section>");
1593     debug_file_printf("<story-file-section>");
1594     debug_file_printf("<type>");
1595     debug_file_print_with_entities(name);
1596     debug_file_printf("</type>");
1597     debug_file_printf("<address>%d</address>", beginning_address);
1598 }
1599
1600 extern void end_writing_debug_sections(int32 end_address)
1601 {   debug_file_printf("<end-address>%d</end-address>", end_address);
1602     debug_file_printf("</story-file-section>");
1603 }
1604
1605 extern void write_debug_undef(int32 symbol_index)
1606 {   if (!symbol_debug_info[symbol_index].backpatch_pos.valid)
1607     {   compiler_error
1608             ("Attempt to erase debugging information never written or since "
1609                 "erased");
1610     }
1611     if (symbols[symbol_index].type != CONSTANT_T)
1612     {   compiler_error
1613             ("Attempt to erase debugging information for a non-constant "
1614              "because of an #undef");
1615     }
1616     if (fsetpos
1617          (Debug_fp, &symbol_debug_info[symbol_index].backpatch_pos.position))
1618     {   fatalerror("I/O failure: can't seek in debugging information file");
1619     }
1620     /* There are 7 characters in ``<value>''. */
1621     if (fseek(Debug_fp, -7L, SEEK_CUR))
1622     {   fatalerror("I/O failure: can't seek in debugging information file");
1623     }
1624     /* Overwrite:      <value>*BACKPATCH*</value> */
1625     debug_file_printf("                          ");
1626     nullify_debug_file_position
1627         (&symbol_debug_info[symbol_index].backpatch_pos);
1628     if (fseek(Debug_fp, 0L, SEEK_END))
1629     {   fatalerror("I/O failure: can't seek in debugging information file");
1630     }
1631 }
1632
1633 static void apply_debug_information_backpatches
1634     (debug_backpatch_accumulator *accumulator)
1635 {   int32 backpatch_index, backpatch_value;
1636     for (backpatch_index = accumulator->number_of_values_to_backpatch;
1637          backpatch_index--;)
1638     {   if (fsetpos
1639                 (Debug_fp,
1640                  &accumulator->values_and_backpatch_positions
1641                      [backpatch_index].backpatch_position))
1642         {   fatalerror
1643                 ("I/O failure: can't seek in debugging information file");
1644         }
1645         backpatch_value =
1646             (*accumulator->backpatching_function)
1647                 (accumulator->values_and_backpatch_positions
1648                     [backpatch_index].value);
1649         debug_file_printf
1650             ("%11d", /* Space for up to 10 digits plus a negative sign. */
1651              backpatch_value);
1652     }
1653 }
1654
1655 static void apply_debug_information_symbol_backpatches()
1656 {   int backpatch_symbol;
1657     for (backpatch_symbol = no_symbols; backpatch_symbol--;)
1658     {   if (symbol_debug_info[backpatch_symbol].backpatch_pos.valid)
1659         {   if (fsetpos(Debug_fp,
1660                         &symbol_debug_info[backpatch_symbol].backpatch_pos.position))
1661             {   fatalerror
1662                     ("I/O failure: can't seek in debugging information file");
1663             }
1664             debug_file_printf("%11d", symbols[backpatch_symbol].value);
1665         }
1666     }
1667 }
1668
1669 static void write_debug_system_constants()
1670 {   int *system_constant_list =
1671         glulx_mode ? glulx_system_constant_list : z_system_constant_list;
1672     int system_constant_index = 0;
1673
1674     /* Store system constants. */
1675     for (; system_constant_list[system_constant_index] != -1;
1676          ++system_constant_index)
1677     {   int system_constant = system_constant_list[system_constant_index];
1678         debug_file_printf("<constant>");
1679         debug_file_printf
1680             ("<identifier>#%s</identifier>",
1681              system_constants.keywords[system_constant]);
1682         debug_file_printf
1683             ("<value>%d</value>",
1684              value_of_system_constant(system_constant));
1685         debug_file_printf("</constant>");
1686     }
1687 }
1688
1689 extern void end_debug_file()
1690 {   write_debug_system_constants();
1691     debug_file_printf("</inform-story-file>\n");
1692
1693     if (glulx_mode)
1694     {   apply_debug_information_backpatches(&object_backpatch_accumulator);
1695     } else
1696     {   apply_debug_information_backpatches(&packed_code_backpatch_accumulator);
1697     }
1698     apply_debug_information_backpatches(&code_backpatch_accumulator);
1699     apply_debug_information_backpatches(&global_backpatch_accumulator);
1700     apply_debug_information_backpatches(&array_backpatch_accumulator);
1701     apply_debug_information_backpatches(&grammar_backpatch_accumulator);
1702
1703     apply_debug_information_symbol_backpatches();
1704
1705     close_debug_file();
1706 }
1707
1708 /* ========================================================================= */
1709 /*   Data structure management routines                                      */
1710 /* ------------------------------------------------------------------------- */
1711
1712 extern void init_files_vars(void)
1713 {   malloced_bytes = 0;
1714     checksum_low_byte = 0; /* Z-code */
1715     checksum_high_byte = 0;
1716     checksum_long = 0; /* Glulx */
1717     checksum_count = 0;
1718     transcript_open = FALSE;
1719 }
1720
1721 extern void files_begin_prepass(void)
1722 {
1723     total_files = 0;
1724     total_input_files = 0;
1725     current_input_file = 0;
1726     current_origsource_file = 0;
1727 }
1728
1729 extern void files_begin_pass(void)
1730 {   total_chars_read=0;
1731 }
1732
1733 static void initialise_accumulator
1734     (debug_backpatch_accumulator *accumulator,
1735      int32 (* backpatching_function)(int32))
1736 {   accumulator->number_of_values_to_backpatch = 0;
1737     accumulator->number_of_available_backpatches =
1738         INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION;
1739     accumulator->values_and_backpatch_positions =
1740         my_malloc
1741             (sizeof(value_and_backpatch_position) *
1742                  accumulator->number_of_available_backpatches,
1743              "values and debug information backpatch positions");
1744     accumulator->backpatching_function = backpatching_function;
1745 }
1746
1747 extern void files_allocate_arrays(void)
1748 {
1749     initialise_memory_list(&InputFiles_memlist,
1750         sizeof(FileId), 16, (void**)&InputFiles,
1751         "input file storage");
1752     if (debugfile_switch)
1753     {   if (glulx_mode)
1754         {   initialise_accumulator
1755                 (&object_backpatch_accumulator, &backpatch_object_address);
1756         } else
1757         {   initialise_accumulator
1758                 (&packed_code_backpatch_accumulator,
1759                  &backpatch_packed_code_address);
1760         }
1761         initialise_accumulator
1762             (&code_backpatch_accumulator, &backpatch_code_address);
1763         initialise_accumulator
1764             (&global_backpatch_accumulator, &backpatch_global_address);
1765         initialise_accumulator
1766             (&array_backpatch_accumulator, &backpatch_array_address);
1767         initialise_accumulator
1768             (&grammar_backpatch_accumulator, &backpatch_grammar_address);
1769     }
1770 }
1771
1772 static void tear_down_accumulator(debug_backpatch_accumulator *accumulator)
1773 {   my_free
1774         (&(accumulator->values_and_backpatch_positions),
1775          "values and debug information backpatch positions");
1776 }
1777
1778 extern void files_free_arrays(void)
1779 {
1780     int ix;
1781     for (ix=0; ix<total_files; ix++)
1782     {
1783         my_free(&InputFiles[ix].filename, "filename storage");
1784     }
1785     deallocate_memory_list(&InputFiles_memlist);
1786
1787     if (debugfile_switch)
1788     {   if (!glulx_mode)
1789         {   tear_down_accumulator(&object_backpatch_accumulator);
1790         } else
1791         {   tear_down_accumulator(&packed_code_backpatch_accumulator);
1792         }
1793         tear_down_accumulator(&code_backpatch_accumulator);
1794         tear_down_accumulator(&global_backpatch_accumulator);
1795         tear_down_accumulator(&array_backpatch_accumulator);
1796         tear_down_accumulator(&grammar_backpatch_accumulator);
1797     }
1798 }
1799
1800 /* ========================================================================= */