moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-30 12:52:16 -05:00
Code Issues Releases Wiki Activity
script-manager-rework
Simba/Units/Misc/mPasLex.pas

1615 lines
43 KiB
ObjectPascal
Raw Permalink Normal View History

Nothing's changed? First git commit =D
2010-03-13 10:33:04 -05:00
{+--------------------------------------------------------------------------+
| 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.
Reference in New Issue Copy Permalink