src/parser.adb

with Core_Types; use Core_Types;
with Errors;
package body Parser is
   function Is_Whitespace (C : Character) return Boolean is
   begin return C = ' ' or C = ASCII.HT or C = ASCII.CR or C = ASCII.LF; end Is_Whitespace;
   function Is_Digit (C : Character) return Boolean is (C >= '0' and C <= '9');
   function Is_Alpha (C : Character) return Boolean is
   begin return (C >= 'A' and C <= 'Z') or (C >= 'a' and C <= 'z'); end Is_Alpha;
   function Is_Alnum (C : Character) return Boolean is (Is_Alpha (C) or Is_Digit (C));
   function Char_To_Byte (C : Character) return Byte is (Byte (Character'Pos (C)));
   function Byte_To_Char (B : Byte) return Character is
   begin if B > 127 then return '?'; else return Character'Val (Integer (B)); end if; end Byte_To_Char;
   function To_Upper (C : Character) return Character is
   begin if C >= 'a' and C <= 'z' then return Character'Val (Character'Pos (C) - 32); else return C; end if; end To_Upper;
   function Match_Command (Token : String) return Command_Id is
      Upper : String (Token'Range);
   begin
      for I in Token'Range loop Upper (I) := To_Upper (Token (I)); end loop;
      if Upper = "HELP" then return Cmd_Help;
      elsif Upper = "SET" or Upper = "SET_CONFIG" then return Cmd_Set_Config;
      elsif Upper = "PROCESS" or Upper = "PROCESS_DATA" then return Cmd_Process_Data;
      elsif Upper = "STATE" or Upper = "QUERY_STATE" then return Cmd_Query_State;
      elsif Upper = "SERIALIZE" then return Cmd_Serialize;
      elsif Upper = "VERIFY" then return Cmd_Verify;
      elsif Upper = "TEST" or Upper = "SELF_TEST" then return Cmd_Self_Test;
      elsif Upper = "RESET" then return Cmd_Reset;
      elsif Upper = "AUTH" or Upper = "AUTHORIZE" then return Cmd_Authorize;
      elsif Upper = "EXIT" or Upper = "QUIT" then return Cmd_Exit;
      else return Cmd_None;
      end if;
   end Match_Command;
   function Parse_Line (Line : String; Cmd : out Parsed_Command; Log : in out Errors.Error_Log) return Status_Code is
      I : Natural := Line'First; Start : Natural; Token_Len : Natural;
      Token : String (1 .. 32); Arg_Idx : Natural := 0; Val : Integer; Digit_Count : Natural;
   begin
      Cmd := (Id => Cmd_None, Arg_Count => 0, Args => (others => 0), Raw => (others => ' '));
      if Line'Length = 0 then return Success; end if;
      if Line'Length > Cmd.Raw'Length then
         Errors.Set_Error (Log, Buffer_Overflow, 0, "long"); return Buffer_Overflow;
      end if;
      for J in Line'Range loop
         if J - Line'First < Cmd.Raw'Length then Cmd.Raw (J - Line'First) := Line (J); end if;
      end loop;
      while I <= Line'Last and Is_Whitespace (Line (I)) loop I := I + 1; end loop;
      if I > Line'Last then return Success; end if;
      Start := I;
      while I <= Line'Last and not Is_Whitespace (Line (I)) loop I := I + 1; end loop;
      Token_Len := I - Start;
      if Token_Len = 0 or Token_Len > Token'Length then
         Errors.Set_Error (Log, Parse_Error, 0, "token"); return Parse_Error;
      end if;
      for K in 0 .. Token_Len - 1 loop Token (K + 1) := Line (Start + K); end loop;
      Cmd.Id := Match_Command (Token (1 .. Token_Len));
      if Cmd.Id = Cmd_None then
         Errors.Set_Error (Log, Parse_Error, 0, "unknown"); return Parse_Error;
      end if;
      while I <= Line'Last loop
         while I <= Line'Last and Is_Whitespace (Line (I)) loop I := I + 1; end loop;
         if I > Line'Last then exit; end if;
         if Arg_Idx >= Max_Command_Args then
            Errors.Set_Error (Log, Buffer_Overflow, 0, "args"); return Buffer_Overflow;
         end if;
         Val := 0; Digit_Count := 0;
         while I <= Line'Last and Is_Digit (Line (I)) loop
            Val := Val * 10 + (Character'Pos (Line (I)) - Character'Pos ('0'));
            if Val > 255 then Errors.Set_Error (Log, Out_Of_Range, 0, "arg"); return Out_Of_Range; end if;
            Digit_Count := Digit_Count + 1; I := I + 1;
         end loop;
         if Digit_Count = 0 then Errors.Set_Error (Log, Parse_Error, 0, "num"); return Parse_Error; end if;
         Cmd.Args (Arg_Idx) := Byte (Val); Arg_Idx := Arg_Idx + 1;
      end loop;
      Cmd.Arg_Count := Arg_Idx;
      return Success;
   end Parse_Line;
   function Command_Requires_Args (C : Command_Id) return Boolean is
   begin
      case C is
         when Cmd_Set_Config | Cmd_Process_Data | Cmd_Authorize => return True;
         when others => return False;
      end case;
   end Command_Requires_Args;
end Parser;