mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-14 05:15:16 -05:00
8d9a439d49
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@434 3f818213-9676-44b0-a9b4-5e4c4e03d09d
1615 lines
44 KiB
ObjectPascal
1615 lines
44 KiB
ObjectPascal
{+--------------------------------------------------------------------------+
|
||
| Class: TmwPasLex
|
||
| Created: 07.98 - 10.98
|
||
| Author: Martin Waldenburg
|
||
| Description: A very fast Pascal tokenizer.
|
||
| Version: 1.32
|
||
| Copyright (c) 1998, 1999 Martin Waldenburg
|
||
| All rights reserved.
|
||
|
|
||
| LICENCE CONDITIONS
|
||
|
|
||
| USE OF THE ENCLOSED SOFTWARE
|
||
| INDICATES YOUR ASSENT TO THE
|
||
| FOLLOWING LICENCE CONDITIONS.
|
||
|
|
||
|
|
||
|
|
||
| These Licence Conditions are exlusively
|
||
| governed by the Law and Rules of the
|
||
| Federal Republic of Germany.
|
||
|
|
||
| Redistribution and use in source and binary form, with or without
|
||
| modification, are permitted provided that the following conditions
|
||
| are met:
|
||
|
|
||
| 1. Redistributions of source code must retain the above copyright
|
||
| notice, this list of conditions and the following disclaimer.
|
||
| If the source is modified, the complete original and unmodified
|
||
| source code has to distributed with the modified version.
|
||
|
|
||
| 2. Redistributions in binary form must reproduce the above
|
||
| copyright notice, these licence conditions and the disclaimer
|
||
| found at the end of this licence agreement in the documentation
|
||
| and/or other materials provided with the distribution.
|
||
|
|
||
| 3. Software using this code must contain a visible line of credit.
|
||
|
|
||
| 4. If my code is used in a "for profit" product, you have to donate
|
||
| to a registered charity in an amount that you feel is fair.
|
||
| You may use it in as many of your products as you like.
|
||
| Proof of this donation must be provided to the author of
|
||
| this software.
|
||
|
|
||
| 5. If you for some reasons don't want to give public credit to the
|
||
| author, you have to donate three times the price of your software
|
||
| product, or any other product including this component in any way,
|
||
| but no more than $500 US and not less than $200 US, or the
|
||
| equivalent thereof in other currency, to a registered charity.
|
||
| You have to do this for every of your products, which uses this
|
||
| code separately.
|
||
| Proof of this donations must be provided to the author of
|
||
| this software.
|
||
|
|
||
|
|
||
| DISCLAIMER:
|
||
|
|
||
| THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
|
||
|
|
||
| ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||
| THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||
| PARTICULAR PURPOSE ARE DISCLAIMED.
|
||
|
|
||
| IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||
| INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||
| (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||
| OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||
| WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||
| NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||
| THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||
|
|
||
| Martin.Waldenburg@T-Online.de
|
||
+--------------------------------------------------------------------------+}
|
||
|
||
{25/03/2003 Olivier GUILBAUD <golivier@free.fr> update for lazarus project}
|
||
|
||
unit mPasLex;
|
||
{$mode objfpc}{$H+}{$M+}
|
||
interface
|
||
|
||
uses
|
||
SysUtils;
|
||
|
||
var
|
||
Identifiers: array[#0..#255]of ByteBool;
|
||
mHashTable: array[#0..#255]of Integer;
|
||
|
||
type
|
||
TTokenKind=(tkAbsolute, tkAbstract, tkAddressOp, tkAnd, tkAnsiComment,
|
||
tkArray, tkAs, tkAt, tkAsciiChar, tkAsm, tkAssembler, tkAssign, tkAutomated,
|
||
tkBegin, tkBadString, tkBorComment, tkCase, tkCdecl, tkClass, tkColon,
|
||
tkComma, tkCompDirect, tkConst, tkConstructor, tkCRLF, tkCRLFCo, tkDefault,
|
||
tkDestructor, tkDispid, tkDispinterface, tkDiv, tkDo, tkDoubleAddressOp,
|
||
tkDotDot, tkDownto, tkDynamic, tkElse, tkEnd, tkEqual, tkError, tkExcept,
|
||
tkExport, tkExports, tkExternal, tkFar, tkFile, tkFinalization, tkFinally,
|
||
tkFloat, tkFor, tkForward, tkFunction, tkGoto, tkGreater, tkGreaterEqual,
|
||
tkIdentifier, tkIf, tkImplementation, tkImplements, tkIn, tkInclude, tkIndex,
|
||
tkInherited, tkInitialization, tkInline, tkInteger, tkInterface, tkIs,
|
||
tkKeyString, tkLabel, tkLibrary, tkLower, tkLowerEqual, tkMessage, tkMinus,
|
||
tkMod, tkName, tkNear, tkNil, tkNodefault, tkNone, tkNot, tkNotEqual, tkNull,
|
||
tkNumber, tkObject, tkOf, tkOn, tkOr, tkOut, tkOverload, tkOverride,
|
||
tkPacked, tkPascal, tkPlus, tkPoint, tkPointerSymbol, tkPrivate, tkProcedure,
|
||
tkProgram, tkProperty, tkProtected, tkPublic, tkPublished, tkRaise, tkRead,
|
||
tkReadonly, tkRecord, tkRegister, tkReintroduce, tkRepeat, tkResident,
|
||
tkResourcestring, tkRoundClose, tkRoundOpen, tkSafecall, tkSemiColon, tkSet,
|
||
tkShl, tkShr, tkSlash, tkSlashesComment, tkSquareClose, tkSquareOpen,
|
||
tkSpace, tkStar, tkStdcall, tkStored, tkString, tkStringresource, tkSymbol,
|
||
tkThen, tkThreadvar, tkTo, tkTry, tkType, tkUnit, tkUnknown, tkUntil, tkUses,
|
||
tkVar, tkVirtual, tkWhile, tkWith, tkWrite, tkWriteonly, tkXor);
|
||
|
||
TCommentState=(csAnsi, csBor, csNo);
|
||
|
||
TmwPasLex=class(TObject)
|
||
private
|
||
fComment: TCommentState;
|
||
fOrigin: PChar;
|
||
fProcTable: array[#0..#255]of procedure of Object;
|
||
Run: Longint;
|
||
Temp: PChar;
|
||
FRoundCount: Integer;
|
||
FSquareCount: Integer;
|
||
fStringLen: Integer;
|
||
fToIdent: PChar;
|
||
fIdentFuncTable: array[0..191]of function: TTokenKind of Object;
|
||
fTokenPos: Integer;
|
||
fLineNumber: Integer;
|
||
FTokenID: TTokenKind;
|
||
fLastIdentPos: Integer;
|
||
fLastNoSpace: TTokenKind;
|
||
fLastNoSpacePos: Integer;
|
||
fLinePos: Integer;
|
||
fIsInterface: Boolean;
|
||
fIsClass: Boolean;
|
||
function KeyHash(ToHash: PChar): Integer;
|
||
function KeyComp(const aKey: string): Boolean;
|
||
function Func15: TTokenKind;
|
||
function Func19: TTokenKind;
|
||
function Func20: TTokenKind;
|
||
function Func21: TTokenKind;
|
||
function Func23: TTokenKind;
|
||
function Func25: TTokenKind;
|
||
function Func27: TTokenKind;
|
||
function Func28: TTokenKind;
|
||
function Func29: TTokenKind;
|
||
function Func32: TTokenKind;
|
||
function Func33: TTokenKind;
|
||
function Func35: TTokenKind;
|
||
function Func37: TTokenKind;
|
||
function Func38: TTokenKind;
|
||
function Func39: TTokenKind;
|
||
function Func40: TTokenKind;
|
||
function Func41: TTokenKind;
|
||
function Func44: TTokenKind;
|
||
function Func45: TTokenKind;
|
||
function Func47: TTokenKind;
|
||
function Func49: TTokenKind;
|
||
function Func52: TTokenKind;
|
||
function Func54: TTokenKind;
|
||
function Func55: TTokenKind;
|
||
function Func56: TTokenKind;
|
||
function Func57: TTokenKind;
|
||
function Func59: TTokenKind;
|
||
function Func60: TTokenKind;
|
||
function Func61: TTokenKind;
|
||
function Func63: TTokenKind;
|
||
function Func64: TTokenKind;
|
||
function Func65: TTokenKind;
|
||
function Func66: TTokenKind;
|
||
function Func69: TTokenKind;
|
||
function Func71: TTokenKind;
|
||
function Func73: TTokenKind;
|
||
function Func75: TTokenKind;
|
||
function Func76: TTokenKind;
|
||
function Func79: TTokenKind;
|
||
function Func81: TTokenKind;
|
||
function Func84: TTokenKind;
|
||
function Func85: TTokenKind;
|
||
function Func87: TTokenKind;
|
||
function Func88: TTokenKind;
|
||
function Func91: TTokenKind;
|
||
function Func92: TTokenKind;
|
||
function Func94: TTokenKind;
|
||
function Func95: TTokenKind;
|
||
function Func96: TTokenKind;
|
||
function Func97: TTokenKind;
|
||
function Func98: TTokenKind;
|
||
function Func99: TTokenKind;
|
||
function Func100: TTokenKind;
|
||
function Func101: TTokenKind;
|
||
function Func102: TTokenKind;
|
||
function Func103: TTokenKind;
|
||
function Func105: TTokenKind;
|
||
function Func106: TTokenKind;
|
||
function Func117: TTokenKind;
|
||
function Func126: TTokenKind;
|
||
function Func129: TTokenKind;
|
||
function Func132: TTokenKind;
|
||
function Func133: TTokenKind;
|
||
function Func136: TTokenKind;
|
||
function Func141: TTokenKind;
|
||
function Func143: TTokenKind;
|
||
function Func166: TTokenKind;
|
||
function Func168: TTokenKind;
|
||
function Func191: TTokenKind;
|
||
function AltFunc: TTokenKind;
|
||
procedure InitIdent;
|
||
function IdentKind(MayBe: PChar): TTokenKind;
|
||
procedure SetOrigin(NewValue: PChar);
|
||
procedure SetRunPos(Value: Integer);
|
||
procedure MakeMethodTables;
|
||
procedure AddressOpProc;
|
||
procedure AsciiCharProc;
|
||
procedure AnsiProc;
|
||
procedure BorProc;
|
||
procedure BraceCloseProc;
|
||
procedure BraceOpenProc;
|
||
procedure ColonProc;
|
||
procedure CommaProc;
|
||
procedure CRProc;
|
||
procedure EqualProc;
|
||
procedure GreaterProc;
|
||
procedure IdentProc;
|
||
procedure IntegerProc;
|
||
procedure LFProc;
|
||
procedure LowerProc;
|
||
procedure MinusProc;
|
||
procedure NullProc;
|
||
procedure NumberProc;
|
||
procedure PlusProc;
|
||
procedure PointerSymbolProc;
|
||
procedure PointProc;
|
||
procedure RoundCloseProc;
|
||
procedure RoundOpenProc;
|
||
procedure SemiColonProc;
|
||
procedure SlashProc;
|
||
procedure SpaceProc;
|
||
procedure SquareCloseProc;
|
||
procedure SquareOpenProc;
|
||
procedure StarProc;
|
||
procedure StringProc;
|
||
procedure SymbolProc;
|
||
procedure UnknownProc;
|
||
function GetToken: string;
|
||
function InSymbols(aChar: Char): Boolean;
|
||
protected
|
||
public
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
function CharAhead(Count: Integer): Char;
|
||
procedure Next;
|
||
procedure NextID(ID: TTokenKind);
|
||
procedure NextNoJunk;
|
||
procedure NextClass;
|
||
property IsClass: Boolean read fIsClass;
|
||
property IsInterface: Boolean read fIsInterface;
|
||
property LastIdentPos: Integer read fLastIdentPos;
|
||
property LastNoSpace: TTokenKind read fLastNoSpace;
|
||
property LastNoSpacePos: Integer read fLastNoSpacePos;
|
||
property LineNumber: Integer read fLineNumber;
|
||
property LinePos: Integer read fLinePos;
|
||
property Origin: PChar read fOrigin write SetOrigin;
|
||
property RunPos: Integer read Run write SetRunPos;
|
||
property TokenPos: Integer read fTokenPos;
|
||
property Token: string read GetToken;
|
||
property TokenID: TTokenKind read FTokenID;
|
||
published
|
||
end;
|
||
|
||
var
|
||
mwPasLex: TmwPasLex;
|
||
|
||
implementation
|
||
|
||
procedure MakeIdentTable;
|
||
var
|
||
I, J: Char;
|
||
begin
|
||
for I:=#0 to #255 do
|
||
begin
|
||
Case I of
|
||
'_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I]:=True;
|
||
else Identifiers[I]:=False;
|
||
end;
|
||
J:=UpperCase(I)[1];
|
||
Case I of
|
||
'a'..'z', 'A'..'Z', '_': mHashTable[I]:=Ord(J)-64;
|
||
else mHashTable[Char(I)]:=0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.InitIdent;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
for I:=0 to 191 do
|
||
Case I of
|
||
15: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func15;
|
||
19: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func19;
|
||
20: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func20;
|
||
21: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func21;
|
||
23: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func23;
|
||
25: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func25;
|
||
27: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func27;
|
||
28: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func28;
|
||
29: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func29;
|
||
32: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func32;
|
||
33: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func33;
|
||
35: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func35;
|
||
37: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func37;
|
||
38: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func38;
|
||
39: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func39;
|
||
40: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func40;
|
||
41: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func41;
|
||
44: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func44;
|
||
45: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func45;
|
||
47: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func47;
|
||
49: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func49;
|
||
52: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func52;
|
||
54: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func54;
|
||
55: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func55;
|
||
56: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func56;
|
||
57: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func57;
|
||
59: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func59;
|
||
60: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func60;
|
||
61: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func61;
|
||
63: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func63;
|
||
64: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func64;
|
||
65: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func65;
|
||
66: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func66;
|
||
69: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func69;
|
||
71: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func71;
|
||
73: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func73;
|
||
75: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func75;
|
||
76: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func76;
|
||
79: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func79;
|
||
81: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func81;
|
||
84: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func84;
|
||
85: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func85;
|
||
87: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func87;
|
||
88: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func88;
|
||
91: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func91;
|
||
92: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func92;
|
||
94: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func94;
|
||
95: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func95;
|
||
96: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func96;
|
||
97: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func97;
|
||
98: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func98;
|
||
99: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func99;
|
||
100: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func100;
|
||
101: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func101;
|
||
102: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func102;
|
||
103: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func103;
|
||
105: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func105;
|
||
106: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func106;
|
||
117: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func117;
|
||
126: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func126;
|
||
129: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func129;
|
||
132: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func132;
|
||
133: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func133;
|
||
136: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func136;
|
||
141: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func141;
|
||
143: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func143;
|
||
166: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func166;
|
||
168: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func168;
|
||
191: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func191;
|
||
else fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}AltFunc;
|
||
end;
|
||
end;
|
||
|
||
function TmwPasLex.KeyHash(ToHash: PChar): Integer;
|
||
begin
|
||
Result:=0;
|
||
while ToHash^in ['a'..'z', 'A'..'Z']do
|
||
begin
|
||
Inc(Result, mHashTable[ToHash^]);
|
||
Inc(ToHash);
|
||
end;
|
||
if ToHash^in ['_', '0'..'9']then Inc(ToHash);
|
||
fStringLen:=ToHash-fToIdent;
|
||
end; { KeyHash }
|
||
|
||
function TmwPasLex.KeyComp(const aKey: string): Boolean;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Temp:=fToIdent;
|
||
if Length(aKey)=fStringLen then
|
||
begin
|
||
Result:=True;
|
||
for i:=1 to fStringLen do
|
||
begin
|
||
if mHashTable[Temp^]<>mHashTable[aKey[i]]then
|
||
begin
|
||
Result:=False;
|
||
Break;
|
||
end;
|
||
Inc(Temp);
|
||
end;
|
||
end else Result:=False;
|
||
end; { KeyComp }
|
||
|
||
function TmwPasLex.Func15: TTokenKind;
|
||
begin
|
||
if KeyComp('If')then Result:=tkIf else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func19: TTokenKind;
|
||
begin
|
||
if KeyComp('Do')then Result:=tkDo else
|
||
if KeyComp('And')then Result:=tkAnd else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func20: TTokenKind;
|
||
begin
|
||
if KeyComp('As')then Result:=tkAs else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func21: TTokenKind;
|
||
begin
|
||
if KeyComp('Of')then Result:=tkOf else
|
||
if KeyComp('At')then Result:=tkAt else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func23: TTokenKind;
|
||
begin
|
||
if KeyComp('End')then Result:=tkEnd else
|
||
if KeyComp('In')then Result:=tkIn else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func25: TTokenKind;
|
||
begin
|
||
if KeyComp('Far')then Result:=tkFar else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func27: TTokenKind;
|
||
begin
|
||
if KeyComp('Cdecl')then Result:=tkCdecl else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func28: TTokenKind;
|
||
begin
|
||
if KeyComp('Read')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkRead
|
||
end else
|
||
if KeyComp('Case')then Result:=tkCase else
|
||
if KeyComp('Is')then Result:=tkIs else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func29: TTokenKind;
|
||
begin
|
||
if KeyComp('On')then Result:=tkOn else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func32: TTokenKind;
|
||
begin
|
||
if KeyComp('File')then Result:=tkFile else
|
||
if KeyComp('Label')then Result:=tkLabel else
|
||
if KeyComp('Mod')then Result:=tkMod else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func33: TTokenKind;
|
||
begin
|
||
if KeyComp('Or')then Result:=tkOr else
|
||
if KeyComp('Name')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkName
|
||
end else
|
||
if KeyComp('Asm')then Result:=tkAsm else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func35: TTokenKind;
|
||
begin
|
||
if KeyComp('To')then Result:=tkTo else
|
||
if KeyComp('Nil')then Result:=tkNil else
|
||
if KeyComp('Div')then Result:=tkDiv else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func37: TTokenKind;
|
||
begin
|
||
if KeyComp('Begin')then Result:=tkBegin else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func38: TTokenKind;
|
||
begin
|
||
if KeyComp('Near')then Result:=tkNear else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func39: TTokenKind;
|
||
begin
|
||
if KeyComp('For')then Result:=tkFor else
|
||
if KeyComp('Shl')then Result:=tkShl else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func40: TTokenKind;
|
||
begin
|
||
if KeyComp('Packed')then Result:=tkPacked else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func41: TTokenKind;
|
||
begin
|
||
if KeyComp('Else')then Result:=tkElse else
|
||
if KeyComp('Var')then Result:=tkVar else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func44: TTokenKind;
|
||
begin
|
||
if KeyComp('Set')then Result:=tkSet else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func45: TTokenKind;
|
||
begin
|
||
if KeyComp('Shr')then Result:=tkShr else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func47: TTokenKind;
|
||
begin
|
||
if KeyComp('Then')then Result:=tkThen else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func49: TTokenKind;
|
||
begin
|
||
if KeyComp('Not')then Result:=tkNot else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func52: TTokenKind;
|
||
begin
|
||
if KeyComp('Raise')then Result:=tkRaise else
|
||
if KeyComp('Pascal')then Result:=tkPascal else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func54: TTokenKind;
|
||
begin
|
||
if KeyComp('Class')then
|
||
begin
|
||
Result:=tkClass;
|
||
if fLastNoSpace=tkEqual then
|
||
begin
|
||
fIsClass:=True;
|
||
if Identifiers[CharAhead(fStringLen)]then fIsClass:=False;
|
||
end else fIsClass:=False;
|
||
end else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func55: TTokenKind;
|
||
begin
|
||
if KeyComp('Object')then Result:=tkObject else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func56: TTokenKind;
|
||
begin
|
||
if KeyComp('Index')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkIndex
|
||
end else
|
||
if KeyComp('Out')then Result:=tkOut else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func57: TTokenKind;
|
||
begin
|
||
if KeyComp('While')then Result:=tkWhile else
|
||
if KeyComp('Goto')then Result:=tkGoto else
|
||
if KeyComp('Xor')then Result:=tkXor else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func59: TTokenKind;
|
||
begin
|
||
if KeyComp('Safecall')then Result:=tkSafecall else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func60: TTokenKind;
|
||
begin
|
||
if KeyComp('With')then Result:=tkWith else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func61: TTokenKind;
|
||
begin
|
||
if KeyComp('Dispid')then Result:=tkDispid else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func63: TTokenKind;
|
||
begin
|
||
if KeyComp('Public')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkPublic
|
||
end else
|
||
if KeyComp('Record')then Result:=tkRecord else
|
||
if KeyComp('Try')then Result:=tkTry else
|
||
if KeyComp('Array')then Result:=tkArray else
|
||
if KeyComp('Inline')then Result:=tkInline else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func64: TTokenKind;
|
||
begin
|
||
if KeyComp('Uses')then Result:=tkUses else
|
||
if KeyComp('Unit')then Result:=tkUnit else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func65: TTokenKind;
|
||
begin
|
||
if KeyComp('Repeat')then Result:=tkRepeat else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func66: TTokenKind;
|
||
begin
|
||
if KeyComp('Type')then Result:=tkType else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func69: TTokenKind;
|
||
begin
|
||
if KeyComp('Dynamic')then Result:=tkDynamic else
|
||
if KeyComp('Default')then Result:=tkDefault else
|
||
if KeyComp('Message')then Result:=tkMessage else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func71: TTokenKind;
|
||
begin
|
||
if KeyComp('Stdcall')then Result:=tkStdcall else
|
||
if KeyComp('Const')then Result:=tkConst else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func73: TTokenKind;
|
||
begin
|
||
if KeyComp('Except')then Result:=tkExcept else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func75: TTokenKind;
|
||
begin
|
||
if KeyComp('Write')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkWrite
|
||
end else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func76: TTokenKind;
|
||
begin
|
||
if KeyComp('Until')then Result:=tkUntil else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func79: TTokenKind;
|
||
begin
|
||
if KeyComp('Finally')then Result:=tkFinally else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func81: TTokenKind;
|
||
begin
|
||
if KeyComp('Interface')then
|
||
begin
|
||
Result:=tkInterface;
|
||
if fLastNoSpace=tkEqual then
|
||
fIsInterface:=True else fIsInterface:=False;
|
||
end else
|
||
if KeyComp('Stored')then Result:=tkStored else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func84: TTokenKind;
|
||
begin
|
||
if KeyComp('Abstract')then Result:=tkAbstract else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func85: TTokenKind;
|
||
begin
|
||
if KeyComp('Library')then Result:=tkLibrary else
|
||
if KeyComp('Forward')then Result:=tkForward else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func87: TTokenKind;
|
||
begin
|
||
if KeyComp('String')then Result:=tkString else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func88: TTokenKind;
|
||
begin
|
||
if KeyComp('Program')then Result:=tkProgram else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func91: TTokenKind;
|
||
begin
|
||
if KeyComp('Private')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkPrivate
|
||
end else
|
||
if KeyComp('Downto')then Result:=tkDownto else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func92: TTokenKind;
|
||
begin
|
||
if KeyComp('overload') then
|
||
Result:=tkOverload
|
||
else
|
||
if KeyComp('Inherited') then
|
||
Result:=tkInherited
|
||
else
|
||
Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func94: TTokenKind;
|
||
begin
|
||
if KeyComp('Resident')then Result:=tkResident else
|
||
if KeyComp('Readonly')then Result:=tkReadonly else
|
||
if KeyComp('Assembler')then Result:=tkAssembler else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func95: TTokenKind;
|
||
begin
|
||
if KeyComp('Absolute')then Result:=tkAbsolute else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func96: TTokenKind;
|
||
begin
|
||
if KeyComp('Published')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkPublished
|
||
end else
|
||
if KeyComp('Override')then Result:=tkOverride else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func97: TTokenKind;
|
||
begin
|
||
if KeyComp('Threadvar')then Result:=tkThreadvar else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func98: TTokenKind;
|
||
begin
|
||
if KeyComp('Export')then Result:=tkExport else
|
||
if KeyComp('Nodefault')then Result:=tkNodefault else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func99: TTokenKind;
|
||
begin
|
||
if KeyComp('External')then Result:=tkExternal else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func100: TTokenKind;
|
||
begin
|
||
if KeyComp('Automated')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkAutomated
|
||
end else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func101: TTokenKind;
|
||
begin
|
||
if KeyComp('Register')then Result:=tkRegister else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func102: TTokenKind;
|
||
begin
|
||
if KeyComp('Function')then Result:=tkFunction else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func103: TTokenKind;
|
||
begin
|
||
if KeyComp('Virtual')then Result:=tkVirtual else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func105: TTokenKind;
|
||
begin
|
||
if KeyComp('Procedure')then Result:=tkProcedure else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func106: TTokenKind;
|
||
begin
|
||
if KeyComp('Protected')then
|
||
begin
|
||
if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
|
||
Result:=tkProtected
|
||
end else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func117: TTokenKind;
|
||
begin
|
||
if KeyComp('Exports')then Result:=tkExports else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func126: TTokenKind;
|
||
begin
|
||
if KeyComp('Implements') then
|
||
Result:=tkImplements
|
||
else
|
||
Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func129: TTokenKind;
|
||
begin
|
||
if KeyComp('Dispinterface')then Result:=tkDispinterface else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func132: TTokenKind;
|
||
begin
|
||
if KeyComp('Reintroduce') then
|
||
Result:=tkReintroduce
|
||
else
|
||
Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func133: TTokenKind;
|
||
begin
|
||
if KeyComp('Property')then Result:=tkProperty else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func136: TTokenKind;
|
||
begin
|
||
if KeyComp('Finalization')then Result:=tkFinalization else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func141: TTokenKind;
|
||
begin
|
||
if KeyComp('Writeonly')then Result:=tkWriteonly else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func143: TTokenKind;
|
||
begin
|
||
if KeyComp('Destructor')then Result:=tkDestructor else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func166: TTokenKind;
|
||
begin
|
||
if KeyComp('Constructor')then Result:=tkConstructor else
|
||
if KeyComp('Implementation')then Result:=tkImplementation else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func168: TTokenKind;
|
||
begin
|
||
if KeyComp('Initialization')then Result:=tkInitialization else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.Func191: TTokenKind;
|
||
begin
|
||
if KeyComp('Resourcestring')then Result:=tkResourcestring else
|
||
if KeyComp('Stringresource')then Result:=tkStringresource else Result:=tkIdentifier;
|
||
end;
|
||
|
||
function TmwPasLex.AltFunc: TTokenKind;
|
||
begin
|
||
Result:=tkIdentifier
|
||
end;
|
||
|
||
function TmwPasLex.IdentKind(MayBe: PChar): TTokenKind;
|
||
var
|
||
HashKey: Integer;
|
||
begin
|
||
fToIdent:=MayBe;
|
||
HashKey:=KeyHash(MayBe);
|
||
if HashKey<192 then
|
||
Result:=fIdentFuncTable[HashKey]()
|
||
else
|
||
Result:=tkIdentifier;
|
||
end;
|
||
|
||
procedure TmwPasLex.MakeMethodTables;
|
||
var
|
||
I: Char;
|
||
begin
|
||
for I:=#0 to #255 do
|
||
case I of
|
||
#0: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NullProc;
|
||
#10: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LFProc;
|
||
#13: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CRProc;
|
||
#1..#9, #11, #12, #14..#32:
|
||
fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SpaceProc;
|
||
'#': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AsciiCharProc;
|
||
'$': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IntegerProc;
|
||
#39: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StringProc;
|
||
'0'..'9': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NumberProc;
|
||
'A'..'Z', 'a'..'z', '_':
|
||
fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IdentProc;
|
||
'{': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceOpenProc;
|
||
'}': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceCloseProc;
|
||
'!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~':
|
||
begin
|
||
case I of
|
||
'(': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundOpenProc;
|
||
')': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundCloseProc;
|
||
'*': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StarProc;
|
||
'+': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PlusProc;
|
||
',': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CommaProc;
|
||
'-': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}MinusProc;
|
||
'.': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointProc;
|
||
'/': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SlashProc;
|
||
':': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}ColonProc;
|
||
';': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SemiColonProc;
|
||
'<': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LowerProc;
|
||
'=': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}EqualProc;
|
||
'>': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}GreaterProc;
|
||
'@': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AddressOpProc;
|
||
'[': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareOpenProc;
|
||
']': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareCloseProc;
|
||
'^': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointerSymbolProc;
|
||
else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SymbolProc;
|
||
end;
|
||
end;
|
||
else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}UnknownProc;
|
||
end;
|
||
end;
|
||
|
||
constructor TmwPasLex.Create;
|
||
begin
|
||
inherited Create;
|
||
InitIdent;
|
||
MakeMethodTables;
|
||
end; { Create }
|
||
|
||
destructor TmwPasLex.Destroy;
|
||
begin
|
||
inherited Destroy;
|
||
end; { Destroy }
|
||
|
||
procedure TmwPasLex.SetOrigin(NewValue: PChar);
|
||
begin
|
||
fOrigin:=NewValue;
|
||
fComment:=csNo;
|
||
fLineNumber:=0;
|
||
fLinePos:=0;
|
||
Run:=0;
|
||
Next;
|
||
end; { SetOrigin }
|
||
|
||
procedure TmwPasLex.SetRunPos(Value: Integer);
|
||
begin
|
||
Run:=Value;
|
||
Next;
|
||
end;
|
||
|
||
procedure TmwPasLex.AddressOpProc;
|
||
begin
|
||
Case FOrigin[Run+1]of
|
||
'@':
|
||
begin
|
||
fTokenID:=tkDoubleAddressOp;
|
||
Inc(Run, 2);
|
||
end;
|
||
else
|
||
begin
|
||
fTokenID:=tkAddressOp;
|
||
Inc(Run);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.AsciiCharProc;
|
||
begin
|
||
fTokenID:=tkAsciiChar;
|
||
Inc(Run);
|
||
while FOrigin[Run]in ['0'..'9']do Inc(Run);
|
||
end;
|
||
|
||
procedure TmwPasLex.BraceCloseProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenId:=tkError;
|
||
end;
|
||
|
||
procedure TmwPasLex.BorProc;
|
||
begin
|
||
fTokenID:=tkBorComment;
|
||
case FOrigin[Run]of
|
||
#0:
|
||
begin
|
||
NullProc;
|
||
Exit;
|
||
end;
|
||
|
||
#10:
|
||
begin
|
||
LFProc;
|
||
Exit;
|
||
end;
|
||
|
||
#13:
|
||
begin
|
||
CRProc;
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
while FOrigin[Run]<>#0 do
|
||
case FOrigin[Run]of
|
||
'}':
|
||
begin
|
||
fComment:=csNo;
|
||
Inc(Run);
|
||
Break;
|
||
end;
|
||
#10: Break;
|
||
|
||
#13: Break;
|
||
else Inc(Run);
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.BraceOpenProc;
|
||
var
|
||
i: Integer;
|
||
s: string;
|
||
begin
|
||
Case FOrigin[Run+1]of
|
||
'$': fTokenID:=tkCompDirect;
|
||
'.':
|
||
begin
|
||
fComment := csBor;
|
||
i := 1;
|
||
while (FOrigin[Run + 1 + i] <> #0) and (i <= 8) do
|
||
begin
|
||
s := s + FOrigin[Run + 1 + i];
|
||
Inc(i);
|
||
end;
|
||
if (AnsiCompareText(s, 'include ') = 0) then
|
||
begin
|
||
//Inc(Run, 8);
|
||
fTokenID := tkInclude;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
fTokenID:=tkBorComment;
|
||
fComment:=csBor;
|
||
end;
|
||
end;
|
||
Inc(Run);
|
||
while FOrigin[Run]<>#0 do
|
||
case FOrigin[Run]of
|
||
'}':
|
||
begin
|
||
fComment:=csNo;
|
||
Inc(Run);
|
||
Break;
|
||
end;
|
||
#10: Break;
|
||
|
||
#13: Break;
|
||
else Inc(Run);
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.ColonProc;
|
||
begin
|
||
Case FOrigin[Run+1]of
|
||
'=':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkAssign;
|
||
end;
|
||
else
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkColon;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.CommaProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkComma;
|
||
end;
|
||
|
||
procedure TmwPasLex.CRProc;
|
||
begin
|
||
Case fComment of
|
||
csBor: fTokenID:=tkCRLFCo;
|
||
csAnsi: fTokenID:=tkCRLFCo;
|
||
else fTokenID:=tkCRLF;
|
||
end;
|
||
|
||
Case FOrigin[Run+1]of
|
||
#10: Inc(Run, 2);
|
||
else Inc(Run);
|
||
end;
|
||
Inc(fLineNumber);
|
||
fLinePos:=Run;
|
||
end;
|
||
|
||
procedure TmwPasLex.EqualProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkEqual;
|
||
end;
|
||
|
||
procedure TmwPasLex.GreaterProc;
|
||
begin
|
||
Case FOrigin[Run+1]of
|
||
'=':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkGreaterEqual;
|
||
end;
|
||
else
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkGreater;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TmwPasLex.InSymbols(aChar: Char): Boolean;
|
||
begin
|
||
if aChar in ['#', '$', '&', #39, '(', ')', '*', '+', ',', '<27>', '.', '/', ':',
|
||
';', '<', '=', '>', '@', '[', ']', '^']then Result:=True else Result:=False;
|
||
end;
|
||
|
||
function TmwPasLex.CharAhead(Count: Integer): Char;
|
||
begin
|
||
Temp:=fOrigin+Run+Count;
|
||
while Temp^in [#1..#9, #11, #12, #14..#32]do Inc(Temp);
|
||
Result:=Temp^;
|
||
end;
|
||
|
||
Function TokeToString(Toke : TTokenKind) : string;
|
||
begin;
|
||
case toke of
|
||
tkAbsolute: result := 'tkAbsolute';
|
||
tkAbstract: result := 'tkAbstract';
|
||
tkAddressOp: result := 'tkAddressOp';
|
||
tkAnd: result := 'tkAnd';
|
||
tkAnsiComment: result := 'tkAnsiComment';
|
||
tkArray: result := 'tkArray';
|
||
tkAs: result := 'tkAs';
|
||
tkAt: result := 'tkAt';
|
||
tkAsciiChar: result := 'tkAsciiChar';
|
||
tkAsm: result := 'tkAsm';
|
||
tkAssembler: result := 'tkAssembler';
|
||
tkAssign: result := 'tkAssign';
|
||
tkAutomated: result := 'tkAutomated';
|
||
tkBegin: result := 'tkBegin';
|
||
tkBadString: result := 'tkBadString';
|
||
tkBorComment: result := 'tkBorComment';
|
||
tkCase: result := 'tkCase';
|
||
tkCdecl: result := 'tkCdecl';
|
||
tkClass: result := 'tkClass';
|
||
tkColon: result := 'tkColon';
|
||
tkComma: result := 'tkComma';
|
||
tkCompDirect: result := 'tkCompDirect';
|
||
tkConst: result := 'tkConst';
|
||
tkConstructor: result := 'tkConstructor';
|
||
tkCRLF: result := 'tkCRLF';
|
||
tkCRLFCo: result := 'tkCRLFCo';
|
||
tkDefault: result := 'tkDefault';
|
||
tkDestructor: result := 'tkDestructor';
|
||
tkDispid: result := 'tkDispid';
|
||
tkDispinterface: result := 'tkDispinterface';
|
||
tkDiv: result := 'tkDiv';
|
||
tkDo: result := 'tkDo';
|
||
tkDoubleAddressOp: result := 'tkDoubleAddressOp';
|
||
tkDotDot: result := 'tkDotDot';
|
||
tkDownto: result := 'tkDownto';
|
||
tkDynamic: result := 'tkDynamic';
|
||
tkElse: result := 'tkElse';
|
||
tkEnd: result := 'tkEnd';
|
||
tkEqual: result := 'tkEqual';
|
||
tkError: result := 'tkError';
|
||
tkExcept: result := 'tkExcept';
|
||
tkExport: result := 'tkExport';
|
||
tkExports: result := 'tkExports';
|
||
tkExternal: result := 'tkExternal';
|
||
tkFar: result := 'tkFar';
|
||
tkFile: result := 'tkFile';
|
||
tkFinalization: result := 'tkFinalization';
|
||
tkFinally: result := 'tkFinally';
|
||
tkFloat: result := 'tkFloat';
|
||
tkFor: result := 'tkFor';
|
||
tkForward: result := 'tkForward';
|
||
tkFunction: result := 'tkFunction';
|
||
tkGoto: result := 'tkGoto';
|
||
tkGreater: result := 'tkGreater';
|
||
tkGreaterEqual: result := 'tkGreaterEqual';
|
||
tkIdentifier: result := 'tkIdentifier';
|
||
tkIf: result := 'tkIf';
|
||
tkImplementation: result := 'tkImplementation';
|
||
tkImplements: result := 'tkImplements';
|
||
tkIn: result := 'tkIn';
|
||
tkINCLUDE: result := 'tkINCLUDE';
|
||
tkIndex: result := 'tkIndex';
|
||
tkInherited: result := 'tkInherited';
|
||
tkInitialization: result := 'tkInitialization';
|
||
tkInline: result := 'tkInline';
|
||
tkInteger: result := 'tkInteger';
|
||
tkInterface: result := 'tkInterface';
|
||
tkIs: result := 'tkIs';
|
||
tkKeyString: result := 'tkKeyString';
|
||
tkLabel: result := 'tkLabel';
|
||
tkLibrary: result := 'tkLibrary';
|
||
tkLower: result := 'tkLower';
|
||
tkLowerEqual: result := 'tkLowerEqual';
|
||
tkMessage: result := 'tkMessage';
|
||
tkMinus: result := 'tkMinus';
|
||
tkMod: result := 'tkMod';
|
||
tkName: result := 'tkName';
|
||
tkNear: result := 'tkNear';
|
||
tkNil: result := 'tkNil';
|
||
tkNodefault: result := 'tkNodefault';
|
||
tkNone: result := 'tkNone';
|
||
tkNot: result := 'tkNot';
|
||
tkNotEqual: result := 'tkNotEqual';
|
||
tkNull: result := 'tkNull';
|
||
tkNumber: result := 'tkNumber';
|
||
tkObject: result := 'tkObject';
|
||
tkOf: result := 'tkOf';
|
||
tkOn: result := 'tkOn';
|
||
tkOr: result := 'tkOr';
|
||
tkOut: result := 'tkOut';
|
||
tkOverload: result := 'tkOverload';
|
||
tkOverride: result := 'tkOverride';
|
||
tkPacked: result := 'tkPacked';
|
||
tkPascal: result := 'tkPascal';
|
||
tkPlus: result := 'tkPlus';
|
||
tkPoint: result := 'tkPoint';
|
||
tkPointerSymbol: result := 'tkPointerSymbol';
|
||
tkPrivate: result := 'tkPrivate';
|
||
tkProcedure: result := 'tkProcedure';
|
||
tkProgram: result := 'tkProgram';
|
||
tkProperty: result := 'tkProperty';
|
||
tkProtected: result := 'tkProtected';
|
||
tkPublic: result := 'tkPublic';
|
||
tkPublished: result := 'tkPublished';
|
||
tkRaise: result := 'tkRaise';
|
||
tkRead: result := 'tkRead';
|
||
tkReadonly: result := 'tkReadonly';
|
||
tkRecord: result := 'tkRecord';
|
||
tkRegister: result := 'tkRegister';
|
||
tkReintroduce: result := 'tkReintroduce';
|
||
tkRepeat: result := 'tkRepeat';
|
||
tkResident: result := 'tkResident';
|
||
tkResourcestring: result := 'tkResourcestring';
|
||
tkRoundClose: result := 'tkRoundClose';
|
||
tkRoundOpen: result := 'tkRoundOpen';
|
||
tkSafecall: result := 'tkSafecall';
|
||
tkSemiColon: result := 'tkSemiColon';
|
||
tkSet: result := 'tkSet';
|
||
tkShl: result := 'tkShl';
|
||
tkShr: result := 'tkShr';
|
||
tkSlash: result := 'tkSlash';
|
||
tkSlashesComment: result := 'tkSlashesComment';
|
||
tkSquareClose: result := 'tkSquareClose';
|
||
tkSquareOpen: result := 'tkSquareOpen';
|
||
tkSpace: result := 'tkSpace';
|
||
tkStar: result := 'tkStar';
|
||
tkStdcall: result := 'tkStdcall';
|
||
tkStored: result := 'tkStored';
|
||
tkString: result := 'tkString';
|
||
tkStringresource: result := 'tkStringresource';
|
||
tkSymbol: result := 'tkSymbol';
|
||
tkThen: result := 'tkThen';
|
||
tkThreadvar: result := 'tkThreadvar';
|
||
tkTo: result := 'tkTo';
|
||
tkTry: result := 'tkTry';
|
||
tkType: result := 'tkType';
|
||
tkUnit: result := 'tkUnit';
|
||
tkUnknown: result := 'tkUnknown';
|
||
tkUntil: result := 'tkUntil';
|
||
tkUses: result := 'tkUses';
|
||
tkVar: result := 'tkVar';
|
||
tkVirtual: result := 'tkVirtual';
|
||
tkWhile: result := 'tkWhile';
|
||
tkWith: result := 'tkWith';
|
||
tkWrite: result := 'tkWrite';
|
||
tkWriteonly: result := 'tkWriteonly';
|
||
tkXor: Result := 'tkXor';
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.IdentProc;
|
||
begin
|
||
fTokenID:=IdentKind((fOrigin+Run));
|
||
Inc(Run, fStringLen);
|
||
while Identifiers[fOrigin[Run]]do Inc(Run);
|
||
end;
|
||
|
||
procedure TmwPasLex.IntegerProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkInteger;
|
||
while FOrigin[Run]in ['0'..'9', 'A'..'F', 'a'..'f']do Inc(Run);
|
||
end;
|
||
|
||
procedure TmwPasLex.LFProc;
|
||
begin
|
||
Case fComment of
|
||
csBor: fTokenID:=tkCRLFCo;
|
||
csAnsi: fTokenID:=tkCRLFCo;
|
||
else fTokenID:=tkCRLF;
|
||
end;
|
||
Inc(Run);
|
||
Inc(fLineNumber);
|
||
fLinePos:=Run;
|
||
end;
|
||
|
||
procedure TmwPasLex.LowerProc;
|
||
begin
|
||
case FOrigin[Run+1]of
|
||
'=':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkLowerEqual;
|
||
end;
|
||
'>':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkNotEqual;
|
||
end
|
||
else
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkLower;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.MinusProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkMinus;
|
||
end;
|
||
|
||
procedure TmwPasLex.NullProc;
|
||
begin
|
||
fTokenID:=tkNull;
|
||
end;
|
||
|
||
procedure TmwPasLex.NumberProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkNumber;
|
||
while FOrigin[Run]in ['0'..'9', '.', 'e', 'E']do
|
||
begin
|
||
case FOrigin[Run]of
|
||
'.':
|
||
if FOrigin[Run+1]='.' then Break else fTokenID:=tkFloat
|
||
end;
|
||
Inc(Run);
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.PlusProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkPlus;
|
||
end;
|
||
|
||
procedure TmwPasLex.PointerSymbolProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkPointerSymbol;
|
||
end;
|
||
|
||
procedure TmwPasLex.PointProc;
|
||
begin
|
||
case FOrigin[Run+1]of
|
||
'.':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkDotDot;
|
||
end;
|
||
')':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkSquareClose;
|
||
Dec(FSquareCount);
|
||
end;
|
||
else
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkPoint;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.RoundCloseProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkRoundClose;
|
||
Dec(FRoundCount);
|
||
end;
|
||
|
||
procedure TmwPasLex.AnsiProc;
|
||
begin
|
||
fTokenID:=tkAnsiComment;
|
||
case FOrigin[Run]of
|
||
#0:
|
||
begin
|
||
NullProc;
|
||
Exit;
|
||
end;
|
||
|
||
#10:
|
||
begin
|
||
LFProc;
|
||
Exit;
|
||
end;
|
||
|
||
#13:
|
||
begin
|
||
CRProc;
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
while fOrigin[Run]<>#0 do
|
||
case fOrigin[Run]of
|
||
'*':
|
||
if fOrigin[Run+1]=')' then
|
||
begin
|
||
fComment:=csNo;
|
||
Inc(Run, 2);
|
||
Break;
|
||
end else Inc(Run);
|
||
#10: Break;
|
||
|
||
#13: Break;
|
||
else Inc(Run);
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.RoundOpenProc;
|
||
begin
|
||
Inc(Run);
|
||
case fOrigin[Run]of
|
||
'*':
|
||
begin
|
||
fTokenID:=tkAnsiComment;
|
||
if FOrigin[Run+1]='$' then fTokenID:=tkCompDirect else fComment:=csAnsi;
|
||
Inc(Run);
|
||
while fOrigin[Run]<>#0 do
|
||
case fOrigin[Run]of
|
||
'*':
|
||
if fOrigin[Run+1]=')' then
|
||
begin
|
||
fComment:=csNo;
|
||
Inc(Run, 2);
|
||
Break;
|
||
end else Inc(Run);
|
||
#10: Break;
|
||
#13: Break;
|
||
else Inc(Run);
|
||
end;
|
||
end;
|
||
'.':
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSquareOpen;
|
||
Inc(FSquareCount);
|
||
end;
|
||
else
|
||
begin
|
||
FTokenID:=tkRoundOpen;
|
||
Inc(FRoundCount);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.SemiColonProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSemiColon;
|
||
end;
|
||
|
||
procedure TmwPasLex.SlashProc;
|
||
begin
|
||
case FOrigin[Run+1]of
|
||
'/':
|
||
begin
|
||
Inc(Run, 2);
|
||
fTokenID:=tkSlashesComment;
|
||
while FOrigin[Run]<>#0 do
|
||
begin
|
||
case FOrigin[Run]of
|
||
#10, #13: Break;
|
||
end;
|
||
Inc(Run);
|
||
end;
|
||
end;
|
||
else
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSlash;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TmwPasLex.SpaceProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSpace;
|
||
while FOrigin[Run]in [#1..#9, #11, #12, #14..#32]do Inc(Run);
|
||
end;
|
||
|
||
procedure TmwPasLex.SquareCloseProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSquareClose;
|
||
Dec(FSquareCount);
|
||
end;
|
||
|
||
procedure TmwPasLex.SquareOpenProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSquareOpen;
|
||
Inc(FSquareCount);
|
||
end;
|
||
|
||
procedure TmwPasLex.StarProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkStar;
|
||
end;
|
||
|
||
procedure TmwPasLex.StringProc;
|
||
begin
|
||
fTokenID:=tkString;
|
||
if(FOrigin[Run+1]=#39)and(FOrigin[Run+2]=#39)then Inc(Run, 2);
|
||
repeat
|
||
case FOrigin[Run]of
|
||
#0, #10, #13: Break;
|
||
end;
|
||
Inc(Run);
|
||
until FOrigin[Run]=#39;
|
||
if FOrigin[Run]<>#0 then Inc(Run);
|
||
end;
|
||
|
||
procedure TmwPasLex.SymbolProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkSymbol;
|
||
end;
|
||
|
||
procedure TmwPasLex.UnknownProc;
|
||
begin
|
||
Inc(Run);
|
||
fTokenID:=tkUnknown;
|
||
end;
|
||
|
||
procedure TmwPasLex.Next;
|
||
begin
|
||
Case fTokenID of
|
||
tkIdentifier:
|
||
begin
|
||
fLastIdentPos:=fTokenPos;
|
||
fLastNoSpace:=fTokenID;
|
||
fLastNoSpacePos:=fTokenPos;
|
||
end;
|
||
tkSpace: ;
|
||
else
|
||
begin
|
||
fLastNoSpace:=fTokenID;
|
||
fLastNoSpacePos:=fTokenPos;
|
||
end;
|
||
end;
|
||
fTokenPos:=Run;
|
||
Case fComment of
|
||
csNo: fProcTable[fOrigin[Run]];
|
||
else
|
||
Case fComment of
|
||
csBor: BorProc;
|
||
csAnsi: AnsiProc;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TmwPasLex.GetToken: string;
|
||
var
|
||
Len: Longint;
|
||
begin
|
||
Result := '';
|
||
Len:=Run-fTokenPos;
|
||
SetString(Result, (FOrigin+fTokenPos), Len);
|
||
end;
|
||
|
||
procedure TmwPasLex.NextID(ID: TTokenKind);
|
||
begin
|
||
repeat
|
||
Case fTokenID of
|
||
tkNull: Break;
|
||
else Next;
|
||
end;
|
||
until fTokenID=ID;
|
||
end;
|
||
|
||
procedure TmwPasLex.NextNoJunk;
|
||
begin
|
||
repeat
|
||
Next;
|
||
until not(fTokenID in [tkSlashesComment, tkAnsiComment, tkBorComment, tkCRLF, tkCRLFCo, tkSpace]);
|
||
end;
|
||
|
||
procedure TmwPasLex.NextClass;
|
||
begin
|
||
if fTokenID<>tkNull then next;
|
||
repeat
|
||
Case fTokenID of
|
||
tkNull: Break;
|
||
else Next;
|
||
end;
|
||
until(fTokenID=tkClass)and(IsClass);
|
||
end;
|
||
|
||
initialization
|
||
MakeIdentTable;
|
||
|
||
end.
|
||
|
||
|
||
|
||
|
||
|
||
|