instruct/Instruct.inf

   1 !% -GS\r
   2 !% $MAX_STATIC_DATA=20000;\r
   3 !%\r
   4 ! =================================================================================================\r
   5 !   INSTRUCTOR -- reformat Inform source files -- Roger Firth (roger@firthworks.com)\r
   6 !\r
   7 !   V1.2 11Oct04 - fixed support for dynamic Class declarations\r
   8 !   V1.1 29Jan04 - changed ReadSourceLine() to handle cross-platform End-Of-Line characters\r
   9 !   V1.0 13Nov03 - first public release\r
  10 !\r
  11 !   This program is a pretty-printer -- it reads an Inform source file, and writes the same\r
  12 !   information, neatly formatted, to an output file (which must be DIFFERENT FROM the input file).\r
  13 !   Use it only on source files which compile without any errors.\r
  14 !\r
  15 !   The program is a standalone Glulx utility which does not used the Inform library files.\r
  16 !   To compile it, you will need to include on the command line: $MAX_STATIC_DATA=20000\r
  17 !   and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do.\r
  18 !\r
  19 !   This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without \r
  20 !   modification, are permitted in any medium without royalty provided the copyright notice and \r
  21 !   this notice are preserved.\r
  22 !\r
  23 ! =================================================================================================\r
  24 !   These settings should be sufficient, but may need adjusting for an enormous game.\r
  25 \r
  26 Constant MAX_SOURCE 4100;               ! Line of source input.\r
  27 Array    theSource -> MAX_SOURCE;\r
  28 \r
  29 Constant MAX_STRING 4100;               ! Double-quoted string.\r
  30 Array    theString -> MAX_STRING;\r
  31 \r
  32 Constant MAX_OUTPUT 200;                ! Line of source output.\r
  33 Array    theOutput -> MAX_OUTPUT;\r
  34 \r
  35 Constant MAX_INPUT 50;                  ! Line of keyboard input.\r
  36 Array    theInput -> MAX_INPUT;\r
  37 \r
  38 Constant MAX_TOKENS 2;                  ! Input tokens.\r
  39 Array    TokenStart -> MAX_TOKENS;\r
  40 Array    TokenEnd   -> MAX_TOKENS;\r
  41 Array    Tokens    --> MAX_TOKENS;      ! Command, optional numbers.\r
  42 \r
  43 \r
  44 Constant DEFAULT_INDENT   4;            ! Tab size.\r
  45 Constant DEFAULT_COMMENT 40;            ! Comment alignment;\r
  46 Constant DEFAULT_MARGIN  80;            ! Wrap long lines.\r
  47 \r
  48 Constant fixBadSyntax   = true;         ! " to ' in name properties, etc.\r
  49 !Constant indentWithTabs = false;       ! Leading spaces become tabs.\r
  50 \r
  51 ! =================================================================================================\r
  52 !   Since we're not using the Glulx Inform library files, we need to set up our own Glk\r
  53 !   Input/Output.\r
  54 \r
  55 Include "infglk";                       ! Use sensible names for calls to Glk.\r
  56 \r
  57 Array   gg_event --> 4;                 ! The event handler uses a four-word array.\r
  58 Global  gg_mainwin = 0;                 ! There is only one window.\r
  59 \r
  60 Constant ANY_OLD_ROCK 0;                ! Rock values don't seem necessary here.\r
  61 \r
  62 ! =================================================================================================\r
  63 !   General constants used by the tool.\r
  64 \r
  65 Constant TAB     $09;\r
  66 Constant NEWLINE $0A;\r
  67 Constant RETURN  $0D;\r
  68 Constant SPACE   $20;\r
  69 Constant SQUOTE  $27;\r
  70 Constant COMMA   $2C;\r
  71 Constant ATSIGN  $40;\r
  72 \r
  73 Constant LEX_INVALID      0;\r
  74 Constant LEX_NEWLINE    100;\r
  75 Constant LEX_COMMENT    200;\r
  76 \r
  77 Constant LEX_VALUE      300;    ! context-sensitive spacing\r
  78 Constant LEX_IDENT      310;    ! ABC123_\r
  79 Constant LEX_STATEMENT  320;    ! do if else objectloop print print_ret switch until while\r
  80 Constant LEX_NUMBER     370;    ! 123 $FF $$1010\r
  81 Constant LEX_DQ_STRING  380;    ! "..."\r
  82 Constant LEX_SQ_STRING  390;    ! '...'\r
  83 Constant LEX_VALUE_END  399;\r
  84 \r
  85 Constant LEX_SEPARATE   400;\r
  86 \r
  87 Constant LEX_SEPG0      400;    ! space before:NO   after:NO\r
  88 Constant LEX_ARROW      410;    ! ->\r
  89 Constant LEX_DOT        420;    ! .\r
  90 Constant LEX_SEPG0_END  499;    ! --> >> .# .& .. ..# ..& ::\r
  91 \r
  92 Constant LEX_SEPG1      500;    ! space before:NO   after:YES\r
  93 Constant LEX_COLON      510;    ! :\r
  94 Constant LEX_SEMIC      520;    ! ;\r
  95 Constant LEX_COMMA      530;    ! ,\r
  96 Constant LEX_RPAREN     540;    ! )\r
  97 Constant LEX_RBRACE     550;    ! }\r
  98 Constant LEX_RBRCKT     560;    ! ]\r
  99 Constant LEX_SEPG1_END  599;    !\r
 100 \r
 101 Constant LEX_SEPG2      600;    ! space before:YES  after:NO\r
 102 Constant LEX_LPAREN     610;    ! (\r
 103 Constant LEX_LBRACE     620;    ! {\r
 104 Constant LEX_LTLT       630;    ! <<\r
 105 Constant LEX_HASH       640;    ! #\r
 106 Constant LEX_TILDE      650;    ! ~\r
 107 Constant LEX_SEPG2_END  699;    ! ~~ ## #a$ #n$ #r$ #w$ @ ? ?~\r
 108 \r
 109 Constant LEX_SEPG3      700;    ! space before:YES  after:YES\r
 110 Constant LEX_LBRCKT     710;    ! [\r
 111 Constant LEX_ASTERISK   720;    ! *\r
 112 Constant LEX_SEPG3_END  799;    ! = + / % | || & && == ~= < > <= >=\r
 113 \r
 114 Constant LEX_SEPG4      800;    ! context-sensitive spacing\r
 115 Constant LEX_MINUS      810;    ! -\r
 116 Constant LEX_MINUSMINUS 820;    ! --\r
 117 Constant LEX_PLUSPLUS   830;    ! ++\r
 118 Constant LEX_SEPG4_END  899;    !\r
 119 \r
 120 Constant LEX_SEPARATE_END   999;\r
 121 \r
 122 \r
 123 Array DirEnd string "End";\r
 124 Array DirIf3 string "Ifv3";\r
 125 Array DirIf5 string "Ifv5";\r
 126 Array DirLnk string "Link";\r
 127 Array DirStb string "Stub";\r
 128 Array DirVrb string "Verb";\r
 129 Array DirArr string "Array";\r
 130 Array DirCla string "Class";\r
 131 \r
 132 Array DirEnf string "Endif";\r
 133 Array DirIfd string "Ifdef";\r
 134 Array DirIfn string "Ifnot";\r
 135 Array DirTra string "Trace";\r
 136 Array DirUnd string "Undef";\r
 137 Array DirExt string "Extend";\r
 138 Array DirGlo string "Global";\r
 139 Array DirIfu string "Ifndef";\r
 140 \r
 141 Array DirIft string "Iftrue";\r
 142 Array DirImp string "Import";\r
 143 Array DirNby string "Nearby";\r
 144 Array DirObj string "Object";\r
 145 Array DirSer string "Serial";\r
 146 Array DirDef string "Default";\r
 147 Array DirIff string "Iffalse";\r
 148 Array DirInc string "Include";\r
 149 \r
 150 Array DirMsg string "Message";\r
 151 Array DirRel string "Release";\r
 152 Array DirRep string "Replace";\r
 153 Array DirVer string "Version";\r
 154 Array DirCon string "Constant";\r
 155 Array DirPro string "Property";\r
 156 Array DirSwi string "Switches";\r
 157 Array DirAtt string "Attribute";\r
 158 \r
 159 Array DirLow string "Lowstring";\r
 160 Array DirAbb string "Abbreviate";\r
 161 Array DirDct string "Dictionary";\r
 162 Array DirSts string "Statusline";\r
 163 Array DirZch string "Zcharacter";\r
 164 Array DirFak string "Fake_action";\r
 165 Array DirSys string "System_file";\r
 166 \r
 167 Array Directives table\r
 168     DirEnd DirIf3 DirIf5 DirLnk DirStb DirVrb DirArr DirCla\r
 169     DirEnf DirIfd DirIfn DirTra DirUnd DirExt DirGlo DirIfu\r
 170     DirIft DirImp DirNby DirObj DirSer DirDef DirIff DirInc\r
 171     DirMsg DirRel DirRep DirVer DirCon DirPro DirSwi DirAtt\r
 172     DirLow DirAbb DirDct DirSts DirZch DirFak DirSys;\r
 173 \r
 174 \r
 175 Array ObjHas string "has";\r
 176 Array ObjWth string "with";\r
 177 Array ObjCla string "class";\r
 178 Array ObjPri string "private";\r
 179 \r
 180 Array ObjSegments table\r
 181     ObjHas ObjWth ObjCla ObjPri;\r
 182 \r
 183 \r
 184 Array SmtDo_ string "do";\r
 185 Array SmtIf_ string "if";\r
 186 !Array SmtBox string "box";\r
 187 Array SmtFor string "for";\r
 188 Array SmtEls string "else";\r
 189 !Array SmtFnt string "font";\r
 190 !Array SmtGiv string "give";\r
 191 !Array SmtJmp string "jump";\r
 192 \r
 193 !Array SmtMov string "move";\r
 194 !Array SmtQit string "quit";\r
 195 !Array SmtRed string "read";\r
 196 !Array SmtSav string "save";\r
 197 !Array SmtBrk string "break";\r
 198 Array SmtPri string "print";\r
 199 !Array SmtRtr string "rtrue";\r
 200 !Array SmtSty string "style";\r
 201 \r
 202 Array SmtUnt string "until";\r
 203 Array SmtWhi string "while";\r
 204 !Array SmtRem string "remove";\r
 205 !Array SmtRet string "return";\r
 206 !Array SmtRfa string "rfalse";\r
 207 !Array SmtSpa string "spaces";\r
 208 !Array SmtStr string "string";\r
 209 Array SmtSwi string "switch";\r
 210 \r
 211 !Array SmtRes string "restore";\r
 212 !Array SmtNew string "new_line";\r
 213 !Array SmtCon string "continue";\r
 214 !Array SmtInv string "inversion";\r
 215 Array SmtPrt string "print_ret";\r
 216 Array SmtObj string "objectloop";\r
 217 \r
 218 ! Array Statements table\r
 219 !   SmtDo_ SmtIf_ SmtBox SmtFor SmtEls SmtFnt SmtGiv SmtJmp\r
 220 !   SmtMov SmtQit SmtRed SmtSav SmtBrk SmtPri SmtRtr SmtSty\r
 221 !   SmtUnt SmtWhi SmtRem SmtRet SmtRfa SmtSpa SmtStr SmtSwi\r
 222 !   SmtRes SmtNew SmtCon SmtInv SmtPrt SmtObj;\r
 223 \r
 224 Array Statements table\r
 225     SmtDo_ SmtIf_ SmtFor SmtEls SmtPri SmtUnt SmtWhi SmtSwi SmtPrt SmtObj;\r
 226 \r
 227 \r
 228 Array PrpNam string "name";\r
 229 \r
 230 Array Properties table\r
 231     PrpNam PrpNam;\r
 232 \r
 233 ! =================================================================================================\r
 234 !   Variables used by the tool.\r
 235 \r
 236 Global   indentSize    = DEFAULT_INDENT;\r
 237 Global   commentColumn = DEFAULT_COMMENT;\r
 238 Global   marginColumn  = DEFAULT_MARGIN;\r
 239 \r
 240 Global   sourceStream;\r
 241 Global   targetStream;\r
 242 \r
 243 Global   currentState;\r
 244 Constant STATE_NONE               0;\r
 245 Constant STATE_CLASS_HEADER     100;\r
 246 Constant STATE_OBJECT_HEADER    200;\r
 247 Constant STATE_OBJECT_BODY      250;\r
 248 Constant STATE_VERB             300;\r
 249 Constant STATE_ROUTINE          400;\r
 250 Constant STATE_OTHER_DIR        500;\r
 251 \r
 252 Global   nextWhite;\r
 253 Constant NEXT_NONE      0;\r
 254 Constant NEXT_SPACE     1;\r
 255 Constant NEXT_NEWLINE   2;\r
 256 Constant NEXT_BLANKLINE 3;\r
 257 \r
 258 Global   savedChar;                     ! read one character too many\r
 259 Global   sourceLine;                    ! source line count\r
 260 Global   sourceLen;                     ! source line length\r
 261 Global   sourceP1;                      ! start of lexeme\r
 262 Global   sourceP2;                      ! end of lexeme + 1\r
 263 Global   sourceP3;                      ! end of string + 1\r
 264 Global   previousLex;                   ! previous lexeme\r
 265 Global   parenCount;                    ! unmatched parentheses\r
 266 \r
 267 Global   outputLen;                     ! output line length\r
 268 Global   currentIndent;                 ! units of indentation\r
 269 \r
 270 Global   prevLineBlank;                                 ! a few flags\r
 271 Global   routineIsEmbedded;\r
 272 Global   directiveIsEmbedded;\r
 273 Global   mapDQtoSQ;\r
 274 \r
 275 \r
 276 ! =================================================================================================\r
 277 !   Instructions for use.\r
 278 \r
 279 [ ShowHelp;\r
 280     font off;\r
 281     print "This tool pretty-prints an Inform source file. It is driven by these commands:^\r
 282      ^\r
 283      N - reformat a new source file. You are prompted for the name of the input\r
 284      ^    source file, and for a second file to receive the output. Ensure that\r
 285      ^    the output file is DIFFERENT FROM the input file, or the input will be\r
 286      ^    overwritten.^\r
 287      ^\r
 288      Q - quit.^\r
 289      ^\r
 290      I <num> - specify the size of each indentation.^\r
 291      I       - reset to default of ", DEFAULT_INDENT, ".^\r
 292      C <num> - specify the column to align inline comment (0 for no alignment).^\r
 293      C       - reset to default of ", DEFAULT_COMMENT, ".^\r
 294      M <num> - specify the column to wrap long lines (0 for no wrap).^\r
 295      M       - reset to default of ", DEFAULT_MARGIN, ".^\r
 296      ^\r
 297      ? - display these instructions.^";\r
 298      font on;\r
 299 ];\r
 300 \r
 301 [ ShowStatus;\r
 302     font off;\r
 303     new_line;\r
 304     print\r
 305         "   Indent:", indentSize,\r
 306         "   Inline comment col:", commentColumn,\r
 307         "   Right margin col:", marginColumn;\r
 308     new_line; new_line;\r
 309     font on;\r
 310 ];\r
 311 \r
 312 ! =================================================================================================\r
 313 !   This is the top-level control loop.\r
 314 \r
 315 [ Main;\r
 316 \r
 317     @setiosys 2 0;                      ! Set Glk as the VM's I/O layer.\r
 318     gg_mainwin =                        ! Open the main window.\r
 319         glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK);\r
 320     glk_set_window(gg_mainwin);         ! Make it the current window.\r
 321 \r
 322     glk_set_style(style_Header);\r
 323     print "INSTRUCTOR 1.2";\r
 324     glk_set_style(style_Normal);\r
 325     print "^A tool for reformatting Inform source files.^^";\r
 326     ShowHelp();                         ! Explain what they can do.\r
 327 \r
 328     while (true) {                      ! Loop here until "Q" typed.\r
 329         ShowStatus();\r
 330         print "> ";                     ! Prompt for a line of input.\r
 331         if (~~ParseLine()) continue;    ! Nothing typed\r
 332         Tokens-->0 = theInput->(TokenStart->0);\r
 333         Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1);\r
 334         switch (Tokens-->0) {           ! Deal with the character, then loop back.\r
 335           'C','c':  DoCommentColumn();\r
 336           'I','i':  DoIndentSize();\r
 337           'M','m':  DoMarginColumn();\r
 338           'N','n':  DoReformat();\r
 339           'Q','q':  DoQuit();\r
 340           '?','/':  ShowHelp();\r
 341           default:  print "Possible keys are N, Q, I, C, M and ?^";\r
 342         }\r
 343     }\r
 344 ];\r
 345 \r
 346 ! =================================================================================================\r
 347 !   I/O handling.\r
 348 \r
 349 [ InputLine buf buflen;                 ! Input a line of characters.\r
 350     glk_request_line_event(gg_mainwin, buf, buflen, 0);\r
 351     while (true) {                      ! Wait for RETURN to be pressed.\r
 352         glk_select(gg_event);           ! LineInput is the only interesting event.\r
 353         if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin)\r
 354             return (gg_event-->2);      ! Number of characters.\r
 355     }\r
 356 ];\r
 357 \r
 358 [ ParseLine                             ! Read line of input, find tokens\r
 359     i j n;\r
 360     for (i=0 : i<MAX_TOKENS : i++) TokenStart->i = TokenEnd->i = 0;\r
 361     n = InputLine(theInput, MAX_INPUT);\r
 362     glk_select_poll(gg_event);\r
 363     if (n == 0) rfalse;                 ! Nothing typed.\r
 364     for (i=j=0 : i<MAX_TOKENS : i++) {\r
 365         while (theInput->j == SPACE or COMMA) {\r
 366             j++;\r
 367             if (j >= n) return i;\r
 368         }\r
 369         TokenStart->i = j;\r
 370         while (theInput->j ~= SPACE or COMMA) {\r
 371             j++;\r
 372             TokenEnd->i = j;\r
 373             if (j >= n) return i+1;\r
 374         }\r
 375     }\r
 376     return i;\r
 377 ];\r
 378 \r
 379 [ ParseNumber a b                       ! Parse token as bin/dec/hex number.\r
 380     char base num i;\r
 381     if (a == b) return -1;\r
 382     base = 10; num = 0;\r
 383     i = a;\r
 384     if (theInput->i == '-') i++;\r
 385     if (theInput->i == '$') {\r
 386         base = 16; i++;\r
 387         if (theInput->i == '$') { base = 2; i++; }\r
 388     }\r
 389     for ( : i<b : i++) {\r
 390         char = theInput->i;\r
 391         if (char >= '0' && char <= '9') char = char - '0';\r
 392         else {\r
 393             if (char >= 'A' && char <= 'Z') char = char - 'A' + 10;\r
 394             else {\r
 395                 if (char >= 'a' && char <= 'z') char = char - 'a' + 10;\r
 396                 else return -1;\r
 397             }\r
 398         }\r
 399         if (char < base) num = (num * base) + char;\r
 400         else return -1;\r
 401     }\r
 402     if (theInput->a == '-') num = -num;\r
 403     return num;\r
 404 ];\r
 405 \r
 406 [ OpenSourceForRead\r
 407     fileref;\r
 408     fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK);\r
 409     if (fileref == GLK_NULL) "Failed to create Source fileref.";\r
 410     sourceStream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK);\r
 411     if (sourceStream == GLK_NULL) "Failed to open Source stream.";\r
 412     glk_fileref_destroy(fileref);\r
 413     rfalse;                             ! Successful -- OK to continue.\r
 414 ];\r
 415 \r
 416 [ OpenTargetForWrite\r
 417     fileref;\r
 418     fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Write, ANY_OLD_ROCK);\r
 419     if (fileref == GLK_NULL) "Failed to create Target fileref.";\r
 420     targetStream = glk_stream_open_file(fileref, filemode_Write, ANY_OLD_ROCK);\r
 421     if (targetStream == GLK_NULL) "Failed to open Target stream.";\r
 422     glk_fileref_destroy(fileref);\r
 423     rfalse;                             ! Successful -- OK to continue.\r
 424 ];\r
 425 \r
 426 ! =================================================================================================\r
 427 !   Quit from the utility.\r
 428 \r
 429 [ DoQuit;\r
 430     print "Hit any key to exit.^"; quit;\r
 431 ];\r
 432 \r
 433 ! =================================================================================================\r
 434 !   Set indent size.\r
 435 \r
 436 [ DoIndentSize;\r
 437     if (Tokens-->1 < 0)\r
 438         indentSize = DEFAULT_INDENT;\r
 439     else\r
 440         indentSize = Tokens-->1;\r
 441 ];\r
 442 \r
 443 ! =================================================================================================\r
 444 !   Set inline comment column.\r
 445 \r
 446 [ DoCommentColumn;\r
 447     if (Tokens-->1 < 0)\r
 448         commentColumn = DEFAULT_COMMENT;\r
 449     else\r
 450         commentColumn = Tokens-->1;\r
 451 ];\r
 452 \r
 453 ! =================================================================================================\r
 454 !   Set right margin column.\r
 455 \r
 456 [ DoMarginColumn;\r
 457     if (Tokens-->1 < 0)\r
 458         marginColumn = DEFAULT_MARGIN;\r
 459     else\r
 460         marginColumn = Tokens-->1;\r
 461 ];\r
 462 \r
 463 ! =================================================================================================\r
 464 !   Reformat the source.\r
 465 \r
 466 [ DoReformat\r
 467     lex x;\r
 468 \r
 469     print "First, specify an Inform source file to be reformatted.^";\r
 470     glk_select_poll(gg_event);\r
 471     if (OpenSourceForRead()) return;\r
 472 \r
 473     print "Now, specify a DIFFERENT file to hold the reformatted output.^";\r
 474     glk_select_poll(gg_event);\r
 475     if (OpenTargetForWrite()) { glk_stream_close(sourceStream, GLK_NULL); return; }\r
 476 \r
 477     currentState = STATE_NONE;\r
 478     nextWhite = NEXT_NONE;\r
 479     sourceLine = sourceLen = sourceP1 = sourceP2 = sourceP3 = 0;\r
 480     previousLex = parenCount = outputLen = currentIndent = 0;\r
 481 \r
 482     prevLineBlank = true;\r
 483     routineIsEmbedded = directiveIsEmbedded = mapDQtoSQ = false;\r
 484 \r
 485     ! Break the source file into lexemes.\r
 486 \r
 487     for (lex=GetLexeme() : lex : lex=GetLexeme()) {\r
 488 \r
 489         ! Deal with newlines and comments.\r
 490 \r
 491         if (lex == LEX_NEWLINE) {\r
 492             switch (nextWhite) {\r
 493               NEXT_NEWLINE:   PutNL(1);\r
 494               NEXT_BLANKLINE: PutNL(2);\r
 495             }\r
 496             continue;\r
 497         }\r
 498         if (lex == LEX_COMMENT) {\r
 499             if (outputLen) {\r
 500                 PutSpace(commentColumn-outputLen);\r
 501                 nextWhite = NEXT_SPACE;\r
 502             }\r
 503             else\r
 504                 nextWhite = NEXT_NONE;\r
 505             PrintLexeme(lex); PutNL(1);\r
 506             continue;\r
 507         }\r
 508         switch (nextWhite) {\r
 509           NEXT_NEWLINE:   PutNL(1);\r
 510           NEXT_BLANKLINE: PutNL(2);\r
 511         }\r
 512 \r
 513         ! Set up default spacing for this lexeme.\r
 514 \r
 515         switch (lex) {\r
 516           LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG1 to LEX_SEPG1_END:\r
 517             nextWhite = NEXT_NONE;\r
 518           LEX_SEPG2 to LEX_SEPG2_END, LEX_SEPG3 to LEX_SEPG3_END:\r
 519             nextWhite = NEXT_SPACE;\r
 520         }\r
 521 \r
 522         ! Handle the lexeme according to the current major state.\r
 523 \r
 524         switch (currentState) {\r
 525 \r
 526           ! At outermost level of source.\r
 527 \r
 528           STATE_NONE:\r
 529             print "* "; glk_select_poll(gg_event);\r
 530             currentIndent = 0;\r
 531             switch (lex) {\r
 532               LEX_IDENT:                ! New directive.\r
 533                 x = MatchString(theSource, sourceP1, sourceP2, Directives);\r
 534                 if (x) switch (Directives-->x) {\r
 535                       DirCla:\r
 536                         nextWhite = NEXT_BLANKLINE;\r
 537                         currentState = STATE_CLASS_HEADER;\r
 538                       DirObj,DirNby:\r
 539                         nextWhite = NEXT_BLANKLINE;\r
 540                         currentState = STATE_OBJECT_HEADER;\r
 541                       DirVrb,DirExt:\r
 542                         nextWhite = NEXT_BLANKLINE;\r
 543                         currentState = STATE_VERB;\r
 544                         if (fixBadSyntax) mapDQtoSQ = true;\r
 545                       default:\r
 546                         currentState = STATE_OTHER_DIR;\r
 547                 }\r
 548                 else {                  ! Must be a user-defined class.\r
 549                     nextWhite = NEXT_BLANKLINE;\r
 550                     currentState = STATE_OBJECT_HEADER;\r
 551                 }\r
 552                 if (fixBadSyntax && Directives-->x == DirNby) {\r
 553                     PutChar('O'); PutChar('b'); PutChar('j'); PutChar('e'); PutChar('c'); PutChar('t');\r
 554                     PutChar(' '); PutChar(' '); PutChar('-'); PutChar('>');\r
 555                     nextWhite = NEXT_SPACE;\r
 556                 }\r
 557                 else {\r
 558                     PrintDirective();\r
 559                     if (currentState == STATE_CLASS_HEADER or STATE_OBJECT_HEADER)\r
 560                         PutSpace(indentSize*2-sourceP2+sourceP1);\r
 561                 }\r
 562               LEX_LBRCKT:               ! New standalone routine.\r
 563                 nextWhite = NEXT_BLANKLINE; PrintLexeme(lex);\r
 564                 currentIndent = 1; ControlReset();\r
 565                 currentState = STATE_ROUTINE; routineIsEmbedded = false;\r
 566               LEX_HASH:                 ! Prefix to new directive.\r
 567                 PrintLexeme(lex);\r
 568               default:\r
 569                 PrintLexeme(lex);\r
 570                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_NONE.";\r
 571             }\r
 572 \r
 573           ! Standalone or Embedded routine.\r
 574 \r
 575           STATE_ROUTINE:\r
 576             switch (ControlGet()) {\r
 577               CONTROL_IF_SCOPE:\r
 578                 if (lex == LEX_LBRACE)\r
 579                     ControlSet(CONTROL_IF_MULTI);\r
 580                 else {\r
 581                     ControlSet(CONTROL_IF_SINGLE);\r
 582                     currentIndent++;\r
 583                     nextWhite = NEXT_NEWLINE;\r
 584                 }\r
 585               CONTROL_XX_SCOPE:\r
 586                 if (lex == LEX_LBRACE)\r
 587                     ControlSet(CONTROL_XX_MULTI);\r
 588                 else {\r
 589                     ControlSet(CONTROL_XX_SINGLE);\r
 590                     currentIndent++;\r
 591                     nextWhite = NEXT_NEWLINE;\r
 592                 }\r
 593             }\r
 594             switch (lex) {\r
 595               LEX_SEMIC:\r
 596                 PrintLexeme(lex);\r
 597                 if (previousLex == LEX_RBRCKT && ~~routineIsEmbedded) {\r
 598                     currentState = STATE_NONE;\r
 599                     nextWhite = NEXT_BLANKLINE;\r
 600                 }\r
 601                 while (ControlGet() == CONTROL_XX_SINGLE) {\r
 602                     ControlPop();\r
 603                     currentIndent--;\r
 604                 }\r
 605                 if (ControlGet() == CONTROL_IF_SINGLE) {\r
 606                     ControlSet(CONTROL_IF_ELSE);\r
 607                     currentIndent--;\r
 608                 }\r
 609               LEX_RBRCKT:\r
 610                 if (routineIsEmbedded) {\r
 611                     currentState = STATE_OBJECT_BODY;\r
 612                     currentIndent = 2;\r
 613                 }\r
 614                 else\r
 615                     currentIndent = 0;\r
 616                 PrintLexeme(lex);\r
 617               LEX_HASH:\r
 618                 if (outputLen == 0) {   ! Prefix to new directive.\r
 619                     PrintLexeme(lex);\r
 620                     lex = GetLexeme();\r
 621                     PrintDirective();\r
 622                     currentState = STATE_OTHER_DIR; directiveIsEmbedded = true;\r
 623                 }\r
 624                 else\r
 625                     PrintLexeme(lex);\r
 626               LEX_LBRACE:\r
 627                 PrintLexeme(lex);\r
 628                 currentIndent++;\r
 629               LEX_RBRACE:\r
 630                 currentIndent--;\r
 631                 if (ControlGet() == CONTROL_IF_MULTI) {\r
 632                     ControlSet(CONTROL_IF_ELSE);\r
 633                     PrintLexeme(lex);\r
 634                 }\r
 635                 else {\r
 636                     if (ControlGet() == CONTROL_IF_ELSE) {\r
 637                         ControlPop();\r
 638                         while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
 639                             ControlPop();\r
 640                             currentIndent--;\r
 641                         }\r
 642                         if (ControlGet() == CONTROL_IF_MULTI)\r
 643                             ControlSet(CONTROL_IF_ELSE);\r
 644                     }\r
 645                     PrintLexeme(lex);\r
 646                     if (ControlGet() == CONTROL_XX_MULTI) {\r
 647                         ControlPop();\r
 648                         while (ControlGet() == CONTROL_XX_SINGLE) {\r
 649                             ControlPop();\r
 650                             currentIndent--;\r
 651                         }\r
 652                         if (ControlGet() == CONTROL_IF_SINGLE) {\r
 653                             ControlSet(CONTROL_IF_ELSE);\r
 654                             currentIndent--;\r
 655                         }\r
 656                     }\r
 657                 }\r
 658               LEX_COLON:\r
 659                 if (parenCount == 0) {\r
 660                     PullSpace(indentSize/2); PrintLexeme(lex); nextWhite = NEXT_NEWLINE;\r
 661                 } else {\r
 662                     nextWhite = NEXT_SPACE; PrintLexeme(lex);\r
 663                 }\r
 664               LEX_DOT:\r
 665                 if (outputLen)\r
 666                     PrintLexeme(lex);\r
 667                 else\r
 668                     { nextWhite = NEXT_NEWLINE; PrintLexeme(lex); PullSpace(indentSize/2); }\r
 669               LEX_LPAREN, LEX_PLUSPLUS, LEX_MINUSMINUS:\r
 670                 if (previousLex == LEX_IDENT or LEX_LPAREN or LEX_PLUSPLUS or LEX_MINUSMINUS)\r
 671                     nextWhite = NEXT_NONE;\r
 672                 PrintLexeme(lex);\r
 673               LEX_RPAREN:\r
 674                 PrintLexeme(lex);\r
 675                 if (parenCount == 0) {\r
 676                     if (ControlGet() == CONTROL_IF_COND) ControlSet(CONTROL_IF_SCOPE);\r
 677                     if (ControlGet() == CONTROL_XX_COND) ControlSet(CONTROL_XX_SCOPE);\r
 678                 }\r
 679               LEX_MINUS:\r
 680                 PrintLexeme(lex);\r
 681                 if (previousLex ~= LEX_IDENT or LEX_NUMBER or LEX_RPAREN)\r
 682                     nextWhite = NEXT_NONE;\r
 683               LEX_IDENT:\r
 684                 x = MatchString(theSource, sourceP1, sourceP2, Statements);\r
 685                 if (ControlGet() == CONTROL_IF_ELSE && ~~(x && Statements-->x == SmtEls)) {\r
 686                     ControlPop();\r
 687                     while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
 688                         ControlPop();\r
 689                         currentIndent--;\r
 690                     }\r
 691                 }\r
 692                 if (x) {\r
 693                     lex = LEX_STATEMENT;\r
 694                     switch (Statements-->x) {\r
 695                       SmtIf_:\r
 696                         ControlPush(CONTROL_IF_COND);\r
 697                       SmtFor, SmtWhi, SmtSwi, SmtObj:\r
 698                         ControlPush(CONTROL_XX_COND);\r
 699                       SmtDo_:\r
 700                         ControlPush(CONTROL_XX_SCOPE);\r
 701                       SmtEls:\r
 702                         ControlSet(CONTROL_XX_SCOPE);\r
 703                     }\r
 704                 }\r
 705                 if (previousLex == LEX_PLUSPLUS or LEX_MINUSMINUS)\r
 706                     nextWhite = NEXT_NONE;\r
 707                 PrintLexeme(lex);\r
 708               LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
 709                 if (ControlGet() == CONTROL_IF_ELSE) {\r
 710                     ControlPop();\r
 711                     while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
 712                         ControlPop();\r
 713                         currentIndent--;\r
 714                     }\r
 715                 }\r
 716                 PrintLexeme(lex);\r
 717               default:\r
 718                 PrintLexeme(lex);\r
 719                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_ROUTINE.";\r
 720             }\r
 721 \r
 722           ! Class or Object directive, in header.\r
 723 \r
 724           STATE_CLASS_HEADER,\r
 725           STATE_OBJECT_HEADER:\r
 726             switch (lex) {\r
 727               LEX_SEMIC:\r
 728                 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
 729                 currentState = STATE_NONE;\r
 730               LEX_IDENT:\r
 731                 if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {\r
 732                     PutNL(1);\r
 733                     currentIndent = 2;\r
 734                     PrintLexeme(lex);\r
 735                     PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);\r
 736                     currentState = STATE_OBJECT_BODY;\r
 737                 }\r
 738                 else {\r
 739                     if (currentState == STATE_CLASS_HEADER)\r
 740                         PrintDirective();\r
 741                     else\r
 742                         PrintLexeme(lex);\r
 743                 }\r
 744               LEX_ARROW, LEX_DQ_STRING:\r
 745                 nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;\r
 746               LEX_LPAREN, LEX_NUMBER, LEX_RPAREN:\r
 747                 nextWhite = NEXT_NONE; PrintLexeme(lex);\r
 748               LEX_COMMA:                ! don't need a comma here\r
 749                 if (~~fixBadSyntax) PrintLexeme(lex);\r
 750               default:\r
 751                 PrintLexeme(lex);\r
 752                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_CLASS/OBJECT_HEADER.";\r
 753             }\r
 754 \r
 755           ! Class or Object directive, in body.\r
 756 \r
 757           STATE_OBJECT_BODY:\r
 758             switch (lex) {\r
 759               LEX_SEMIC:\r
 760                 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
 761                 currentState = STATE_NONE;\r
 762                 currentIndent = 0;\r
 763                 mapDQtoSQ = false;\r
 764               LEX_LBRCKT:               ! New embedded routine.\r
 765                 PrintLexeme(lex);\r
 766                 currentIndent++; ControlReset();\r
 767                 currentState = STATE_ROUTINE; routineIsEmbedded = true;\r
 768               LEX_COMMA:\r
 769                 PrintLexeme(lex); nextWhite = NEXT_NEWLINE;\r
 770                 mapDQtoSQ = false;\r
 771               LEX_IDENT:\r
 772                 if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {\r
 773                     if (previousLex ~= LEX_COMMA) {\r
 774                         if (fixBadSyntax) PutChar(',');\r
 775                         PutNL(1);\r
 776                     }\r
 777                     PrintLexeme(lex);\r
 778                     PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);\r
 779                     mapDQtoSQ = false;\r
 780                 }\r
 781                 else {\r
 782                     if (fixBadSyntax && MatchString(theSource, sourceP1, sourceP2, Properties)) mapDQtoSQ = true;\r
 783                     PrintLexeme(lex);\r
 784                 }\r
 785               LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
 786                 PrintLexeme(lex);\r
 787               default:\r
 788                 PrintLexeme(lex);\r
 789                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OBJECT_BODY.";\r
 790             }\r
 791 \r
 792           ! Verb directive.\r
 793 \r
 794           STATE_VERB:\r
 795             switch (lex) {\r
 796               LEX_SEMIC:\r
 797                 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
 798                 currentState = STATE_NONE;\r
 799                 currentIndent = 0;\r
 800                 mapDQtoSQ = false;\r
 801               LEX_ASTERISK:\r
 802                 currentIndent = 1;\r
 803                 nextWhite = NEXT_NEWLINE; PrintLexeme(lex);\r
 804               LEX_ARROW:\r
 805                 nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;\r
 806               LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
 807                 PrintLexeme(lex);\r
 808               default:\r
 809                 PrintLexeme(lex);\r
 810                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_VERB.";\r
 811             }\r
 812 \r
 813           ! Other directive (not Class/Object/Verb).\r
 814 \r
 815           STATE_OTHER_DIR:\r
 816             switch (lex) {\r
 817               LEX_SEMIC:\r
 818                 PrintLexeme(lex);\r
 819                 if (directiveIsEmbedded) {\r
 820                     currentState = STATE_ROUTINE; directiveIsEmbedded = false;\r
 821                 }\r
 822                 else {\r
 823                     currentState = STATE_NONE;\r
 824                     currentIndent = 0;\r
 825                 }\r
 826               LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
 827                 PrintLexeme(lex);\r
 828               default:\r
 829                 PrintLexeme(lex);\r
 830                 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OTHER_DIR.";\r
 831             }\r
 832 \r
 833         }   ! end of switch(currentState)\r
 834         previousLex = lex;\r
 835     }\r
 836     if (outputlen) PutNL(1);\r
 837 \r
 838     glk_stream_close(sourceStream, GLK_NULL);\r
 839     glk_stream_close(targetStream, GLK_NULL);\r
 840     "^^OK";\r
 841 ];\r
 842 \r
 843 [ MatchString buf p1 p2 tab\r
 844     i j k len str;\r
 845     len = p2 - p1;\r
 846     for (i=1 : i<=tab-->0 : i++) {\r
 847         str = tab-->i;\r
 848         if (str->0 < len) continue;\r
 849         if (str->0 > len) rfalse;\r
 850         for (j=1,k=p1 : j<=len : j++,k++)\r
 851             if ((str->j | $20) ~= (buf->k | $20)) jump tryNext;\r
 852         return i;\r
 853       .tryNext;\r
 854     }\r
 855     rfalse;\r
 856 ];\r
 857 \r
 858 ! =================================================================================================\r
 859 !   Stack for control structuress.\r
 860 \r
 861 Constant MAX_STACK 20;                  ! Nested control structures.\r
 862 Array controlStack --> MAX_STACK;\r
 863 \r
 864 Constant CONTROL_IF_COND    10;         ! Looking for end of IF condition\r
 865 Constant CONTROL_IF_SCOPE   11;         ! Looking for { after IF condition\r
 866 Constant CONTROL_IF_SINGLE  12;         ! Controlling a single statement\r
 867 Constant CONTROL_IF_MULTI   13;         ! Controlling multiple statements\r
 868 Constant CONTROL_IF_ELSE    14;         ! Looking for ELSE after IF statement\r
 869 Constant CONTROL_XX_COND    20;         ! Looking for end of other condition\r
 870 Constant CONTROL_XX_SCOPE   21;         ! Looking for { after other condition\r
 871 Constant CONTROL_XX_SINGLE  22;         ! Controlling a single statement\r
 872 Constant CONTROL_XX_MULTI   23;         ! Controlling multiple statements\r
 873 \r
 874 [ ControlPush val\r
 875     p;\r
 876     p = (controlStack-->0) + 1;\r
 877     if (p == MAX_STACK) {\r
 878         print "Stack overflow: increase MAX_STACK and recompile.^";\r
 879         DoQuit();\r
 880     }\r
 881     controlStack-->0 = p;\r
 882     controlStack-->p = val;\r
 883 ];\r
 884 \r
 885 [ ControlPop\r
 886     p;\r
 887     p = controlStack-->0;\r
 888     if (p) {\r
 889         (controlStack-->0)--;\r
 890         p = controlStack-->p;\r
 891     }\r
 892     return p;\r
 893 ];\r
 894 \r
 895 [ ControlSet val\r
 896     p;\r
 897     p = controlStack-->0;\r
 898     if (p)\r
 899         controlStack-->p = val;\r
 900     else\r
 901         "INSPECTOR bug at source line ", sourceLine, ": StackSet on empty stack.";\r
 902 ];\r
 903 \r
 904 [ ControlGet\r
 905     p;\r
 906     p = controlStack-->0;\r
 907     if (p)\r
 908         p = controlStack-->p;\r
 909     return p;\r
 910 ];\r
 911 \r
 912 [ ControlReset; controlStack-->0 = 0; ];\r
 913 \r
 914 ! [ ControlDebug x\r
 915 !   i;\r
 916 !   new_line;\r
 917 !   switch (x) {\r
 918 !     0: print "Xxx ";\r
 919 !     1: print "Psh ";\r
 920 !     2: print "Pop ";\r
 921 !     3: print "Set ";\r
 922 !     4: print "Get ";\r
 923 !     default: print x, " ";\r
 924 !   }\r
 925 !   for (i=1 : i<=controlStack-->0 : i++) {\r
 926 !       print i,":";\r
 927 !       switch (controlStack-->i) {\r
 928 !         0:                print "none ";\r
 929 !         CONTROL_IF_COND:  print "IfCo ";\r
 930 !         CONTROL_IF_SCOPE: print "IfSc ";\r
 931 !         CONTROL_IF_SINGLE:print "IfSi ";\r
 932 !         CONTROL_IF_MULTI: print "IfMu ";\r
 933 !         CONTROL_IF_ELSE:  print "IfEl ";\r
 934 !         CONTROL_XX_COND:  print "XxCo ";\r
 935 !         CONTROL_XX_SCOPE: print "XxSc ";\r
 936 !         CONTROL_XX_SINGLE:print "XxSi ";\r
 937 !         CONTROL_XX_MULTI: print "XxMu ";\r
 938 !       }\r
 939 !   }\r
 940 !   new_line;\r
 941 ! ];\r
 942 \r
 943 ! =================================================================================================\r
 944 \r
 945 [ GetLexeme\r
 946     c rval;\r
 947 \r
 948     if (sourceLen == 0) {               ! Need next line of source.\r
 949         sourceLen = ReadSourceLine();\r
 950         if (sourceLen == 0) rfalse;     ! End-of-file.\r
 951         sourceP1 = 0;                   ! Start of buffer.\r
 952     }\r
 953     else\r
 954         sourceP1 = sourceP2;            ! Continue from last time.\r
 955 \r
 956     ! Ignore leading whitespace.\r
 957 \r
 958     while (isWhiteSpace(theSource->sourceP1)) sourceP1++;\r
 959     if (theSource->sourceP1 == NEWLINE) {\r
 960         sourceLen = 0;\r
 961         return LEX_NEWLINE;\r
 962     }\r
 963 \r
 964     ! Found start of lexeme.\r
 965 \r
 966     sourceP2 = sourceP1 + 1;\r
 967     switch (theSource->sourceP1) {\r
 968 \r
 969       '_', 'A' to 'Z', 'a' to 'z':                              ! identifier\r
 970         while (isIdentifier(theSource->sourceP2)) sourceP2++;\r
 971         rval = LEX_IDENT;\r
 972 \r
 973       '0' to '9':                                               ! decimal number\r
 974         while (isDecimal(theSource->sourceP2)) sourceP2++;\r
 975         rval = LEX_NUMBER;\r
 976 \r
 977       '$':                                                      ! hex/binary number\r
 978         if (theSource->sourceP2 == '$') {\r
 979             sourceP2++;\r
 980             while(isBinary(theSource->sourceP2)) sourceP2++;\r
 981         }\r
 982         else {\r
 983             while(isHex(theSource->sourceP2)) sourceP2++;\r
 984         }\r
 985         rval = LEX_NUMBER;\r
 986 \r
 987       '"':                                                      ! "..." string\r
 988         theString->0 = theSource->sourceP1;\r
 989         sourceP3 = 1;\r
 990         do {\r
 991             if (sourceP3 == MAX_STRING) {\r
 992                 print "String too long: increase MAX_STRING and recompile.^";\r
 993                 DoQuit();\r
 994             }\r
 995             c = theSource->(sourceP2++); theString->(sourceP3++) = c;\r
 996             if (c == NEWLINE) {\r
 997                 do {\r
 998                     sourceLen = ReadSourceLine();\r
 999                     sourceP2 = 0;\r
1000                     while (isWhiteSpace(theSource->sourceP2)) sourceP2++;\r
1001                 } until (theSource->sourceP2 ~= NEWLINE);\r
1002             }\r
1003         } until (c == '"');\r
1004         rval = LEX_DQ_STRING;\r
1005 \r
1006       SQUOTE:                                                   ! '...' string\r
1007         while (theSource->sourceP2 ~= SQUOTE) sourceP2++;\r
1008         sourceP2++;\r
1009         rval = LEX_SQ_STRING;\r
1010 \r
1011       '!':                                                      ! comment\r
1012         sourceP2 = sourceLen - 1;\r
1013         rval = LEX_COMMENT;\r
1014 \r
1015       '#':\r
1016         switch (theSource->sourceP2) {\r
1017           '#':          sourceP2++; rval = LEX_SEPG2_END;               ! ##\r
1018           'a':\r
1019             switch (theSource->(sourceP2+1)) {\r
1020               '$':      sourceP2 = sourceP2+2; rval = LEX_SEPG2_END;    ! #a$\r
1021               default:  rval = LEX_HASH;                                ! #\r
1022             }\r
1023           'n':\r
1024             switch (theSource->(sourceP2+1)) {\r
1025               '$':      sourceP2 = sourceP2+2; rval = LEX_SEPG2_END;    ! #n$\r
1026               default:  rval = LEX_HASH;                                ! #\r
1027             }\r
1028           'r':\r
1029             switch (theSource->(sourceP2+1)) {\r
1030               '$':      sourceP2 = sourceP2+2; rval = LEX_SEPG2_END;    ! #r$\r
1031               default:  rval = LEX_HASH;                                ! #\r
1032             }\r
1033           'w':\r
1034             switch (theSource->(sourceP2+1)) {\r
1035               '$':      sourceP2 = sourceP2+2; rval = LEX_SEPG2_END;    ! #w$\r
1036               default:  rval = LEX_HASH;                        ! #\r
1037             }\r
1038           default:      rval = LEX_HASH;                        ! #\r
1039         }\r
1040 \r
1041       '%':              rval = LEX_SEPG3_END;                   ! %\r
1042 \r
1043       '&':\r
1044         switch (theSource->sourceP2) {\r
1045           '&':          sourceP2++; rval = LEX_SEPG3_END;       ! &&\r
1046           default:      rval = LEX_SEPG3_END;                   ! &\r
1047         }\r
1048 \r
1049       '(':              rval = LEX_LPAREN;                      ! (\r
1050                         parenCount++;\r
1051 \r
1052       ')':              rval = LEX_RPAREN;                      ! )\r
1053                         parenCount--;\r
1054 \r
1055       '*':              rval = LEX_ASTERISK;                    ! *\r
1056 \r
1057       '+':\r
1058         switch (theSource->sourceP2) {\r
1059           '+':          sourceP2++; rval = LEX_PLUSPLUS;        ! ++\r
1060           default:      rval = LEX_SEPG3_END;                   ! +\r
1061         }\r
1062 \r
1063       ',':              rval = LEX_COMMA;                       ! ,\r
1064 \r
1065       '-':\r
1066         switch (theSource->sourceP2) {\r
1067           '-':\r
1068             sourceP2++; switch (theSource->sourceP2) {\r
1069               '>':      sourceP2++; rval = LEX_SEPG0_END;       ! -->\r
1070               default:  rval = LEX_MINUSMINUS;                  ! --\r
1071             }\r
1072           '>':          sourceP2++; rval = LEX_ARROW;           ! ->\r
1073           default:      rval = LEX_MINUS;                       ! -\r
1074         }\r
1075 \r
1076       '.':\r
1077         switch (theSource->sourceP2) {\r
1078           '.':\r
1079             sourceP2++; switch (theSource->sourceP2) {\r
1080               '#':      sourceP2++; rval = LEX_SEPG0_END;       ! ..#\r
1081               '&':      sourceP2++; rval = LEX_SEPG0_END;       ! ..&\r
1082               default:  rval = LEX_SEPG0_END;                   ! ..\r
1083             }\r
1084           '#':          sourceP2++; rval = LEX_SEPG0_END;       ! .#\r
1085           '&':          sourceP2++; rval = LEX_SEPG0_END;       ! .&\r
1086           default:      rval = LEX_DOT;                         ! .\r
1087         }\r
1088 \r
1089       '/':              rval = LEX_SEPG3_END;                   ! /\r
1090 \r
1091       ':':\r
1092         switch (theSource->sourceP2) {\r
1093           ':':          sourceP2++; rval = LEX_SEPG0_END;       ! ::\r
1094           default:      rval = LEX_COLON;                       ! :\r
1095         }\r
1096 \r
1097       ';':              rval = LEX_SEMIC;                       ! ;\r
1098 \r
1099       '<':\r
1100         switch (theSource->sourceP2) {\r
1101           '=':          sourceP2++; rval = LEX_SEPG3_END;       ! <=\r
1102           '<':          sourceP2++; rval = LEX_LTLT;            ! <<\r
1103           default:      rval = LEX_SEPG3_END;                   ! <\r
1104         }\r
1105 \r
1106       '=':\r
1107         switch (theSource->sourceP2) {\r
1108           '=':          sourceP2++; rval = LEX_SEPG3_END;       ! ==\r
1109           default:      rval = LEX_SEPG3_END;                   ! =\r
1110         }\r
1111 \r
1112       '>':\r
1113         switch (theSource->sourceP2) {\r
1114           '=':          sourceP2++; rval = LEX_SEPG3_END;       ! >=\r
1115           '>':          sourceP2++; rval = LEX_SEPG0_END;       ! >>\r
1116           default:      rval = LEX_SEPG3_END;                   ! >\r
1117         }\r
1118 \r
1119       '?':\r
1120         switch (theSource->sourceP2) {\r
1121           '~':          sourceP2++; rval = LEX_SEPG2_END;       ! ?~\r
1122           default:      rval = LEX_SEPG2_END;                   ! ?\r
1123         }\r
1124 \r
1125       ATSIGN:           rval = LEX_SEPG2_END;                   ! @\r
1126 \r
1127       '[':              rval = LEX_LBRCKT;                      ! [\r
1128 \r
1129       ']':              rval = LEX_RBRCKT;                      ! ]\r
1130 \r
1131       '{':              rval = LEX_LBRACE;                      ! {\r
1132 \r
1133       '}':              rval = LEX_RBRACE;                      ! }\r
1134 \r
1135       '|':\r
1136         switch (theSource->sourceP2) {\r
1137           '|':          sourceP2++; rval = LEX_SEPG3_END;       ! ||\r
1138           default:      rval = LEX_SEPG3_END;                   ! |\r
1139         }\r
1140 \r
1141       '~':\r
1142         switch (theSource->sourceP2) {\r
1143           '=':          sourceP2++; rval = LEX_SEPG3_END;       ! ~=\r
1144           '~':          sourceP2++; rval = LEX_SEPG2_END;       ! ~~\r
1145           default:      rval = LEX_TILDE;                       ! ~\r
1146         }\r
1147 \r
1148       default:          rval = LEX_INVALID;                     ! Not valid.\r
1149     }\r
1150     return rval;\r
1151 ];\r
1152 \r
1153 [ isWhiteSpace c;\r
1154     if (c == ' ' or TAB) rtrue;\r
1155     rfalse;\r
1156 ];\r
1157 \r
1158 [ isBinary c;\r
1159     if (c == '0' or '1') rtrue;\r
1160     rfalse;\r
1161 ];\r
1162 \r
1163 [ isDecimal c;\r
1164     if (c >= '0' && c <= '9') rtrue;\r
1165     rfalse;\r
1166 ];\r
1167 \r
1168 [ isHex c;\r
1169     if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')) rtrue;\r
1170     rfalse;\r
1171 ];\r
1172 \r
1173 [ isIdentifier c;\r
1174     if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c == '_')) rtrue;\r
1175     rfalse;\r
1176 ];\r
1177 \r
1178 [ ReadSourceChar\r
1179     c;\r
1180     if (savedChar) { c = savedChar; savedChar = 0; }\r
1181     else             c = glk_get_char_stream(sourceStream);\r
1182     if (c == NEWLINE or RETURN) {\r
1183         savedChar = glk_get_char_stream(sourceStream);\r
1184         if (savedChar == NEWLINE or RETURN && savedChar ~= c) savedChar = 0;\r
1185         c = NEWLINE;\r
1186     }\r
1187     return c;\r
1188 ];\r
1189 \r
1190 [ ReadSourceLine\r
1191     c len;\r
1192     do {\r
1193         c = ReadSourceChar();\r
1194         if (c == -1)    ! end of stream\r
1195             if (len) c = NEWLINE; else return 0;\r
1196         if (len == MAX_SOURCE) {\r
1197             print "Source line too long: increase MAX_SOURCE and recompile.^";\r
1198             DoQuit();\r
1199             break;\r
1200         }\r
1201         theSource->len++ = c;\r
1202     } until (c == NEWLINE);\r
1203     sourceLine++;\r
1204     return len;\r
1205 ];\r
1206 \r
1207 ! [ ReadSourceLine\r
1208 !     len;\r
1209 !     len = glk_get_line_stream(sourceStream, theSource, MAX_SOURCE);\r
1210 !     sourceLine++;\r
1211 !     if (len && theSource->(len-1) ~= NEWLINE)\r
1212 !         if (len == MAX_SOURCE-1) {\r
1213 !             print "Source line too long: increase MAX_SOURCE and recompile.^";\r
1214 !             DoQuit();\r
1215 !         }\r
1216 !         else\r
1217 !             theSource->(len++) = NEWLINE;\r
1218 !     return len;\r
1219 ! ];\r
1220 \r
1221 ! =================================================================================================\r
1222 \r
1223 [ PrintDirective\r
1224     i;\r
1225     switch (nextWhite) {\r
1226       NEXT_NONE:\r
1227         ;\r
1228       NEXT_SPACE:\r
1229         if (marginColumn > 0 && outputLen > marginColumn)\r
1230             PutNL(1);\r
1231         else\r
1232             PutSpace(1);\r
1233       NEXT_NEWLINE:\r
1234         PutNL(1);\r
1235       NEXT_BLANKLINE:\r
1236         PutNL(2);\r
1237     }\r
1238     i = sourceP1;\r
1239     PutUpper(theSource->i);\r
1240     for (i++ : i<sourceP2 : i++) PutLower(theSource->i);\r
1241     nextWhite = NEXT_SPACE;\r
1242 ];\r
1243 \r
1244 [ PrintLexeme lex\r
1245     i;\r
1246     switch (nextWhite) {\r
1247       NEXT_NONE:\r
1248         ;\r
1249       NEXT_SPACE:\r
1250         if (marginColumn > 0 && outputLen > marginColumn && lex ~= LEX_COMMENT)\r
1251             PutNL(1);\r
1252         else\r
1253             PutSpace(1);\r
1254       NEXT_NEWLINE:\r
1255         PutNL(1);\r
1256       NEXT_BLANKLINE:\r
1257         PutNL(2);\r
1258     }\r
1259 \r
1260     if (lex == LEX_DQ_STRING) {\r
1261         if (outputLen)\r
1262             for (i=0 : i<sourceP3 : i++)\r
1263                 if (theString->i == NEWLINE) {\r
1264                     currentIndent++;\r
1265                     PutNL(1);\r
1266                     for (i=0 : i<sourceP3 : i++) PutChar(theString->i);\r
1267                     currentIndent--;\r
1268                     jump Done;\r
1269                 }\r
1270         if (mapDQtoSQ) {\r
1271 !           theString->0 = theString->(sourceP3-1) = SQUOTE; ! avoid compiler bug\r
1272             theString->0 = SQUOTE;\r
1273             theString->(sourceP3-1) = SQUOTE;\r
1274         }\r
1275         for (i=0 : i<sourceP3 : i++) PutChar(theString->i);\r
1276     }\r
1277     else\r
1278         for (i=sourceP1 : i<sourceP2 : i++)\r
1279             if (theSource->i == TAB)\r
1280                 PutChar(SPACE);\r
1281             else\r
1282                 PutChar(theSource->i);\r
1283 \r
1284   .Done;\r
1285 \r
1286     switch (lex) {\r
1287       LEX_SEMIC, LEX_LBRACE, LEX_RBRACE:\r
1288         nextWhite = NEXT_NEWLINE;\r
1289       LEX_VALUE to LEX_VALUE_END, LEX_SEPG4 to LEX_SEPG4_END,\r
1290       LEX_SEPG1 to LEX_SEPG1_END, LEX_SEPG3 to LEX_SEPG3_END:\r
1291         nextWhite = NEXT_SPACE;\r
1292       LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG2 to LEX_SEPG2_END:\r
1293         nextWhite = NEXT_NONE;\r
1294     }\r
1295 ];\r
1296 \r
1297 [ PutChar c;\r
1298     if (c == NEWLINE) return PutNL(1);\r
1299     if (outputLen == 0) {\r
1300         for ( : outputLen<indentSize*currentIndent : outputLen++) theOutput->outputLen = SPACE;\r
1301         if (c == SPACE) return;\r
1302     }\r
1303     if (outputLen == MAX_OUTPUT) {\r
1304         print "Output line too long: increase MAX_OUTPUT and recompile.^";\r
1305         DoQuit();\r
1306     }\r
1307     theOutput->outputLen = c;\r
1308     outputLen++;\r
1309 ];\r
1310 \r
1311 [ PutUpper c; PutChar(glk_char_to_upper(c)); ];\r
1312 \r
1313 [ PutLower c; PutChar(glk_char_to_lower(c)); ];\r
1314 \r
1315 [ PutSpace n;\r
1316     if (n < 1) n = 1;\r
1317     if (outputLen && theOutput->(outputLen-1) ~= SPACE)\r
1318         while (n-- > 0) PutChar(SPACE);\r
1319     nextWhite = NEXT_NONE;\r
1320 ];\r
1321 \r
1322 [ PullSpace n\r
1323     i;\r
1324     for (i=0 : i<n : i++) if (theOutput->i ~= SPACE) break;\r
1325     n = i;\r
1326     for ( : i<outputLen : i++) theOutput->(i-n) = theOutput->i;\r
1327     outputLen = outputLen - n;\r
1328 ];\r
1329 \r
1330 [ PutNL n;\r
1331 !   i j;\r
1332     while (n--) {\r
1333         if (outputLen) {\r
1334 !           j = 0;\r
1335 !           if (indentWithTabs) {\r
1336 !               for (j=0 : j<outputLen : j++) if (theOutput->j ~= SPACE) break;\r
1337 !               for (i=0 : i<j/indentSize : i++) print (char) TAB;\r
1338 !               j = j - j%indentSize;\r
1339 !           }\r
1340             glk_put_buffer_stream(targetStream, theOutput, outputLen);\r
1341             outputLen = 0;\r
1342             glk_put_char_stream(targetStream, NEWLINE);\r
1343             prevLineBlank = false;\r
1344         }\r
1345         else\r
1346             if (~~prevLineBlank) {\r
1347                 glk_put_char_stream(targetStream, NEWLINE);\r
1348                 prevLineBlank = true;\r
1349             }\r
1350     }\r
1351     nextWhite = NEXT_NONE;\r
1352 ];\r
1353 \r
1354 ! =================================================================================================\r