?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Imported Upstream version 6.33
[debian_inform6-compiler.git] / directs.c
blob16072fb121c367e7190018648e7955e66e99c3f3
1 /* ------------------------------------------------------------------------- */
2 /* "directs" : Directives (# commands) */
3 /* */
4 /* Part of Inform 6.33 */
5 /* copyright (c) Graham Nelson 1993 - 2014 */
6 /* */
7 /* ------------------------------------------------------------------------- */
8
9 #include "header.h"
10
11 int no_routines, /* Number of routines compiled so far */
12 no_named_routines, /* Number not embedded in objects */
13 no_locals, /* Number of locals in current routine */
14 no_termcs; /* Number of terminating characters */
15 int terminating_characters[32];
16
17 int32 routine_starts_line; /* Source code line on which the current
18 routine starts. (Useful for reporting
19 "unused variable" warnings on the start
20 line rather than the end line.) */
21
22 static int constant_made_yet; /* Have any constants been defined yet? */
23
24 static int ifdef_stack[32], ifdef_sp;
25
26 /* ------------------------------------------------------------------------- */
27
28 static int ebf_error_recover(char *s1, char *s2)
29 {
30 /* Display an "expected... but found..." error, then skim forward
31 to the next semicolon and return FALSE. This is such a common
32 case in parse_given_directive() that it's worth a utility
33 function. You will see many error paths that look like:
34 return ebf_error_recover(...);
35 */
36 ebf_error(s1, s2);
37 panic_mode_error_recovery();
38 return FALSE;
39 }
40
41 /* ------------------------------------------------------------------------- */
42
43 extern int parse_given_directive(int internal_flag)
44 { /* Internal_flag is FALSE if the directive is encountered normally,
45 TRUE if encountered with a # prefix inside a routine or object
46 definition.
47
48 Returns: FALSE if program continues, TRUE if end of file reached. */
49
50 int *trace_level; int32 i, j, k, n, flag;
51 const char *constant_name;
52 debug_location_beginning beginning_debug_location;
53
54 switch(token_value)
55 {
56
57 /* --------------------------------------------------------------------- */
58 /* Abbreviate "string1" ["string2" ...] */
59 /* --------------------------------------------------------------------- */
60
61 case ABBREVIATE_CODE:
62
63 do
64 { get_next_token();
65 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
66 return FALSE;
67
68 /* Z-code has a 64-abbrev limit; Glulx doesn't. */
69 if (!glulx_mode && no_abbreviations==64)
70 { error("All 64 abbreviations already declared");
71 panic_mode_error_recovery(); return FALSE;
72 }
73 if (no_abbreviations==MAX_ABBREVS)
74 memoryerror("MAX_ABBREVS", MAX_ABBREVS);
75
76 if (abbrevs_lookup_table_made)
77 { error("All abbreviations must be declared together");
78 panic_mode_error_recovery(); return FALSE;
79 }
80 if (token_type != DQ_TT)
81 return ebf_error_recover("abbreviation string", token_text);
82 if (strlen(token_text)<2)
83 { error_named("It's not worth abbreviating", token_text);
84 continue;
85 }
86 make_abbreviation(token_text);
87 } while (TRUE);
88
89 /* --------------------------------------------------------------------- */
90 /* Array arrayname array... */
91 /* --------------------------------------------------------------------- */
92
93 case ARRAY_CODE: make_global(TRUE, FALSE); break; /* See "tables.c" */
94
95 /* --------------------------------------------------------------------- */
96 /* Attribute newname [alias oldname] */
97 /* --------------------------------------------------------------------- */
98
99 case ATTRIBUTE_CODE:
100 make_attribute(); break; /* See "objects.c" */
101
102 /* --------------------------------------------------------------------- */
103 /* Class classname ... */
104 /* --------------------------------------------------------------------- */
105
106 case CLASS_CODE:
107 if (internal_flag)
108 { error("Cannot nest #Class inside a routine or object");
109 panic_mode_error_recovery(); return FALSE;
110 }
111 make_class(NULL); /* See "objects.c" */
112 return FALSE;
113
114 /* --------------------------------------------------------------------- */
115 /* Constant newname [[=] value] [, ...] */
116 /* --------------------------------------------------------------------- */
117
118 case CONSTANT_CODE:
119 constant_made_yet=TRUE;
120
121 ParseConstantSpec:
122 get_next_token(); i = token_value;
123 beginning_debug_location = get_token_location_beginning();
124
125 if ((token_type != SYMBOL_TT)
126 || (!(sflags[i] & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))))
127 { discard_token_location(beginning_debug_location);
128 return ebf_error_recover("new constant name", token_text);
129 }
130
131 assign_symbol(i, 0, CONSTANT_T);
132 constant_name = token_text;
133
134 get_next_token();
135
136 if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
137 { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
138 { debug_file_printf("<constant>");
139 debug_file_printf("<identifier>%s</identifier>", constant_name);
140 write_debug_symbol_optional_backpatch(i);
141 write_debug_locations(get_token_location_end(beginning_debug_location));
142 debug_file_printf("</constant>");
143 }
144 goto ParseConstantSpec;
145 }
146
147 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
148 { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
149 { debug_file_printf("<constant>");
150 debug_file_printf("<identifier>%s</identifier>", constant_name);
151 write_debug_symbol_optional_backpatch(i);
152 write_debug_locations(get_token_location_end(beginning_debug_location));
153 debug_file_printf("</constant>");
154 }
155 return FALSE;
156 }
157
158 if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
159 put_token_back();
160
161 { assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
162 if (AO.marker != 0)
163 { assign_marked_symbol(i, AO.marker, AO.value,
164 CONSTANT_T);
165 sflags[i] |= CHANGE_SFLAG;
166 if (i == grammar_version_symbol)
167 error(
168 "Grammar__Version must be given an explicit constant value");
169 }
170 else
171 { assign_symbol(i, AO.value, CONSTANT_T);
172 if (i == grammar_version_symbol)
173 { if ((grammar_version_number != AO.value)
174 && (no_fake_actions > 0))
175 error(
176 "Once a fake action has been defined it is too late to \
177 change the grammar version. (If you are using the library, move any \
178 Fake_Action directives to a point after the inclusion of \"Parser\".)");
179 grammar_version_number = AO.value;
180 }
181 }
182 }
183
184 if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
185 { debug_file_printf("<constant>");
186 debug_file_printf("<identifier>%s</identifier>", constant_name);
187 write_debug_symbol_optional_backpatch(i);
188 write_debug_locations
189 (get_token_location_end(beginning_debug_location));
190 debug_file_printf("</constant>");
191 }
192
193 get_next_token();
194 if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
195 goto ParseConstantSpec;
196 put_token_back();
197 break;
198
199 /* --------------------------------------------------------------------- */
200 /* Default constantname integer */
201 /* --------------------------------------------------------------------- */
202
203 case DEFAULT_CODE:
204 if (module_switch)
205 { error("'Default' cannot be used in -M (Module) mode");
206 panic_mode_error_recovery(); return FALSE;
207 }
208
209 get_next_token();
210 if (token_type != SYMBOL_TT)
211 return ebf_error_recover("name", token_text);
212
213 i = -1;
214 if (sflags[token_value] & UNKNOWN_SFLAG)
215 { i = token_value;
216 sflags[i] |= DEFCON_SFLAG;
217 }
218
219 get_next_token();
220 if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
221 put_token_back();
222
223 { assembly_operand AO;
224 AO = parse_expression(CONSTANT_CONTEXT);
225 if (i != -1)
226 { if (AO.marker != 0)
227 { assign_marked_symbol(i, AO.marker, AO.value,
228 CONSTANT_T);
229 sflags[i] |= CHANGE_SFLAG;
230 }
231 else assign_symbol(i, AO.value, CONSTANT_T);
232 }
233 }
234
235 break;
236
237 /* --------------------------------------------------------------------- */
238 /* Dictionary 'word' */
239 /* Dictionary 'word' val1 */
240 /* Dictionary 'word' val1 val3 */
241 /* --------------------------------------------------------------------- */
242
243 case DICTIONARY_CODE:
244 /* In Inform 5, this directive had the form
245 Dictionary SYMBOL "word";
246 This was deprecated as of I6 (if not earlier), and is no longer
247 supported at all. The current form just creates a dictionary word,
248 with the given values for dict_par1 and dict_par3. If the word
249 already exists, the values are bit-or'd in with the existing
250 values.
251 (We don't offer a way to set dict_par2, because that is entirely
252 reserved for the verb number. Or'ing values into it would create
253 garbage.)
254 */
255 get_next_token();
256 if (token_type != SQ_TT && token_type != DQ_TT)
257 return ebf_error_recover("dictionary word", token_text);
258
259 {
260 char *wd = token_text;
261 int val1 = 0;
262 int val3 = 0;
263
264 get_next_token();
265 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
266 put_token_back();
267 }
268 else {
269 assembly_operand AO;
270 put_token_back();
271 AO = parse_expression(CONSTANT_CONTEXT);
272 if (module_switch && (AO.marker != 0))
273 error("A definite value must be given as a Dictionary flag");
274 else
275 val1 = AO.value;
276
277 get_next_token();
278 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
279 put_token_back();
280 }
281 else {
282 assembly_operand AO;
283 put_token_back();
284 AO = parse_expression(CONSTANT_CONTEXT);
285 if (module_switch && (AO.marker != 0))
286 error("A definite value must be given as a Dictionary flag");
287 else
288 val3 = AO.value;
289 }
290 }
291
292 if (!glulx_mode) {
293 if ((val1 & ~0xFF) || (val3 & ~0xFF)) {
294 warning("Dictionary flag values cannot exceed $FF in Z-code");
295 }
296 }
297 else {
298 if ((val1 & ~0xFFFF) || (val3 & ~0xFFFF)) {
299 warning("Dictionary flag values cannot exceed $FFFF in Glulx");
300 }
301 }
302
303 dictionary_add(wd, val1, 0, val3);
304 }
305 break;
306
307 /* --------------------------------------------------------------------- */
308 /* End */
309 /* --------------------------------------------------------------------- */
310
311 case END_CODE: return(TRUE);
312
313 case ENDIF_CODE:
314 if (ifdef_sp == 0) error("'Endif' without matching 'If...'");
315 else ifdef_sp--;
316 break;
317
318 /* --------------------------------------------------------------------- */
319 /* Extend ... */
320 /* --------------------------------------------------------------------- */
321
322 case EXTEND_CODE: extend_verb(); return FALSE; /* see "tables.c" */
323
324 /* --------------------------------------------------------------------- */
325 /* Fake_Action name */
326 /* --------------------------------------------------------------------- */
327
328 case FAKE_ACTION_CODE:
329 make_fake_action(); break; /* see "verbs.c" */
330
331 /* --------------------------------------------------------------------- */
332 /* Global variable [= value / array...] */
333 /* --------------------------------------------------------------------- */
334
335 case GLOBAL_CODE: make_global(FALSE, FALSE); break; /* See "tables.c" */
336
337 /* --------------------------------------------------------------------- */
338 /* If... */
339 /* */
340 /* Note that each time Inform tests an If... condition, it stacks the */
341 /* result (TRUE or FALSE) on ifdef_stack: thus, the top of this stack */
342 /* reveals what clause of the current If... is being compiled: */
343 /* */
344 /* If...; ... Ifnot; ... Endif; */
345 /* top of stack: TRUE FALSE */
346 /* */
347 /* This is used to detect "two Ifnots in same If" errors. */
348 /* --------------------------------------------------------------------- */
349
350 case IFDEF_CODE:
351 flag = TRUE;
352 goto DefCondition;
353 case IFNDEF_CODE:
354 flag = FALSE;
355
356 DefCondition:
357 get_next_token();
358 if (token_type != SYMBOL_TT)
359 return ebf_error_recover("symbol name", token_text);
360
361 if ((token_text[0] == 'V')
362 && (token_text[1] == 'N')
363 && (token_text[2] == '_')
364 && (strlen(token_text)==7))
365 { i = atoi(token_text+3);
366 if (VNUMBER < i) flag = (flag)?FALSE:TRUE;
367 goto HashIfCondition;
368 }
369
370 if (sflags[token_value] & UNKNOWN_SFLAG) flag = (flag)?FALSE:TRUE;
371 else sflags[token_value] |= USED_SFLAG;
372 goto HashIfCondition;
373
374 case IFNOT_CODE:
375 if (ifdef_sp == 0)
376 error("'Ifnot' without matching 'If...'");
377 else
378 if (!(ifdef_stack[ifdef_sp-1]))
379 error("Second 'Ifnot' for the same 'If...' condition");
380 else
381 { dont_enter_into_symbol_table = -2; n = 1;
382 directives.enabled = TRUE;
383 do
384 { get_next_token();
385 if (token_type == EOF_TT)
386 { error("End of file reached in code 'If...'d out");
387 directives.enabled = FALSE;
388 return TRUE;
389 }
390 if (token_type == DIRECTIVE_TT)
391 { switch(token_value)
392 { case ENDIF_CODE:
393 n--; break;
394 case IFV3_CODE:
395 case IFV5_CODE:
396 case IFDEF_CODE:
397 case IFNDEF_CODE:
398 case IFTRUE_CODE:
399 case IFFALSE_CODE:
400 n++; break;
401 case IFNOT_CODE:
402 if (n == 1)
403 { error(
404 "Second 'Ifnot' for the same 'If...' condition");
405 break;
406 }
407 }
408 }
409 } while (n > 0);
410 ifdef_sp--;
411 dont_enter_into_symbol_table = FALSE;
412 directives.enabled = FALSE;
413 }
414 break;
415
416 case IFV3_CODE:
417 flag = FALSE; if (version_number == 3) flag = TRUE;
418 goto HashIfCondition;
419
420 case IFV5_CODE:
421 flag = TRUE; if (version_number == 3) flag = FALSE;
422 goto HashIfCondition;
423
424 case IFTRUE_CODE:
425 { assembly_operand AO;
426 AO = parse_expression(CONSTANT_CONTEXT);
427 if (module_switch && (AO.marker != 0))
428 { error("This condition can't be determined");
429 flag = 0;
430 }
431 else flag = (AO.value != 0);
432 }
433 goto HashIfCondition;
434
435 case IFFALSE_CODE:
436 { assembly_operand AO;
437 AO = parse_expression(CONSTANT_CONTEXT);
438 if (module_switch && (AO.marker != 0))
439 { error("This condition can't be determined");
440 flag = 1;
441 }
442 else flag = (AO.value == 0);
443 }
444 goto HashIfCondition;
445
446 HashIfCondition:
447 get_next_token();
448 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
449 return ebf_error_recover("semicolon after 'If...' condition", token_text);
450
451 if (flag)
452 { ifdef_stack[ifdef_sp++] = TRUE; return FALSE; }
453 else
454 { dont_enter_into_symbol_table = -2; n = 1;
455 directives.enabled = TRUE;
456 do
457 { get_next_token();
458 if (token_type == EOF_TT)
459 { error("End of file reached in code 'If...'d out");
460 directives.enabled = FALSE;
461 return TRUE;
462 }
463 if (token_type == DIRECTIVE_TT)
464 {
465 switch(token_value)
466 { case ENDIF_CODE:
467 n--; break;
468 case IFV3_CODE:
469 case IFV5_CODE:
470 case IFDEF_CODE:
471 case IFNDEF_CODE:
472 case IFTRUE_CODE:
473 case IFFALSE_CODE:
474 n++; break;
475 case IFNOT_CODE:
476 if (n == 1)
477 { ifdef_stack[ifdef_sp++] = FALSE;
478 n--; break;
479 }
480 }
481 }
482 } while (n > 0);
483 directives.enabled = FALSE;
484 dont_enter_into_symbol_table = FALSE;
485 }
486 break;
487
488 /* --------------------------------------------------------------------- */
489 /* Import global <varname> [, ...] */
490 /* */
491 /* (Further imported goods may be allowed later.) */
492 /* --------------------------------------------------------------------- */
493
494 case IMPORT_CODE:
495 if (!module_switch)
496 { error("'Import' can only be used in -M (Module) mode");
497 panic_mode_error_recovery(); return FALSE;
498 }
499 directives.enabled = TRUE;
500 do
501 { get_next_token();
502 if ((token_type == DIRECTIVE_TT) && (token_value == GLOBAL_CODE))
503 make_global(FALSE, TRUE);
504 else error_named("'Import' cannot import things of this type:",
505 token_text);
506 get_next_token();
507 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
508 put_token_back();
509 directives.enabled = FALSE;
510 break;
511
512 /* --------------------------------------------------------------------- */
513 /* Include "[>]filename" */
514 /* */
515 /* The ">" character means to load the file from the same directory as */
516 /* the current file, instead of relying on the include path. */
517 /* --------------------------------------------------------------------- */
518
519 case INCLUDE_CODE:
520 get_next_token();
521 if (token_type != DQ_TT)
522 return ebf_error_recover("filename in double-quotes", token_text);
523
524 { char *name = token_text;
525
526 get_next_token();
527 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
528 ebf_error("semicolon ';' after Include filename", token_text);
529
530 if (strcmp(name, "language__") == 0)
531 load_sourcefile(Language_Name, 0);
532 else if (name[0] == '>')
533 load_sourcefile(name+1, 1);
534 else load_sourcefile(name, 0);
535 return FALSE;
536 }
537
538 /* --------------------------------------------------------------------- */
539 /* Link "filename" */
540 /* --------------------------------------------------------------------- */
541
542 case LINK_CODE:
543 get_next_token();
544 if (token_type != DQ_TT)
545 return ebf_error_recover("filename in double-quotes", token_text);
546 link_module(token_text); /* See "linker.c" */
547 break;
548
549 /* --------------------------------------------------------------------- */
550 /* Lowstring constantname "text of string" */
551 /* --------------------------------------------------------------------- */
552 /* Unlike most constant creations, these do not require backpatching: */
553 /* the low strings always occupy a table at a fixed offset in the */
554 /* Z-machine (after the abbreviations table has finished, at 0x100). */
555 /* --------------------------------------------------------------------- */
556
557 case LOWSTRING_CODE:
558 if (module_switch)
559 { error("'LowString' cannot be used in -M (Module) mode");
560 panic_mode_error_recovery(); return FALSE;
561 }
562 get_next_token(); i = token_value;
563 if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
564 return ebf_error_recover("new low string name", token_text);
565
566 get_next_token();
567 if (token_type != DQ_TT)
568 return ebf_error_recover("literal string in double-quotes", token_text);
569
570 assign_symbol(i, compile_string(token_text, TRUE, TRUE), CONSTANT_T);
571 break;
572
573 /* --------------------------------------------------------------------- */
574 /* Message | "information" */
575 /* | error "error message" */
576 /* | fatalerror "fatal error message" */
577 /* | warning "warning message" */
578 /* --------------------------------------------------------------------- */
579
580 case MESSAGE_CODE:
581 directive_keywords.enabled = TRUE;
582 get_next_token();
583 directive_keywords.enabled = FALSE;
584 if (token_type == DQ_TT)
585 { int i;
586 if (hash_printed_since_newline) printf("\n");
587 for (i=0; token_text[i]!=0; i++)
588 { if (token_text[i] == '^') printf("\n");
589 else
590 if (token_text[i] == '~') printf("\"");
591 else printf("%c", token_text[i]);
592 }
593 printf("\n");
594 break;
595 }
596 if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
597 { get_next_token();
598 if (token_type != DQ_TT)
599 { return ebf_error_recover("error message in double-quotes", token_text);
600 }
601 error(token_text); break;
602 }
603 if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
604 { get_next_token();
605 if (token_type != DQ_TT)
606 { return ebf_error_recover("fatal error message in double-quotes", token_text);
607 }
608 fatalerror(token_text); break;
609 }
610 if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
611 { get_next_token();
612 if (token_type != DQ_TT)
613 { return ebf_error_recover("warning message in double-quotes", token_text);
614 }
615 warning(token_text); break;
616 }
617 return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
618 token_text);
619 break;
620
621 /* --------------------------------------------------------------------- */
622 /* Nearby objname "short name" ... */
623 /* --------------------------------------------------------------------- */
624
625 case NEARBY_CODE:
626 if (internal_flag)
627 { error("Cannot nest #Nearby inside a routine or object");
628 panic_mode_error_recovery(); return FALSE;
629 }
630 make_object(TRUE, NULL, -1, -1, -1);
631 return FALSE; /* See "objects.c" */
632
633 /* --------------------------------------------------------------------- */
634 /* Object objname "short name" ... */
635 /* --------------------------------------------------------------------- */
636
637 case OBJECT_CODE:
638 if (internal_flag)
639 { error("Cannot nest #Object inside a routine or object");
640 panic_mode_error_recovery(); return FALSE;
641 }
642 make_object(FALSE, NULL, -1, -1, -1);
643 return FALSE; /* See "objects.c" */
644
645 /* --------------------------------------------------------------------- */
646 /* Property [long] [additive] name [alias oldname] */
647 /* --------------------------------------------------------------------- */
648
649 case PROPERTY_CODE: make_property(); break; /* See "objects.c" */
650
651 /* --------------------------------------------------------------------- */
652 /* Release <number> */
653 /* --------------------------------------------------------------------- */
654
655 case RELEASE_CODE:
656 { assembly_operand AO;
657 AO = parse_expression(CONSTANT_CONTEXT);
658 if (module_switch && (AO.marker != 0))
659 error("A definite value must be given as release number");
660 else
661 release_number = AO.value;
662 }
663 break;
664
665 /* --------------------------------------------------------------------- */
666 /* Replace routine [routinename] */
667 /* --------------------------------------------------------------------- */
668
669 case REPLACE_CODE:
670 /* You can also replace system functions normally implemented in */
671 /* the "hardware" of the Z-machine, like "random()": */
672
673 system_functions.enabled = TRUE;
674 directives.enabled = FALSE;
675 directive_keywords.enabled = FALSE;
676
677 /* Don't count the upcoming symbol as a top-level reference
678 *to* the function. */
679 df_dont_note_global_symbols = TRUE;
680 get_next_token();
681 df_dont_note_global_symbols = FALSE;
682 if (token_type == SYSFUN_TT)
683 { if (system_function_usage[token_value] == 1)
684 error("You can't 'Replace' a system function already used");
685 else system_function_usage[token_value] = 2;
686 get_next_token();
687 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
688 {
689 error("You can't give a 'Replace'd system function a new name");
690 panic_mode_error_recovery(); return FALSE;
691 }
692 return FALSE;
693 }
694
695 if (token_type != SYMBOL_TT)
696 return ebf_error_recover("name of routine to replace", token_text);
697 if (!(sflags[token_value] & UNKNOWN_SFLAG))
698 return ebf_error_recover("name of routine not yet defined", token_text);
699
700 sflags[token_value] |= REPLACE_SFLAG;
701
702 /* If a second symbol is provided, it will refer to the
703 original (replaced) definition of the routine. */
704 i = token_value;
705
706 system_functions.enabled = FALSE;
707 df_dont_note_global_symbols = TRUE;
708 get_next_token();
709 df_dont_note_global_symbols = FALSE;
710 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
711 { return FALSE;
712 }
713
714 if (token_type != SYMBOL_TT || !(sflags[token_value] & UNKNOWN_SFLAG))
715 return ebf_error_recover("semicolon ';' or new routine name", token_text);
716
717 /* Define the original-form symbol as a zero constant. Its
718 value will be overwritten later, when we define the
719 replacement. */
720 assign_symbol(token_value, 0, CONSTANT_T);
721 add_symbol_replacement_mapping(i, token_value);
722
723 break;
724
725 /* --------------------------------------------------------------------- */
726 /* Serial "yymmdd" */
727 /* --------------------------------------------------------------------- */
728
729 case SERIAL_CODE:
730 get_next_token();
731 if ((token_type != DQ_TT) || (strlen(token_text)!=6))
732 { error("The serial number must be a 6-digit date in double-quotes");
733 panic_mode_error_recovery(); return FALSE;
734 }
735 for (i=0; i<6; i++) if (isdigit(token_text[i])==0)
736 { error("The serial number must be a 6-digit date in double-quotes");
737 panic_mode_error_recovery(); return FALSE;
738 }
739 strcpy(serial_code_buffer, token_text);
740 serial_code_given_in_program = TRUE;
741 break;
742
743 /* --------------------------------------------------------------------- */
744 /* Statusline score/time */
745 /* --------------------------------------------------------------------- */
746
747 case STATUSLINE_CODE:
748 if (module_switch)
749 warning("This does not set the final game's statusline");
750
751 directive_keywords.enabled = TRUE;
752 get_next_token();
753 directive_keywords.enabled = FALSE;
754 if ((token_type != DIR_KEYWORD_TT)
755 || ((token_value != SCORE_DK) && (token_value != TIME_DK)))
756 return ebf_error_recover("'score' or 'time' after 'statusline'", token_text);
757 if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
758 else statusline_flag = TIME_STYLE;
759 break;
760
761 /* --------------------------------------------------------------------- */
762 /* Stub routinename number-of-locals */
763 /* --------------------------------------------------------------------- */
764
765 case STUB_CODE:
766 if (internal_flag)
767 { error("Cannot nest #Stub inside a routine or object");
768 panic_mode_error_recovery(); return FALSE;
769 }
770
771 /* The upcoming symbol is a definition; don't count it as a
772 top-level reference *to* the stub function. */
773 df_dont_note_global_symbols = TRUE;
774 get_next_token();
775 df_dont_note_global_symbols = FALSE;
776 if (token_type != SYMBOL_TT)
777 return ebf_error_recover("routine name to stub", token_text);
778
779 i = token_value; flag = FALSE;
780
781 if (sflags[i] & UNKNOWN_SFLAG)
782 { sflags[i] |= STUB_SFLAG;
783 flag = TRUE;
784 }
785
786 get_next_token(); k = token_value;
787 if (token_type != NUMBER_TT)
788 return ebf_error_recover("number of local variables", token_text);
789 if ((k>4) || (k<0))
790 { error("Must specify 0 to 4 local variables for 'Stub' routine");
791 k = 0;
792 }
793
794 if (flag)
795 {
796 /* Give these parameter-receiving local variables names
797 for the benefit of the debugging information file,
798 and for assembly tracing to look sensible. */
799
800 local_variable_texts[0] = "dummy1";
801 local_variable_texts[1] = "dummy2";
802 local_variable_texts[2] = "dummy3";
803 local_variable_texts[3] = "dummy4";
804
805 assign_symbol(i,
806 assemble_routine_header(k, FALSE, (char *) symbs[i], FALSE, i),
807 ROUTINE_T);
808
809 /* Ensure the return value of a stubbed routine is false,
810 since this is necessary to make the library work properly */
811
812 if (!glulx_mode)
813 assemblez_0(rfalse_zc);
814 else
815 assembleg_1(return_gc, zero_operand);
816
817 /* Inhibit "local variable unused" warnings */
818
819 for (i=1; i<=k; i++) variable_usage[i] = 1;
820 sequence_point_follows = FALSE;
821 assemble_routine_end(FALSE, get_token_locations());
822 }
823 break;
824
825 /* --------------------------------------------------------------------- */
826 /* Switches switchblock */
827 /* (this directive is ignored if the -i switch was set at command line) */
828 /* --------------------------------------------------------------------- */
829
830 case SWITCHES_CODE:
831 dont_enter_into_symbol_table = TRUE;
832 get_next_token();
833 dont_enter_into_symbol_table = FALSE;
834 if (token_type != DQ_TT)
835 return ebf_error_recover("string of switches", token_text);
836 if (!ignore_switches_switch)
837 { if (constant_made_yet)
838 error("A 'Switches' directive must must come before \
839 the first constant definition");
840 switches(token_text, 0); /* see "inform.c" */
841 }
842 break;
843
844 /* --------------------------------------------------------------------- */
845 /* System_file */
846 /* */
847 /* Some files are declared as "system files": this information is used */
848 /* by Inform only to skip the definition of a routine X if the designer */
849 /* has indicated his intention to Replace X. */
850 /* --------------------------------------------------------------------- */
851
852 case SYSTEM_CODE:
853 declare_systemfile(); break; /* see "files.c" */
854
855 /* --------------------------------------------------------------------- */
856 /* Trace dictionary */
857 /* objects */
858 /* symbols */
859 /* verbs */
860 /* [on/off] */
861 /* assembly [on/off] */
862 /* expressions [on/off] */
863 /* lines [on/off] */
864 /* --------------------------------------------------------------------- */
865
866 case TRACE_CODE:
867 directives.enabled = FALSE;
868 trace_keywords.enabled = TRUE;
869 get_next_token();
870 trace_keywords.enabled = FALSE;
871 directives.enabled = TRUE;
872 if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
873 { asm_trace_level = 1; return FALSE; }
874
875 if (token_type != TRACE_KEYWORD_TT)
876 return ebf_error_recover("debugging keyword", token_text);
877
878 trace_keywords.enabled = TRUE;
879
880 i = token_value; j = 0;
881 switch(i)
882 { case DICTIONARY_TK: break;
883 case OBJECTS_TK: break;
884 case VERBS_TK: break;
885 default:
886 switch(token_value)
887 { case ASSEMBLY_TK:
888 trace_level = &asm_trace_level; break;
889 case EXPRESSIONS_TK:
890 trace_level = &expr_trace_level; break;
891 case LINES_TK:
892 trace_level = &line_trace_level; break;
893 case TOKENS_TK:
894 trace_level = &tokens_trace_level; break;
895 case LINKER_TK:
896 trace_level = &linker_trace_level; break;
897 case SYMBOLS_TK:
898 trace_level = NULL; break;
899 default:
900 put_token_back();
901 trace_level = &asm_trace_level; break;
902 }
903 j = 1;
904 get_next_token();
905 if ((token_type == SEP_TT) &&
906 (token_value == SEMICOLON_SEP))
907 { put_token_back(); break;
908 }
909 if (token_type == NUMBER_TT)
910 { j = token_value; break; }
911 if ((token_type == TRACE_KEYWORD_TT) && (token_value == ON_TK))
912 { j = 1; break; }
913 if ((token_type == TRACE_KEYWORD_TT) && (token_value == OFF_TK))
914 { j = 0; break; }
915 put_token_back(); break;
916 }
917
918 switch(i)
919 { case DICTIONARY_TK: show_dictionary(); break;
920 case OBJECTS_TK: list_object_tree(); break;
921 case SYMBOLS_TK: list_symbols(j); break;
922 case VERBS_TK: list_verb_table(); break;
923 default:
924 *trace_level = j;
925 break;
926 }
927 trace_keywords.enabled = FALSE;
928 break;
929
930 /* --------------------------------------------------------------------- */
931 /* Undef symbol */
932 /* --------------------------------------------------------------------- */
933
934 case UNDEF_CODE:
935 get_next_token();
936 if (token_type != SYMBOL_TT)
937 return ebf_error_recover("symbol name", token_text);
938
939 if (sflags[token_value] & UNKNOWN_SFLAG)
940 { break; /* undef'ing an undefined constant is okay */
941 }
942
943 if (stypes[token_value] != CONSTANT_T)
944 { error_named("Cannot Undef a symbol which is not a defined constant:", (char *)symbs[token_value]);
945 break;
946 }
947
948 if (debugfile_switch)
949 { write_debug_undef(token_value);
950 }
951 end_symbol_scope(token_value);
952 sflags[token_value] |= USED_SFLAG;
953 break;
954
955 /* --------------------------------------------------------------------- */
956 /* Verb ... */
957 /* --------------------------------------------------------------------- */
958
959 case VERB_CODE: make_verb(); return FALSE; /* see "tables.c" */
960
961 /* --------------------------------------------------------------------- */
962 /* Version <number> */
963 /* --------------------------------------------------------------------- */
964
965 case VERSION_CODE:
966
967 { assembly_operand AO;
968 AO = parse_expression(CONSTANT_CONTEXT);
969 /* If a version has already been set on the command line,
970 that overrides this. */
971 if (version_set_switch)
972 {
973 warning("The Version directive was overridden by a command-line argument.");
974 break;
975 }
976
977 if (module_switch && (AO.marker != 0))
978 error("A definite value must be given as version number");
979 else
980 if (glulx_mode)
981 {
982 warning("The Version directive does not work in Glulx. Use \
983 -vX.Y.Z instead, as either a command-line argument or a header comment.");
984 break;
985 }
986 else
987 { i = AO.value;
988 if ((i<3) || (i>8))
989 { error("The version number must be in the range 3 to 8");
990 break;
991 }
992 select_version(i);
993 }
994 }
995 break; /* see "inform.c" */
996
997 /* --------------------------------------------------------------------- */
998 /* Zcharacter table <num> ... */
999 /* Zcharacter table + <num> ... */
1000 /* Zcharacter <string> <string> <string> */
1001 /* Zcharacter <char> */
1002 /* --------------------------------------------------------------------- */
1003
1004 case ZCHARACTER_CODE:
1005
1006 if (glulx_mode) {
1007 error("The Zcharacter directive has no meaning in Glulx.");
1008 panic_mode_error_recovery(); return FALSE;
1009 }
1010
1011 directive_keywords.enabled = TRUE;
1012 get_next_token();
1013 directive_keywords.enabled = FALSE;
1014
1015 switch(token_type)
1016 { case DQ_TT:
1017 new_alphabet(token_text, 0);
1018 get_next_token();
1019 if (token_type != DQ_TT)
1020 return ebf_error_recover("double-quoted alphabet string", token_text);
1021 new_alphabet(token_text, 1);
1022 get_next_token();
1023 if (token_type != DQ_TT)
1024 return ebf_error_recover("double-quoted alphabet string", token_text);
1025 new_alphabet(token_text, 2);
1026 break;
1027
1028 case SQ_TT:
1029 map_new_zchar(text_to_unicode(token_text));
1030 if (token_text[textual_form_length] != 0)
1031 return ebf_error_recover("single character value", token_text);
1032 break;
1033
1034 case DIR_KEYWORD_TT:
1035 switch(token_value)
1036 { case TABLE_DK:
1037 { int plus_flag = FALSE;
1038 get_next_token();
1039 if ((token_type == SEP_TT) && (token_value == PLUS_SEP))
1040 { plus_flag = TRUE;
1041 get_next_token();
1042 }
1043 while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
1044 { switch(token_type)
1045 { case NUMBER_TT:
1046 new_zscii_character(token_value, plus_flag);
1047 plus_flag = TRUE; break;
1048 case SQ_TT:
1049 new_zscii_character(text_to_unicode(token_text),
1050 plus_flag);
1051 if (token_text[textual_form_length] != 0)
1052 return ebf_error_recover("single character value",
1053 token_text);
1054 plus_flag = TRUE;
1055 break;
1056 default:
1057 return ebf_error_recover("character or Unicode number",
1058 token_text);
1059 }
1060 get_next_token();
1061 }
1062 if (plus_flag) new_zscii_finished();
1063 put_token_back();
1064 }
1065 break;
1066 case TERMINATING_DK:
1067 get_next_token();
1068 while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
1069 { switch(token_type)
1070 { case NUMBER_TT:
1071 terminating_characters[no_termcs++]
1072 = token_value;
1073 break;
1074 default:
1075 return ebf_error_recover("ZSCII number",
1076 token_text);
1077 }
1078 get_next_token();
1079 }
1080 put_token_back();
1081 break;
1082 default:
1083 return ebf_error_recover("'table', 'terminating', \
1084 a string or a constant",
1085 token_text);
1086 }
1087 break;
1088 default:
1089 return ebf_error_recover("three alphabet strings, \
1090 a 'table' or 'terminating' command or a single character", token_text);
1091 }
1092 break;
1093
1094 /* ===================================================================== */
1095
1096 }
1097
1098 /* We are now at the end of a syntactically valid directive. It
1099 should be terminated by a semicolon. */
1100
1101 get_next_token();
1102 if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
1103 { ebf_error("';'", token_text);
1104 /* Put the non-semicolon back. We will continue parsing from
1105 that point, in hope that it's the start of a new directive.
1106 (This recovers cleanly from a missing semicolon at the end
1107 of a directive. It's not so clean if the directive *does*
1108 end with a semicolon, but there's extra garbage before it.) */
1109 put_token_back();
1110 }
1111 return FALSE;
1112 }
1113
1114 /* ========================================================================= */
1115 /* Data structure management routines */
1116 /* ------------------------------------------------------------------------- */
1117
1118 extern void init_directs_vars(void)
1119 {
1120 }
1121
1122 extern void directs_begin_pass(void)
1123 { no_routines = 0;
1124 no_named_routines = 0;
1125 no_locals = 0;
1126 no_termcs = 0;
1127 constant_made_yet = FALSE;
1128 ifdef_sp = 0;
1129 }
1130
1131 extern void directs_allocate_arrays(void)
1132 {
1133 }
1134
1135 extern void directs_free_arrays(void)
1136 {
1137 }
1138
1139 /* ========================================================================= */
Debian packaging for ‘inform6-compiler’