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