{+--------------------------------------------------------------------------+
 | 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, '(', ')', '*', '+', ',', '–', '.', '/', ':',
    ';', '<', '=', '>', '@', '[', ']', '^']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.