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