├── CastaliaParserDefines.inc ├── CastaliaPasLex.pas ├── CastaliaPasLexTypes.pas ├── CastaliaSimplePasPar.pas ├── CastaliaSimplePasParTypes.pas └── README.txt /CastaliaParserDefines.inc: -------------------------------------------------------------------------------- 1 | {$IFDEF VER200} 2 | {$DEFINE D8_NEWER} 3 | {$DEFINE D9_NEWER} 4 | {$DEFINE D10_NEWER} 5 | {$DEFINE D11_NEWER} 6 | {$DEFINE D12_NEWER} 7 | {$ENDIF} 8 | 9 | {$IFDEF VER190} 10 | {$DEFINE D8_NEWER} 11 | {$DEFINE D9_NEWER} 12 | {$DEFINE D10_NEWER} 13 | {$DEFINE D11_NEWER} 14 | {$ENDIF} 15 | 16 | {$IFDEF VER180} 17 | {$DEFINE D8_NEWER} 18 | {$DEFINE D9_NEWER} 19 | {$DEFINE 10_NEWER} 20 | {$ENDIF} 21 | 22 | {$IFDEF VER170} 23 | {$DEFINE D8_NEWER} 24 | {$DEFINE D9_NEWER} 25 | {$ENDIF} 26 | 27 | {$IFDEF VER160} 28 | {$DEFINE D8_NEWER} 29 | {$ENDIF} -------------------------------------------------------------------------------- /CastaliaPasLex.pas: -------------------------------------------------------------------------------- 1 | {----------------------------------------------------------------------------- 2 | The contents of this file are subject to the Mozilla Public License Version 3 | 1.1 (the "License"); you may not use this file except in compliance with the 4 | License. You may obtain a copy of the License at 5 | http://www.mozilla.org/NPL/NPL-1_1Final.html 6 | 7 | Software distributed under the License is distributed on an "AS IS" basis, 8 | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9 | the specific language governing rights and limitations under the License. 10 | 11 | The Original Code is: mwPasLex.PAS, released August 17, 1999. 12 | 13 | The Initial Developer of the Original Code is Martin Waldenburg 14 | (Martin.Waldenburg@T-Online.de). 15 | Portions created by Martin Waldenburg are Copyright (C) 1998, 1999 Martin 16 | Waldenburg. 17 | All Rights Reserved. 18 | 19 | Contributor(s): James Jacobson _____________________________________. 20 | 21 | Last Modified: mm/dd/yyyy 22 | Current Version: 2.2 23 | 24 | Notes: This program is a very fast Pascal tokenizer. I'd like to invite the 25 | Delphi community to develop it further and to create a fully featured Object 26 | Pascal parser. 27 | 28 | Modification history: 29 | 30 | Daniel Rolf between 20010723 and 20020116 31 | 32 | Made ready for Delphi 6 33 | 34 | platform 35 | deprecated 36 | varargs 37 | local 38 | 39 | Known Issues: 40 | -----------------------------------------------------------------------------} 41 | 42 | unit CastaliaPasLex; 43 | 44 | {$I CastaliaParserDefines.inc} 45 | 46 | interface 47 | 48 | uses 49 | //!! pruned uses 50 | SysUtils, Classes, Controls, CastaliaPasLexTypes; 51 | 52 | var 53 | Identifiers: array[#0..#255] of ByteBool; 54 | mHashTable: array[#0..#255] of Integer; 55 | 56 | type 57 | TmwBasePasLex = class; 58 | TDirectiveEvent = procedure(Sender: TmwBasePasLex) of object; 59 | 60 | PDefineRec = ^TDefineRec; 61 | TDefineRec = record 62 | Defined: Boolean; 63 | StartCount: Integer; 64 | Next: PDefineRec; 65 | end; 66 | 67 | TmwBasePasLex = class(TObject) 68 | private 69 | fCommentState: TCommentState; 70 | fOrigin: PChar; 71 | fProcTable: array[#0..#255] of procedure of object; 72 | Run: Integer; 73 | RunAhead: Integer; 74 | TempRun: Integer; 75 | fIdentFuncTable: array[0..191] of function: TptTokenKind of object; 76 | fTokenPos: Integer; 77 | fLineNumber: Integer; 78 | FTokenID: TptTokenKind; 79 | fLinePos: Integer; 80 | fExID: TptTokenKind; 81 | FOnMessage: TMessageEvent; 82 | fOnCompDirect: TDirectiveEvent; 83 | fOnElseDirect: TDirectiveEvent; 84 | fOnEndIfDirect: TDirectiveEvent; 85 | fOnIfDefDirect: TDirectiveEvent; 86 | fOnIfNDefDirect: TDirectiveEvent; 87 | fOnResourceDirect: TDirectiveEvent; 88 | fOnIncludeDirect: TDirectiveEvent; 89 | fOnDefineDirect: TDirectiveEvent; 90 | fOnIfOptDirect: TDirectiveEvent; 91 | fOnIfDirect: TDirectiveEvent; 92 | fOnIfEndDirect: TDirectiveEvent; 93 | fOnElseIfDirect: TDirectiveEvent; 94 | fOnUnDefDirect: TDirectiveEvent; 95 | FDirectiveParamOrigin: PChar; 96 | 97 | fAsmCode : Boolean; // DR 2002-01-14 98 | 99 | FDefines: TStrings; 100 | FDefineStack: Integer; 101 | FTopDefineRec: PDefineRec; 102 | FUseDefines: Boolean; 103 | 104 | function KeyHash: Integer; 105 | function KeyComp(const aKey: string): Boolean; 106 | function Func9: tptTokenKind; 107 | function Func15: TptTokenKind; 108 | function Func19: TptTokenKind; 109 | function Func20: TptTokenKind; 110 | function Func21: TptTokenKind; 111 | function Func23: TptTokenKind; 112 | function Func25: TptTokenKind; 113 | function Func27: TptTokenKind; 114 | function Func28: TptTokenKind; 115 | function Func29: TptTokenKind; 116 | function Func30: TptTokenKind; 117 | function Func32: TptTokenKind; 118 | function Func33: TptTokenKind; 119 | function Func35: TptTokenKind; 120 | function Func36: TptTokenKind; 121 | function Func37: TptTokenKind; 122 | function Func38: TptTokenKind; 123 | function Func39: TptTokenKind; 124 | function Func40: TptTokenKind; 125 | function Func41: TptTokenKind; 126 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 127 | function Func42: TptTokenKind; 128 | {$ENDIF} 129 | function Func43: TptTokenKind; 130 | function Func44: TptTokenKind; 131 | function Func45: TptTokenKind; 132 | function Func46: TptTokenKind; 133 | function Func47: TptTokenKind; 134 | function Func49: TptTokenKind; 135 | function Func52: TptTokenKind; 136 | function Func54: TptTokenKind; 137 | function Func55: TptTokenKind; 138 | function Func56: TptTokenKind; 139 | function Func57: TptTokenKind; 140 | function Func58: TptTokenKind; 141 | function Func59: TptTokenKind; 142 | function Func60: TptTokenKind; 143 | function Func61: TptTokenKind; 144 | function Func62: TptTokenKind; 145 | function Func63: TptTokenKind; 146 | function Func64: TptTokenKind; 147 | function Func65: TptTokenKind; 148 | function Func66: TptTokenKind; 149 | function Func69: TptTokenKind; 150 | function Func71: TptTokenKind; 151 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 152 | function Func72: TptTokenKind; 153 | {$ENDIF} 154 | function Func73: TptTokenKind; 155 | function Func75: TptTokenKind; 156 | function Func76: TptTokenKind; 157 | function Func78: TptTokenKind; 158 | function Func79: TptTokenKind; 159 | function Func81: TptTokenKind; 160 | function Func84: TptTokenKind; 161 | function Func85: TptTokenKind; 162 | function Func86: TptTokenKind; 163 | function Func87: TptTokenKind; 164 | function Func88: TptTokenKind; 165 | {$IFDEF D8_NEWER} 166 | function Func89: TptTokenKind; //JThurman 2004-03-03 167 | {$ENDIF} 168 | function Func91: TptTokenKind; 169 | function Func92: TptTokenKind; 170 | function Func94: TptTokenKind; 171 | function Func95: TptTokenKind; 172 | function Func96: TptTokenKind; 173 | function Func97: TptTokenKind; 174 | function Func98: TptTokenKind; 175 | function Func99: TptTokenKind; 176 | function Func100: TptTokenKind; 177 | function Func101: TptTokenKind; 178 | function Func102: TptTokenKind; 179 | function Func103: TptTokenKind; 180 | function Func104: TptTokenKind; 181 | function Func105: TptTokenKind; 182 | function Func106: TptTokenKind; 183 | function Func107: TptTokenKind; 184 | function Func108: TptTokenKind; 185 | function Func112: TptTokenKind; 186 | function Func117: TptTokenKind; 187 | function Func123: TptTokenKind; 188 | function Func126: TptTokenKind; 189 | function Func127: TptTokenKind; 190 | function Func128: TptTokenKind; 191 | function Func129: TptTokenKind; 192 | function Func130: TptTokenKind; 193 | function Func132: TptTokenKind; 194 | function Func133: TptTokenKind; 195 | function Func136: TptTokenKind; 196 | function Func141: TptTokenKind; 197 | function Func143: TptTokenKind; 198 | function Func166: TptTokenKind; 199 | function Func167: TptTokenKind; 200 | function Func168: TptTokenKind; 201 | function Func191: TptTokenKind; 202 | function AltFunc: TptTokenKind; 203 | procedure InitIdent; 204 | function GetPosXY: TTokenPoint; // !! changed to TokenPoint //jdj 7/18/1999 205 | function IdentKind: TptTokenKind; 206 | procedure SetRunPos(Value: Integer); 207 | procedure MakeMethodTables; 208 | procedure AddressOpProc; 209 | {$IFDEF D8_NEWER} //JThurman 2004-04-06 210 | procedure AmpersandOpProc; 211 | {$ENDIF} 212 | procedure AsciiCharProc; 213 | procedure AnsiProc; 214 | procedure BorProc; 215 | procedure BraceCloseProc; 216 | procedure BraceOpenProc; 217 | procedure ColonProc; 218 | procedure CommaProc; 219 | procedure CRProc; 220 | procedure EqualProc; 221 | procedure GreaterProc; 222 | procedure IdentProc; 223 | procedure IntegerProc; 224 | procedure LFProc; 225 | procedure LowerProc; 226 | procedure MinusProc; 227 | procedure NullProc; 228 | procedure NumberProc; 229 | procedure PlusProc; 230 | procedure PointerSymbolProc; 231 | procedure PointProc; 232 | procedure RoundCloseProc; 233 | procedure RoundOpenProc; 234 | procedure SemiColonProc; 235 | procedure SlashProc; 236 | procedure SpaceProc; 237 | procedure SquareCloseProc; 238 | procedure SquareOpenProc; 239 | procedure StarProc; 240 | procedure StringProc; 241 | procedure StringDQProc; 242 | procedure SymbolProc; 243 | procedure UnknownProc; 244 | function GetToken: string; 245 | function GetTokenLen: Integer; 246 | function GetCommentState: Pointer; 247 | function GetCompilerDirective: string; 248 | procedure SetCommentState(const Value: Pointer); 249 | procedure InitLine; 250 | function GetDirectiveKind: TptTokenKind; 251 | function GetDirectiveParam: string; 252 | function GetStringContent: string; 253 | function GetIsJunk: Boolean; 254 | function GetIsSpace: Boolean; 255 | function GetIsOrdIdent: Boolean; 256 | function GetIsRealType: Boolean; 257 | function GetIsStringType: Boolean; 258 | function GetIsVarantType: Boolean; 259 | function GetIsAddOperator: Boolean; 260 | function GetIsMulOperator: Boolean; 261 | function GetIsRelativeOperator: Boolean; 262 | function GetIsCompilerDirective: Boolean; 263 | function GetIsOrdinalType: Boolean; 264 | function GetGenID: TptTokenKind;procedure SetOnElseIfDirect(const Value: TDirectiveEvent); 265 | 266 | function IsDefined(const ADefine: string): Boolean; 267 | procedure EnterDefineBlock(ADefined: Boolean); 268 | procedure ExitDefineBlock; 269 | procedure CloneDefinesFrom(ALexer: TmwBasePasLex); 270 | 271 | procedure DoProcTable(AChar: Char); 272 | function IsIdentifiers(AChar: Char): Boolean; 273 | function HashValue(AChar: Char): Integer; 274 | protected 275 | procedure SetLine(const Value: string); virtual; 276 | procedure SetOrigin(NewValue: PChar); virtual; 277 | procedure SetOnCompDirect(const Value: TDirectiveEvent); virtual; 278 | procedure SetOnDefineDirect(const Value: TDirectiveEvent); virtual; 279 | procedure SetOnElseDirect(const Value: TDirectiveEvent); virtual; 280 | procedure SetOnEndIfDirect(const Value: TDirectiveEvent); virtual; 281 | procedure SetOnIfDefDirect(const Value: TDirectiveEvent); virtual; 282 | procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); virtual; 283 | procedure SetOnIfOptDirect(const Value: TDirectiveEvent); virtual; 284 | procedure SetOnIncludeDirect(const Value: TDirectiveEvent); virtual; 285 | procedure SetOnResourceDirect(const Value: TDirectiveEvent); virtual; 286 | procedure SetOnUnDefDirect(const Value: TDirectiveEvent); virtual; 287 | procedure SetOnIfDirect(const Value: TDirectiveEvent); virtual; 288 | procedure SetOnIfEndDirect(const Value: TDirectiveEvent); virtual; 289 | 290 | public 291 | constructor Create; 292 | destructor Destroy; override; 293 | function CharAhead: Char; 294 | procedure Next; 295 | procedure NextID(ID: TptTokenKind); 296 | procedure NextNoJunk; 297 | procedure NextNoSpace; 298 | procedure Init; 299 | procedure InitFrom(ALexer: TmwBasePasLex); 300 | function FirstInLine: Boolean; 301 | 302 | procedure AddDefine(const ADefine: string); 303 | procedure RemoveDefine(const ADefine: string); 304 | procedure ClearDefines; 305 | procedure InitDefines; 306 | 307 | property CommentState: Pointer read GetCommentState write SetCommentState; 308 | property CompilerDirective: string read GetCompilerDirective; 309 | property DirectiveParam: string read GetDirectiveParam; 310 | property IsJunk: Boolean read GetIsJunk; 311 | property IsSpace: Boolean read GetIsSpace; 312 | property Line: string write SetLine; 313 | //Note: setting the following two properties does not GO to that line, it just sets the internal counters 314 | property LineNumber: Integer read fLineNumber write fLineNumber; 315 | property LinePos: Integer read fLinePos write fLinePos; 316 | property Origin: PChar read fOrigin write SetOrigin; 317 | property PosXY: TTokenPoint read GetPosXY; // !! changed to TokenPoint //jdj 7/18/1999 318 | property RunPos: Integer read Run write SetRunPos; 319 | property Token: string read GetToken; 320 | property TokenLen: Integer read GetTokenLen; 321 | property TokenPos: Integer read fTokenPos; 322 | property TokenID: TptTokenKind read FTokenID; 323 | property ExID: TptTokenKind read fExID; 324 | property GenID: TptTokenKind read GetGenID; 325 | property StringContent: string read GetStringContent; 326 | property IsOrdIdent: Boolean read GetIsOrdIdent; 327 | property IsOrdinalType: Boolean read GetIsOrdinalType; 328 | property IsRealType: Boolean read GetIsRealType; 329 | property IsStringType: Boolean read GetIsStringType; 330 | property IsVariantType: Boolean read GetIsVarantType; 331 | property IsRelativeOperator: Boolean read GetIsRelativeOperator; 332 | property IsAddOperator: Boolean read GetIsAddOperator; 333 | property IsMulOperator: Boolean read GetIsMulOperator; 334 | property IsCompilerDirective: Boolean read GetIsCompilerDirective; 335 | property OnMessage: TMessageEvent read FOnMessage write FOnMessage; 336 | property OnCompDirect: TDirectiveEvent read fOnCompDirect write SetOnCompDirect; 337 | property OnDefineDirect: TDirectiveEvent read fOnDefineDirect write SetOnDefineDirect; 338 | property OnElseDirect: TDirectiveEvent read fOnElseDirect write SetOnElseDirect; 339 | property OnEndIfDirect: TDirectiveEvent read fOnEndIfDirect write SetOnEndIfDirect; 340 | property OnIfDefDirect: TDirectiveEvent read fOnIfDefDirect write SetOnIfDefDirect; 341 | property OnIfNDefDirect: TDirectiveEvent read fOnIfNDefDirect write SetOnIfNDefDirect; 342 | property OnIfOptDirect: TDirectiveEvent read fOnIfOptDirect write SetOnIfOptDirect; 343 | property OnIncludeDirect: TDirectiveEvent read fOnIncludeDirect write SetOnIncludeDirect; 344 | property OnIfDirect: TDirectiveEvent read fOnIfDirect write SetOnIfDirect; 345 | property OnIfEndDirect: TDirectiveEvent read fOnIfEndDirect write 346 | SetOnIfEndDirect; 347 | property OnElseIfDirect: TDirectiveEvent read fOnElseIfDirect write 348 | SetOnElseIfDirect; 349 | property OnResourceDirect: TDirectiveEvent read fOnResourceDirect write SetOnResourceDirect; 350 | property OnUnDefDirect: TDirectiveEvent read fOnUnDefDirect write SetOnUnDefDirect; 351 | 352 | property AsmCode : Boolean read fAsmCode write fAsmCode; // DR 2002-01-14 353 | property DirectiveParamOrigin: pchar read FDirectiveParamOrigin; 354 | 355 | property UseDefines: Boolean read FUseDefines write FUseDefines; 356 | 357 | end; 358 | 359 | TmwPasLex = class(TmwBasePasLex) 360 | private 361 | fAheadLex: TmwBasePasLex; 362 | function GetAheadExID: TptTokenKind; 363 | function GetAheadGenID: TptTokenKind; 364 | function GetAheadToken: string; 365 | function GetAheadTokenID: TptTokenKind; 366 | function GetStatus: TmwPasLexStatus; 367 | procedure SetStatus(const Value: TmwPasLexStatus); 368 | protected 369 | procedure SetLine(const Value: string); override; 370 | procedure SetOrigin(NewValue: PChar); override; 371 | procedure SetOnCompDirect(const Value: TDirectiveEvent); override; 372 | procedure SetOnDefineDirect(const Value: TDirectiveEvent); override; 373 | procedure SetOnElseDirect(const Value: TDirectiveEvent); override; 374 | procedure SetOnEndIfDirect(const Value: TDirectiveEvent); override; 375 | procedure SetOnIfDefDirect(const Value: TDirectiveEvent); override; 376 | procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); override; 377 | procedure SetOnIfOptDirect(const Value: TDirectiveEvent); override; 378 | procedure SetOnIncludeDirect(const Value: TDirectiveEvent); override; 379 | procedure SetOnResourceDirect(const Value: TDirectiveEvent); override; 380 | procedure SetOnUnDefDirect(const Value: TDirectiveEvent); override; 381 | public 382 | constructor Create; 383 | destructor Destroy; override; 384 | procedure InitAhead; 385 | procedure AheadNext; 386 | property AheadLex: TmwBasePasLex read fAheadLex; 387 | property AheadToken: string read GetAheadToken; 388 | property AheadTokenID: TptTokenKind read GetAheadTokenID; 389 | property AheadExID: TptTokenKind read GetAheadExID; 390 | property AheadGenID: TptTokenKind read GetAheadGenID; 391 | property Status: TmwPasLexStatus read GetStatus write SetStatus; 392 | end; 393 | 394 | implementation 395 | 396 | uses Windows; 397 | 398 | procedure MakeIdentTable; 399 | var 400 | I, J: Char; 401 | begin 402 | for I := #0 to #255 do 403 | begin 404 | case I of 405 | '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True; 406 | else Identifiers[I] := False; 407 | end; 408 | J := UpperCase(I)[1]; 409 | case I of 410 | 'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64; 411 | else mHashTable[Char(I)] := 0; 412 | end; 413 | end; 414 | end; 415 | 416 | function TmwBasePasLex.CharAhead: Char; 417 | begin 418 | RunAhead := Run; 419 | // while fOrigin[RunAhead] in [#1..#32] do 420 | while (fOrigin[RunAhead] > #0) and (fOrigin[RunAhead] < #33) do 421 | 422 | inc(RunAhead); 423 | Result := fOrigin[RunAhead]; 424 | end; 425 | 426 | procedure TmwBasePasLex.ClearDefines; 427 | var 428 | Frame: PDefineRec; 429 | begin 430 | while FTopDefineRec <> nil do 431 | begin 432 | Frame := FTopDefineRec; 433 | FTopDefineRec := Frame^.Next; 434 | Dispose(Frame); 435 | end; 436 | FDefines.Clear; 437 | FDefineStack := 0; 438 | end; 439 | 440 | procedure TmwBasePasLex.CloneDefinesFrom(ALexer: TmwBasePasLex); 441 | var 442 | Frame, LastFrame, SourceFrame: PDefineRec; 443 | begin 444 | ClearDefines; 445 | FDefines.Assign(ALexer.FDefines); 446 | FDefineStack := ALexer.FDefineStack; 447 | 448 | Frame := nil; 449 | SourceFrame := ALexer.FTopDefineRec; 450 | while SourceFrame <> nil do 451 | begin 452 | New(Frame); 453 | if FTopDefineRec = nil then 454 | FTopDefineRec := Frame 455 | else 456 | LastFrame^.Next := Frame; 457 | Frame^.Defined := SourceFrame^.Defined; 458 | Frame^.StartCount := SourceFrame^.StartCount; 459 | LastFrame := Frame; 460 | 461 | SourceFrame := SourceFrame^.Next; 462 | end; 463 | if Frame <> nil then 464 | Frame^.Next := nil; 465 | 466 | // New(StackFrame); 467 | // StackFrame^.Next := FTopDefineRec; 468 | // StackFrame^.Defined := ADefined; 469 | // StackFrame^.StartCount := FDefineStack; 470 | // FTopDefineRec := StackFrame; 471 | // if not ADefined then 472 | // Inc(FDefineStack); 473 | 474 | end; 475 | 476 | function TmwBasePasLex.GetPosXY: TTokenPoint; 477 | begin //jdj 7/18/1999 478 | // !! changed setting code 479 | Result.X:= FTokenPos - FLinePos; 480 | Result.Y:= FLineNumber; 481 | end; 482 | 483 | procedure TmwBasePasLex.InitIdent; 484 | var 485 | I: Integer; 486 | begin 487 | for I := 0 to 191 do 488 | case I of 489 | {$IFDEF D8_NEWER} 490 | 9: fIdentFuncTable[I] := Func9; 491 | {$ENDIF} 492 | 15: fIdentFuncTable[I] := Func15; 493 | 19: fIdentFuncTable[I] := Func19; 494 | 20: fIdentFuncTable[I] := Func20; 495 | 21: fIdentFuncTable[I] := Func21; 496 | 23: fIdentFuncTable[I] := Func23; 497 | 25: fIdentFuncTable[I] := Func25; 498 | 27: fIdentFuncTable[I] := Func27; 499 | 28: fIdentFuncTable[I] := Func28; 500 | 29: fIdentFuncTable[I] := Func29; 501 | 30: fIdentFuncTable[I] := Func30; 502 | 32: fIdentFuncTable[I] := Func32; 503 | 33: fIdentFuncTable[I] := Func33; 504 | 35: fIdentFuncTable[I] := Func35; 505 | 36: fIdentFuncTable[I] := Func36; 506 | 37: fIdentFuncTable[I] := Func37; 507 | 38: fIdentFuncTable[I] := Func38; 508 | 39: fIdentFuncTable[I] := Func39; 509 | 40: fIdentFuncTable[I] := Func40; 510 | 41: fIdentFuncTable[I] := Func41; 511 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 512 | 42: fIdentFuncTable[I] := Func42; 513 | {$ENDIF} 514 | 43: fIdentFuncTable[I] := Func43; 515 | 44: fIdentFuncTable[I] := Func44; 516 | 45: fIdentFuncTable[I] := Func45; 517 | 46: fIdentFuncTable[I] := Func46; 518 | 47: fIdentFuncTable[I] := Func47; 519 | 49: fIdentFuncTable[I] := Func49; 520 | 52: fIdentFuncTable[I] := Func52; 521 | 54: fIdentFuncTable[I] := Func54; 522 | 55: fIdentFuncTable[I] := Func55; 523 | 56: fIdentFuncTable[I] := Func56; 524 | 57: fIdentFuncTable[I] := Func57; 525 | 58: fIdentFuncTable[I] := Func58; 526 | 59: fIdentFuncTable[I] := Func59; 527 | 60: fIdentFuncTable[I] := Func60; 528 | 61: fIdentFuncTable[I] := Func61; 529 | 62: fIdentFuncTable[I] := Func62; 530 | 63: fIdentFuncTable[I] := Func63; 531 | 64: fIdentFuncTable[I] := Func64; 532 | 65: fIdentFuncTable[I] := Func65; 533 | 66: fIdentFuncTable[I] := Func66; 534 | 69: fIdentFuncTable[I] := Func69; 535 | 71: fIdentFuncTable[I] := Func71; 536 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 537 | 72: fIdentFuncTable[I] := Func72; 538 | {$ENDIF} 539 | 73: fIdentFuncTable[I] := Func73; 540 | 75: fIdentFuncTable[I] := Func75; 541 | 76: fIdentFuncTable[I] := Func76; 542 | 78: fIdentFuncTable[I] := Func78; 543 | 79: fIdentFuncTable[I] := Func79; 544 | 81: fIdentFuncTable[I] := Func81; 545 | 84: fIdentFuncTable[I] := Func84; 546 | 85: fIdentFuncTable[I] := Func85; 547 | 86: fIdentFuncTable[I] := Func86; 548 | 87: fIdentFuncTable[I] := Func87; 549 | 88: fIdentFuncTable[I] := Func88; 550 | {$IFDEF D8_NEWER} //JThurman 2004-03-03 551 | 89: fIdentFuncTable[I] := Func89; 552 | {$ENDIF} 553 | 91: fIdentFuncTable[I] := Func91; 554 | 92: fIdentFuncTable[I] := Func92; 555 | 94: fIdentFuncTable[I] := Func94; 556 | 95: fIdentFuncTable[I] := Func95; 557 | 96: fIdentFuncTable[I] := Func96; 558 | 97: fIdentFuncTable[I] := Func97; 559 | 98: fIdentFuncTable[I] := Func98; 560 | 99: fIdentFuncTable[I] := Func99; 561 | 100: fIdentFuncTable[I] := Func100; 562 | 101: fIdentFuncTable[I] := Func101; 563 | 102: fIdentFuncTable[I] := Func102; 564 | 103: fIdentFuncTable[I] := Func103; 565 | 104: fIdentFuncTable[I] := Func104; 566 | 105: fIdentFuncTable[I] := Func105; 567 | 106: fIdentFuncTable[I] := Func106; 568 | 107: fIdentFuncTable[I] := Func107; 569 | 108: fIdentFuncTable[I] := Func108; 570 | 112: fIdentFuncTable[I] := Func112; 571 | 117: fIdentFuncTable[I] := Func117; 572 | 123: fIdentFuncTable[I] := Func123; 573 | 126: fIdentFuncTable[I] := Func126; 574 | 127: fIdentFuncTable[I] := Func127; 575 | 128: fIdentFuncTable[I] := Func128; 576 | 129: fIdentFuncTable[I] := Func129; 577 | 130: fIdentFuncTable[I] := Func130; 578 | 132: fIdentFuncTable[I] := Func132; 579 | 133: fIdentFuncTable[I] := Func133; 580 | 136: fIdentFuncTable[I] := Func136; 581 | 141: fIdentFuncTable[I] := Func141; 582 | 143: fIdentFuncTable[I] := Func143; 583 | 166: fIdentFuncTable[I] := Func166; 584 | 167: fIdentFuncTable[I] := Func167; 585 | 168: fIdentFuncTable[I] := Func168; 586 | 191: fIdentFuncTable[I] := Func191; 587 | else fIdentFuncTable[I] := AltFunc; 588 | end; 589 | end; 590 | 591 | function TmwBasePasLex.KeyHash: Integer; 592 | begin 593 | Result := 0; 594 | while IsIdentifiers(fOrigin[Run]) do 595 | begin 596 | Inc(Result, HashValue(fOrigin[Run])); 597 | //inc(Result, mHashTable[fOrigin[Run]]); 598 | inc(Run); 599 | end; 600 | end; { KeyHash } 601 | 602 | function TmwBasePasLex.KeyComp(const aKey: string): Boolean; 603 | var 604 | I: Integer; 605 | Temp: PChar; 606 | begin 607 | if Length(aKey) = TokenLen then 608 | begin 609 | Temp := fOrigin + fTokenPos; 610 | Result := True; 611 | for i := 1 to TokenLen do 612 | begin 613 | if mHashTable[Temp^] <> mHashTable[aKey[i]] then 614 | begin 615 | Result := False; 616 | break; 617 | end; 618 | inc(Temp); 619 | end; 620 | end 621 | else Result := False; 622 | end; { KeyComp } 623 | 624 | function TmwBasePasLex.Func9: tptTokenKind; 625 | begin 626 | Result := ptIdentifier; 627 | if KeyComp('Add') then 628 | FExID := ptAdd; 629 | end; 630 | 631 | function TmwBasePasLex.Func15: TptTokenKind; 632 | begin 633 | Result := ptIdentifier; 634 | if KeyComp('If') then Result := ptIf; 635 | end; 636 | 637 | function TmwBasePasLex.Func19: TptTokenKind; 638 | begin 639 | Result := ptIdentifier; 640 | if KeyComp('Do') then Result := ptDo else 641 | if KeyComp('And') then Result := ptAnd; 642 | end; 643 | 644 | function TmwBasePasLex.Func20: TptTokenKind; 645 | begin 646 | Result := ptIdentifier; 647 | if KeyComp('As') then Result := ptAs; 648 | end; 649 | 650 | function TmwBasePasLex.Func21: TptTokenKind; 651 | begin 652 | Result := ptIdentifier; 653 | if KeyComp('Of') then Result := ptOf else 654 | if KeyComp('At') then fExID := ptAt; 655 | end; 656 | 657 | function TmwBasePasLex.Func23: TptTokenKind; 658 | begin 659 | Result := ptIdentifier; 660 | if KeyComp('End') then Result := ptEnd else 661 | if KeyComp('In') then Result := ptIn; 662 | end; 663 | 664 | function TmwBasePasLex.Func25: TptTokenKind; 665 | begin 666 | Result := ptIdentifier; 667 | if KeyComp('Far') then fExID := ptFar; 668 | end; 669 | 670 | function TmwBasePasLex.Func27: TptTokenKind; 671 | begin 672 | Result := ptIdentifier; 673 | if KeyComp('Cdecl') then fExID := ptCdecl; 674 | end; 675 | 676 | function TmwBasePasLex.Func28: TptTokenKind; 677 | begin 678 | Result := ptIdentifier; 679 | if KeyComp('Read') then fExID := ptRead else 680 | if KeyComp('Case') then Result := ptCase else 681 | if KeyComp('Is') then Result := ptIs; 682 | end; 683 | 684 | function TmwBasePasLex.Func29: TptTokenKind; 685 | begin 686 | Result := ptIdentifier; 687 | if KeyComp('On') then fExID := ptOn; 688 | end; 689 | 690 | function TmwBasePasLex.Func30: TptTokenKind; 691 | begin 692 | Result := ptIdentifier; 693 | if KeyComp('Char') then fExID := ptChar; 694 | end; 695 | 696 | function TmwBasePasLex.Func32: TptTokenKind; 697 | begin 698 | Result := ptIdentifier; 699 | if KeyComp('File') then Result := ptFile else 700 | if KeyComp('Label') then Result := ptLabel else 701 | if KeyComp('Mod') then Result := ptMod; 702 | end; 703 | 704 | function TmwBasePasLex.Func33: TptTokenKind; 705 | begin 706 | Result := ptIdentifier; 707 | if KeyComp('Or') then Result := ptOr else 708 | if KeyComp('Name') then fExID := ptName else 709 | if KeyComp('Asm') then Result := ptAsm; 710 | end; 711 | 712 | function TmwBasePasLex.Func35: TptTokenKind; 713 | begin 714 | Result := ptIdentifier; 715 | if KeyComp('Nil') then Result := ptNil else 716 | if KeyComp('To') then Result := ptTo else 717 | if KeyComp('Div') then Result := ptDiv; 718 | end; 719 | 720 | function TmwBasePasLex.Func36: TptTokenKind; 721 | begin 722 | Result := ptIdentifier; 723 | if KeyComp('Real') then fExID := ptReal else 724 | if KeyComp('Real48') then fExID := ptReal48; 725 | end; 726 | 727 | function TmwBasePasLex.Func37: TptTokenKind; 728 | begin 729 | Result := ptIdentifier; 730 | if KeyComp('Begin') then Result := ptBegin else 731 | if KeyComp('Break') then fExID := ptBreak; 732 | end; 733 | 734 | function TmwBasePasLex.Func38: TptTokenKind; 735 | begin 736 | Result := ptIdentifier; 737 | if KeyComp('Near') then fExID := ptNear; 738 | end; 739 | 740 | function TmwBasePasLex.Func39: TptTokenKind; 741 | begin 742 | Result := ptIdentifier; 743 | if KeyComp('For') then Result := ptFor else 744 | if KeyComp('Shl') then Result := ptShl; 745 | end; 746 | 747 | function TmwBasePasLex.Func40: TptTokenKind; 748 | begin 749 | Result := ptIdentifier; 750 | if KeyComp('Packed') then Result := ptPacked; 751 | end; 752 | 753 | function TmwBasePasLex.Func41: TptTokenKind; 754 | begin 755 | Result := ptIdentifier; 756 | if KeyComp('Var') then Result := ptVar else 757 | if KeyComp('Else') then Result := ptElse else 758 | if KeyComp('Halt') then fExID := ptHalt; 759 | end; 760 | 761 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 762 | function TmwBasePasLex.Func42: TptTokenKind; 763 | begin 764 | Result := ptIdentifier; 765 | if KeyComp('Final') then 766 | fExID := ptFinal; //TODO: Is this supposed to be an ExID? 767 | end; 768 | {$ENDIF} 769 | 770 | function TmwBasePasLex.Func43: TptTokenKind; 771 | begin 772 | Result := ptIdentifier; 773 | if KeyComp('Int64') then fExID := ptInt64 774 | else if KeyComp('local') then fExID := ptLocal; 775 | end; 776 | 777 | function TmwBasePasLex.Func44: TptTokenKind; 778 | begin 779 | Result := ptIdentifier; 780 | if KeyComp('Set') then Result := ptSet else 781 | if KeyComp('Package') then fExID := ptPackage; 782 | end; 783 | 784 | function TmwBasePasLex.Func45: TptTokenKind; 785 | begin 786 | Result := ptIdentifier; 787 | if KeyComp('Shr') then Result := ptShr; 788 | end; 789 | 790 | function TmwBasePasLex.Func46: TptTokenKind; 791 | begin 792 | Result := ptIdentifier; 793 | if KeyComp('PChar') then fExId := ptPChar 794 | {$IFDEF D8_NEWER} //JThurman 2004-03-19 795 | else 796 | if KeyComp('Sealed') then Result := ptSealed; 797 | {$ELSE} 798 | ; 799 | {$ENDIF} 800 | end; 801 | 802 | function TmwBasePasLex.Func47: TptTokenKind; 803 | begin 804 | Result := ptIdentifier; 805 | if KeyComp('Then') then Result := ptThen else 806 | if KeyComp('Comp') then fExID := ptComp; 807 | end; 808 | 809 | function TmwBasePasLex.Func49: TptTokenKind; 810 | begin 811 | Result := ptIdentifier; 812 | if KeyComp('Not') then Result := ptNot; 813 | end; 814 | 815 | function TmwBasePasLex.Func52: TptTokenKind; 816 | begin 817 | Result := ptIdentifier; 818 | if KeyComp('Byte') then fExID := ptByte else 819 | if KeyComp('Raise') then Result := ptRaise else 820 | if KeyComp('Pascal') then fExID := ptPascal; 821 | end; 822 | 823 | function TmwBasePasLex.Func54: TptTokenKind; 824 | begin 825 | Result := ptIdentifier; 826 | if KeyComp('Class') then Result := ptClass; 827 | end; 828 | 829 | function TmwBasePasLex.Func55: TptTokenKind; 830 | begin 831 | Result := ptIdentifier; 832 | if KeyComp('Object') then Result := ptObject; 833 | end; 834 | 835 | function TmwBasePasLex.Func56: TptTokenKind; 836 | begin 837 | Result := ptIdentifier; 838 | if KeyComp('Index') then fExID := ptIndex else 839 | if KeyComp('Out') then fExID := ptOut else // bug in Delphi's documentation: OUT is a directive 840 | if KeyComp('Abort') then fExID := ptAbort; 841 | end; 842 | 843 | function TmwBasePasLex.Func57: TptTokenKind; 844 | begin 845 | Result := ptIdentifier; 846 | if KeyComp('While') then Result := ptWhile else 847 | if KeyComp('Xor') then Result := ptXor else 848 | if KeyComp('Goto') then Result := ptGoto; 849 | end; 850 | 851 | function TmwBasePasLex.Func58: TptTokenKind; 852 | begin 853 | Result := ptIdentifier; 854 | if KeyComp('Exit') then fExID := ptExit; 855 | end; 856 | 857 | function TmwBasePasLex.Func59: TptTokenKind; 858 | begin 859 | Result := ptIdentifier; 860 | if KeyComp('Safecall') then fExID := ptSafecall else 861 | if KeyComp('Double') then fExID := ptDouble; 862 | end; 863 | 864 | function TmwBasePasLex.Func60: TptTokenKind; 865 | begin 866 | Result := ptIdentifier; 867 | if KeyComp('With') then Result := ptWith else 868 | if KeyComp('Word') then fExID := ptWord; 869 | end; 870 | 871 | function TmwBasePasLex.Func61: TptTokenKind; 872 | begin 873 | Result := ptIdentifier; 874 | if KeyComp('Dispid') then fExID := ptDispid; 875 | end; 876 | 877 | function TmwBasePasLex.Func62: TptTokenKind; 878 | begin 879 | Result := ptIdentifier; 880 | if KeyComp('Cardinal') then fExID := ptCardinal; 881 | end; 882 | 883 | function TmwBasePasLex.Func63: TptTokenKind; 884 | begin 885 | Result := ptIdentifier; 886 | case fOrigin[fTokenPos] of 887 | 'P', 'p': if KeyComp('Public') then fExID := ptPublic; 888 | 'A', 'a': if KeyComp('Array') then Result := ptArray; 889 | 'T', 't': if KeyComp('Try') then Result := ptTry; 890 | 'R', 'r': if KeyComp('Record') then Result := ptRecord; 891 | 'I', 'i': if KeyComp('Inline') then 892 | begin 893 | Result := ptInline; 894 | fExID := ptInline; 895 | end; 896 | end; 897 | end; 898 | 899 | function TmwBasePasLex.Func64: TptTokenKind; 900 | begin 901 | Result := ptIdentifier; 902 | case fOrigin[fTokenPos] of 903 | 'B', 'b': if KeyComp('Boolean') then fExID := ptBoolean; 904 | 'D', 'd': if KeyComp('DWORD') then fExID := ptDWORD; 905 | 'U', 'u': if KeyComp('Uses') then Result := ptUses 906 | else 907 | if KeyComp('Unit') then Result := ptUnit; 908 | {$IFDEF D8_NEWER} 909 | 'H', 'h': if KeyComp('Helper') then Result := ptHelper; 910 | {$ENDIF} 911 | end; 912 | end; 913 | 914 | function TmwBasePasLex.Func65: TptTokenKind; 915 | begin 916 | Result := ptIdentifier; 917 | if KeyComp('Repeat') then Result := ptRepeat; 918 | end; 919 | 920 | function TmwBasePasLex.Func66: TptTokenKind; 921 | begin 922 | Result := ptIdentifier; 923 | if KeyComp('Single') then fExID := ptSingle else 924 | if KeyComp('Type') then Result := ptType 925 | {$IFDEF D8_NEWER}//JThurman 2004-03-23 926 | else 927 | if KeyComp('Unsafe') then Result := ptUnsafe 928 | {$ENDIF} 929 | ; 930 | end; 931 | 932 | function TmwBasePasLex.Func69: TptTokenKind; 933 | begin 934 | Result := ptIdentifier; 935 | if KeyComp('Default') then fExID := ptDefault else 936 | if KeyComp('Dynamic') then fExID := ptDynamic else 937 | if KeyComp('Message') then fExID := ptMessage; 938 | end; 939 | 940 | function TmwBasePasLex.Func71: TptTokenKind; 941 | begin 942 | Result := ptIdentifier; 943 | if KeyComp('WideChar') then fExID := ptWideChar else 944 | if KeyComp('Stdcall') then fExID := ptStdcall else 945 | if KeyComp('Const') then Result := ptConst; 946 | end; 947 | 948 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 949 | function TmwBasePasLex.Func72: TptTokenKind; 950 | begin 951 | Result := ptIdentifier; 952 | if KeyComp('Static') then 953 | fExID := ptStatic; 954 | end; 955 | {$ENDIF} 956 | 957 | function TmwBasePasLex.Func73: TptTokenKind; 958 | begin 959 | Result := ptIdentifier; 960 | if KeyComp('Except') then Result := ptExcept; 961 | end; 962 | 963 | function TmwBasePasLex.Func75: TptTokenKind; 964 | begin 965 | Result := ptIdentifier; 966 | if KeyComp('Write') then fExID := ptWrite; 967 | end; 968 | 969 | function TmwBasePasLex.Func76: TptTokenKind; 970 | begin 971 | Result := ptIdentifier; 972 | if KeyComp('Until') then Result := ptUntil; 973 | end; 974 | 975 | function TmwBasePasLex.Func78: TptTokenKind; 976 | begin 977 | Result := ptIdentifier; 978 | if KeyComp('Integer') then fExID := ptInteger 979 | {$IFDEF D8_NEWER} 980 | else if KeyComp('Remove') then 981 | FExID := ptRemove 982 | {$ENDIF} 983 | ; 984 | end; 985 | 986 | function TmwBasePasLex.Func79: TptTokenKind; 987 | begin 988 | Result := ptIdentifier; 989 | if KeyComp('Finally') then Result := ptFinally 990 | {$IFDEF D12_NEWER} 991 | else if KeyComp('Reference') then fExID := ptReference; 992 | {$ENDIF} 993 | 994 | end; 995 | 996 | function TmwBasePasLex.Func81: TptTokenKind; 997 | begin 998 | Result := ptIdentifier; 999 | if KeyComp('Extended') then fExID := ptExtended else 1000 | if KeyComp('Stored') then fExID := ptStored else 1001 | if KeyComp('Interface') then Result := ptInterface 1002 | else if KeyComp('Deprecated') then fExID := ptDeprecated; // DR 2001-10-20 1003 | end; 1004 | 1005 | function TmwBasePasLex.Func84: TptTokenKind; 1006 | begin 1007 | Result := ptIdentifier; 1008 | if KeyComp('Abstract') then fExID := ptAbstract; 1009 | end; 1010 | 1011 | function TmwBasePasLex.Func85: TptTokenKind; 1012 | begin 1013 | Result := ptIdentifier; 1014 | if KeyComp('Library') then Result := ptLibrary else 1015 | if KeyComp('Forward') then fExID := ptForward else 1016 | if KeyComp('Variant') then fExID := ptVariant; 1017 | end; 1018 | 1019 | function TmwBasePasLex.Func87: TptTokenKind; 1020 | begin 1021 | Result := ptIdentifier; 1022 | if KeyComp('String') then Result := ptString; 1023 | end; 1024 | 1025 | function TmwBasePasLex.Func88: TptTokenKind; 1026 | begin 1027 | Result := ptIdentifier; 1028 | if KeyComp('Program') then Result := ptProgram; 1029 | end; 1030 | 1031 | {$IFDEF D8_NEWER} //JThurman 2004-03-03 1032 | function TmwBasePasLex.Func89: TptTokenKind; 1033 | begin 1034 | Result := ptIdentifier; 1035 | if KeyComp('Strict') then Result := ptStrict; 1036 | end; 1037 | {$ENDIF} 1038 | 1039 | function TmwBasePasLex.Func91: TptTokenKind; 1040 | begin 1041 | Result := ptIdentifier; 1042 | if KeyComp('Downto') then Result := ptDownto else 1043 | if KeyComp('Private') then fExID := ptPrivate else 1044 | if KeyComp('Longint') then fExID := ptLongint; 1045 | end; 1046 | 1047 | function TmwBasePasLex.Func92: TptTokenKind; 1048 | begin 1049 | Result := ptIdentifier; 1050 | if KeyComp('Inherited') then Result := ptInherited else 1051 | if KeyComp('LongBool') then fExID := ptLongBool else 1052 | if KeyComp('Overload') then fExID := ptOverload; 1053 | end; 1054 | 1055 | function TmwBasePasLex.Func94: TptTokenKind; 1056 | begin 1057 | Result := ptIdentifier; 1058 | if KeyComp('Resident') then fExID := ptResident else 1059 | if KeyComp('Readonly') then fExID := ptReadonly else 1060 | if KeyComp('Assembler') then fExID := ptAssembler; 1061 | end; 1062 | 1063 | function TmwBasePasLex.Func95: TptTokenKind; 1064 | begin 1065 | Result := ptIdentifier; 1066 | if KeyComp('Contains') then fExID := ptContains else 1067 | if KeyComp('Absolute') then fExID := ptAbsolute; 1068 | end; 1069 | 1070 | function TmwBasePasLex.Func96: TptTokenKind; 1071 | begin 1072 | Result := ptIdentifier; 1073 | if KeyComp('ByteBool') then fExID := ptByteBool else 1074 | if KeyComp('Override') then fExID := ptOverride else 1075 | if KeyComp('Published') then fExID := ptPublished; 1076 | end; 1077 | 1078 | function TmwBasePasLex.Func97: TptTokenKind; 1079 | begin 1080 | Result := ptIdentifier; 1081 | if KeyComp('Threadvar') then Result := ptThreadvar; 1082 | end; 1083 | 1084 | function TmwBasePasLex.Func98: TptTokenKind; 1085 | begin 1086 | Result := ptIdentifier; 1087 | if KeyComp('Export') then fExID := ptExport else 1088 | if KeyComp('Nodefault') then fExID := ptNodefault; 1089 | end; 1090 | 1091 | function TmwBasePasLex.Func99: TptTokenKind; 1092 | begin 1093 | Result := ptIdentifier; 1094 | if KeyComp('External') then fExID := ptExternal; 1095 | end; 1096 | 1097 | function TmwBasePasLex.Func100: TptTokenKind; 1098 | begin 1099 | Result := ptIdentifier; 1100 | if KeyComp('Automated') then fExID := ptAutomated else 1101 | if KeyComp('Smallint') then fExID := ptSmallint; 1102 | end; 1103 | 1104 | function TmwBasePasLex.Func101: TptTokenKind; 1105 | begin 1106 | Result := ptIdentifier; 1107 | if KeyComp('Register') then fExID := ptRegister 1108 | else if KeyComp('Platform') then fExID := ptPlatform // DR 2001-10-20 1109 | else if KeyComp('Continue') then fExID := ptContinue; 1110 | end; 1111 | 1112 | function TmwBasePasLex.Func102: TptTokenKind; 1113 | begin 1114 | Result := ptIdentifier; 1115 | if KeyComp('Function') then Result := ptFunction; 1116 | end; 1117 | 1118 | function TmwBasePasLex.Func103: TptTokenKind; 1119 | begin 1120 | Result := ptIdentifier; 1121 | if KeyComp('Virtual') then fExID := ptVirtual; 1122 | end; 1123 | 1124 | function TmwBasePasLex.Func104: TptTokenKind; 1125 | begin 1126 | Result := ptIdentifier; 1127 | if KeyComp('WordBool') then fExID := ptWordBool; 1128 | end; 1129 | 1130 | function TmwBasePasLex.Func105: TptTokenKind; 1131 | begin 1132 | Result := ptIdentifier; 1133 | if KeyComp('Procedure') then Result := ptProcedure; 1134 | end; 1135 | 1136 | function TmwBasePasLex.Func106: TptTokenKind; 1137 | begin 1138 | Result := ptIdentifier; 1139 | if KeyComp('Protected') then fExID := ptProtected; 1140 | end; 1141 | 1142 | function TmwBasePasLex.Func107: TptTokenKind; 1143 | begin 1144 | Result := ptIdentifier; 1145 | if KeyComp('Currency') then fExID := ptCurrency; 1146 | end; 1147 | 1148 | function TmwBasePasLex.Func108: TptTokenKind; 1149 | begin 1150 | Result := ptIdentifier; 1151 | if KeyComp('Longword') then fExID := ptLongword; 1152 | {$IFDEF D8_NEWER} //JThurman 2004-03-20 1153 | if KeyComp('Operator') then fExID := ptOperator; 1154 | {$ENDIF} 1155 | end; 1156 | 1157 | function TmwBasePasLex.Func112: TptTokenKind; 1158 | begin 1159 | Result := ptIdentifier; 1160 | if KeyComp('Requires') then fExID := ptRequires; 1161 | end; 1162 | 1163 | function TmwBasePasLex.Func117: TptTokenKind; 1164 | begin 1165 | Result := ptIdentifier; 1166 | if KeyComp('Exports') then Result := ptExports else 1167 | if KeyComp('OleVariant') then fExID := ptOleVariant; 1168 | end; 1169 | 1170 | function TmwBasePasLex.Func123: TptTokenKind; 1171 | begin 1172 | Result := ptIdentifier; 1173 | if KeyComp('Shortint') then fExID := ptShortint; 1174 | end; 1175 | 1176 | function TmwBasePasLex.Func126: TptTokenKind; 1177 | begin 1178 | Result := ptIdentifier; 1179 | if KeyComp('Implements') then fExID := ptImplements; 1180 | end; 1181 | 1182 | function TmwBasePasLex.Func127: TptTokenKind; 1183 | begin 1184 | Result := ptIdentifier; 1185 | if KeyComp('Runerror') then fExID := ptRunError; 1186 | end; 1187 | 1188 | function TmwBasePasLex.Func128: TptTokenKind; 1189 | begin 1190 | if KeyComp('WideString') then fExID := ptWideString; 1191 | Result := ptIdentifier; 1192 | end; 1193 | 1194 | function TmwBasePasLex.Func129: TptTokenKind; 1195 | begin 1196 | Result := ptIdentifier; 1197 | if KeyComp('Dispinterface') then Result := ptDispinterface 1198 | end; 1199 | 1200 | function TmwBasePasLex.Func130: TptTokenKind; 1201 | begin 1202 | Result := ptIdentifier; 1203 | if KeyComp('AnsiString') then fExID := ptAnsiString; 1204 | end; 1205 | 1206 | function TmwBasePasLex.Func132: TptTokenKind; 1207 | begin 1208 | Result := ptIdentifier; 1209 | if KeyComp('Reintroduce') then fExID := ptReintroduce; 1210 | end; 1211 | 1212 | function TmwBasePasLex.Func133: TptTokenKind; 1213 | begin 1214 | Result := ptIdentifier; 1215 | if KeyComp('Property') then Result := ptProperty; 1216 | end; 1217 | 1218 | function TmwBasePasLex.Func136: TptTokenKind; 1219 | begin 1220 | Result := ptIdentifier; 1221 | if KeyComp('Finalization') then Result := ptFinalization; 1222 | end; 1223 | 1224 | function TmwBasePasLex.Func141: TptTokenKind; 1225 | begin 1226 | Result := ptIdentifier; 1227 | if KeyComp('Writeonly') then fExID := ptWriteonly; 1228 | end; 1229 | 1230 | function TmwBasePasLex.Func143: TptTokenKind; 1231 | begin 1232 | Result := ptIdentifier; 1233 | if KeyComp('Destructor') then Result := ptDestructor; 1234 | end; 1235 | 1236 | function TmwBasePasLex.Func166: TptTokenKind; 1237 | begin 1238 | Result := ptIdentifier; 1239 | if KeyComp('Constructor') then Result := ptConstructor else 1240 | if KeyComp('Implementation') then Result := ptImplementation; 1241 | end; 1242 | 1243 | function TmwBasePasLex.Func167: TptTokenKind; 1244 | begin 1245 | Result := ptIdentifier; 1246 | if KeyComp('ShortString') then fExID := ptShortString; 1247 | end; 1248 | 1249 | function TmwBasePasLex.Func168: TptTokenKind; 1250 | begin 1251 | Result := ptIdentifier; 1252 | if KeyComp('Initialization') then Result := ptInitialization; 1253 | end; 1254 | 1255 | function TmwBasePasLex.Func191: TptTokenKind; 1256 | begin 1257 | Result := ptIdentifier; 1258 | if KeyComp('Resourcestring') then Result := ptResourcestring else 1259 | if KeyComp('Stringresource') then fExID := ptStringresource; 1260 | end; 1261 | 1262 | function TmwBasePasLex.AltFunc: TptTokenKind; 1263 | begin 1264 | Result := ptIdentifier; 1265 | end; 1266 | 1267 | function TmwBasePasLex.IdentKind: TptTokenKind; 1268 | var 1269 | HashKey: Integer; 1270 | begin 1271 | HashKey := KeyHash; 1272 | if HashKey < 192 then 1273 | Result := fIdentFuncTable[HashKey] 1274 | else Result := ptIdentifier; 1275 | end; 1276 | 1277 | procedure TmwBasePasLex.MakeMethodTables; 1278 | var 1279 | I: Char; 1280 | begin 1281 | for I := #0 to #255 do 1282 | case I of 1283 | #0: fProcTable[I] := NullProc; 1284 | #10: fProcTable[I] := LFProc; 1285 | #13: fProcTable[I] := CRProc; 1286 | #1..#9, #11, #12, #14..#32: 1287 | fProcTable[I] := SpaceProc; 1288 | '#': fProcTable[I] := AsciiCharProc; 1289 | '$': fProcTable[I] := IntegerProc; 1290 | #39: fProcTable[I] := StringProc; 1291 | '0'..'9': fProcTable[I] := NumberProc; 1292 | 'A'..'Z', 'a'..'z', '_': 1293 | fProcTable[I] := IdentProc; 1294 | '{': fProcTable[I] := BraceOpenProc; 1295 | '}': fProcTable[I] := BraceCloseProc; 1296 | '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~': 1297 | begin 1298 | case I of 1299 | '(': fProcTable[I] := RoundOpenProc; 1300 | ')': fProcTable[I] := RoundCloseProc; 1301 | '*': fProcTable[I] := StarProc; 1302 | '+': fProcTable[I] := PlusProc; 1303 | ',': fProcTable[I] := CommaProc; 1304 | '-': fProcTable[I] := MinusProc; 1305 | '.': fProcTable[I] := PointProc; 1306 | '/': fProcTable[I] := SlashProc; 1307 | ':': fProcTable[I] := ColonProc; 1308 | ';': fProcTable[I] := SemiColonProc; 1309 | '<': fProcTable[I] := LowerProc; 1310 | '=': fProcTable[I] := EqualProc; 1311 | '>': fProcTable[I] := GreaterProc; 1312 | '@': fProcTable[I] := AddressOpProc; 1313 | '[': fProcTable[I] := SquareOpenProc; 1314 | ']': fProcTable[I] := SquareCloseProc; 1315 | '^': fProcTable[I] := PointerSymbolProc; 1316 | '"': fProcTable[I] := StringDQProc; // DR 2002-01-14 1317 | {$IFDEF D8_NEWER} //JThurman 2004-04-06 1318 | '&': fProcTable[I] := AmpersandOpProc; 1319 | {$ENDIF} 1320 | else fProcTable[I] := SymbolProc; 1321 | end; 1322 | end; 1323 | else fProcTable[I] := UnknownProc; 1324 | end; 1325 | end; 1326 | 1327 | constructor TmwBasePasLex.Create; 1328 | begin 1329 | inherited Create; 1330 | fOrigin := nil; 1331 | InitIdent; 1332 | MakeMethodTables; 1333 | fExID := ptUnKnown; 1334 | 1335 | FUseDefines := True; 1336 | FDefines := TStringList.Create; 1337 | FTopDefineRec := nil; 1338 | InitDefines; 1339 | end; { Create } 1340 | 1341 | destructor TmwBasePasLex.Destroy; 1342 | begin 1343 | ClearDefines; //If we don't do this, we get a memory leak 1344 | FDefines.Free; 1345 | fOrigin := nil; 1346 | inherited Destroy; 1347 | end; 1348 | 1349 | procedure TmwBasePasLex.DoProcTable(AChar: Char); 1350 | begin 1351 | if AChar <= #255 then 1352 | fProcTable[AChar] 1353 | else 1354 | begin 1355 | IdentProc; 1356 | end; 1357 | end; 1358 | 1359 | { Destroy } 1360 | 1361 | procedure TmwBasePasLex.SetOrigin(NewValue: PChar); 1362 | begin 1363 | fOrigin := NewValue; 1364 | Init; 1365 | Next; 1366 | end; { SetOrigin } 1367 | 1368 | procedure TmwBasePasLex.SetRunPos(Value: Integer); 1369 | begin 1370 | Run := Value; 1371 | Next; 1372 | end; 1373 | 1374 | procedure TmwBasePasLex.AddDefine(const ADefine: string); 1375 | begin 1376 | FDefines.Add(ADefine); 1377 | end; 1378 | 1379 | procedure TmwBasePasLex.AddressOpProc; 1380 | begin 1381 | case FOrigin[Run + 1] of 1382 | '@': 1383 | begin 1384 | fTokenID := ptDoubleAddressOp; 1385 | inc(Run, 2); 1386 | end; 1387 | else 1388 | begin 1389 | fTokenID := ptAddressOp; 1390 | inc(Run); 1391 | end; 1392 | end; 1393 | end; 1394 | 1395 | procedure TmwBasePasLex.AsciiCharProc; 1396 | begin 1397 | fTokenID := ptAsciiChar; 1398 | inc(Run); 1399 | if FOrigin[Run] = '$' then 1400 | begin 1401 | inc(Run); 1402 | while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run); 1403 | end else 1404 | begin 1405 | while FOrigin[Run] in ['0'..'9'] do 1406 | inc(Run); 1407 | end; 1408 | end; 1409 | 1410 | procedure TmwBasePasLex.BraceCloseProc; 1411 | begin 1412 | inc(Run); 1413 | fTokenId := ptError; 1414 | if Assigned(FOnMessage) then 1415 | FOnMessage(Self, meError, 'Illegal character', PosXY.X, PosXY.Y); 1416 | end; 1417 | 1418 | procedure TmwBasePasLex.BorProc; 1419 | begin 1420 | fTokenID := ptBorComment; 1421 | case FOrigin[Run] of 1422 | #0: 1423 | begin 1424 | NullProc; 1425 | if Assigned(FOnMessage) then 1426 | FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y); 1427 | exit; 1428 | end; 1429 | { DR 2001-08-02 1430 | 1431 | #10: 1432 | begin 1433 | LFProc; 1434 | exit; 1435 | end; 1436 | 1437 | #13: 1438 | begin 1439 | CRProc; 1440 | exit; 1441 | end; 1442 | } 1443 | end; 1444 | 1445 | while FOrigin[Run] <> #0 do 1446 | case FOrigin[Run] of 1447 | '}': 1448 | begin 1449 | fCommentState := csNo; 1450 | inc(Run); 1451 | break; 1452 | end; 1453 | { DR 2001-08-02 1454 | #10: break; 1455 | 1456 | #13: break; 1457 | } 1458 | #10: 1459 | begin 1460 | inc(Run); 1461 | inc(fLineNumber); 1462 | fLinePos := Run; 1463 | end; 1464 | #13: 1465 | begin 1466 | inc(Run); 1467 | if FOrigin[Run] = #10 then inc( Run ); 1468 | inc(fLineNumber); 1469 | fLinePos := Run; 1470 | end; 1471 | else inc(Run); 1472 | end; 1473 | end; 1474 | 1475 | procedure TmwBasePasLex.BraceOpenProc; 1476 | var 1477 | Param, Def: string; 1478 | begin 1479 | case FOrigin[Run + 1] of 1480 | '$': fTokenID := GetDirectiveKind; 1481 | else 1482 | begin 1483 | fTokenID := ptBorComment; 1484 | fCommentState := csBor; 1485 | end; 1486 | end; 1487 | inc(Run); 1488 | while FOrigin[Run] <> #0 do 1489 | case FOrigin[Run] of 1490 | '}': 1491 | begin 1492 | fCommentState := csNo; 1493 | inc(Run); 1494 | break; 1495 | end; 1496 | #10: 1497 | begin 1498 | inc(Run); 1499 | inc(fLineNumber); 1500 | fLinePos := Run; 1501 | end; 1502 | #13: 1503 | begin 1504 | inc(Run); 1505 | if FOrigin[Run] = #10 then inc( Run ); 1506 | inc(fLineNumber); 1507 | fLinePos := Run; 1508 | end; 1509 | { #10: break; DR 2001-10-12 1510 | 1511 | #13: break;} 1512 | else inc(Run); 1513 | end; 1514 | case fTokenID of 1515 | PtCompDirect: 1516 | begin 1517 | if Assigned(fOnCompDirect) then 1518 | fOnCompDirect(Self); 1519 | end; 1520 | PtDefineDirect: 1521 | begin 1522 | if FUseDefines then 1523 | AddDefine(DirectiveParam); 1524 | if Assigned(fOnDefineDirect) then 1525 | fOnDefineDirect(Self); 1526 | end; 1527 | PtElseDirect: 1528 | begin 1529 | if FUseDefines then 1530 | begin 1531 | if FTopDefineRec <> nil then 1532 | begin 1533 | if FTopDefineRec^.Defined then 1534 | Inc(FDefineStack) 1535 | else 1536 | if FDefineStack > 0 then 1537 | Dec(FDefineStack); 1538 | end; 1539 | end; 1540 | if Assigned(fOnElseDirect) then 1541 | fOnElseDirect(Self); 1542 | end; 1543 | PtEndIfDirect: 1544 | begin 1545 | if FUseDefines then 1546 | ExitDefineBlock; 1547 | if Assigned(fOnEndIfDirect) then 1548 | fOnEndIfDirect(Self); 1549 | end; 1550 | PtIfDefDirect: 1551 | begin 1552 | if FUseDefines then 1553 | EnterDefineBlock(IsDefined(DirectiveParam)); 1554 | if Assigned(fOnIfDefDirect) then 1555 | fOnIfDefDirect(Self); 1556 | end; 1557 | PtIfNDefDirect: 1558 | begin 1559 | if FUseDefines then 1560 | EnterDefineBlock(not IsDefined(DirectiveParam)); 1561 | if Assigned(fOnIfNDefDirect) then 1562 | fOnIfNDefDirect(Self); 1563 | end; 1564 | PtIfOptDirect: 1565 | begin 1566 | if Assigned(fOnIfOptDirect) then 1567 | fOnIfOptDirect(Self); 1568 | end; 1569 | PtIfDirect: 1570 | begin 1571 | if FUseDefines then 1572 | begin 1573 | Param := DirectiveParam; 1574 | if Pos('DEFINED', Param) = 1 then 1575 | begin 1576 | Def := Copy(Param, 9, Length(Param) - 9); 1577 | EnterDefineBlock(IsDefined(Def)); 1578 | end; 1579 | end; 1580 | if Assigned(fOnIfDirect) then 1581 | fOnIfDirect(Self); 1582 | end; 1583 | PtIfEndDirect: 1584 | begin 1585 | if FUseDefines then 1586 | ExitDefineBlock; 1587 | if Assigned(fOnIfEndDirect) then 1588 | fOnIfEndDirect(Self); 1589 | end; 1590 | PtElseIfDirect: 1591 | begin 1592 | if FUseDefines then 1593 | begin 1594 | if FTopDefineRec <> nil then 1595 | begin 1596 | if FTopDefineRec^.Defined then 1597 | Inc(FDefineStack) 1598 | else 1599 | begin 1600 | if FDefineStack > 0 then 1601 | Dec(FDefineStack); 1602 | Param := DirectiveParam; 1603 | if Pos('DEFINED', Param) = 1 then 1604 | begin 1605 | Def := Copy(Param, 9, Length(Param) - 9); 1606 | EnterDefineBlock(IsDefined(Def)); 1607 | end; 1608 | end; 1609 | end; 1610 | end; 1611 | if Assigned(fOnElseIfDirect) then 1612 | fOnElseIfDirect(Self); 1613 | end; 1614 | PtIncludeDirect: 1615 | begin 1616 | if Assigned(fOnIncludeDirect) then 1617 | fOnIncludeDirect(Self); 1618 | end; 1619 | PtResourceDirect: 1620 | begin 1621 | if Assigned(fOnResourceDirect) then 1622 | fOnResourceDirect(Self); 1623 | end; 1624 | PtUndefDirect: 1625 | begin 1626 | if FUseDefines then 1627 | RemoveDefine(DirectiveParam); 1628 | if Assigned(fOnUndefDirect) then 1629 | fOnUndefDirect(Self); 1630 | end; 1631 | end; 1632 | end; 1633 | 1634 | procedure TmwBasePasLex.ColonProc; 1635 | begin 1636 | case FOrigin[Run + 1] of 1637 | '=': 1638 | begin 1639 | inc(Run, 2); 1640 | fTokenID := ptAssign; 1641 | end; 1642 | else 1643 | begin 1644 | inc(Run); 1645 | fTokenID := ptColon; 1646 | end; 1647 | end; 1648 | end; 1649 | 1650 | procedure TmwBasePasLex.CommaProc; 1651 | begin 1652 | inc(Run); 1653 | fTokenID := ptComma; 1654 | end; 1655 | 1656 | procedure TmwBasePasLex.CRProc; 1657 | begin 1658 | case fCommentState of 1659 | csBor: fTokenID := ptCRLFCo; 1660 | csAnsi: fTokenID := ptCRLFCo; 1661 | else fTokenID := ptCRLF; 1662 | end; 1663 | 1664 | case FOrigin[Run + 1] of 1665 | #10: inc(Run, 2); 1666 | else inc(Run); 1667 | end; 1668 | inc(fLineNumber); 1669 | fLinePos := Run; 1670 | end; 1671 | 1672 | procedure TmwBasePasLex.EnterDefineBlock(ADefined: Boolean); 1673 | var 1674 | StackFrame: PDefineRec; 1675 | begin 1676 | New(StackFrame); 1677 | StackFrame^.Next := FTopDefineRec; 1678 | StackFrame^.Defined := ADefined; 1679 | StackFrame^.StartCount := FDefineStack; 1680 | FTopDefineRec := StackFrame; 1681 | if not ADefined then 1682 | Inc(FDefineStack); 1683 | end; 1684 | 1685 | procedure TmwBasePasLex.EqualProc; 1686 | begin 1687 | inc(Run); 1688 | fTokenID := ptEqual; 1689 | end; 1690 | 1691 | procedure TmwBasePasLex.ExitDefineBlock; 1692 | var 1693 | StackFrame: PDefineRec; 1694 | begin 1695 | StackFrame := FTopDefineRec; 1696 | if StackFrame <> nil then 1697 | begin 1698 | FDefineStack := StackFrame^.StartCount; 1699 | FTopDefineRec := StackFrame^.Next; 1700 | Dispose(StackFrame); 1701 | end; 1702 | end; 1703 | procedure TmwBasePasLex.GreaterProc; 1704 | begin 1705 | case FOrigin[Run + 1] of 1706 | '=': 1707 | begin 1708 | inc(Run, 2); 1709 | fTokenID := ptGreaterEqual; 1710 | end; 1711 | else 1712 | begin 1713 | inc(Run); 1714 | fTokenID := ptGreater; 1715 | end; 1716 | end; 1717 | end; 1718 | 1719 | function TmwBasePasLex.HashValue(AChar: Char): Integer; 1720 | begin 1721 | if AChar <= #255 then 1722 | Result := mHashTable[fOrigin[Run]] 1723 | else 1724 | Result := Ord(AChar); 1725 | end; 1726 | 1727 | procedure TmwBasePasLex.IdentProc; 1728 | begin 1729 | fTokenID := IdentKind; 1730 | end; 1731 | 1732 | procedure TmwBasePasLex.IntegerProc; 1733 | begin 1734 | inc(Run); 1735 | fTokenID := ptIntegerConst; 1736 | while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do 1737 | inc(Run); 1738 | end; 1739 | 1740 | function TmwBasePasLex.IsDefined(const ADefine: string): Boolean; 1741 | begin 1742 | Result := FDefines.IndexOf(ADefine) > -1; 1743 | end; 1744 | 1745 | function TmwBasePasLex.IsIdentifiers(AChar: Char): Boolean; 1746 | begin 1747 | if AChar <= #255 then 1748 | Result := Identifiers[AChar] 1749 | else 1750 | Result := True; 1751 | end; 1752 | 1753 | procedure TmwBasePasLex.LFProc; 1754 | begin 1755 | case fCommentState of 1756 | csBor: fTokenID := ptCRLFCo; 1757 | csAnsi: fTokenID := ptCRLFCo; 1758 | else fTokenID := ptCRLF; 1759 | end; 1760 | inc(Run); 1761 | inc(fLineNumber); 1762 | fLinePos := Run; 1763 | end; 1764 | 1765 | procedure TmwBasePasLex.LowerProc; 1766 | begin 1767 | case FOrigin[Run + 1] of 1768 | '=': 1769 | begin 1770 | inc(Run, 2); 1771 | fTokenID := ptLowerEqual; 1772 | end; 1773 | '>': 1774 | begin 1775 | inc(Run, 2); 1776 | fTokenID := ptNotEqual; 1777 | end 1778 | else 1779 | begin 1780 | inc(Run); 1781 | fTokenID := ptLower; 1782 | end; 1783 | end; 1784 | end; 1785 | 1786 | procedure TmwBasePasLex.MinusProc; 1787 | begin 1788 | inc(Run); 1789 | fTokenID := ptMinus; 1790 | end; 1791 | 1792 | procedure TmwBasePasLex.NullProc; 1793 | begin 1794 | fTokenID := ptNull; 1795 | end; 1796 | 1797 | procedure TmwBasePasLex.NumberProc; 1798 | begin 1799 | inc(Run); 1800 | fTokenID := ptIntegerConst; 1801 | while FOrigin[Run] in ['0'..'9', '.', 'e', 'E'] do 1802 | begin 1803 | case FOrigin[Run] of 1804 | '.': 1805 | if FOrigin[Run + 1] = '.' then 1806 | break 1807 | else fTokenID := ptFloat 1808 | end; 1809 | inc(Run); 1810 | end; 1811 | end; 1812 | 1813 | procedure TmwBasePasLex.PlusProc; 1814 | begin 1815 | inc(Run); 1816 | fTokenID := ptPlus; 1817 | end; 1818 | 1819 | procedure TmwBasePasLex.PointerSymbolProc; 1820 | begin 1821 | inc(Run); 1822 | fTokenID := ptPointerSymbol; 1823 | 1824 | //This is a wierd Pascal construct that rarely appears, but needs to be 1825 | //supported. ^M is a valid char reference (#13, in this case) 1826 | if FOrigin[Run] in ['a'..'z','A'..'Z'] then 1827 | begin 1828 | inc(Run); 1829 | fTokenID := ptAsciiChar; 1830 | end; 1831 | end; 1832 | 1833 | procedure TmwBasePasLex.PointProc; 1834 | begin 1835 | case FOrigin[Run + 1] of 1836 | '.': 1837 | begin 1838 | inc(Run, 2); 1839 | fTokenID := ptDotDot; 1840 | end; 1841 | ')': 1842 | begin 1843 | inc(Run, 2); 1844 | fTokenID := ptSquareClose; 1845 | end; 1846 | else 1847 | begin 1848 | inc(Run); 1849 | fTokenID := ptPoint; 1850 | end; 1851 | end; 1852 | end; 1853 | 1854 | procedure TmwBasePasLex.RemoveDefine(const ADefine: string); 1855 | var 1856 | I: Integer; 1857 | begin 1858 | I := FDefines.IndexOf(ADefine); 1859 | if I > -1 then 1860 | FDefines.Delete(I); 1861 | end; 1862 | 1863 | procedure TmwBasePasLex.RoundCloseProc; 1864 | begin 1865 | inc(Run); 1866 | fTokenID := ptRoundClose; 1867 | end; 1868 | 1869 | procedure TmwBasePasLex.AnsiProc; 1870 | begin 1871 | fTokenID := ptAnsiComment; 1872 | case FOrigin[Run] of 1873 | #0: 1874 | begin 1875 | NullProc; 1876 | if Assigned(FOnMessage) then 1877 | FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y); 1878 | exit; 1879 | end; 1880 | 1881 | { DR 2001-08-02 1882 | #10: 1883 | begin 1884 | LFProc; 1885 | exit; 1886 | end; 1887 | 1888 | #13: 1889 | begin 1890 | CRProc; 1891 | exit; 1892 | end; 1893 | } 1894 | end; 1895 | 1896 | while fOrigin[Run] <> #0 do 1897 | case fOrigin[Run] of 1898 | '*': 1899 | if fOrigin[Run + 1] = ')' then 1900 | begin 1901 | fCommentState := csNo; 1902 | inc(Run, 2); 1903 | break; 1904 | end 1905 | else inc(Run); 1906 | { DR 2001-08-02 1907 | #10: break; 1908 | 1909 | #13: break; 1910 | } 1911 | #10: 1912 | begin 1913 | inc(Run); 1914 | inc(fLineNumber); 1915 | fLinePos := Run; 1916 | end; 1917 | #13: 1918 | begin 1919 | inc(Run); 1920 | if FOrigin[Run] = #10 then inc( Run ); 1921 | inc(fLineNumber); 1922 | fLinePos := Run; 1923 | end; 1924 | else inc(Run); 1925 | end; 1926 | end; 1927 | 1928 | procedure TmwBasePasLex.RoundOpenProc; 1929 | begin 1930 | inc(Run); 1931 | case fOrigin[Run] of 1932 | '*': 1933 | begin 1934 | fTokenID := ptAnsiComment; 1935 | if FOrigin[Run + 1] = '$' then 1936 | fTokenID := GetDirectiveKind 1937 | else fCommentState := csAnsi; 1938 | inc(Run); 1939 | while fOrigin[Run] <> #0 do 1940 | case fOrigin[Run] of 1941 | '*': 1942 | if fOrigin[Run + 1] = ')' then 1943 | begin 1944 | fCommentState := csNo; 1945 | inc(Run, 2); 1946 | break; 1947 | end 1948 | else inc(Run); 1949 | { DR 2001-08-02 1950 | #10: break; 1951 | #13: break; 1952 | } 1953 | #10: 1954 | begin 1955 | inc(Run); 1956 | inc(fLineNumber); 1957 | fLinePos := Run; 1958 | end; 1959 | #13: 1960 | begin 1961 | inc(Run); 1962 | if FOrigin[Run] = #10 then inc( Run ); 1963 | inc(fLineNumber); 1964 | fLinePos := Run; 1965 | end; 1966 | else inc(Run); 1967 | end; 1968 | end; 1969 | '.': 1970 | begin 1971 | inc(Run); 1972 | fTokenID := ptSquareOpen; 1973 | end; 1974 | else fTokenID := ptRoundOpen; 1975 | end; 1976 | case fTokenID of 1977 | PtCompDirect: 1978 | begin 1979 | if Assigned(fOnCompDirect) then 1980 | fOnCompDirect(Self); 1981 | end; 1982 | PtDefineDirect: 1983 | begin 1984 | if Assigned(fOnDefineDirect) then 1985 | fOnDefineDirect(Self); 1986 | end; 1987 | PtElseDirect: 1988 | begin 1989 | if Assigned(fOnElseDirect) then 1990 | fOnElseDirect(Self); 1991 | end; 1992 | PtEndIfDirect: 1993 | begin 1994 | if Assigned(fOnEndIfDirect) then 1995 | fOnEndIfDirect(Self); 1996 | end; 1997 | PtIfDefDirect: 1998 | begin 1999 | if Assigned(fOnIfDefDirect) then 2000 | fOnIfDefDirect(Self); 2001 | end; 2002 | PtIfNDefDirect: 2003 | begin 2004 | if Assigned(fOnIfNDefDirect) then 2005 | fOnIfNDefDirect(Self); 2006 | end; 2007 | PtIfOptDirect: 2008 | begin 2009 | if Assigned(fOnIfOptDirect) then 2010 | fOnIfOptDirect(Self); 2011 | end; 2012 | PtIncludeDirect: 2013 | begin 2014 | if Assigned(fOnIncludeDirect) then 2015 | fOnIncludeDirect(Self); 2016 | end; 2017 | PtResourceDirect: 2018 | begin 2019 | if Assigned(fOnResourceDirect) then 2020 | fOnResourceDirect(Self); 2021 | end; 2022 | PtUndefDirect: 2023 | begin 2024 | if Assigned(fOnUndefDirect) then 2025 | fOnUndefDirect(Self); 2026 | end; 2027 | end; 2028 | end; 2029 | 2030 | procedure TmwBasePasLex.SemiColonProc; 2031 | begin 2032 | inc(Run); 2033 | fTokenID := ptSemiColon; 2034 | end; 2035 | 2036 | procedure TmwBasePasLex.SlashProc; 2037 | begin 2038 | case FOrigin[Run + 1] of 2039 | '/': 2040 | begin 2041 | inc(Run, 2); 2042 | fTokenID := ptSlashesComment; 2043 | while FOrigin[Run] <> #0 do 2044 | begin 2045 | case FOrigin[Run] of 2046 | #10, #13: break; 2047 | end; 2048 | inc(Run); 2049 | end; 2050 | end; 2051 | else 2052 | begin 2053 | inc(Run); 2054 | fTokenID := ptSlash; 2055 | end; 2056 | end; 2057 | end; 2058 | 2059 | procedure TmwBasePasLex.SpaceProc; 2060 | begin 2061 | inc(Run); 2062 | fTokenID := ptSpace; 2063 | while FOrigin[Run] in [#1..#9, #11, #12, #14..#32] do 2064 | inc(Run); 2065 | end; 2066 | 2067 | procedure TmwBasePasLex.SquareCloseProc; 2068 | begin 2069 | inc(Run); 2070 | fTokenID := ptSquareClose; 2071 | end; 2072 | 2073 | procedure TmwBasePasLex.SquareOpenProc; 2074 | begin 2075 | inc(Run); 2076 | fTokenID := ptSquareOpen; 2077 | end; 2078 | 2079 | procedure TmwBasePasLex.StarProc; 2080 | begin 2081 | inc(Run); 2082 | fTokenID := ptStar; 2083 | end; 2084 | 2085 | procedure TmwBasePasLex.StringProc; 2086 | begin 2087 | fTokenID := ptStringConst; 2088 | repeat 2089 | inc(Run); 2090 | case FOrigin[Run] of 2091 | #0, #10, #13: 2092 | begin 2093 | if Assigned(FOnMessage) then 2094 | FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y); 2095 | break; 2096 | end; 2097 | #39: 2098 | begin 2099 | while (FOrigin[Run] = #39) and (FOrigin[Run + 1] = #39) do 2100 | begin 2101 | inc(Run, 2); 2102 | end; 2103 | end; 2104 | end; 2105 | until FOrigin[Run] = #39; 2106 | if FOrigin[Run] = #39 then 2107 | begin 2108 | inc(Run); 2109 | if TokenLen = 3 then 2110 | begin 2111 | fTokenID := ptAsciiChar; 2112 | end; 2113 | end; 2114 | end; 2115 | 2116 | procedure TmwBasePasLex.SymbolProc; 2117 | begin 2118 | inc(Run); 2119 | fTokenID := ptSymbol; 2120 | end; 2121 | 2122 | procedure TmwBasePasLex.UnknownProc; 2123 | begin 2124 | inc(Run); 2125 | fTokenID := ptUnknown; 2126 | if Assigned(FOnMessage) then 2127 | FOnMessage(Self, meError, 'Unknown Character', PosXY.X, PosXY.Y); 2128 | end; 2129 | 2130 | procedure TmwBasePasLex.Next; 2131 | begin 2132 | fExID := ptUnKnown; 2133 | fTokenPos := Run; 2134 | case fCommentState of 2135 | csNo: 2136 | begin 2137 | DoProcTable(fOrigin[Run]); 2138 | (*{$IFDEF D10_NEWER} 2139 | if fOrigin[Run] < #256 then 2140 | fProcTable[fOrigin[Run]] 2141 | else //non-ASCII unicode char 2142 | IdentProc; 2143 | {$ELSE} 2144 | fProcTable[fOrigin[Run]]; 2145 | {$ENDIF}*) 2146 | end; 2147 | else 2148 | case fCommentState of 2149 | csBor: BorProc; 2150 | csAnsi: AnsiProc; 2151 | end; 2152 | end; 2153 | end; 2154 | 2155 | 2156 | function TmwBasePasLex.GetIsJunk: Boolean; 2157 | begin 2158 | result := IsTokenIDJunk(FTokenID) or (FUseDefines and (FDefineStack > 0) and (TokenID <> ptNull)); 2159 | // Result := fTokenID in [ptAnsiComment, ptBorComment, ptCRLF, ptCRLFCo, ptSlashesComment, ptSpace]; //XM 20001210 2160 | end; 2161 | 2162 | function TmwBasePasLex.GetIsSpace: Boolean; 2163 | begin 2164 | Result := fTokenID in [ptCRLF, ptSpace]; 2165 | end; 2166 | 2167 | function TmwBasePasLex.GetToken: string; 2168 | begin 2169 | SetString(Result, (FOrigin + fTokenPos), GetTokenLen); 2170 | end; 2171 | 2172 | function TmwBasePasLex.GetTokenLen: Integer; 2173 | begin 2174 | Result := Run - fTokenPos; 2175 | end; 2176 | 2177 | procedure TmwBasePasLex.NextID(ID: TptTokenKind); 2178 | begin 2179 | repeat 2180 | case fTokenID of 2181 | ptNull: break; 2182 | else Next; 2183 | end; 2184 | until fTokenID = ID; 2185 | end; 2186 | 2187 | procedure TmwBasePasLex.NextNoJunk; 2188 | begin 2189 | repeat 2190 | Next; 2191 | until not IsJunk; 2192 | end; 2193 | 2194 | procedure TmwBasePasLex.NextNoSpace; 2195 | begin 2196 | repeat 2197 | Next; 2198 | until not IsSpace; 2199 | end; 2200 | 2201 | function TmwBasePasLex.FirstInLine: Boolean; 2202 | var 2203 | RunBack: Integer; 2204 | begin 2205 | Result := True; 2206 | if fTokenPos = 0 then exit; 2207 | RunBack := fTokenPos; 2208 | dec(RunBack); 2209 | while fOrigin[RunBack] in [#1..#9, #11, #12, #14..#32] do 2210 | dec(RunBack); 2211 | if RunBack = 0 then exit; 2212 | case fOrigin[RunBack] of 2213 | #10, #13: exit; 2214 | else 2215 | begin 2216 | Result := False; 2217 | exit; 2218 | end; 2219 | end; 2220 | end; 2221 | 2222 | function TmwBasePasLex.GetCommentState: Pointer; 2223 | begin 2224 | Result := Pointer(fCommentState); 2225 | end; 2226 | 2227 | function TmwBasePasLex.GetCompilerDirective: string; 2228 | var 2229 | DirectLen: Integer; 2230 | begin 2231 | if TokenID <> ptCompDirect then 2232 | Result := '' 2233 | else 2234 | case fOrigin[fTokenPos] of 2235 | '(': 2236 | begin 2237 | DirectLen := Run - fTokenPos - 4; 2238 | SetString(Result, (FOrigin + fTokenPos + 2), DirectLen); 2239 | Result := UpperCase(Result); 2240 | end; 2241 | '{': 2242 | begin 2243 | DirectLen := Run - fTokenPos - 2; 2244 | SetString(Result, (FOrigin + fTokenPos + 1), DirectLen); 2245 | Result := UpperCase(Result); 2246 | end; 2247 | end; 2248 | end; 2249 | 2250 | function TmwBasePasLex.GetDirectiveKind: TptTokenKind; 2251 | var 2252 | TempPos: Integer; 2253 | begin 2254 | case fOrigin[fTokenPos] of 2255 | '(': Run := FTokenPos + 3; 2256 | '{': Run := FTokenPos + 2; 2257 | end; 2258 | FDirectiveParamOrigin := FOrigin + FTokenPos; 2259 | TempPos := fTokenPos; 2260 | fTokenPos := Run; 2261 | case KeyHash of 2262 | 9: 2263 | if KeyComp('I') then 2264 | Result := ptIncludeDirect else 2265 | Result := ptCompDirect; 2266 | 15: 2267 | if KeyComp('IF') then 2268 | Result := ptIfDirect else 2269 | Result := ptCompDirect; 2270 | 18: 2271 | if KeyComp('R') then 2272 | begin 2273 | if not (fOrigin[Run] in ['+', '-']) then 2274 | Result := ptResourceDirect else Result := ptCompDirect; 2275 | end else Result := ptCompDirect; 2276 | 30: 2277 | if KeyComp('IFDEF') then 2278 | Result := ptIfDefDirect else 2279 | Result := ptCompDirect; 2280 | 38: 2281 | if KeyComp('ENDIF') then 2282 | Result := ptEndIfDirect else 2283 | if KeyComp('IFEND') then 2284 | Result := ptIfEndDirect else 2285 | Result := ptCompDirect; 2286 | 41: 2287 | if KeyComp('ELSE') then 2288 | Result := ptElseDirect else 2289 | Result := ptCompDirect; 2290 | 43: 2291 | if KeyComp('DEFINE') then 2292 | Result := ptDefineDirect else 2293 | Result := ptCompDirect; 2294 | 44: 2295 | if KeyComp('IFNDEF') then 2296 | Result := ptIfNDefDirect else 2297 | Result := ptCompDirect; 2298 | 50: 2299 | if KeyComp('UNDEF') then 2300 | Result := ptUndefDirect else 2301 | Result := ptCompDirect; 2302 | 56: 2303 | if KeyComp('ELSEIF') then 2304 | Result := ptElseIfDirect else 2305 | Result := ptCompDirect; 2306 | 66: 2307 | if KeyComp('IFOPT') then 2308 | Result := ptIfOptDirect else 2309 | Result := ptCompDirect; 2310 | 68: 2311 | if KeyComp('INCLUDE') then 2312 | Result := ptIncludeDirect else 2313 | Result := ptCompDirect; 2314 | 104: 2315 | if KeyComp('Resource') then 2316 | Result := ptResourceDirect else 2317 | Result := ptCompDirect; 2318 | else Result := ptCompDirect; 2319 | end; 2320 | fTokenPos := TempPos; 2321 | dec(Run); 2322 | end; 2323 | 2324 | function TmwBasePasLex.GetDirectiveParam: string; 2325 | var 2326 | EndPos: Integer; 2327 | ParamLen: Integer; 2328 | begin 2329 | // !! without this set... there is a warning? 2330 | EndPos:= 0; 2331 | case fOrigin[fTokenPos] of 2332 | '(': 2333 | begin 2334 | TempRun := FTokenPos + 3; 2335 | EndPos := Run - 2; 2336 | end; 2337 | '{': 2338 | begin 2339 | TempRun := FTokenPos + 2; 2340 | EndPos := Run - 1; 2341 | end; 2342 | end; 2343 | while IsIdentifiers(fOrigin[TempRun]) do 2344 | inc(TempRun); 2345 | while fOrigin[TempRun] in ['+', ',', '-'] do 2346 | begin 2347 | inc(TempRun); 2348 | while IsIdentifiers(fOrigin[TempRun]) do 2349 | inc(TempRun); 2350 | if (fOrigin[TempRun - 1] in ['+', ',', '-']) and (fOrigin[TempRun] = ' ') 2351 | then inc(TempRun); 2352 | end; 2353 | if fOrigin[TempRun] = ' ' then inc(TempRun); 2354 | ParamLen := EndPos - TempRun; 2355 | SetString(Result, (FOrigin + TempRun), ParamLen); 2356 | Result := UpperCase(Result); 2357 | end; 2358 | 2359 | procedure TmwBasePasLex.Init; 2360 | begin 2361 | fCommentState := csNo; 2362 | fLineNumber := 0; 2363 | fLinePos := 0; 2364 | Run := 0; 2365 | InitDefines; 2366 | end; 2367 | 2368 | procedure TmwBasePasLex.InitFrom(ALexer: TmwBasePasLex); 2369 | begin 2370 | Origin := ALexer.Origin; 2371 | fCommentState := ALexer.fCommentState; 2372 | fLineNumber := ALexer.fLineNumber; 2373 | fLinePos := ALexer.fLinePos; 2374 | Run := ALexer.Run; 2375 | CloneDefinesFrom(ALexer); 2376 | end; 2377 | 2378 | procedure TmwBasePasLex.InitDefines; 2379 | begin 2380 | ClearDefines; 2381 | //Set up the defines that are defined by the compiler 2382 | {$IFDEF VER130} 2383 | AddDefine('VER130'); 2384 | {$ENDIF} 2385 | {$IFDEF VER140} 2386 | AddDefine('VER140'); 2387 | {$ENDIF} 2388 | {$IFDEF VER150} 2389 | AddDefine('VER150'); 2390 | {$ENDIF} 2391 | {$IFDEF VER160} 2392 | AddDefine('VER160'); 2393 | {$ENDIF} 2394 | {$IFDEF VER170} 2395 | AddDefine('VER170'); 2396 | {$ENDIF} 2397 | {$IFDEF VER180} 2398 | AddDefine('VER180'); 2399 | {$ENDIF} 2400 | {$IFDEF VER185} 2401 | AddDefine('VER185'); 2402 | {$ENDIF} 2403 | {$IFDEF VER190} 2404 | AddDefine('VER190'); 2405 | {$ENDIF} 2406 | {$IFDEF VER200} 2407 | AddDefine('VER200'); 2408 | {$ENDIF} 2409 | {$IFDEF WIN32} 2410 | AddDefine('WIN32'); 2411 | {$ENDIF} 2412 | {$IFDEF LINUX} 2413 | AddDefine('LINUX'); 2414 | {$ENDIF} 2415 | {$IFDEF CPU386} 2416 | AddDefine('CPU386'); 2417 | {$ENDIF} 2418 | {$IFDEF MSWINDOWS} 2419 | AddDefine('MSWINDOWS'); 2420 | {$ENDIF} 2421 | {$IFDEF CONDITIONALEXPRESSIONS} 2422 | AddDefine('CONDITIONALEXPRESSIONS'); 2423 | {$ENDIF} 2424 | {$IFDEF UNICODE} 2425 | AddDefine('UNICODE'); 2426 | {$ENDIF} 2427 | end; 2428 | 2429 | procedure TmwBasePasLex.InitLine; 2430 | begin 2431 | fLineNumber := 0; 2432 | fLinePos := 0; 2433 | Run := 0; 2434 | end; 2435 | 2436 | procedure TmwBasePasLex.SetCommentState(const Value: Pointer); 2437 | begin 2438 | fCommentState := TCommentState(Value); 2439 | end; 2440 | 2441 | procedure TmwBasePasLex.SetLine(const Value: string); 2442 | begin 2443 | fOrigin := PChar(Value); 2444 | InitLine; 2445 | Next; 2446 | end; 2447 | 2448 | function TmwBasePasLex.GetStringContent: string; 2449 | var 2450 | TempString: string; 2451 | sEnd: Integer; 2452 | begin 2453 | if TokenID <> ptStringConst then 2454 | Result := '' 2455 | else 2456 | begin 2457 | TempString := Token; 2458 | sEnd := Length(TempString); 2459 | if TempString[sEnd] <> #39 then inc(sEnd); 2460 | Result := Copy(TempString, 2, sEnd - 2); 2461 | TempString := ''; 2462 | end; 2463 | end; 2464 | 2465 | function TmwBasePasLex.GetIsOrdIdent: Boolean; 2466 | begin 2467 | Result := False; 2468 | if fTokenID = ptIdentifier then 2469 | Result := fExID in [ptBoolean, ptByte, ptChar, ptDWord, ptInt64, ptInteger, 2470 | ptLongInt, ptLongWord, ptPChar, ptShortInt, ptSmallInt, ptWideChar, ptWord] 2471 | end; 2472 | 2473 | function TmwBasePasLex.GetIsOrdinalType: Boolean; 2474 | begin 2475 | Result := GetIsOrdIdent or (fTokenID in [ptAsciiChar, ptIntegerConst]); 2476 | end; 2477 | 2478 | function TmwBasePasLex.GetIsRealType: Boolean; 2479 | begin 2480 | Result := False; 2481 | if fTokenID = ptIdentifier then 2482 | Result := fExID in [ptComp, ptCurrency, ptDouble, ptExtended, ptReal, ptReal48, ptSingle] 2483 | end; 2484 | 2485 | function TmwBasePasLex.GetIsStringType: Boolean; 2486 | begin 2487 | Result := False; 2488 | if fTokenID = ptIdentifier then 2489 | Result := fExID in [ptAnsiString, ptWideString] 2490 | else 2491 | if fTokenID = ptString then 2492 | Result := True 2493 | else 2494 | if fTokenID = ptStringConst then Result := True; 2495 | end; 2496 | 2497 | function TmwBasePasLex.GetIsVarantType: Boolean; 2498 | begin 2499 | Result := False; 2500 | if fTokenID = ptIdentifier then 2501 | Result := fExID in [ptOleVariant, ptVariant] 2502 | end; 2503 | 2504 | function TmwBasePasLex.GetIsAddOperator: Boolean; 2505 | begin 2506 | Result := fTokenID in [ptMinus, ptOr, ptPlus, ptXor]; 2507 | end; 2508 | 2509 | function TmwBasePasLex.GetIsMulOperator: Boolean; 2510 | begin 2511 | Result := fTokenID in [ptAnd, ptAs, ptDiv, ptMod, ptShl, ptShr, ptSlash, ptStar]; 2512 | end; 2513 | 2514 | function TmwBasePasLex.GetIsRelativeOperator: Boolean; 2515 | begin 2516 | Result := fTokenID in [ptAs, ptEqual, ptGreater, ptGreaterEqual, ptLower, ptLowerEqual, 2517 | ptIn, ptIs, ptNotEqual]; 2518 | end; 2519 | 2520 | function TmwBasePasLex.GetIsCompilerDirective: Boolean; 2521 | begin 2522 | Result := fTokenID in [ptCompDirect, ptDefineDirect, ptElseDirect, 2523 | ptEndIfDirect, ptIfDefDirect, ptIfNDefDirect, ptIfOptDirect, 2524 | ptIncludeDirect, ptResourceDirect, ptUndefDirect]; 2525 | end; 2526 | 2527 | function TmwBasePasLex.GetGenID: TptTokenKind; 2528 | begin 2529 | Result := fTokenID; 2530 | if fTokenID = ptIdentifier then 2531 | if fExID <> ptUnknown then Result := fExID; 2532 | end; 2533 | 2534 | { TmwPasLex } 2535 | 2536 | constructor TmwPasLex.Create; 2537 | begin 2538 | inherited Create; 2539 | fAheadLex := TmwBasePasLex.Create; 2540 | end; 2541 | 2542 | destructor TmwPasLex.Destroy; 2543 | begin 2544 | fAheadLex.Free; 2545 | inherited Destroy; 2546 | end; 2547 | 2548 | procedure TmwPasLex.SetOrigin(NewValue: PChar); 2549 | begin 2550 | inherited SetOrigin(NewValue); 2551 | fAheadLex.SetOrigin(NewValue); 2552 | end; 2553 | 2554 | procedure TmwPasLex.SetLine(const Value: string); 2555 | begin 2556 | inherited SetLine(Value); 2557 | fAheadLex.SetLine(Value); 2558 | end; 2559 | 2560 | procedure TmwPasLex.AheadNext; 2561 | begin 2562 | fAheadLex.NextNoJunk; 2563 | end; 2564 | 2565 | function TmwPasLex.GetAheadExID: TptTokenKind; 2566 | begin 2567 | Result := fAheadLex.ExID; 2568 | end; 2569 | 2570 | function TmwPasLex.GetAheadGenID: TptTokenKind; 2571 | begin 2572 | Result := fAheadLex.GenID; 2573 | end; 2574 | 2575 | function TmwPasLex.GetAheadToken: string; 2576 | begin 2577 | Result := fAheadLex.Token; 2578 | end; 2579 | 2580 | function TmwPasLex.GetAheadTokenID: TptTokenKind; 2581 | begin 2582 | Result := fAheadLex.TokenID; 2583 | end; 2584 | 2585 | procedure TmwPasLex.InitAhead; 2586 | begin 2587 | fAheadLex.CommentState := CommentState; 2588 | fAheadLex.RunPos := RunPos; 2589 | FAheadLex.fLineNumber := FLineNumber; 2590 | FAheadLex.FLinePos := FLinePos; 2591 | 2592 | FAheadLex.CloneDefinesFrom(Self); 2593 | 2594 | //FAheadLex.FTokenPos := FTokenPos; 2595 | while fAheadLex.IsJunk do 2596 | fAheadLex.Next; 2597 | end; 2598 | 2599 | function TmwPasLex.GetStatus: TmwPasLexStatus; 2600 | begin 2601 | Result.CommentState := fCommentState; 2602 | Result.ExID := fExID; 2603 | Result.LineNumber := fLineNumber; 2604 | Result.LinePos := fLinePos; 2605 | Result.Origin := fOrigin; 2606 | Result.RunPos := Run; 2607 | Result.TokenPos := fTokenPos; 2608 | Result.TokenID := fTokenID; 2609 | end; 2610 | 2611 | procedure TmwPasLex.SetStatus(const Value: TmwPasLexStatus); 2612 | begin 2613 | fCommentState := Value.CommentState; 2614 | fExID := Value.ExID; 2615 | fLineNumber := Value.LineNumber; 2616 | fLinePos := Value.LinePos; 2617 | fOrigin := Value.Origin; 2618 | Run := Value.RunPos; 2619 | fTokenPos := Value.TokenPos; 2620 | fTokenID := Value.TokenID; 2621 | fAheadLex.Origin := Value.Origin; 2622 | end; 2623 | 2624 | procedure TmwBasePasLex.SetOnCompDirect(const Value: TDirectiveEvent); 2625 | begin 2626 | fOnCompDirect := Value; 2627 | end; 2628 | 2629 | procedure TmwBasePasLex.SetOnDefineDirect(const Value: TDirectiveEvent); 2630 | begin 2631 | fOnDefineDirect := Value; 2632 | end; 2633 | 2634 | procedure TmwBasePasLex.SetOnElseDirect(const Value: TDirectiveEvent); 2635 | begin 2636 | fOnElseDirect := Value; 2637 | end; 2638 | 2639 | procedure TmwBasePasLex.SetOnElseIfDirect(const Value: TDirectiveEvent); 2640 | begin 2641 | fOnElseIfDirect := Value; 2642 | end; 2643 | 2644 | procedure TmwBasePasLex.SetOnEndIfDirect(const Value: TDirectiveEvent); 2645 | begin 2646 | fOnEndIfDirect := Value; 2647 | end; 2648 | 2649 | procedure TmwBasePasLex.SetOnIfDefDirect(const Value: TDirectiveEvent); 2650 | begin 2651 | fOnIfDefDirect := Value; 2652 | end; 2653 | 2654 | procedure TmwBasePasLex.SetOnIfDirect(const Value: TDirectiveEvent); 2655 | begin 2656 | FOnIfDirect := Value; 2657 | end; 2658 | 2659 | procedure TmwBasePasLex.SetOnIfEndDirect(const Value: TDirectiveEvent); 2660 | begin 2661 | FOnIfEndDirect := Value; 2662 | end; 2663 | 2664 | procedure TmwBasePasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent); 2665 | begin 2666 | fOnIfNDefDirect := Value; 2667 | end; 2668 | 2669 | procedure TmwBasePasLex.SetOnIfOptDirect(const Value: TDirectiveEvent); 2670 | begin 2671 | fOnIfOptDirect := Value; 2672 | end; 2673 | 2674 | procedure TmwBasePasLex.SetOnIncludeDirect(const Value: TDirectiveEvent); 2675 | begin 2676 | fOnIncludeDirect := Value; 2677 | end; 2678 | 2679 | procedure TmwBasePasLex.SetOnResourceDirect(const Value: TDirectiveEvent); 2680 | begin 2681 | fOnResourceDirect := Value; 2682 | end; 2683 | 2684 | procedure TmwBasePasLex.SetOnUnDefDirect(const Value: TDirectiveEvent); 2685 | begin 2686 | fOnUnDefDirect := Value; 2687 | end; 2688 | 2689 | procedure TmwPasLex.SetOnCompDirect(const Value: TDirectiveEvent); 2690 | begin 2691 | inherited; 2692 | //AheadLex.OnCompDirect := Value; 2693 | end; 2694 | 2695 | procedure TmwPasLex.SetOnDefineDirect(const Value: TDirectiveEvent); 2696 | begin 2697 | inherited; 2698 | //AheadLex.OnDefineDirect := Value; 2699 | end; 2700 | 2701 | procedure TmwPasLex.SetOnElseDirect(const Value: TDirectiveEvent); 2702 | begin 2703 | inherited; 2704 | //AheadLex.OnElseDirect := Value; 2705 | end; 2706 | 2707 | procedure TmwPasLex.SetOnEndIfDirect(const Value: TDirectiveEvent); 2708 | begin 2709 | inherited; 2710 | //AheadLex.OnEndIfDirect := Value; 2711 | end; 2712 | 2713 | procedure TmwPasLex.SetOnIfDefDirect(const Value: TDirectiveEvent); 2714 | begin 2715 | inherited; 2716 | //AheadLex.OnIfDefDirect := Value; 2717 | end; 2718 | 2719 | procedure TmwPasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent); 2720 | begin 2721 | inherited; 2722 | //AheadLex.OnIfNDefDirect := Value; 2723 | end; 2724 | 2725 | procedure TmwPasLex.SetOnIfOptDirect(const Value: TDirectiveEvent); 2726 | begin 2727 | inherited; 2728 | //AheadLex.OnIfOptDirect := Value; 2729 | end; 2730 | 2731 | procedure TmwPasLex.SetOnIncludeDirect(const Value: TDirectiveEvent); 2732 | begin 2733 | inherited; 2734 | //AheadLex.OnIncludeDirect := Value; 2735 | end; 2736 | 2737 | procedure TmwPasLex.SetOnResourceDirect(const Value: TDirectiveEvent); 2738 | begin 2739 | inherited; 2740 | //AheadLex.OnResourceDirect := Value; 2741 | end; 2742 | 2743 | procedure TmwPasLex.SetOnUnDefDirect(const Value: TDirectiveEvent); 2744 | begin 2745 | inherited; 2746 | //AheadLex.OnUnDefDirect := Value; 2747 | end; 2748 | 2749 | function TmwBasePasLex.Func86: TptTokenKind; 2750 | begin 2751 | Result := ptIdentifier; 2752 | if KeyComp('Varargs') then fExID := ptVarargs; 2753 | end; 2754 | 2755 | procedure TmwBasePasLex.StringDQProc; 2756 | begin 2757 | if not fAsmCode then 2758 | begin 2759 | SymbolProc; 2760 | Exit; 2761 | end; 2762 | fTokenID := ptStringDQConst; 2763 | repeat 2764 | inc(Run); 2765 | case FOrigin[Run] of 2766 | #0, #10, #13: 2767 | begin 2768 | if Assigned(FOnMessage) then 2769 | FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y); 2770 | break; 2771 | end; 2772 | '\': 2773 | begin 2774 | Inc( Run ); 2775 | if FOrigin[Run] in [#32..#255] then Inc( Run ); 2776 | end; 2777 | end; 2778 | until FOrigin[Run] = '"'; 2779 | if FOrigin[Run] = '"' then 2780 | inc(Run); 2781 | end; 2782 | 2783 | {$IFDEF D8_NEWER} //JThurman 2004-04-06 2784 | procedure TmwBasePasLex.AmpersandOpProc; 2785 | begin 2786 | FTokenID := ptAmpersand; 2787 | inc(Run); 2788 | while FOrigin[Run] in ['a'..'z', 'A'..'Z','0'..'9'] do 2789 | inc(Run); 2790 | FTokenID := ptIdentifier; 2791 | end; 2792 | {$ENDIF} 2793 | 2794 | initialization 2795 | MakeIdentTable; 2796 | end. 2797 | 2798 | -------------------------------------------------------------------------------- /CastaliaPasLexTypes.pas: -------------------------------------------------------------------------------- 1 | {--------------------------------------------------------------------------- 2 | The contents of this file are subject to the Mozilla Public License Version 3 | 1.1 (the "License"); you may not use this file except in compliance with the 4 | License. You may obtain a copy of the License at 5 | http://www.mozilla.org/NPL/NPL-1_1Final.html 6 | 7 | Software distributed under the License is distributed on an "AS IS" basis, 8 | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9 | the specific language governing rights and limitations under the License. 10 | 11 | The Original Code is: mwPasLexTypes, released November 14, 1999. 12 | 13 | The Initial Developer of the Original Code is Martin Waldenburg 14 | unit CastaliaPasLexTypes; 15 | 16 | ----------------------------------------------------------------------------} 17 | 18 | unit CastaliaPasLexTypes; 19 | 20 | interface 21 | 22 | uses SysUtils, TypInfo; 23 | 24 | {$INCLUDE CastaliaParserDefines.inc} 25 | 26 | var 27 | CompTable: array[#0..#255] of byte; 28 | 29 | type 30 | 31 | TMessageEventType = ( meError, meNotSupported ); 32 | 33 | TMessageEvent = procedure(Sender: TObject; const Typ : TMessageEventType; const Msg: string; X, Y: Integer ) of object; //jdj 7/16/1999; DR 2001-11-06 34 | 35 | TCommentState = (csAnsi, csBor, csNo); 36 | 37 | TTokenPoint = packed record 38 | X : Integer; 39 | Y : Integer; 40 | end; 41 | 42 | TptTokenKind = ( 43 | ptAbort, //JThurman 2004-11-8 (flow control routines) 44 | ptAbsolute, 45 | ptAbstract, 46 | ptAdd, 47 | ptAddressOp, 48 | ptAmpersand, 49 | ptAnd, 50 | ptAnsiComment, 51 | ptAnsiString, 52 | ptArray, 53 | ptAs, 54 | ptAsciiChar, 55 | ptAsm, 56 | ptAssembler, 57 | ptAssign, 58 | ptAt, 59 | ptAutomated, 60 | ptBegin, 61 | ptBoolean, 62 | ptBorComment, 63 | ptBraceClose, 64 | ptBraceOpen, 65 | ptBreak, //JThurman 2004-11-8 (flow control routines) 66 | ptByte, 67 | ptByteBool, 68 | ptCardinal, 69 | ptCase, 70 | ptCdecl, 71 | ptChar, 72 | ptClass, 73 | ptClassForward, 74 | ptClassFunction, 75 | ptClassProcedure, 76 | ptColon, 77 | ptComma, 78 | ptComp, 79 | ptCompDirect, 80 | ptConst, 81 | ptConstructor, 82 | ptContains, 83 | ptContinue, //JThurman 2004-11-8 (flow control routines) 84 | ptCRLF, 85 | ptCRLFCo, 86 | ptCurrency, 87 | ptDefault, 88 | ptDefineDirect, 89 | ptDeprecated, // DR 2001-10-20 90 | ptDestructor, 91 | ptDispid, 92 | ptDispinterface, 93 | ptDiv, 94 | ptDo, 95 | ptDotDot, 96 | ptDouble, 97 | ptDoubleAddressOp, 98 | ptDownto, 99 | ptDWORD, 100 | ptDynamic, 101 | ptElse, 102 | ptElseDirect, 103 | ptEnd, 104 | ptEndIfDirect, 105 | ptEqual, 106 | ptError, 107 | ptExcept, 108 | ptExit, //JThurman 2004-11-8 (flow control routine) 109 | ptExport, 110 | ptExports, 111 | ptExtended, 112 | ptExternal, 113 | ptFar, 114 | ptFile, 115 | {$IFDEF D8_NEWER} //JThurman 2004-03-20 116 | ptFinal, 117 | {$ENDIF} 118 | ptFinalization, 119 | ptFinally, 120 | ptFloat, 121 | ptFor, 122 | ptForward, 123 | ptFunction, 124 | ptGoto, 125 | ptGreater, 126 | ptGreaterEqual, 127 | ptHalt, //JThurman 2004-11-8 (flow control routines) 128 | {$IFDEF D8_NEWER} //JThurman 2004-04-06 129 | ptHelper, 130 | {$ENDIF} 131 | ptIdentifier, 132 | ptIf, 133 | ptIfDirect, 134 | ptIfEndDirect, 135 | ptElseIfDirect, 136 | ptIfDefDirect, 137 | ptIfNDefDirect, 138 | ptIfOptDirect, 139 | ptImplementation, 140 | ptImplements, 141 | ptIn, 142 | ptIncludeDirect, 143 | ptIndex, 144 | ptInherited, 145 | ptInitialization, 146 | ptInline, 147 | ptInt64, 148 | ptInteger, 149 | ptIntegerConst, 150 | ptInterface, 151 | ptIs, 152 | ptLabel, 153 | ptLibrary, 154 | ptLocal, // DR 2001-11-14 155 | ptLongBool, 156 | ptLongint, 157 | ptLongword, 158 | ptLower, 159 | ptLowerEqual, 160 | ptMessage, 161 | ptMinus, 162 | ptMod, 163 | ptName, 164 | ptNear, 165 | ptNil, 166 | ptNodefault, 167 | ptNone, 168 | ptNot, 169 | ptNotEqual, 170 | ptNull, 171 | ptObject, 172 | ptOf, 173 | ptOleVariant, 174 | ptOn, 175 | {$IFDEF D8_NEWER} //JThurman 2004-03-20 176 | ptOperator, 177 | {$ENDIF} 178 | ptOr, 179 | ptOut, 180 | ptOverload, 181 | ptOverride, 182 | ptPackage, 183 | ptPacked, 184 | ptPascal, 185 | ptPChar, 186 | ptPlatform, // DR 2001-10-20 187 | ptPlus, 188 | ptPoint, 189 | ptPointerSymbol, 190 | ptPrivate, 191 | ptProcedure, 192 | ptProgram, 193 | ptProperty, 194 | ptProtected, 195 | ptPublic, 196 | ptPublished, 197 | ptRaise, 198 | ptRead, 199 | ptReadonly, 200 | ptReal, 201 | ptReal48, 202 | ptRecord, 203 | {$IFDEF D12_NEWER} 204 | ptReference, //JThurman 2008-25-07 (anonymous methods) 205 | {$ENDIF} 206 | ptRegister, 207 | ptReintroduce, 208 | ptRemove, 209 | ptRepeat, 210 | ptRequires, 211 | ptResident, 212 | ptResourceDirect, 213 | ptResourcestring, 214 | ptRoundClose, 215 | ptRoundOpen, 216 | ptRunError, //JThurman 2004-11-8 (flow control routines) 217 | ptSafeCall, 218 | {$IFDEF D8_NEWER} //JThurman 2004-03-19 219 | ptSealed, 220 | {$ENDIF} 221 | ptSemiColon, 222 | ptSet, 223 | ptShl, 224 | ptShortint, 225 | ptShortString, 226 | ptShr, 227 | ptSingle, 228 | ptSlash, 229 | ptSlashesComment, 230 | ptSmallint, 231 | ptSpace, 232 | ptSquareClose, 233 | ptSquareOpen, 234 | ptStar, 235 | {$IFDEF D8_NEWER} //JThurman 2004-03-20 236 | ptStatic, 237 | {$ENDIF} 238 | ptStdcall, 239 | ptStored, 240 | {$IFDEF D8_NEWER} 241 | ptStrict, //JThurman 2004-03-03 242 | {$ENDIF} 243 | ptString, 244 | ptStringConst, 245 | ptStringDQConst, // 2002-01-14 246 | ptStringresource, 247 | ptSymbol, 248 | ptThen, 249 | ptThreadvar, 250 | ptTo, 251 | ptTry, 252 | ptType, 253 | ptUndefDirect, 254 | ptUnit, 255 | ptUnknown, 256 | {$IFDEF D8_NEWER} //JThurman 2004-03-2003 257 | ptUnsafe, 258 | {$ENDIF} 259 | ptUntil, 260 | ptUses, 261 | ptVar, 262 | ptVarargs, // DR 2001-11-14 263 | ptVariant, 264 | ptVirtual, 265 | ptWhile, 266 | ptWideChar, 267 | ptWideString, 268 | ptWith, 269 | ptWord, 270 | ptWordBool, 271 | ptWrite, 272 | ptWriteonly, 273 | ptXor); 274 | 275 | TmwPasLexStatus = record 276 | CommentState: TCommentState; 277 | ExID: TptTokenKind; 278 | LineNumber: Integer; 279 | LinePos: Integer; 280 | Origin: PChar; 281 | RunPos: Integer; 282 | TokenPos: Integer; 283 | TokenID: TptTokenKind; 284 | end; 285 | 286 | const ExTypes = [ptDWORD, ptUnknown]; 287 | 288 | function TokenName(Value: TptTokenKind): string; 289 | function ptTokenName(Value: TptTokenKind): string; 290 | function IsTokenIDJunk(const aTokenID : TptTokenKind ) :Boolean; //XM 20001210 291 | 292 | implementation 293 | 294 | function TokenName(Value: TptTokenKind): string; 295 | begin //jdj 7/18/1999 296 | Result := Copy(ptTokenName(Value), 3, MaxInt); 297 | end; 298 | 299 | function ptTokenName(Value: TptTokenKind): string; 300 | begin 301 | result := GetEnumName(TypeInfo(TptTokenKind), Integer(Value)); 302 | end; 303 | 304 | function IsTokenIDJunk(const aTokenID : TptTokenKind ) :boolean; //XM 20001210 305 | begin 306 | Result := aTokenID in [ptAnsiComment, ptBorComment, ptCRLF, ptCRLFCo, ptSlashesComment, ptSpace, 307 | ptIfDirect, 308 | ptIfEndDirect, 309 | ptElseIfDirect, 310 | ptIfDefDirect, 311 | ptIfNDefDirect, 312 | ptEndIfDirect, 313 | ptIfOptDirect, 314 | ptDefineDirect, 315 | ptUndefDirect]; 316 | end; 317 | 318 | 319 | end. 320 | 321 | -------------------------------------------------------------------------------- /CastaliaSimplePasParTypes.pas: -------------------------------------------------------------------------------- 1 | {--------------------------------------------------------------------------- 2 | The contents of this file are subject to the Mozilla Public License Version 3 | 1.1 (the "License"); you may not use this file except in compliance with the 4 | License. You may obtain a copy of the License at 5 | http://www.mozilla.org/NPL/NPL-1_1Final.html 6 | 7 | Software distributed under the License is distributed on an "AS IS" basis, 8 | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9 | the specific language governing rights and limitations under the License. 10 | 11 | The Original Code is: mwSimplePasParTypes, released November 14, 1999. 12 | 13 | The Initial Developer of the Original Code is Martin Waldenburg 14 | unit CastaliaPasLexTypes; 15 | 16 | ----------------------------------------------------------------------------} 17 | 18 | unit CastaliaSimplePasParTypes; 19 | 20 | interface 21 | 22 | uses SysUtils, TypInfo; 23 | 24 | type 25 | TmwParseError = ( 26 | InvalidAdditiveOperator, 27 | InvalidAccessSpecifier, 28 | InvalidCharString, 29 | InvalidClassMethodHeading, 30 | InvalidConstantDeclaration, 31 | InvalidConstSection, 32 | InvalidDeclarationSection, 33 | InvalidDirective16Bit, 34 | InvalidDirectiveBinding, 35 | InvalidDirectiveCalling, 36 | InvalidExportedHeading, 37 | InvalidForStatement, 38 | InvalidInitializationSection, 39 | InvalidInterfaceDeclaration, 40 | InvalidInterfaceType, 41 | InvalidLabelId, 42 | InvalidLabeledStatement, 43 | InvalidMethodHeading, 44 | InvalidMultiplicativeOperator, 45 | InvalidNumber, 46 | InvalidOrdinalIdentifier, 47 | InvalidParameter, 48 | InvalidParseFile, 49 | InvalidProceduralDirective, 50 | InvalidProceduralType, 51 | InvalidProcedureDeclarationSection, 52 | InvalidProcedureMethodDeclaration, 53 | InvalidRealIdentifier, 54 | InvalidRelativeOperator, 55 | InvalidStorageSpecifier, 56 | InvalidStringIdentifier, 57 | InvalidStructuredType, 58 | InvalidTryStatement, 59 | InvalidTypeKind, 60 | InvalidVariantIdentifier, 61 | InvalidVarSection, 62 | vchInvalidClass, //vch 63 | vchInvalidMethod, //vch 64 | vchInvalidProcedure,//vch 65 | vchInvalidCircuit, //vch 66 | vchInvalidIncludeFile //vch 67 | ); 68 | 69 | TmwPasCodeInfo = ( 70 | ciNone, //: @BUG heresy ! 71 | ciAccessSpecifier, 72 | ciAdditiveOperator, 73 | ciArrayConstant, 74 | ciArrayType, 75 | ciAsmStatement, 76 | ciBlock, 77 | ciCaseLabel, 78 | ciCaseSelector, 79 | ciCaseStatement, 80 | ciCharString, 81 | ciClassClass, //DR 2001-07-16 82 | ciClassField, 83 | ciClassForward, 84 | ciClassFunctionHeading, 85 | ciClassHeritage, 86 | ciClassMemberList, 87 | ciClassMethodDirective, 88 | ciClassMethodHeading, 89 | ciClassMethodOrProperty, 90 | ciClassMethodResolution, 91 | ciClassProcedureHeading, 92 | ciClassProperty, 93 | ciClassReferenceType, 94 | ciClassType, 95 | ciClassTypeEnd, // DR 2001-07-31 96 | ciClassVisibility, 97 | ciCompoundStatement, 98 | ciConstantColon, 99 | ciConstantDeclaration, 100 | ciConstantEqual, 101 | ciConstantExpression, 102 | ciConstantName, 103 | ciConstantValue, 104 | ciConstantValueTyped, 105 | ciConstParameter, 106 | ciConstructorHeading, 107 | ciConstructorName, 108 | ciConstSection, 109 | ciContainsClause, 110 | ciContainsExpression, 111 | ciContainsIdentifier, 112 | ciContainsStatement, 113 | ciDeclarationSection, 114 | ciDesignator, 115 | ciDestructorHeading, 116 | ciDestructorName, 117 | ciDirective16Bit, 118 | ciDirectiveBinding, 119 | ciDirectiveCalling, 120 | ciDirectiveDeprecated, // DR 2001-10-20 121 | ciDirectiveLibrary, // DR 2001-10-20 122 | ciDirectiveLocal, // DR 2001-11-14 123 | ciDirectivePlatform, // DR 2001-10-20 124 | ciDirectiveVarargs, // DR 2001-11-14 125 | ciDispIDSpecifier, // DR 2001-07-26 126 | ciDispInterfaceForward, 127 | ciEmptyStatement, 128 | ciEnumeratedType, 129 | ciEnumeratedTypeItem, // DR 2001-10-29 130 | ciExceptBlock, 131 | ciExceptionBlockElseBranch, 132 | ciExceptionClassTypeIdentifier, 133 | ciExceptionHandler, 134 | ciExceptionHandlerList, 135 | ciExceptionIdentifier, 136 | ciExceptionVariable, 137 | ciExpliciteType, 138 | ciExportedHeading, 139 | ciExportsClause, 140 | ciExportsElement, 141 | ciExpression, 142 | ciExpressionList, 143 | ciExternalDirective, 144 | ciExternalDirectiveThree, 145 | ciExternalDirectiveTwo, 146 | ciFactor, 147 | ciFieldDeclaration, 148 | ciFieldList, 149 | ciFileType, 150 | ciFormalParameterList, 151 | ciFormalParameterSection, 152 | ciForStatement, 153 | ciForwardDeclaration, // DR 2001-07-23 154 | ciFunctionHeading, 155 | ciFunctionMethodDeclaration, 156 | ciFunctionMethodName, 157 | ciFunctionProcedureBlock, 158 | ciFunctionProcedureName, 159 | ciHandlePtCompDirect, //XM 20001125 160 | ciHandlePtDefineDirect, //XM 20001125 161 | ciHandlePtElseDirect, //XM 20001125 162 | ciHandlePtIfDefDirect, //XM 20001125 163 | ciHandlePtEndIfDirect, //XM 20001125 164 | ciHandlePtIfNDefDirect, //XM 20001125 165 | ciHandlePtIfOptDirect, //XM 20001125 166 | ciHandlePtIncludeDirect,//XM 20001125 167 | ciHandlePtResourceDirect,//XM 20001125 168 | ciHandlePtUndefDirect, //XM 20001125 169 | ciIdentifier, 170 | ciIdentifierList, 171 | ciIfStatement, 172 | ciImplementationSection, 173 | ciIncludeFile, 174 | ciIndexSpecifier, // DR 2001-07-26 175 | ciInheritedStatement, 176 | ciInitializationSection, 177 | ciInlineStatement, 178 | ciInterfaceDeclaration, 179 | ciInterfaceForward, 180 | ciInterfaceGUID, 181 | ciInterfaceHeritage, 182 | ciInterfaceMemberList, 183 | ciInterfaceSection, 184 | ciInterfaceType, 185 | ciLabelDeclarationSection, 186 | ciLabeledStatement, 187 | ciLabelId, 188 | ciLibraryFile, 189 | ciMainUsedUnitExpression, 190 | ciMainUsedUnitName, 191 | ciMainUsedUnitStatement, 192 | ciMainUsesClause, 193 | ciMultiplicativeOperator, 194 | ciNewFormalParameterType, 195 | ciNumber, 196 | ciNextToken, //XM 20002512 197 | ciObjectConstructorHeading, 198 | ciObjectDestructorHeading, 199 | ciObjectField, 200 | ciObjectForward, 201 | ciObjectFunctionHeading, 202 | ciObjectHeritage, 203 | ciObjectMemberList, 204 | ciObjectMethodDirective, 205 | ciObjectMethodHeading, 206 | ciObjectNameOfMethod, 207 | ciObjectProcedureHeading, 208 | ciObjectProperty, // DR 2001-08-07 209 | ciObjectPropertySpecifiers, // DR 2001-08-07 210 | ciObjectType, 211 | ciObjectTypeEnd, // DR 2001-08-07 212 | ciObjectVisibility, 213 | ciOldFormalParameterType, 214 | ciOrdinalIdentifier, 215 | ciOrdinalType, 216 | ciOutParameter, 217 | ciPackageFile, 218 | ciParameterFormal, 219 | ciParameterName, 220 | ciParameterNameList, 221 | ciParseFile, 222 | ciPointerType, 223 | ciProceduralDirective, 224 | ciProceduralType, 225 | ciProcedureDeclarationSection, 226 | ciProcedureHeading, 227 | ciProcedureMethodDeclaration, 228 | ciProcedureMethodName, 229 | ciProgramBlock, 230 | ciProgramFile, 231 | ciPropertyDefault, // DR 2001-07-16 232 | ciPropertyInterface, 233 | ciPropertyName, 234 | ciPropertyParameterConst, 235 | ciPropertyParameterList, 236 | ciPropertySpecifiers, 237 | ciQualifiedIdentifier, 238 | ciQualifiedIdentifierList, 239 | ciRaiseStatement, 240 | ciReadAccessIdentifier, 241 | ciRealIdentifier, 242 | ciRealType, 243 | ciRecordConstant, 244 | ciRecordFieldConstant, 245 | ciRecordType, 246 | ciRecordVariant, 247 | ciRelativeOperator, 248 | ciRepeatStatement, 249 | ciRequiresClause, 250 | ciRequiresIdentifier, 251 | ciResolutionInterfaceName, 252 | ciResourceDeclaration, 253 | ciReturnType, 254 | ciSEMICOLON, //XM 20002512 255 | ciSetConstructor, 256 | ciSetElement, 257 | ciSetType, 258 | ciSimpleExpression, 259 | ciSimpleStatement, 260 | ciSimpleType, 261 | ciSkipAnsiComment, 262 | ciSkipBorComment, 263 | ciSkipSlashesComment, 264 | ciSkipSpace, //XM 20002511 265 | ciSkipCRLFco, //XM 20002511 266 | ciSkipCRLF, //XM 20002511 267 | ciStatement, 268 | ciStatementList, 269 | ciStorageExpression, 270 | ciStorageIdentifier, 271 | ciStorageDefault, 272 | ciStorageNoDefault, 273 | ciStorageSpecifier, 274 | ciStorageStored, 275 | ciStringIdentifier, 276 | ciStringStatement, 277 | ciStringType, 278 | ciStructuredType, 279 | ciSubrangeType, 280 | ciTagField, 281 | ciTagFieldName, 282 | ciTagFieldTypeName, 283 | ciTerm, 284 | ciTryStatement, 285 | ciTypedConstant, 286 | ciTypeDeclaration, 287 | ciTypeId, 288 | ciTypeKind, 289 | ciTypeName, 290 | ciTypeSection, 291 | ciUnitFile, 292 | ciUnitId, 293 | ciUsedUnitName, 294 | ciUsedUnitsList, 295 | ciUsesClause, 296 | ciVarAbsolute, 297 | ciVarEqual, 298 | ciVarDeclaration, 299 | ciVariable, 300 | ciVariableList, 301 | ciVariableReference, 302 | ciVariableTwo, 303 | ciVariantIdentifier, 304 | ciVariantSection, 305 | ciVarParameter, 306 | ciVarSection, 307 | ciVisibilityAutomated, 308 | ciVisibilityPrivate, 309 | ciVisibilityProtected, 310 | ciVisibilityPublic, 311 | ciVisibilityPublished, 312 | ciVisibilityUnknown, 313 | ciWhileStatement, 314 | ciWithStatement, 315 | ciWriteAccessIdentifier 316 | ); 317 | 318 | function ParserErrorName(Value: TmwParseError): string; 319 | 320 | implementation 321 | 322 | function ParserErrorName(Value: TmwParseError): string; 323 | begin 324 | result := GetEnumName(TypeInfo(TmwParseError), Integer(Value)); 325 | end; 326 | 327 | end. 328 | 329 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | These files make up a hand-written high speed parser for the Object Pascal dialect known as "Delphi." The original work was done byt Martin Waldenburg in the late 1990s, and the project was abandoned sometime before 2003, when I found the code and began working on it. I have kept it updated as necessary to work with my project, called "Castalia." 2 | 3 | More information about Castalia can be found at http://www.twodesk.com/castalia. 4 | 5 | To use the parser, you create a new class that descends from TmwSimplePasPar, and override the virtual methods for the various source code elements that you need to work with. This parser does not produce a syntax tree or a symbol table, but unmodified, it will act as an acceptor for Delphi code. 6 | 7 | !!!!! IMPORTANT !!!!! 8 | One thing to note: The file names are used in the Castalia product, which is incorporated into the Delphi IDE. If you use this code in any Delphi IDE addin or components that will be installed into the Delphi IDE, you will need to change the names of the units to match your own project, or you will cause compatibility problems with other products. 9 | 10 | Once again: YOU MUST CHANGE THE FILENAMES TO SOMETHING UNIQUE TO YOU BEFORE USING THEM. 11 | 12 | Enjoy! 13 | 14 | --Jacob Thurman 15 | jacob@jacobthurman.com 16 | http://www.jacobthurman.com 17 | --------------------------------------------------------------------------------