src/directs.c

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