mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-18 15:25:00 -05:00
2883 lines
70 KiB
ObjectPascal
2883 lines
70 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with the
|
|
License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/NPL/NPL-1_1Final.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: mwPasLex.PAS, released August 17, 1999.
|
|
|
|
The Initial Developer of the Original Code is Martin Waldenburg
|
|
(Martin.Waldenburg@T-Online.de).
|
|
Portions created by Martin Waldenburg are Copyright (C) 1998, 1999 Martin
|
|
Waldenburg.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): James Jacobson _____________________________________.
|
|
|
|
Last Modified: mm/dd/yyyy
|
|
Current Version: 2.2
|
|
|
|
Notes: This program is a very fast Pascal tokenizer. I'd like to invite the
|
|
Delphi community to develop it further and to create a fully featured Object
|
|
Pascal parser.
|
|
|
|
Modification history:
|
|
|
|
Daniel Rolf between 20010723 and 20020116
|
|
|
|
Made ready for Delphi 6
|
|
|
|
platform
|
|
deprecated
|
|
varargs
|
|
local
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
|
|
unit CastaliaPasLex;
|
|
|
|
{$include ValistusDefines.inc}
|
|
{$IFDEF FPC}
|
|
{$mode delphi}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
//!! pruned uses
|
|
SysUtils, Classes, Controls, CastaliaPasLexTypes;
|
|
|
|
var
|
|
Identifiers: array[#0..#255] of ByteBool;
|
|
mHashTable: array[#0..#255] of Integer;
|
|
|
|
type
|
|
TmwBasePasLex = class;
|
|
TDirectiveEvent = procedure(Sender: TmwBasePasLex) of object;
|
|
|
|
PDefineRec = ^TDefineRec;
|
|
TDefineRec = record
|
|
Defined: Boolean;
|
|
StartCount: Integer;
|
|
Next: PDefineRec;
|
|
end;
|
|
TDefineRecArray = array of TDefineRec;
|
|
|
|
TSaveDefinesRec = record
|
|
RecArray: TDefineRecArray;
|
|
Stack: Integer;
|
|
Defines: string;
|
|
end;
|
|
|
|
TmwBasePasLex = class(TObject)
|
|
private
|
|
fCommentState: TCommentState;
|
|
fOrigin: PAnsiChar;
|
|
fProcTable: array[#0..#255] of procedure of object;
|
|
Run: Integer;
|
|
RunAhead: Integer;
|
|
TempRun: Integer;
|
|
fIdentFuncTable: array[0..191] of function: TptTokenKind of object;
|
|
fTokenPos: Integer;
|
|
fLineNumber: Integer;
|
|
FTokenID: TptTokenKind;
|
|
fLinePos: Integer;
|
|
fExID: TptTokenKind;
|
|
FOnMessage: TMessageEvent;
|
|
fOnCompDirect: TDirectiveEvent;
|
|
fOnElseDirect: TDirectiveEvent;
|
|
fOnEndIfDirect: TDirectiveEvent;
|
|
fOnIfDefDirect: TDirectiveEvent;
|
|
fOnIfNDefDirect: TDirectiveEvent;
|
|
fOnResourceDirect: TDirectiveEvent;
|
|
fOnIncludeDirect: TDirectiveEvent;
|
|
fOnDefineDirect: TDirectiveEvent;
|
|
fOnIfOptDirect: TDirectiveEvent;
|
|
fOnIfDirect: TDirectiveEvent;
|
|
fOnIfEndDirect: TDirectiveEvent;
|
|
fOnElseIfDirect: TDirectiveEvent;
|
|
fOnUnDefDirect: TDirectiveEvent;
|
|
FDirectiveParamOrigin: PAnsiChar;
|
|
|
|
fAsmCode : Boolean; // DR 2002-01-14
|
|
|
|
FDefines: TStrings;
|
|
FDefineStack: Integer;
|
|
FTopDefineRec: PDefineRec;
|
|
FUseDefines: Boolean;
|
|
|
|
function KeyHash: Integer;
|
|
function KeyComp(const aKey: string): Boolean;
|
|
function Func9: tptTokenKind;
|
|
function Func15: TptTokenKind;
|
|
function Func19: TptTokenKind;
|
|
function Func20: TptTokenKind;
|
|
function Func21: TptTokenKind;
|
|
function Func23: TptTokenKind;
|
|
function Func25: TptTokenKind;
|
|
function Func27: TptTokenKind;
|
|
function Func28: TptTokenKind;
|
|
function Func29: TptTokenKind;
|
|
function Func30: TptTokenKind;
|
|
function Func32: TptTokenKind;
|
|
function Func33: TptTokenKind;
|
|
function Func35: TptTokenKind;
|
|
function Func36: TptTokenKind;
|
|
function Func37: TptTokenKind;
|
|
function Func38: TptTokenKind;
|
|
function Func39: TptTokenKind;
|
|
function Func40: TptTokenKind;
|
|
function Func41: TptTokenKind;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
function Func42: TptTokenKind;
|
|
{$ENDIF}
|
|
function Func43: TptTokenKind;
|
|
function Func44: TptTokenKind;
|
|
function Func45: TptTokenKind;
|
|
function Func46: TptTokenKind;
|
|
function Func47: TptTokenKind;
|
|
function Func49: TptTokenKind;
|
|
function Func52: TptTokenKind;
|
|
function Func54: TptTokenKind;
|
|
function Func55: TptTokenKind;
|
|
function Func56: TptTokenKind;
|
|
function Func57: TptTokenKind;
|
|
function Func58: TptTokenKind;
|
|
function Func59: TptTokenKind;
|
|
function Func60: TptTokenKind;
|
|
function Func61: TptTokenKind;
|
|
function Func62: TptTokenKind;
|
|
function Func63: TptTokenKind;
|
|
function Func64: TptTokenKind;
|
|
function Func65: TptTokenKind;
|
|
function Func66: TptTokenKind;
|
|
function Func69: TptTokenKind;
|
|
function Func71: TptTokenKind;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
function Func72: TptTokenKind;
|
|
{$ENDIF}
|
|
function Func73: TptTokenKind;
|
|
function Func75: TptTokenKind;
|
|
function Func76: TptTokenKind;
|
|
function Func78: TptTokenKind;
|
|
function Func79: TptTokenKind;
|
|
function Func81: TptTokenKind;
|
|
function Func84: TptTokenKind;
|
|
function Func85: TptTokenKind;
|
|
function Func86: TptTokenKind;
|
|
function Func87: TptTokenKind;
|
|
function Func88: TptTokenKind;
|
|
{$IFDEF D8_NEWER}
|
|
function Func89: TptTokenKind; //JThurman 2004-03-03
|
|
{$ENDIF}
|
|
function Func91: TptTokenKind;
|
|
function Func92: TptTokenKind;
|
|
function Func94: TptTokenKind;
|
|
function Func95: TptTokenKind;
|
|
function Func96: TptTokenKind;
|
|
function Func97: TptTokenKind;
|
|
function Func98: TptTokenKind;
|
|
function Func99: TptTokenKind;
|
|
function Func100: TptTokenKind;
|
|
function Func101: TptTokenKind;
|
|
function Func102: TptTokenKind;
|
|
function Func103: TptTokenKind;
|
|
function Func104: TptTokenKind;
|
|
function Func105: TptTokenKind;
|
|
function Func106: TptTokenKind;
|
|
function Func107: TptTokenKind;
|
|
function Func108: TptTokenKind;
|
|
function Func112: TptTokenKind;
|
|
function Func117: TptTokenKind;
|
|
function Func123: TptTokenKind;
|
|
function Func126: TptTokenKind;
|
|
function Func127: TptTokenKind;
|
|
function Func128: TptTokenKind;
|
|
function Func129: TptTokenKind;
|
|
function Func130: TptTokenKind;
|
|
function Func132: TptTokenKind;
|
|
function Func133: TptTokenKind;
|
|
function Func136: TptTokenKind;
|
|
function Func141: TptTokenKind;
|
|
function Func143: TptTokenKind;
|
|
function Func166: TptTokenKind;
|
|
function Func167: TptTokenKind;
|
|
function Func168: TptTokenKind;
|
|
function Func191: TptTokenKind;
|
|
function AltFunc: TptTokenKind;
|
|
procedure InitIdent;
|
|
function GetPosXY: TTokenPoint; // !! changed to TokenPoint //jdj 7/18/1999
|
|
function IdentKind: TptTokenKind;
|
|
procedure SetRunPos(Value: Integer);
|
|
procedure MakeMethodTables;
|
|
procedure AddressOpProc;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-04-06
|
|
procedure AmpersandOpProc;
|
|
{$ENDIF}
|
|
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 StringDQProc;
|
|
procedure SymbolProc;
|
|
procedure UnknownProc;
|
|
function GetToken: string;
|
|
function GetTokenLen: Integer;
|
|
function GetCommentState: Pointer;
|
|
function GetCompilerDirective: string;
|
|
procedure SetCommentState(const Value: Pointer);
|
|
procedure InitLine;
|
|
function GetDirectiveKind: TptTokenKind;
|
|
function GetDirectiveParam: string;
|
|
function GetStringContent: string;
|
|
function GetIsJunk: Boolean;
|
|
function GetIsSpace: Boolean;
|
|
function GetIsOrdIdent: Boolean;
|
|
function GetIsRealType: Boolean;
|
|
function GetIsStringType: Boolean;
|
|
function GetIsVarantType: Boolean;
|
|
function GetIsAddOperator: Boolean;
|
|
function GetIsMulOperator: Boolean;
|
|
function GetIsRelativeOperator: Boolean;
|
|
function GetIsCompilerDirective: Boolean;
|
|
function GetIsOrdinalType: Boolean;
|
|
function GetGenID: TptTokenKind;procedure SetOnElseIfDirect(const Value: TDirectiveEvent);
|
|
|
|
function IsDefined(const ADefine: string): Boolean;
|
|
procedure EnterDefineBlock(ADefined: Boolean);
|
|
procedure ExitDefineBlock;
|
|
|
|
procedure DoProcTable(AChar: AnsiChar);
|
|
function IsIdentifiers(AChar: AnsiChar): Boolean;
|
|
function HashValue(AChar: AnsiChar): Integer;
|
|
protected
|
|
procedure SetLine(const Value: AnsiString); virtual;
|
|
procedure SetOrigin(NewValue: PAnsiChar); virtual;
|
|
procedure SetOnCompDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnDefineDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnElseDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnEndIfDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIfDefDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIfOptDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIncludeDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnResourceDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnUnDefDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIfDirect(const Value: TDirectiveEvent); virtual;
|
|
procedure SetOnIfEndDirect(const Value: TDirectiveEvent); virtual;
|
|
|
|
public
|
|
MaxPos: Integer;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function CharAhead: AnsiChar;
|
|
procedure Next;
|
|
procedure NextID(ID: TptTokenKind);
|
|
procedure NextNoJunk;
|
|
procedure NextNoSpace;
|
|
procedure Init;
|
|
procedure InitFrom(ALexer: TmwBasePasLex);
|
|
function FirstInLine: Boolean;
|
|
|
|
procedure AddDefine(const ADefine: string);
|
|
procedure RemoveDefine(const ADefine: string);
|
|
procedure ClearDefines;
|
|
procedure InitDefines;
|
|
procedure CloneDefinesFrom(ALexer: TmwBasePasLex);
|
|
function SaveDefines: TSaveDefinesRec;
|
|
procedure LoadDefines(From: TSaveDefinesRec);
|
|
|
|
property CommentState: Pointer read GetCommentState write SetCommentState;
|
|
property CompilerDirective: string read GetCompilerDirective;
|
|
property DirectiveParam: string read GetDirectiveParam;
|
|
property IsJunk: Boolean read GetIsJunk;
|
|
property IsSpace: Boolean read GetIsSpace;
|
|
property Line: AnsiString write SetLine;
|
|
//Note: setting the following two properties does not GO to that line, it just sets the internal counters
|
|
property LineNumber: Integer read fLineNumber write fLineNumber;
|
|
property LinePos: Integer read fLinePos write fLinePos;
|
|
property Origin: PAnsiChar read fOrigin write SetOrigin;
|
|
property PosXY: TTokenPoint read GetPosXY; // !! changed to TokenPoint //jdj 7/18/1999
|
|
property RunPos: Integer read Run write SetRunPos;
|
|
property Token: string read GetToken;
|
|
property TokenLen: Integer read GetTokenLen;
|
|
property TokenPos: Integer read fTokenPos;
|
|
property TokenID: TptTokenKind read FTokenID;
|
|
property ExID: TptTokenKind read fExID;
|
|
property GenID: TptTokenKind read GetGenID;
|
|
property StringContent: string read GetStringContent;
|
|
property IsOrdIdent: Boolean read GetIsOrdIdent;
|
|
property IsOrdinalType: Boolean read GetIsOrdinalType;
|
|
property IsRealType: Boolean read GetIsRealType;
|
|
property IsStringType: Boolean read GetIsStringType;
|
|
property IsVariantType: Boolean read GetIsVarantType;
|
|
property IsRelativeOperator: Boolean read GetIsRelativeOperator;
|
|
property IsAddOperator: Boolean read GetIsAddOperator;
|
|
property IsMulOperator: Boolean read GetIsMulOperator;
|
|
property IsCompilerDirective: Boolean read GetIsCompilerDirective;
|
|
property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
|
|
property OnCompDirect: TDirectiveEvent read fOnCompDirect write SetOnCompDirect;
|
|
property OnDefineDirect: TDirectiveEvent read fOnDefineDirect write SetOnDefineDirect;
|
|
property OnElseDirect: TDirectiveEvent read fOnElseDirect write SetOnElseDirect;
|
|
property OnEndIfDirect: TDirectiveEvent read fOnEndIfDirect write SetOnEndIfDirect;
|
|
property OnIfDefDirect: TDirectiveEvent read fOnIfDefDirect write SetOnIfDefDirect;
|
|
property OnIfNDefDirect: TDirectiveEvent read fOnIfNDefDirect write SetOnIfNDefDirect;
|
|
property OnIfOptDirect: TDirectiveEvent read fOnIfOptDirect write SetOnIfOptDirect;
|
|
property OnIncludeDirect: TDirectiveEvent read fOnIncludeDirect write SetOnIncludeDirect;
|
|
property OnIfDirect: TDirectiveEvent read fOnIfDirect write SetOnIfDirect;
|
|
property OnIfEndDirect: TDirectiveEvent read fOnIfEndDirect write
|
|
SetOnIfEndDirect;
|
|
property OnElseIfDirect: TDirectiveEvent read fOnElseIfDirect write
|
|
SetOnElseIfDirect;
|
|
property OnResourceDirect: TDirectiveEvent read fOnResourceDirect write SetOnResourceDirect;
|
|
property OnUnDefDirect: TDirectiveEvent read fOnUnDefDirect write SetOnUnDefDirect;
|
|
|
|
property AsmCode : Boolean read fAsmCode write fAsmCode; // DR 2002-01-14
|
|
property DirectiveParamOrigin: PAnsiChar read FDirectiveParamOrigin;
|
|
|
|
property UseDefines: Boolean read FUseDefines write FUseDefines;
|
|
|
|
property Defines: TStrings read FDefines;
|
|
end;
|
|
|
|
TmwPasLex = class(TmwBasePasLex)
|
|
private
|
|
fAheadLex: TmwBasePasLex;
|
|
function GetAheadExID: TptTokenKind;
|
|
function GetAheadGenID: TptTokenKind;
|
|
function GetAheadToken: string;
|
|
function GetAheadTokenID: TptTokenKind;
|
|
function GetStatus: TmwPasLexStatus;
|
|
procedure SetStatus(const Value: TmwPasLexStatus);
|
|
protected
|
|
procedure SetLine(const Value: AnsiString); override;
|
|
procedure SetOrigin(NewValue: PAnsiChar); override;
|
|
procedure SetOnCompDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnDefineDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnElseDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnEndIfDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnIfDefDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnIfOptDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnIncludeDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnResourceDirect(const Value: TDirectiveEvent); override;
|
|
procedure SetOnUnDefDirect(const Value: TDirectiveEvent); override;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure InitAhead;
|
|
procedure AheadNext;
|
|
property AheadLex: TmwBasePasLex read fAheadLex;
|
|
property AheadToken: string read GetAheadToken;
|
|
property AheadTokenID: TptTokenKind read GetAheadTokenID;
|
|
property AheadExID: TptTokenKind read GetAheadExID;
|
|
property AheadGenID: TptTokenKind read GetAheadGenID;
|
|
property Status: TmwPasLexStatus read GetStatus write SetStatus;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$IFNDEF LCL}
|
|
uses Windows;
|
|
{$ENDIF}
|
|
|
|
procedure MakeIdentTable;
|
|
var
|
|
I, J: AnsiChar;
|
|
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 := AnsiString(UpCase(I))[1];
|
|
case I of
|
|
'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64;
|
|
'0'..'9': mHashTable[I] := Ord(J) - 47;
|
|
else mHashTable[Char(I)] := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.CharAhead: AnsiChar;
|
|
begin
|
|
RunAhead := Run;
|
|
// while fOrigin[RunAhead] in [#1..#32] do
|
|
while (fOrigin[RunAhead] > #0) and (fOrigin[RunAhead] < #33) do
|
|
|
|
inc(RunAhead);
|
|
Result := fOrigin[RunAhead];
|
|
end;
|
|
|
|
procedure TmwBasePasLex.ClearDefines;
|
|
var
|
|
Frame: PDefineRec;
|
|
begin
|
|
while FTopDefineRec <> nil do
|
|
begin
|
|
Frame := FTopDefineRec;
|
|
FTopDefineRec := Frame^.Next;
|
|
Dispose(Frame);
|
|
end;
|
|
FDefines.Clear;
|
|
FDefineStack := 0;
|
|
FTopDefineRec := nil;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.CloneDefinesFrom(ALexer: TmwBasePasLex);
|
|
var
|
|
Frame, LastFrame, SourceFrame: PDefineRec;
|
|
begin
|
|
ClearDefines;
|
|
FDefines.Assign(ALexer.FDefines);
|
|
FDefineStack := ALexer.FDefineStack;
|
|
|
|
Frame := nil;
|
|
LastFrame := nil;
|
|
SourceFrame := ALexer.FTopDefineRec;
|
|
while SourceFrame <> nil do
|
|
begin
|
|
New(Frame);
|
|
if FTopDefineRec = nil then
|
|
FTopDefineRec := Frame
|
|
else
|
|
LastFrame^.Next := Frame;
|
|
Frame^.Defined := SourceFrame^.Defined;
|
|
Frame^.StartCount := SourceFrame^.StartCount;
|
|
LastFrame := Frame;
|
|
|
|
SourceFrame := SourceFrame^.Next;
|
|
end;
|
|
if Frame <> nil then
|
|
Frame^.Next := nil;
|
|
end;
|
|
|
|
function TmwBasePasLex.SaveDefines: TSaveDefinesRec;
|
|
var
|
|
Frame: PDefineRec;
|
|
begin
|
|
Result.Defines := FDefines.CommaText;
|
|
Result.Stack := FDefineStack;
|
|
|
|
Frame := FTopDefineRec;
|
|
while (Frame <> nil) do
|
|
begin
|
|
SetLength(Result.RecArray, Length(Result.RecArray) + 1);
|
|
Result.RecArray[High(Result.RecArray)] := Frame^;
|
|
Result.RecArray[High(Result.RecArray)].Next := nil;
|
|
Frame := Frame^.Next;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.LoadDefines(From: TSaveDefinesRec);
|
|
var
|
|
Frame, LastFrame: PDefineRec;
|
|
i: Integer;
|
|
begin
|
|
ClearDefines;
|
|
FDefines.CommaText := From.Defines;
|
|
FDefineStack := From.Stack;
|
|
|
|
Frame := nil;
|
|
LastFrame := nil;
|
|
for i := 0 to High(From.RecArray) do
|
|
begin
|
|
New(Frame);
|
|
if (i = 0) then
|
|
FTopDefineRec := Frame
|
|
else
|
|
LastFrame^.Next := Frame;
|
|
|
|
Frame^ := From.RecArray[i];
|
|
LastFrame := Frame;
|
|
end;
|
|
|
|
if (Frame <> nil) then
|
|
Frame^.Next := nil;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetPosXY: TTokenPoint;
|
|
begin //jdj 7/18/1999
|
|
// !! changed setting code
|
|
Result.X:= FTokenPos - FLinePos;
|
|
Result.Y:= FLineNumber;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.InitIdent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to 191 do
|
|
case I of
|
|
{$IFDEF D8_NEWER}
|
|
9: fIdentFuncTable[I] := Func9;
|
|
{$ENDIF}
|
|
15: fIdentFuncTable[I] := Func15;
|
|
19: fIdentFuncTable[I] := Func19;
|
|
20: fIdentFuncTable[I] := Func20;
|
|
21: fIdentFuncTable[I] := Func21;
|
|
23: fIdentFuncTable[I] := Func23;
|
|
25: fIdentFuncTable[I] := Func25;
|
|
27: fIdentFuncTable[I] := Func27;
|
|
28: fIdentFuncTable[I] := Func28;
|
|
29: fIdentFuncTable[I] := Func29;
|
|
30: fIdentFuncTable[I] := Func30;
|
|
32: fIdentFuncTable[I] := Func32;
|
|
33: fIdentFuncTable[I] := Func33;
|
|
35: fIdentFuncTable[I] := Func35;
|
|
36: fIdentFuncTable[I] := Func36;
|
|
37: fIdentFuncTable[I] := Func37;
|
|
38: fIdentFuncTable[I] := Func38;
|
|
39: fIdentFuncTable[I] := Func39;
|
|
40: fIdentFuncTable[I] := Func40;
|
|
41: fIdentFuncTable[I] := Func41;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
42: fIdentFuncTable[I] := Func42;
|
|
{$ENDIF}
|
|
43: fIdentFuncTable[I] := Func43;
|
|
44: fIdentFuncTable[I] := Func44;
|
|
45: fIdentFuncTable[I] := Func45;
|
|
46: fIdentFuncTable[I] := Func46;
|
|
47: fIdentFuncTable[I] := Func47;
|
|
49: fIdentFuncTable[I] := Func49;
|
|
52: fIdentFuncTable[I] := Func52;
|
|
54: fIdentFuncTable[I] := Func54;
|
|
55: fIdentFuncTable[I] := Func55;
|
|
56: fIdentFuncTable[I] := Func56;
|
|
57: fIdentFuncTable[I] := Func57;
|
|
58: fIdentFuncTable[I] := Func58;
|
|
59: fIdentFuncTable[I] := Func59;
|
|
60: fIdentFuncTable[I] := Func60;
|
|
61: fIdentFuncTable[I] := Func61;
|
|
62: fIdentFuncTable[I] := Func62;
|
|
63: fIdentFuncTable[I] := Func63;
|
|
64: fIdentFuncTable[I] := Func64;
|
|
65: fIdentFuncTable[I] := Func65;
|
|
66: fIdentFuncTable[I] := Func66;
|
|
69: fIdentFuncTable[I] := Func69;
|
|
71: fIdentFuncTable[I] := Func71;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
72: fIdentFuncTable[I] := Func72;
|
|
{$ENDIF}
|
|
73: fIdentFuncTable[I] := Func73;
|
|
75: fIdentFuncTable[I] := Func75;
|
|
76: fIdentFuncTable[I] := Func76;
|
|
78: fIdentFuncTable[I] := Func78;
|
|
79: fIdentFuncTable[I] := Func79;
|
|
81: fIdentFuncTable[I] := Func81;
|
|
84: fIdentFuncTable[I] := Func84;
|
|
85: fIdentFuncTable[I] := Func85;
|
|
86: fIdentFuncTable[I] := Func86;
|
|
87: fIdentFuncTable[I] := Func87;
|
|
88: fIdentFuncTable[I] := Func88;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-03
|
|
89: fIdentFuncTable[I] := Func89;
|
|
{$ENDIF}
|
|
91: fIdentFuncTable[I] := Func91;
|
|
92: fIdentFuncTable[I] := Func92;
|
|
94: fIdentFuncTable[I] := Func94;
|
|
95: fIdentFuncTable[I] := Func95;
|
|
96: fIdentFuncTable[I] := Func96;
|
|
97: fIdentFuncTable[I] := Func97;
|
|
98: fIdentFuncTable[I] := Func98;
|
|
99: fIdentFuncTable[I] := Func99;
|
|
100: fIdentFuncTable[I] := Func100;
|
|
101: fIdentFuncTable[I] := Func101;
|
|
102: fIdentFuncTable[I] := Func102;
|
|
103: fIdentFuncTable[I] := Func103;
|
|
104: fIdentFuncTable[I] := Func104;
|
|
105: fIdentFuncTable[I] := Func105;
|
|
106: fIdentFuncTable[I] := Func106;
|
|
107: fIdentFuncTable[I] := Func107;
|
|
108: fIdentFuncTable[I] := Func108;
|
|
112: fIdentFuncTable[I] := Func112;
|
|
117: fIdentFuncTable[I] := Func117;
|
|
123: fIdentFuncTable[I] := Func123;
|
|
126: fIdentFuncTable[I] := Func126;
|
|
127: fIdentFuncTable[I] := Func127;
|
|
128: fIdentFuncTable[I] := Func128;
|
|
129: fIdentFuncTable[I] := Func129;
|
|
130: fIdentFuncTable[I] := Func130;
|
|
132: fIdentFuncTable[I] := Func132;
|
|
133: fIdentFuncTable[I] := Func133;
|
|
136: fIdentFuncTable[I] := Func136;
|
|
141: fIdentFuncTable[I] := Func141;
|
|
143: fIdentFuncTable[I] := Func143;
|
|
166: fIdentFuncTable[I] := Func166;
|
|
167: fIdentFuncTable[I] := Func167;
|
|
168: fIdentFuncTable[I] := Func168;
|
|
191: fIdentFuncTable[I] := Func191;
|
|
else fIdentFuncTable[I] := AltFunc;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.KeyHash: Integer;
|
|
begin
|
|
Result := 0;
|
|
while IsIdentifiers(fOrigin[Run]) do
|
|
begin
|
|
Inc(Result, HashValue(fOrigin[Run]));
|
|
//inc(Result, mHashTable[fOrigin[Run]]);
|
|
inc(Run);
|
|
end;
|
|
end; { KeyHash }
|
|
|
|
function TmwBasePasLex.KeyComp(const aKey: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
Temp: PAnsiChar;
|
|
begin
|
|
if Length(aKey) = TokenLen then
|
|
begin
|
|
Temp := fOrigin + fTokenPos;
|
|
Result := True;
|
|
for i := 1 to TokenLen do
|
|
begin
|
|
if mHashTable[Temp^] <> mHashTable[aKey[i]] then
|
|
begin
|
|
Result := False;
|
|
break;
|
|
end;
|
|
inc(Temp);
|
|
end;
|
|
end
|
|
else Result := False;
|
|
end; { KeyComp }
|
|
|
|
function TmwBasePasLex.Func9: tptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Add') then
|
|
FExID := tokAdd;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func15: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('If') then Result := tokIf;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func19: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Do') then Result := tokDo else
|
|
if KeyComp('And') then Result := tokAnd;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func20: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('As') then Result := tokAs;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func21: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Of') then Result := tokOf else
|
|
if KeyComp('At') then fExID := tokAt;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func23: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('End') then Result := tokEnd else
|
|
if KeyComp('In') then Result := tokIn;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func25: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Far') then fExID := tokFar;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func27: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Cdecl') then fExID := tokCdecl;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func28: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Read') then fExID := tokRead else
|
|
if KeyComp('Case') then Result := tokCase else
|
|
if KeyComp('Is') then Result := tokIs;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func29: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('On') then fExID := tokOn;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func30: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Char') then fExID := tokChar;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func32: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('File') then Result := tokFile else
|
|
if KeyComp('Label') then Result := tokLabel else
|
|
if KeyComp('Mod') then Result := tokMod;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func33: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Or') then Result := tokOr else
|
|
if KeyComp('Name') then fExID := tokName else
|
|
if KeyComp('Asm') then Result := tokAsm;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func35: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Nil') then Result := tokNil else
|
|
if KeyComp('To') then Result := tokTo else
|
|
if KeyComp('Div') then Result := tokDiv;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func36: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Real') then fExID := tokReal else
|
|
if KeyComp('Real48') then fExID := tokReal48;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func37: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Begin') then Result := tokBegin else
|
|
if KeyComp('Break') then fExID := tokBreak;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func38: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Near') then fExID := tokNear;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func39: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('For') then Result := tokFor else
|
|
if KeyComp('Shl') then Result := tokShl;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func40: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Packed') then Result := tokPacked;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func41: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Var') then Result := tokVar else
|
|
if KeyComp('Else') then Result := tokElse else
|
|
if KeyComp('Halt') then fExID := tokHalt;
|
|
end;
|
|
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
function TmwBasePasLex.Func42: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Final') then
|
|
fExID := tokFinal; //TODO: Is this supposed to be an ExID?
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TmwBasePasLex.Func43: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Int64') then fExID := tokInt64
|
|
else if KeyComp('local') then fExID := tokLocal;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func44: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Set') then Result := tokSet else
|
|
if KeyComp('Package') then fExID := tokPackage;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func45: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Shr') then Result := tokShr;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func46: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('PChar') then fExId := tokPChar
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-19
|
|
else
|
|
if KeyComp('Sealed') then Result := tokSealed;
|
|
{$ELSE}
|
|
;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TmwBasePasLex.Func47: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Then') then Result := tokThen else
|
|
if KeyComp('Comp') then fExID := tokComp;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func49: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Not') then Result := tokNot;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func52: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Byte') then fExID := tokByte else
|
|
if KeyComp('Raise') then Result := tokRaise else
|
|
if KeyComp('Pascal') then fExID := tokPascal;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func54: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Class') then Result := tokClass;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func55: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Object') then Result := tokObject;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func56: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Index') then fExID := tokIndex else
|
|
if KeyComp('Out') then fExID := tokOut else // bug in Delphi's documentation: OUT is a directive
|
|
if KeyComp('Abort') then fExID := tokAbort;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func57: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('While') then Result := tokWhile else
|
|
if KeyComp('Xor') then Result := tokXor else
|
|
if KeyComp('Goto') then Result := tokGoto;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func58: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Exit') then fExID := tokExit;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func59: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Safecall') then fExID := tokSafecall else
|
|
if KeyComp('Double') then fExID := tokDouble;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func60: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('With') then Result := tokWith else
|
|
if KeyComp('Word') then fExID := tokWord;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func61: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Dispid') then fExID := tokDispid;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func62: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Cardinal') then fExID := tokCardinal;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func63: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
case fOrigin[fTokenPos] of
|
|
'P', 'p': if KeyComp('Public') then fExID := tokPublic;
|
|
'A', 'a': if KeyComp('Array') then Result := tokArray;
|
|
'T', 't': if KeyComp('Try') then Result := tokTry;
|
|
'R', 'r': if KeyComp('Record') then Result := tokRecord;
|
|
'I', 'i': if KeyComp('Inline') then
|
|
begin
|
|
Result := tokInline;
|
|
fExID := tokInline;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func64: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
case fOrigin[fTokenPos] of
|
|
'B', 'b': if KeyComp('Boolean') then fExID := tokBoolean;
|
|
'D', 'd': if KeyComp('DWORD') then fExID := tokDWORD;
|
|
'U', 'u': if KeyComp('Uses') then Result := tokUses
|
|
else
|
|
if KeyComp('Unit') then Result := tokUnit;
|
|
{$IFDEF D8_NEWER}
|
|
'H', 'h': if KeyComp('Helper') then fExID := tokHelper;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func65: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Repeat') then Result := tokRepeat;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func66: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Single') then fExID := tokSingle else
|
|
if KeyComp('Type') then Result := tokType
|
|
{$IFDEF D8_NEWER}//JThurman 2004-03-23
|
|
else
|
|
if KeyComp('Unsafe') then Result := tokUnsafe
|
|
{$ENDIF}
|
|
;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func69: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Default') then fExID := tokDefault else
|
|
if KeyComp('Dynamic') then fExID := tokDynamic else
|
|
if KeyComp('Message') then fExID := tokMessage;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func71: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('WideChar') then fExID := tokWideChar else
|
|
if KeyComp('Stdcall') then fExID := tokStdcall else
|
|
if KeyComp('Const') then Result := tokConst;
|
|
end;
|
|
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
|
|
function TmwBasePasLex.Func72: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Static') then
|
|
fExID := tokStatic;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TmwBasePasLex.Func73: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Except') then Result := tokExcept;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func75: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Write') then fExID := tokWrite;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func76: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Until') then Result := tokUntil;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func78: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Integer') then fExID := tokInteger
|
|
{$IFDEF D8_NEWER}
|
|
else if KeyComp('Remove') then
|
|
FExID := tokRemove
|
|
{$ENDIF}
|
|
;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func79: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Finally') then Result := tokFinally
|
|
{$IFDEF D12_NEWER}
|
|
else if KeyComp('Reference') then fExID := tokReference;
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
function TmwBasePasLex.Func81: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Extended') then fExID := tokExtended else
|
|
if KeyComp('Stored') then fExID := tokStored else
|
|
if KeyComp('Interface') then Result := tokInterface
|
|
else if KeyComp('Deprecated') then fExID := tokDeprecated; // DR 2001-10-20
|
|
end;
|
|
|
|
function TmwBasePasLex.Func84: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Abstract') then fExID := tokAbstract;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func85: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Library') then Result := tokLibrary else
|
|
if KeyComp('Forward') then fExID := tokForward else
|
|
if KeyComp('Variant') then fExID := tokVariant;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func87: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('String') then Result := tokString;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func88: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Program') then Result := tokProgram;
|
|
end;
|
|
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-03
|
|
function TmwBasePasLex.Func89: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Strict') then Result := tokStrict;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TmwBasePasLex.Func91: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Downto') then Result := tokDownto else
|
|
if KeyComp('Private') then fExID := tokPrivate else
|
|
if KeyComp('Longint') then fExID := tokLongint;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func92: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Inherited') then Result := tokInherited else
|
|
if KeyComp('LongBool') then fExID := tokLongBool else
|
|
if KeyComp('Overload') then fExID := tokOverload;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func94: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Resident') then fExID := tokResident else
|
|
if KeyComp('Readonly') then fExID := tokReadonly else
|
|
if KeyComp('Assembler') then fExID := tokAssembler;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func95: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Contains') then fExID := tokContains else
|
|
if KeyComp('Absolute') then fExID := tokAbsolute;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func96: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('ByteBool') then fExID := tokByteBool else
|
|
if KeyComp('Override') then fExID := tokOverride else
|
|
if KeyComp('Published') then fExID := tokPublished;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func97: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Threadvar') then Result := tokThreadvar;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func98: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Export') then fExID := tokExport else
|
|
if KeyComp('Nodefault') then fExID := tokNodefault;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func99: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('External') then fExID := tokExternal;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func100: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Automated') then fExID := tokAutomated else
|
|
if KeyComp('Smallint') then fExID := tokSmallint;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func101: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Register') then fExID := tokRegister
|
|
else if KeyComp('Platform') then fExID := tokPlatform // DR 2001-10-20
|
|
else if KeyComp('Continue') then fExID := tokContinue;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func102: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Function') then Result := tokFunction;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func103: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Virtual') then fExID := tokVirtual;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func104: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('WordBool') then fExID := tokWordBool;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func105: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Procedure') then Result := tokProcedure;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func106: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Protected') then fExID := tokProtected;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func107: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Currency') then fExID := tokCurrency;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func108: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Longword') then fExID := tokLongword;
|
|
{$IFDEF D8_NEWER} //JThurman 2004-03-20
|
|
if KeyComp('Operator') then fExID := tokOperator;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TmwBasePasLex.Func112: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Requires') then fExID := tokRequires;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func117: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Exports') then Result := tokExports else
|
|
if KeyComp('OleVariant') then fExID := tokOleVariant;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func123: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Shortint') then fExID := tokShortint;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func126: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Implements') then fExID := tokImplements;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func127: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Runerror') then fExID := tokRunError;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func128: TptTokenKind;
|
|
begin
|
|
if KeyComp('WideString') then fExID := tokWideString;
|
|
Result := tokIdentifier;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func129: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Dispinterface') then Result := tokDispinterface
|
|
end;
|
|
|
|
function TmwBasePasLex.Func130: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('AnsiString') then fExID := tokAnsiString;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func132: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Reintroduce') then fExID := tokReintroduce;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func133: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Property') then Result := tokProperty;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func136: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Finalization') then Result := tokFinalization;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func141: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Writeonly') then fExID := tokWriteonly;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func143: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Destructor') then Result := tokDestructor;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func166: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Constructor') then Result := tokConstructor else
|
|
if KeyComp('Implementation') then Result := tokImplementation;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func167: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('ShortString') then fExID := tokShortString;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func168: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Initialization') then Result := tokInitialization;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func191: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Resourcestring') then Result := tokResourcestring else
|
|
if KeyComp('Stringresource') then fExID := tokStringresource;
|
|
end;
|
|
|
|
function TmwBasePasLex.AltFunc: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
end;
|
|
|
|
function TmwBasePasLex.IdentKind: TptTokenKind;
|
|
var
|
|
HashKey: Integer;
|
|
begin
|
|
HashKey := KeyHash;
|
|
if HashKey < 192 then
|
|
Result := fIdentFuncTable[HashKey]
|
|
else Result := tokIdentifier;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.MakeMethodTables;
|
|
var
|
|
I: Char;
|
|
begin
|
|
for I := #0 to #255 do
|
|
case I of
|
|
#0: fProcTable[I] := NullProc;
|
|
#10: fProcTable[I] := LFProc;
|
|
#13: fProcTable[I] := CRProc;
|
|
#1..#9, #11, #12, #14..#32:
|
|
fProcTable[I] := SpaceProc;
|
|
'#': fProcTable[I] := AsciiCharProc;
|
|
'$': fProcTable[I] := IntegerProc;
|
|
#39: fProcTable[I] := StringProc;
|
|
'0'..'9': fProcTable[I] := NumberProc;
|
|
'A'..'Z', 'a'..'z', '_':
|
|
fProcTable[I] := IdentProc;
|
|
'{': fProcTable[I] := BraceOpenProc;
|
|
'}': fProcTable[I] := BraceCloseProc;
|
|
'!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~':
|
|
begin
|
|
case I of
|
|
'(': fProcTable[I] := RoundOpenProc;
|
|
')': fProcTable[I] := RoundCloseProc;
|
|
'*': fProcTable[I] := StarProc;
|
|
'+': fProcTable[I] := PlusProc;
|
|
',': fProcTable[I] := CommaProc;
|
|
'-': fProcTable[I] := MinusProc;
|
|
'.': fProcTable[I] := PointProc;
|
|
'/': fProcTable[I] := SlashProc;
|
|
':': fProcTable[I] := ColonProc;
|
|
';': fProcTable[I] := SemiColonProc;
|
|
'<': fProcTable[I] := LowerProc;
|
|
'=': fProcTable[I] := EqualProc;
|
|
'>': fProcTable[I] := GreaterProc;
|
|
'@': fProcTable[I] := AddressOpProc;
|
|
'[': fProcTable[I] := SquareOpenProc;
|
|
']': fProcTable[I] := SquareCloseProc;
|
|
'^': fProcTable[I] := PointerSymbolProc;
|
|
'"': fProcTable[I] := StringDQProc; // DR 2002-01-14
|
|
{$IFDEF D8_NEWER} //JThurman 2004-04-06
|
|
'&': fProcTable[I] := AmpersandOpProc;
|
|
{$ENDIF}
|
|
else fProcTable[I] := SymbolProc;
|
|
end;
|
|
end;
|
|
else fProcTable[I] := UnknownProc;
|
|
end;
|
|
end;
|
|
|
|
constructor TmwBasePasLex.Create;
|
|
begin
|
|
inherited Create;
|
|
fOrigin := nil;
|
|
InitIdent;
|
|
MakeMethodTables;
|
|
fExID := tokUnKnown;
|
|
|
|
FUseDefines := True;
|
|
FDefines := TStringList.Create;
|
|
FTopDefineRec := nil;
|
|
InitDefines;
|
|
|
|
MaxPos := -1;
|
|
end; { Create }
|
|
|
|
destructor TmwBasePasLex.Destroy;
|
|
begin
|
|
ClearDefines; //If we don't do this, we get a memory leak
|
|
FDefines.Free;
|
|
fOrigin := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.DoProcTable(AChar: AnsiChar);
|
|
begin
|
|
if AChar <= #255 then
|
|
fProcTable[AChar]
|
|
else
|
|
begin
|
|
IdentProc;
|
|
end;
|
|
end;
|
|
|
|
{ Destroy }
|
|
|
|
procedure TmwBasePasLex.SetOrigin(NewValue: PAnsiChar);
|
|
begin
|
|
fOrigin := NewValue;
|
|
Init;
|
|
Next;
|
|
end; { SetOrigin }
|
|
|
|
procedure TmwBasePasLex.SetRunPos(Value: Integer);
|
|
begin
|
|
Run := Value;
|
|
Next;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.AddDefine(const ADefine: string);
|
|
begin
|
|
if (FDefines.IndexOf(ADefine) < 0) then
|
|
FDefines.Add(ADefine);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.AddressOpProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'@':
|
|
begin
|
|
fTokenID := tokDoubleAddressOp;
|
|
inc(Run, 2);
|
|
end;
|
|
else
|
|
begin
|
|
fTokenID := tokAddressOp;
|
|
inc(Run);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.AsciiCharProc;
|
|
begin
|
|
fTokenID := tokAsciiChar;
|
|
inc(Run);
|
|
if FOrigin[Run] = '$' then
|
|
begin
|
|
inc(Run);
|
|
while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
|
|
end else
|
|
begin
|
|
while FOrigin[Run] in ['0'..'9'] do
|
|
inc(Run);
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.BraceCloseProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenId := tokError;
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Illegal character', PosXY.X, PosXY.Y);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.BorProc;
|
|
begin
|
|
fTokenID := tokBorComment;
|
|
case FOrigin[Run] of
|
|
#0:
|
|
begin
|
|
NullProc;
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y);
|
|
exit;
|
|
end;
|
|
{ DR 2001-08-02
|
|
|
|
#10:
|
|
begin
|
|
LFProc;
|
|
exit;
|
|
end;
|
|
|
|
#13:
|
|
begin
|
|
CRProc;
|
|
exit;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
while FOrigin[Run] <> #0 do
|
|
case FOrigin[Run] of
|
|
'}':
|
|
begin
|
|
fCommentState := csNo;
|
|
inc(Run);
|
|
break;
|
|
end;
|
|
{ DR 2001-08-02
|
|
#10: break;
|
|
|
|
#13: break;
|
|
}
|
|
#10:
|
|
begin
|
|
inc(Run);
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
#13:
|
|
begin
|
|
inc(Run);
|
|
if FOrigin[Run] = #10 then inc( Run );
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
else inc(Run);
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.BraceOpenProc;
|
|
var
|
|
Param, Def: string;
|
|
tmpRun: Integer;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'$': fTokenID := GetDirectiveKind;
|
|
'.':
|
|
begin
|
|
tmpRun := fTokenPos;
|
|
Run := fTokenPos + 2;
|
|
FDirectiveParamOrigin := FOrigin + FTokenPos;
|
|
FTokenPos := Run;
|
|
case KeyHash of
|
|
68: if KeyComp('INCLUDE') then
|
|
fTokenID := tokIncludeDirect
|
|
else
|
|
fTokenID := tokBorComment;
|
|
136: if KeyComp('INCLUDE_ONCE') then
|
|
fTokenID := tokIncludeDirect
|
|
else
|
|
fTokenID := tokBorComment;
|
|
else
|
|
fTokenId := tokBorComment;
|
|
end;
|
|
FTokenPos := tmpRun;
|
|
Dec(Run);
|
|
end
|
|
else
|
|
fTokenID := tokBorComment;
|
|
end;
|
|
if (fTokenID = tokBorComment) then
|
|
fCommentState := csBor;
|
|
inc(Run);
|
|
while FOrigin[Run] <> #0 do
|
|
case FOrigin[Run] of
|
|
'}':
|
|
begin
|
|
fCommentState := csNo;
|
|
inc(Run);
|
|
break;
|
|
end;
|
|
#10:
|
|
begin
|
|
inc(Run);
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
#13:
|
|
begin
|
|
inc(Run);
|
|
if FOrigin[Run] = #10 then inc( Run );
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
{ #10: break; DR 2001-10-12
|
|
|
|
#13: break;}
|
|
else inc(Run);
|
|
end;
|
|
case fTokenID of
|
|
tokCompDirect:
|
|
begin
|
|
if Assigned(fOnCompDirect) and (FDefineStack = 0) then
|
|
fOnCompDirect(Self);
|
|
end;
|
|
tokDefineDirect:
|
|
begin
|
|
if FUseDefines and (FDefineStack = 0) then
|
|
AddDefine(DirectiveParam);
|
|
if Assigned(fOnDefineDirect) then
|
|
fOnDefineDirect(Self);
|
|
end;
|
|
tokElseDirect:
|
|
begin
|
|
if FUseDefines then
|
|
begin
|
|
if FTopDefineRec <> nil then
|
|
begin
|
|
if FTopDefineRec^.Defined then
|
|
Inc(FDefineStack)
|
|
else
|
|
if FDefineStack > 0 then
|
|
Dec(FDefineStack);
|
|
end;
|
|
end;
|
|
if Assigned(fOnElseDirect) then
|
|
fOnElseDirect(Self);
|
|
end;
|
|
tokEndIfDirect:
|
|
begin
|
|
if FUseDefines then
|
|
ExitDefineBlock;
|
|
if Assigned(fOnEndIfDirect) then
|
|
fOnEndIfDirect(Self);
|
|
end;
|
|
tokIfDefDirect:
|
|
begin
|
|
if FUseDefines then
|
|
EnterDefineBlock(IsDefined(DirectiveParam));
|
|
if Assigned(fOnIfDefDirect) then
|
|
fOnIfDefDirect(Self);
|
|
end;
|
|
tokIfNDefDirect:
|
|
begin
|
|
if FUseDefines then
|
|
EnterDefineBlock(not IsDefined(DirectiveParam));
|
|
if Assigned(fOnIfNDefDirect) then
|
|
fOnIfNDefDirect(Self);
|
|
end;
|
|
tokIfOptDirect:
|
|
begin
|
|
if Assigned(fOnIfOptDirect) then
|
|
fOnIfOptDirect(Self);
|
|
end;
|
|
tokIfDirect:
|
|
begin
|
|
if FUseDefines then
|
|
begin
|
|
Param := DirectiveParam;
|
|
if Pos('DEFINED', Param) = 1 then
|
|
begin
|
|
Def := Copy(Param, 9, Length(Param) - 9);
|
|
EnterDefineBlock(IsDefined(Def));
|
|
end;
|
|
end;
|
|
if Assigned(fOnIfDirect) then
|
|
fOnIfDirect(Self);
|
|
end;
|
|
tokIfEndDirect:
|
|
begin
|
|
if FUseDefines then
|
|
ExitDefineBlock;
|
|
if Assigned(fOnIfEndDirect) then
|
|
fOnIfEndDirect(Self);
|
|
end;
|
|
tokElseIfDirect:
|
|
begin
|
|
if FUseDefines then
|
|
begin
|
|
if FTopDefineRec <> nil then
|
|
begin
|
|
if FTopDefineRec^.Defined then
|
|
Inc(FDefineStack)
|
|
else
|
|
begin
|
|
if FDefineStack > 0 then
|
|
Dec(FDefineStack);
|
|
Param := DirectiveParam;
|
|
if Pos('DEFINED', Param) = 1 then
|
|
begin
|
|
Def := Copy(Param, 9, Length(Param) - 9);
|
|
EnterDefineBlock(IsDefined(Def));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if Assigned(fOnElseIfDirect) then
|
|
fOnElseIfDirect(Self);
|
|
end;
|
|
tokIncludeDirect:
|
|
begin
|
|
if Assigned(fOnIncludeDirect) and (FDefineStack = 0) then
|
|
fOnIncludeDirect(Self);
|
|
end;
|
|
tokResourceDirect:
|
|
begin
|
|
if Assigned(fOnResourceDirect) and (FDefineStack = 0) then
|
|
fOnResourceDirect(Self);
|
|
end;
|
|
tokUndefDirect:
|
|
begin
|
|
if FUseDefines and (FDefineStack = 0) then
|
|
RemoveDefine(DirectiveParam);
|
|
if Assigned(fOnUndefDirect) then
|
|
fOnUndefDirect(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.ColonProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'=':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokAssign;
|
|
end;
|
|
else
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokColon;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.CommaProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokComma;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.CRProc;
|
|
begin
|
|
case fCommentState of
|
|
csBor: fTokenID := tokCRLFCo;
|
|
csAnsi: fTokenID := tokCRLFCo;
|
|
else fTokenID := tokCRLF;
|
|
end;
|
|
|
|
case FOrigin[Run + 1] of
|
|
#10: inc(Run, 2);
|
|
else inc(Run);
|
|
end;
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.EnterDefineBlock(ADefined: Boolean);
|
|
var
|
|
StackFrame: PDefineRec;
|
|
begin
|
|
New(StackFrame);
|
|
StackFrame^.Next := FTopDefineRec;
|
|
StackFrame^.Defined := ADefined;
|
|
StackFrame^.StartCount := FDefineStack;
|
|
FTopDefineRec := StackFrame;
|
|
if not ADefined then
|
|
Inc(FDefineStack);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.EqualProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokEqual;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.ExitDefineBlock;
|
|
var
|
|
StackFrame: PDefineRec;
|
|
begin
|
|
StackFrame := FTopDefineRec;
|
|
if StackFrame <> nil then
|
|
begin
|
|
FDefineStack := StackFrame^.StartCount;
|
|
FTopDefineRec := StackFrame^.Next;
|
|
Dispose(StackFrame);
|
|
end;
|
|
end;
|
|
procedure TmwBasePasLex.GreaterProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'=':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokGreaterEqual;
|
|
end;
|
|
else
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokGreater;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.HashValue(AChar: AnsiChar): Integer;
|
|
begin
|
|
if AChar <= #255 then
|
|
Result := mHashTable[fOrigin[Run]]
|
|
else
|
|
Result := Ord(AChar);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.IdentProc;
|
|
begin
|
|
fTokenID := IdentKind;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.IntegerProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokIntegerConst;
|
|
while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do
|
|
inc(Run);
|
|
end;
|
|
|
|
function TmwBasePasLex.IsDefined(const ADefine: string): Boolean;
|
|
begin
|
|
Result := FDefines.IndexOf(ADefine) > -1;
|
|
end;
|
|
|
|
function TmwBasePasLex.IsIdentifiers(AChar: AnsiChar): Boolean;
|
|
begin
|
|
if AChar <= #255 then
|
|
Result := Identifiers[AChar]
|
|
else
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.LFProc;
|
|
begin
|
|
case fCommentState of
|
|
csBor: fTokenID := tokCRLFCo;
|
|
csAnsi: fTokenID := tokCRLFCo;
|
|
else fTokenID := tokCRLF;
|
|
end;
|
|
inc(Run);
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.LowerProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'=':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokLowerEqual;
|
|
end;
|
|
'>':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokNotEqual;
|
|
end
|
|
else
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokLower;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.MinusProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokMinus;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.NullProc;
|
|
begin
|
|
fTokenID := tokNull;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.NumberProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokIntegerConst;
|
|
while FOrigin[Run] in ['0'..'9', '.', 'e', 'E'] do
|
|
begin
|
|
case FOrigin[Run] of
|
|
'.':
|
|
if FOrigin[Run + 1] = '.' then
|
|
break
|
|
else fTokenID := tokFloat
|
|
end;
|
|
inc(Run);
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.PlusProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokPlus;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.PointerSymbolProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokPointerSymbol;
|
|
|
|
//This is a wierd Pascal construct that rarely appears, but needs to be
|
|
//supported. ^M is a valid char reference (#13, in this case)
|
|
if FOrigin[Run] in ['a'..'z','A'..'Z'] then
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokAsciiChar;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.PointProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'.':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokDotDot;
|
|
end;
|
|
')':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokSquareClose;
|
|
end;
|
|
else
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokPoint;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.RemoveDefine(const ADefine: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := FDefines.IndexOf(ADefine);
|
|
if I > -1 then
|
|
FDefines.Delete(I);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.RoundCloseProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokRoundClose;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.AnsiProc;
|
|
begin
|
|
fTokenID := tokAnsiComment;
|
|
case FOrigin[Run] of
|
|
#0:
|
|
begin
|
|
NullProc;
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y);
|
|
exit;
|
|
end;
|
|
|
|
{ DR 2001-08-02
|
|
#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
|
|
fCommentState := csNo;
|
|
inc(Run, 2);
|
|
break;
|
|
end
|
|
else inc(Run);
|
|
{ DR 2001-08-02
|
|
#10: break;
|
|
|
|
#13: break;
|
|
}
|
|
#10:
|
|
begin
|
|
inc(Run);
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
#13:
|
|
begin
|
|
inc(Run);
|
|
if FOrigin[Run] = #10 then inc( Run );
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
else inc(Run);
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.RoundOpenProc;
|
|
begin
|
|
inc(Run);
|
|
case fOrigin[Run] of
|
|
'*':
|
|
begin
|
|
fTokenID := tokAnsiComment;
|
|
if FOrigin[Run + 1] = '$' then
|
|
fTokenID := GetDirectiveKind
|
|
else fCommentState := csAnsi;
|
|
inc(Run);
|
|
while fOrigin[Run] <> #0 do
|
|
case fOrigin[Run] of
|
|
'*':
|
|
if fOrigin[Run + 1] = ')' then
|
|
begin
|
|
fCommentState := csNo;
|
|
inc(Run, 2);
|
|
break;
|
|
end
|
|
else inc(Run);
|
|
{ DR 2001-08-02
|
|
#10: break;
|
|
#13: break;
|
|
}
|
|
#10:
|
|
begin
|
|
inc(Run);
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
#13:
|
|
begin
|
|
inc(Run);
|
|
if FOrigin[Run] = #10 then inc( Run );
|
|
inc(fLineNumber);
|
|
fLinePos := Run;
|
|
end;
|
|
else inc(Run);
|
|
end;
|
|
end;
|
|
'.':
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSquareOpen;
|
|
end;
|
|
else fTokenID := tokRoundOpen;
|
|
end;
|
|
case fTokenID of
|
|
tokCompDirect:
|
|
begin
|
|
if Assigned(fOnCompDirect) then
|
|
fOnCompDirect(Self);
|
|
end;
|
|
tokDefineDirect:
|
|
begin
|
|
if Assigned(fOnDefineDirect) then
|
|
fOnDefineDirect(Self);
|
|
end;
|
|
tokElseDirect:
|
|
begin
|
|
if Assigned(fOnElseDirect) then
|
|
fOnElseDirect(Self);
|
|
end;
|
|
tokEndIfDirect:
|
|
begin
|
|
if Assigned(fOnEndIfDirect) then
|
|
fOnEndIfDirect(Self);
|
|
end;
|
|
tokIfDefDirect:
|
|
begin
|
|
if Assigned(fOnIfDefDirect) then
|
|
fOnIfDefDirect(Self);
|
|
end;
|
|
tokIfNDefDirect:
|
|
begin
|
|
if Assigned(fOnIfNDefDirect) then
|
|
fOnIfNDefDirect(Self);
|
|
end;
|
|
tokIfOptDirect:
|
|
begin
|
|
if Assigned(fOnIfOptDirect) then
|
|
fOnIfOptDirect(Self);
|
|
end;
|
|
tokIncludeDirect:
|
|
begin
|
|
if Assigned(fOnIncludeDirect) then
|
|
fOnIncludeDirect(Self);
|
|
end;
|
|
tokResourceDirect:
|
|
begin
|
|
if Assigned(fOnResourceDirect) then
|
|
fOnResourceDirect(Self);
|
|
end;
|
|
tokUndefDirect:
|
|
begin
|
|
if Assigned(fOnUndefDirect) then
|
|
fOnUndefDirect(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SemiColonProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSemiColon;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SlashProc;
|
|
begin
|
|
case FOrigin[Run + 1] of
|
|
'/':
|
|
begin
|
|
inc(Run, 2);
|
|
fTokenID := tokSlashesComment;
|
|
while FOrigin[Run] <> #0 do
|
|
begin
|
|
case FOrigin[Run] of
|
|
#10, #13: break;
|
|
end;
|
|
inc(Run);
|
|
end;
|
|
end;
|
|
else
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSlash;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SpaceProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSpace;
|
|
while FOrigin[Run] in [#1..#9, #11, #12, #14..#32] do
|
|
inc(Run);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SquareCloseProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSquareClose;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SquareOpenProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSquareOpen;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.StarProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokStar;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.StringProc;
|
|
begin
|
|
fTokenID := tokStringConst;
|
|
repeat
|
|
inc(Run);
|
|
case FOrigin[Run] of
|
|
#0, #10, #13:
|
|
begin
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y);
|
|
break;
|
|
end;
|
|
#39:
|
|
begin
|
|
while (FOrigin[Run] = #39) and (FOrigin[Run + 1] = #39) do
|
|
begin
|
|
inc(Run, 2);
|
|
end;
|
|
end;
|
|
end;
|
|
until FOrigin[Run] = #39;
|
|
if FOrigin[Run] = #39 then
|
|
begin
|
|
inc(Run);
|
|
if TokenLen = 3 then
|
|
begin
|
|
fTokenID := tokAsciiChar;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SymbolProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokSymbol;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.UnknownProc;
|
|
begin
|
|
inc(Run);
|
|
fTokenID := tokUnknown;
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Unknown Character', PosXY.X, PosXY.Y);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.Next;
|
|
begin
|
|
fExID := tokUnKnown;
|
|
fTokenPos := Run;
|
|
|
|
if (MaxPos > -1) and (fTokenPos > MaxPos) then
|
|
fTokenID := tok_DONE
|
|
else
|
|
case fCommentState of
|
|
csNo:
|
|
begin
|
|
DoProcTable(fOrigin[Run]);
|
|
(*{$IFDEF D10_NEWER}
|
|
if fOrigin[Run] < #256 then
|
|
fProcTable[fOrigin[Run]]
|
|
else //non-ASCII unicode char
|
|
IdentProc;
|
|
{$ELSE}
|
|
fProcTable[fOrigin[Run]];
|
|
{$ENDIF}*)
|
|
end;
|
|
else
|
|
case fCommentState of
|
|
csBor: BorProc;
|
|
csAnsi: AnsiProc;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TmwBasePasLex.GetIsJunk: Boolean;
|
|
begin
|
|
result := IsTokenIDJunk(FTokenID) or (FUseDefines and (FDefineStack > 0) and (TokenID <> tokNull) and (TokenID <> tok_DONE));
|
|
// Result := fTokenID in [tokAnsiComment, tokBorComment, tokCRLF, tokCRLFCo, tokSlashesComment, tokSpace]; //XM 20001210
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsSpace: Boolean;
|
|
begin
|
|
Result := fTokenID in [tokCRLF, tokSpace];
|
|
end;
|
|
|
|
function TmwBasePasLex.GetToken: string;
|
|
begin
|
|
SetString(Result, (FOrigin + fTokenPos), GetTokenLen);
|
|
end;
|
|
|
|
function TmwBasePasLex.GetTokenLen: Integer;
|
|
begin
|
|
Result := Run - fTokenPos;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.NextID(ID: TptTokenKind);
|
|
begin
|
|
repeat
|
|
case fTokenID of
|
|
tokNull, tok_DONE: break;
|
|
else Next;
|
|
end;
|
|
until fTokenID = ID;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.NextNoJunk;
|
|
begin
|
|
repeat
|
|
Next;
|
|
until not IsJunk;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.NextNoSpace;
|
|
begin
|
|
repeat
|
|
Next;
|
|
until not IsSpace;
|
|
end;
|
|
|
|
function TmwBasePasLex.FirstInLine: Boolean;
|
|
var
|
|
RunBack: Integer;
|
|
begin
|
|
Result := True;
|
|
if fTokenPos = 0 then exit;
|
|
RunBack := fTokenPos;
|
|
dec(RunBack);
|
|
while fOrigin[RunBack] in [#1..#9, #11, #12, #14..#32] do
|
|
dec(RunBack);
|
|
if RunBack = 0 then exit;
|
|
case fOrigin[RunBack] of
|
|
#10, #13: exit;
|
|
else
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetCommentState: Pointer;
|
|
begin
|
|
Result := Pointer(fCommentState);
|
|
end;
|
|
|
|
function TmwBasePasLex.GetCompilerDirective: string;
|
|
var
|
|
DirectLen: Integer;
|
|
begin
|
|
if TokenID <> tokCompDirect then
|
|
Result := ''
|
|
else
|
|
case fOrigin[fTokenPos] of
|
|
'(':
|
|
begin
|
|
DirectLen := Run - fTokenPos - 4;
|
|
SetString(Result, (FOrigin + fTokenPos + 2), DirectLen);
|
|
Result := UpperCase(Result);
|
|
end;
|
|
'{':
|
|
begin
|
|
DirectLen := Run - fTokenPos - 2;
|
|
SetString(Result, (FOrigin + fTokenPos + 1), DirectLen);
|
|
Result := UpperCase(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetDirectiveKind: TptTokenKind;
|
|
var
|
|
TempPos: Integer;
|
|
begin
|
|
case fOrigin[fTokenPos] of
|
|
'(': Run := FTokenPos + 3;
|
|
'{': Run := FTokenPos + 2;
|
|
end;
|
|
FDirectiveParamOrigin := FOrigin + FTokenPos;
|
|
TempPos := fTokenPos;
|
|
fTokenPos := Run;
|
|
case KeyHash of
|
|
9:
|
|
if KeyComp('I') then
|
|
Result := tokIncludeDirect else
|
|
Result := tokCompDirect;
|
|
15:
|
|
if KeyComp('IF') then
|
|
Result := tokIfDirect else
|
|
Result := tokCompDirect;
|
|
18:
|
|
if KeyComp('R') then
|
|
begin
|
|
if not (fOrigin[Run] in ['+', '-']) then
|
|
Result := tokResourceDirect else Result := tokCompDirect;
|
|
end else Result := tokCompDirect;
|
|
30:
|
|
if KeyComp('IFDEF') then
|
|
Result := tokIfDefDirect else
|
|
Result := tokCompDirect;
|
|
38:
|
|
if KeyComp('ENDIF') then
|
|
Result := tokEndIfDirect else
|
|
if KeyComp('IFEND') then
|
|
Result := tokIfEndDirect else
|
|
Result := tokCompDirect;
|
|
41:
|
|
if KeyComp('ELSE') then
|
|
Result := tokElseDirect else
|
|
Result := tokCompDirect;
|
|
43:
|
|
if KeyComp('DEFINE') then
|
|
Result := tokDefineDirect else
|
|
Result := tokCompDirect;
|
|
44:
|
|
if KeyComp('IFNDEF') then
|
|
Result := tokIfNDefDirect else
|
|
Result := tokCompDirect;
|
|
50:
|
|
if KeyComp('UNDEF') then
|
|
Result := tokUndefDirect else
|
|
Result := tokCompDirect;
|
|
56:
|
|
if KeyComp('ELSEIF') then
|
|
Result := tokElseIfDirect else
|
|
Result := tokCompDirect;
|
|
66:
|
|
if KeyComp('IFOPT') then
|
|
Result := tokIfOptDirect else
|
|
Result := tokCompDirect;
|
|
68:
|
|
if KeyComp('INCLUDE') then
|
|
Result := tokIncludeDirect else
|
|
Result := tokCompDirect;
|
|
104:
|
|
if KeyComp('Resource') then
|
|
Result := tokResourceDirect else
|
|
Result := tokCompDirect;
|
|
else Result := tokCompDirect;
|
|
end;
|
|
fTokenPos := TempPos;
|
|
dec(Run);
|
|
end;
|
|
|
|
function TmwBasePasLex.GetDirectiveParam: string;
|
|
var
|
|
EndPos: Integer;
|
|
ParamLen: Integer;
|
|
begin
|
|
// !! without this set... there is a warning?
|
|
EndPos:= 0;
|
|
case fOrigin[fTokenPos] of
|
|
'(':
|
|
begin
|
|
TempRun := FTokenPos + 3;
|
|
EndPos := Run - 2;
|
|
end;
|
|
'{':
|
|
begin
|
|
TempRun := FTokenPos + 2;
|
|
EndPos := Run - 1;
|
|
end;
|
|
end;
|
|
while IsIdentifiers(fOrigin[TempRun]) do
|
|
inc(TempRun);
|
|
while fOrigin[TempRun] in ['+', ',', '-'] do
|
|
begin
|
|
inc(TempRun);
|
|
while IsIdentifiers(fOrigin[TempRun]) do
|
|
inc(TempRun);
|
|
if (fOrigin[TempRun - 1] in ['+', ',', '-']) and (fOrigin[TempRun] = ' ')
|
|
then inc(TempRun);
|
|
end;
|
|
if fOrigin[TempRun] = ' ' then inc(TempRun);
|
|
ParamLen := EndPos - TempRun;
|
|
SetString(Result, (FOrigin + TempRun), ParamLen);
|
|
Result := UpperCase(Result);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.Init;
|
|
begin
|
|
fCommentState := csNo;
|
|
fLineNumber := 0;
|
|
fLinePos := 0;
|
|
Run := 0;
|
|
//InitDefines;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.InitFrom(ALexer: TmwBasePasLex);
|
|
begin
|
|
Origin := ALexer.Origin;
|
|
fCommentState := ALexer.fCommentState;
|
|
fLineNumber := ALexer.fLineNumber;
|
|
fLinePos := ALexer.fLinePos;
|
|
Run := ALexer.Run;
|
|
CloneDefinesFrom(ALexer);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.InitDefines;
|
|
begin
|
|
ClearDefines;
|
|
//Set up the defines that are defined by the compiler
|
|
(*
|
|
{$IFDEF VER130}
|
|
AddDefine('VER130');
|
|
{$ENDIF}
|
|
{$IFDEF VER140}
|
|
AddDefine('VER140');
|
|
{$ENDIF}
|
|
{$IFDEF VER150}
|
|
AddDefine('VER150');
|
|
{$ENDIF}
|
|
{$IFDEF VER160}
|
|
AddDefine('VER160');
|
|
{$ENDIF}
|
|
{$IFDEF VER170}
|
|
AddDefine('VER170');
|
|
{$ENDIF}
|
|
{$IFDEF VER180}
|
|
AddDefine('VER180');
|
|
{$ENDIF}
|
|
{$IFDEF VER185}
|
|
AddDefine('VER185');
|
|
{$ENDIF}
|
|
{$IFDEF VER190}
|
|
AddDefine('VER190');
|
|
{$ENDIF}
|
|
{$IFDEF VER200}
|
|
AddDefine('VER200');
|
|
{$ENDIF}
|
|
{$IFDEF WIN32}
|
|
AddDefine('WIN32');
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
AddDefine('LINUX');
|
|
{$ENDIF}
|
|
{$IFDEF CPU386}
|
|
AddDefine('CPU386');
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
AddDefine('MSWINDOWS');
|
|
{$ENDIF}
|
|
{$IFDEF CONDITIONALEXPRESSIONS}
|
|
AddDefine('CONDITIONALEXPRESSIONS');
|
|
{$ENDIF}
|
|
{$IFDEF UNICODE}
|
|
AddDefine('UNICODE');
|
|
{$ENDIF}
|
|
*)
|
|
end;
|
|
|
|
procedure TmwBasePasLex.InitLine;
|
|
begin
|
|
fLineNumber := 0;
|
|
fLinePos := 0;
|
|
Run := 0;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetCommentState(const Value: Pointer);
|
|
begin
|
|
fCommentState := TCommentState(Value);
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetLine(const Value: AnsiString);
|
|
begin
|
|
fOrigin := PAnsiChar(Value);
|
|
InitLine;
|
|
Next;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetStringContent: string;
|
|
var
|
|
TempString: string;
|
|
sEnd: Integer;
|
|
begin
|
|
if TokenID <> tokStringConst then
|
|
Result := ''
|
|
else
|
|
begin
|
|
TempString := Token;
|
|
sEnd := Length(TempString);
|
|
if TempString[sEnd] <> #39 then inc(sEnd);
|
|
Result := Copy(TempString, 2, sEnd - 2);
|
|
TempString := '';
|
|
end;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsOrdIdent: Boolean;
|
|
begin
|
|
Result := False;
|
|
if fTokenID = tokIdentifier then
|
|
Result := fExID in [tokBoolean, tokByte, tokChar, tokDWord, tokInt64, tokInteger,
|
|
tokLongInt, tokLongWord, tokPChar, tokShortInt, tokSmallInt, tokWideChar, tokWord]
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsOrdinalType: Boolean;
|
|
begin
|
|
Result := GetIsOrdIdent or (fTokenID in [tokAsciiChar, tokIntegerConst]);
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsRealType: Boolean;
|
|
begin
|
|
Result := False;
|
|
if fTokenID = tokIdentifier then
|
|
Result := fExID in [tokComp, tokCurrency, tokDouble, tokExtended, tokReal, tokReal48, tokSingle]
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsStringType: Boolean;
|
|
begin
|
|
Result := False;
|
|
if fTokenID = tokIdentifier then
|
|
Result := fExID in [tokAnsiString, tokWideString]
|
|
else
|
|
if fTokenID = tokString then
|
|
Result := True
|
|
else
|
|
if fTokenID = tokStringConst then Result := True;
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsVarantType: Boolean;
|
|
begin
|
|
Result := False;
|
|
if fTokenID = tokIdentifier then
|
|
Result := fExID in [tokOleVariant, tokVariant]
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsAddOperator: Boolean;
|
|
begin
|
|
Result := fTokenID in [tokMinus, tokOr, tokPlus, tokXor];
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsMulOperator: Boolean;
|
|
begin
|
|
Result := fTokenID in [tokAnd, tokAs, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar];
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsRelativeOperator: Boolean;
|
|
begin
|
|
Result := fTokenID in [tokAs, tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual,
|
|
tokIn, tokIs, tokNotEqual];
|
|
end;
|
|
|
|
function TmwBasePasLex.GetIsCompilerDirective: Boolean;
|
|
begin
|
|
Result := fTokenID in [tokCompDirect, tokDefineDirect, tokElseDirect,
|
|
tokEndIfDirect, tokIfDefDirect, tokIfNDefDirect, tokIfOptDirect,
|
|
tokIncludeDirect, tokResourceDirect, tokUndefDirect];
|
|
end;
|
|
|
|
function TmwBasePasLex.GetGenID: TptTokenKind;
|
|
begin
|
|
Result := fTokenID;
|
|
if fTokenID = tokIdentifier then
|
|
if fExID <> tokUnknown then Result := fExID;
|
|
end;
|
|
|
|
{ TmwPasLex }
|
|
|
|
constructor TmwPasLex.Create;
|
|
begin
|
|
inherited Create;
|
|
fAheadLex := TmwBasePasLex.Create;
|
|
end;
|
|
|
|
destructor TmwPasLex.Destroy;
|
|
begin
|
|
fAheadLex.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOrigin(NewValue: PAnsiChar);
|
|
begin
|
|
inherited SetOrigin(NewValue);
|
|
fAheadLex.SetOrigin(NewValue);
|
|
end;
|
|
|
|
procedure TmwPasLex.SetLine(const Value: AnsiString);
|
|
begin
|
|
inherited SetLine(Value);
|
|
fAheadLex.SetLine(Value);
|
|
end;
|
|
|
|
procedure TmwPasLex.AheadNext;
|
|
begin
|
|
fAheadLex.NextNoJunk;
|
|
end;
|
|
|
|
function TmwPasLex.GetAheadExID: TptTokenKind;
|
|
begin
|
|
Result := fAheadLex.ExID;
|
|
end;
|
|
|
|
function TmwPasLex.GetAheadGenID: TptTokenKind;
|
|
begin
|
|
Result := fAheadLex.GenID;
|
|
end;
|
|
|
|
function TmwPasLex.GetAheadToken: string;
|
|
begin
|
|
Result := fAheadLex.Token;
|
|
end;
|
|
|
|
function TmwPasLex.GetAheadTokenID: TptTokenKind;
|
|
begin
|
|
Result := fAheadLex.TokenID;
|
|
end;
|
|
|
|
procedure TmwPasLex.InitAhead;
|
|
begin
|
|
fAheadLex.CommentState := CommentState;
|
|
fAheadLex.RunPos := RunPos;
|
|
FAheadLex.fLineNumber := FLineNumber;
|
|
FAheadLex.FLinePos := FLinePos;
|
|
|
|
FAheadLex.CloneDefinesFrom(Self);
|
|
|
|
//FAheadLex.FTokenPos := FTokenPos;
|
|
while fAheadLex.IsJunk do
|
|
fAheadLex.Next;
|
|
end;
|
|
|
|
function TmwPasLex.GetStatus: TmwPasLexStatus;
|
|
begin
|
|
Result.CommentState := fCommentState;
|
|
Result.ExID := fExID;
|
|
Result.LineNumber := fLineNumber;
|
|
Result.LinePos := fLinePos;
|
|
Result.Origin := fOrigin;
|
|
Result.RunPos := Run;
|
|
Result.TokenPos := fTokenPos;
|
|
Result.TokenID := fTokenID;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetStatus(const Value: TmwPasLexStatus);
|
|
begin
|
|
fCommentState := Value.CommentState;
|
|
fExID := Value.ExID;
|
|
fLineNumber := Value.LineNumber;
|
|
fLinePos := Value.LinePos;
|
|
fOrigin := Value.Origin;
|
|
Run := Value.RunPos;
|
|
fTokenPos := Value.TokenPos;
|
|
fTokenID := Value.TokenID;
|
|
fAheadLex.Origin := Value.Origin;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnCompDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnCompDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnDefineDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnDefineDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnElseDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnElseDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnElseIfDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnElseIfDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnEndIfDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnEndIfDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIfDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnIfDefDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIfDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
FOnIfDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIfEndDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
FOnIfEndDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnIfNDefDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIfOptDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnIfOptDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnIncludeDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnIncludeDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnResourceDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnResourceDirect := Value;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.SetOnUnDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
fOnUnDefDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnCompDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnCompDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnDefineDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnDefineDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnElseDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnElseDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnEndIfDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnEndIfDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnIfDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnIfDefDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnIfNDefDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnIfOptDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnIfOptDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnIncludeDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnIncludeDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnResourceDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnResourceDirect := Value;
|
|
end;
|
|
|
|
procedure TmwPasLex.SetOnUnDefDirect(const Value: TDirectiveEvent);
|
|
begin
|
|
inherited;
|
|
//AheadLex.OnUnDefDirect := Value;
|
|
end;
|
|
|
|
function TmwBasePasLex.Func86: TptTokenKind;
|
|
begin
|
|
Result := tokIdentifier;
|
|
if KeyComp('Varargs') then fExID := tokVarargs;
|
|
end;
|
|
|
|
procedure TmwBasePasLex.StringDQProc;
|
|
begin
|
|
if not fAsmCode then
|
|
begin
|
|
SymbolProc;
|
|
Exit;
|
|
end;
|
|
fTokenID := tokStringDQConst;
|
|
repeat
|
|
inc(Run);
|
|
case FOrigin[Run] of
|
|
#0, #10, #13:
|
|
begin
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y);
|
|
break;
|
|
end;
|
|
'\':
|
|
begin
|
|
Inc( Run );
|
|
if FOrigin[Run] in [#32..#255] then Inc( Run );
|
|
end;
|
|
end;
|
|
until FOrigin[Run] = '"';
|
|
if FOrigin[Run] = '"' then
|
|
inc(Run);
|
|
end;
|
|
|
|
{$IFDEF D8_NEWER} //JThurman 2004-04-06
|
|
procedure TmwBasePasLex.AmpersandOpProc;
|
|
begin
|
|
FTokenID := tokAmpersand;
|
|
inc(Run);
|
|
while FOrigin[Run] in ['a'..'z', 'A'..'Z','0'..'9'] do
|
|
inc(Run);
|
|
FTokenID := tokIdentifier;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
MakeIdentTable;
|
|
end.
|
|
|