unit jtag.svfLex;

interface
uses
   System.Classes,
   Generics.Collections;

type
   TTokenType =
   (
      TT_EOF,
      TT_SKIP,
      TT_SEMI,
      TT_COMMENT,
      TT_ID,
      TT_NUMBER,
      TT_HEX,
      TT_LPAREN,
      TT_RPAREN,
      TT_STRING,

      // SVF commands
      LT_ENDIR,   LT_ENDDR,
      LT_HIR,     LT_HDR,
      LT_TIR,     LT_TDR,
      LT_SIR,     LT_SDR,

      LT_FREQUENCY,
      LT_HZ,
      LT_PIO,
      LT_PIOMAP,

      LT_RUNTEST,
      LT_TCK,
      LT_SCK,
      LT_SEC,
      LT_MAXIMUM,
      LT_ENDSTATE,

      LT_TDI,
      LT_TDO,
      LT_MASK,
      LT_SMASK,

      // SVX commands
      LT_PRINT,

      // TAP States
      LT_STATE,

      LT_DRSELECT,
      LT_DRCAPTURE,
      LT_DRSHIFT,
      LT_DRUPDATE,
      LT_DREXIT1,
      LT_DREXIT2,

      LT_IRSELECT,
      LT_IRCAPTURE,
      LT_IRSHIFT,
      LT_IRUPDATE,
      LT_IREXIT1,
      LT_IREXIT2,

      LT_RESET,
      LT_IDLE,
      LT_IRPAUSE,
      LT_DRPAUSE,


      LT_IN,
      LT_OUT,
      LT_INOUT,

      LT_TRST,
      LT_ON,
      LT_OFF,
      LT_Z,
      LT_ABSENT
   );

   TTokenTypes = set of TTokenType;

   TsvfToken = class
      TokenType   : TTokenType;
      TokenText   : AnsiString;
   end;

   TTokenMap    = TDictionary<AnsiString,TTokenType>;

   TAnsiCharSet = set of AnsiChar;

   TsvfMode = ( SVF, HEX);

   TsvfLEX = class
      private
         fBuffer  : PAnsiChar;
         fStart   : PAnsiChar;
         fForward : PAnsiChar;

         fToken   : TsvfToken;
         fMode    : TsvfMode;

         fLiterals: TTokenMap;

      private
         procedure   InitLiterals;
         function    CheckLiteral( ttext: AnsiString; ttype: TTokenType): TTokenType;

         function    MakeToken(  ttype : TTokenType;
                                 ttext : AnsiString): TsvfToken;


      public
         function    NextToken : TsvfToken;



      public
         constructor Create( Stream: TStream);
         destructor  Destroy; override;
   end;

implementation
uses
   WinAPI.Windows,
   System.SysUtils;

{ TsvfLEX }

// ================================================================================================
// Constructor
// ================================================================================================
constructor TsvfLEX.Create(Stream: TStream);
var
   size  : Int64;
   token : TsvfToken;

begin
   InitLiterals;

   if Assigned( Stream) then
   begin
      size     := Stream.Size - Stream.Position;
      fBuffer  := GetMemory(size+1);

      Stream.Read(fBuffer^, size);

      fMode          := SVF;
      fStart         := fBuffer;
      fForward       := fBuffer;
      fBuffer[size]  := #0;
   end
end;

destructor TsvfLEX.Destroy;
begin
   FreeAndNil(fLiterals);
   inherited;
end;



// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Internals
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// MakeToken
// ================================================================================================
function TsvfLEX.MakeToken(ttype: TTokenType; ttext: AnsiString): TsvfToken;
begin
   result := TsvfToken.Create;

   with result do
   begin
      TokenType := ttype;

      if TokenType in [TT_COMMENT,TT_STRING]
         then TokenText := ttext
         else TokenText := UpperCase(ttext);
   end
end;

// ================================================================================================
// InitLiterals
// ================================================================================================
procedure TsvfLEX.InitLiterals;
begin
   fLiterals := TTokenMap.Create;

   fLiterals.Add('HIR',       LT_HIR         );
   fLiterals.Add('HDR',       LT_HDR         );
   fLiterals.Add('TIR',       LT_TIR         );
   fLiterals.Add('TDR',       LT_TDR         );
   fLiterals.Add('SIR',       LT_SIR         );
   fLiterals.Add('SDR',       LT_SDR         );
   fLiterals.Add('TDI',       LT_TDI         );
   fLiterals.Add('TDO',       LT_TDO         );
   fLiterals.Add('MASK',      LT_MASK        );
   fLiterals.Add('SMASK',     LT_SMASK       );

   fLiterals.Add('FREQUENCY', LT_FREQUENCY   );
   fLiterals.Add('HZ',        LT_HZ          );

   fLiterals.Add('PIO',       LT_PIO         );
   fLiterals.Add('PIOMAP',    LT_PIOMAP      );

   fLiterals.Add('RUNTEST',   LT_RUNTEST     );
   fLiterals.Add('TCK',       LT_TCK         );
   fLiterals.Add('SCK',       LT_SCK         );
   fLiterals.Add('SEC',       LT_SEC         );
   fLiterals.Add('MAXIMUM',   LT_MAXIMUM     );
   fLiterals.Add('ENDSTATE',  LT_ENDSTATE    );

   fLiterals.Add('ENDIR',     LT_ENDIR       );
   fLiterals.Add('ENDDR',     LT_ENDDR       );
   fLiterals.Add('STATE',     LT_STATE       );

   fLiterals.Add('RESET',     LT_RESET       );
   fLiterals.Add('IDLE',      LT_IDLE        );

   fLiterals.Add('DRSELECT',  LT_DRSELECT    );
   fLiterals.Add('DRCAPTURE', LT_DRCAPTURE   );
   fLiterals.Add('DRSHIFT',   LT_DRSHIFT     );
   fLiterals.Add('DRUPDATE',  LT_DRUPDATE    );
   fLiterals.Add('DRPAUSE',   LT_DRPAUSE     );
   fLiterals.Add('DREXIT1',   LT_DREXIT1     );
   fLiterals.Add('DREXIT2',   LT_DREXIT2     );

   fLiterals.Add('IRSELECT',  LT_IRSELECT    );
   fLiterals.Add('IRCAPTURE', LT_DRCAPTURE   );
   fLiterals.Add('IRSHIFT',   LT_IRSHIFT     );
   fLiterals.Add('IRUPDATE',  LT_IRUPDATE    );
   fLiterals.Add('IRPAUSE',   LT_IRPAUSE     );
   fLiterals.Add('IREXIT1',   LT_IREXIT1     );
   fLiterals.Add('IREXIT2',   LT_IREXIT2     );

   fLiterals.Add('IN',        LT_IN          );
   fLiterals.Add('OUT',       LT_OUT         );
   fLiterals.Add('INOUT',     LT_INOUT       );

   fLiterals.Add('TRST',      LT_TRST        );
   fLiterals.Add('ON',        LT_ON          );
   fLiterals.Add('OFF',       LT_OFF         );
   fLiterals.Add('Z',         LT_Z           );
   fLiterals.Add('ABSENT',    LT_ABSENT      );

   fLiterals.Add('PRINT',     LT_PRINT       );
end;

// ================================================================================================
// CheckLiteral
// ================================================================================================
function TsvfLEX.CheckLiteral(ttext: AnsiString; ttype: TTokenType): TTokenType;
begin
   result := ttype;
   fLiterals.TryGetValue(ttext, result);
end;



// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// NextToken
// ================================================================================================
function TsvfLEX.NextToken: TsvfToken;

   function GetTokenText: AnsiString;
   begin
      SetLength( result, fForward-fStart);
      MoveMemory( @result[1], fStart, fForward-fStart);
   end;

var
   ttext : AnsiString;
   ttype : TTokenType;

begin
   while true do
   begin
      result   := nil;
      fForward := fStart;

      if fMode = HEX then
         case fForward^ of
            // ----------------------------------------------------
            // HEX digits
            // ----------------------------------------------------
            '0'..'9','a'..'f','A'..'F':
               begin
                  INC(fForward);

                  while fForward^ in ['0'..'9','a'..'f','A'..'F'] do
                     INC(fForward);

                  result := MakeToken( TT_HEX, GetTokenText);
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // HEX end
            // ----------------------------------------------------
            ')':
               begin
                  fMode := SVF;
                  INC(fForward);

                  result := MakeToken( TT_RPAREN, '');
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // SPACE,TAB
            // ----------------------------------------------------
            #32, #9: INC(fStart);

            // ----------------------------------------------------
            // CR/LF
            // ----------------------------------------------------
            #13,#10:
               begin
                  INC(fStart);

                  while fStart^ in [#13,#10] do
                     INC(fStart)
               end;

            // ----------------------------------------------------
            // Invalid char
            // ----------------------------------------------------
            else
               ;
         end

      else
         case fForward^ of
            // ----------------------------------------------------
            // String
            // ----------------------------------------------------
            '"':
               begin
                  INC(fForward);

                  while not (fForward^ in ['"',#13,#10]) do
                     INC(fForward);

                  if fForward^ = '"' then
                     INC(fForward);

                  result := MakeToken( TT_STRING, GetTokenText);
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // semicolon
            // ----------------------------------------------------
            ';':
               begin
                  INC(fForward);

                  result := MakeToken( TT_SEMI, ';');
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // comment
            // ----------------------------------------------------
            '!','/':
               begin
                  if fForward^ = '/' then
                  begin
                     INC(fForward);

                     if fForward^ <> '/' then
                        ; //raise
                  end;

                  INC(fForward);

                  while not (fForward^ in [#13,#10]) do
                     INC(fForward);

                  result := MakeToken( TT_COMMENT, GetTokenText);
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // id
            // ----------------------------------------------------
            'a'..'z','A'..'Z':
               begin
                  INC(fForward);

                  while fForward^ in ['a'..'z','A'..'Z'] do
                     INC(fForward);

                  ttext  := GetTokenText;
                  ttype  := CheckLiteral( ttext, TT_ID);
                  result := MakeToken( ttype, ttext);
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // number
            // ----------------------------------------------------
            '0'..'9':
               begin
                  INC(fForward);

                  while fForward^ in ['0'..'9'] do
                     INC(fForward);

                  if fForward^ = '.' then
                  begin
                     INC(fForward);

                     while fForward^ in ['0'..'9'] do
                        INC(fForward)
                  end;

                  if fForward^ in ['e','E'] then
                  begin
                     INC(fForward);

                     if fForward^ in ['+','-'] then
                     begin
                        INC(fForward);

                        if fForward^ in ['0'..'9'] then
                        begin
                           INC(fForward);

                           while fForward^ in ['0'..'9'] do
                              INC(fForward);
                        end

                        else
                           // raise
                     end
                     else
                        ; // raise

                  end;

                  result := MakeToken( TT_NUMBER, GetTokenText);
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // HEX start
            // ----------------------------------------------------
            '(':
               begin
                  fMode := HEX;
                  INC(fForward);

                  result := MakeToken( TT_LPAREN, '');
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // WS,CR/LF
            // ----------------------------------------------------
            #32, #9: INC(fStart);

            #13,#10:
               begin
                  INC(fStart);

                  while fStart^ in [#13,#10] do
                     INC(fStart)
               end;

            // ----------------------------------------------------
            // EOF
            // ----------------------------------------------------
            #0:
               begin
                  result := MakeToken( TT_EOF, '');
                  fStart := fForward;
               end;

            // ----------------------------------------------------
            // invalid
            // ----------------------------------------------------
            else
               begin
                  fStart := 0;
                  break;
               end;
         end;


      if Assigned(result) then
         break;
   end;
end;



end.