directs.c

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