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