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