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