--
with starlet, system, condition_handling, text_io, GLOBAL_CONSTANTS;
with SYSTEM_LIBRARY, TERMINAL_IO, TPARSE, TPARSE_ACTIONS, DYNAMIC_STRING;
with LOGICAL_NAME_PROCESSOR;
use starlet, text_io, DYNAMIC_STRING, LOGICAL_NAME_PROCESSOR, GLOBAL_CONSTANTS;
use TERMINAL_IO, SYSTEM_LIBRARY;
--
package body COMMAND_PARSER is
--+----------------------------------------------------------------------
--
--	Unit Type : PACKAGE BODY 
--	Unit Name : COMMAND_PARSER
--	Version   : V01.0F
--
--	Author : Stephen R. Rainier                   Date : 11/01/85
--
--	Purpose : Package of routines to massage a command block.
--
--	Parameters :
--
--	Name		Mode(I,O,IO)	Type/Subtype		Description
--	----		------------	------------		------------
--	CMD_BLOCK	    IO		COMMAND_BLOCK		command breakup
--
--
--	Modifications :
--
--	Name			Date		Description of Change
--	----			----		---------------------
--
--
--	Packages "WITH"ed : Ada$Predefined:system, condition_handling, text_io,
--				DYNAMIC_STRING, TPARSE, TPARSE_ACTIONS, starlet,
--				LOGICAL_NAME_PROCESSOR, GLOBAL_CONSTANTS
--				TERMINAL_IO,  SYSTEM_LIBRARY
--
--	Procedure/Function "CALL"s : CMD_PARSE, SHIFT_CMD, ID_CMD
--
--	Exceptions :
--
--	Name			Handled/Raised		Description
--	----			--------------		-----------
--	DATA_FILE_ERROR			R		missing data file
--	constraint_error		H		unknown command code
--	name_error			H		non-existent file
--	use_error			H		incorrect file usage
--
--	Side Effects :
--
--	Comments :
--%----------------------------------------------------------------------

--
--	Local (Invisible) Declarations
--

function FIND_CMD(NAME : in string; FILENAME : in string) return boolean is
  CMD_DATA : file_type;
  CMD_VALUE : DYN_STRING;
  FIRST : integer;
  CHAR : character;
  FLAG : boolean := false;
begin
  open(CMD_DATA, IN_FILE, FILENAME);
  reset(CMD_DATA);

  while not end_of_file(CMD_DATA) loop
    CMD_VALUE := D_STRING("");
    CHAR := ' ';

    while (not end_of_line(CMD_DATA)) and (CHAR /= '!') loop
	get(CMD_DATA,CHAR);
	CMD_VALUE := CMD_VALUE & D_STRING(CHAR);
    end loop;

    skip_line(CMD_DATA);
    if FILENAME = ENV_FILE then		-- env. file has more information --
      FIRST := INDEX(CMD_VALUE, D_STRING('/'), 1);
      if FIRST >= 1 then CMD_VALUE := SUBSTRING(CMD_VALUE, 1, FIRST - 1);end if;
    end if;

    if NAME = STR(CMD_VALUE) then FLAG := true; exit; end if;
  end loop;

  CLOSE(CMD_DATA);
  return FLAG;

  exception
    when name_error | use_error => raise DATA_FILE_ERROR;
    when others => raise;

end FIND_CMD;

--
--	Global (Visible) Declarations
--

procedure SHIFT_CMD(CMD_BLOCK : in out COMMAND_BLOCK) is
begin
  CMD_BLOCK.NAME := CMD_BLOCK.P2;
  CMD_BLOCK.P2 := CMD_BLOCK.P3;
  CMD_BLOCK.P3 := CMD_BLOCK.P4;
  CMD_BLOCK.P4 := CMD_BLOCK.P5;
  CMD_BLOCK.P5 := CMD_BLOCK.P6;
  CMD_BLOCK.P6 := D_STRING("");
  CMD_BLOCK.SWITCH := CMD_BLOCK.SUBSWITCH;
  CMD_BLOCK.SUBSWITCH := D_STRING("");
end SHIFT_CMD;


procedure ID_CMD(CMD_BLOCK : in out COMMAND_BLOCK; 
    			SAVE_FLG : in boolean := true) is
  PRIV_CMD : CONFIG_COMMAND_ID;
  TEMP : DYN_STRING;
  ABBREV : string(1..3);
begin
					-- check for APSE command
  CMD_BLOCK.CODE := UNKNOWN;		-- assume the worst; no match
  case CMD_BLOCK.TCODE is
    when SMG_K_TRM_UP => put_line(" --- Got an up arrow ---");
    			    CMD_BLOCK.CODE := COMMENT;
    when SMG_K_TRM_DOWN => put_line(" --- Got an down arrow ---");
    			    CMD_BLOCK.CODE := COMMENT;
    when SMG_K_TRM_LEFT => put_line(" --- Got an left arrow ---");
    			    CMD_BLOCK.CODE := COMMENT;
    when SMG_K_TRM_RIGHT => put_line(" --- Got an right arrow ---");
    			    CMD_BLOCK.CODE := COMMENT;
    when SMG_K_TRM_PREV_SCREEN => CMD_BLOCK.CODE := REP;
    when SMG_K_TRM_HELP => CMD_BLOCK.CODE := HEL;
			   CMD_BLOCK.P2 := D_STRING("");
			   CMD_BLOCK.LINE := D_STRING("");
    when others => null;
  end case;

  if CMD_BLOCK.CODE /= UNKNOWN then		-- skip these checks if found --
    null;
  elsif LENGTH(CMD_BLOCK.LINE) = 0 then CMD_BLOCK.CODE := COMMENT;
  elsif STR(CMD_BLOCK.LINE)(1) = '@' then 
    if LENGTH(CMD_BLOCK.LINE) >= 5 and then 
				STR(CMD_BLOCK.LINE)(1..5) = "@SYS$" then 
      CMD_BLOCK.CODE := INDIRECT;		-- it is a system utility --
    elsif INDEX(CMD_BLOCK.LINE, D_STRING('['),1) >= 1 then
      CMD_BLOCK.CODE := ILLEGAL;
    elsif LENGTH(CMD_BLOCK.IN_FILE) = 0 then -- only one level of indirection --
      CMD_BLOCK.LINE := SUBSTRING(CMD_BLOCK.LINE,2,LENGTH(CMD_BLOCK.LINE)-1);
      CMD_PARSE(CMD_BLOCK);
      CMD_BLOCK.CODE := INDIRECT;
    else
      CMD_BLOCK.CODE := ILLEGAL;	-- anything else is illegal --
    end if;
  elsif STR(CMD_BLOCK.LINE)(1) = '!' then CMD_BLOCK.CODE := COMMENT;
  elsif LENGTH(CMD_BLOCK.NAME) >= 3 then
    ABBREV := STR(CMD_BLOCK.NAME)(1..3);
    begin
      CMD_BLOCK.CODE := COMMAND_ID'value(ABBREV);
    exception
      when constraint_error => CMD_BLOCK.CODE := UNKNOWN;
    end;
  else CMD_BLOCK.CODE := ILLEGAL;
    begin
      TEMP := D_STRING(GET_SYMBOL(STR(CMD_BLOCK.NAME)));
      if LENGTH(TEMP) > 0 then		-- got a defined symbol
	TEMP := D_STRING(UPPER(STR(TEMP)));  -- convert to upper case letters
	if LENGTH(CMD_BLOCK.LINE) = LENGTH(CMD_BLOCK.NAME) then
	  CMD_BLOCK.LINE := TEMP;
	else
          CMD_BLOCK.LINE :=TEMP & SUBSTRING(CMD_BLOCK.LINE,
		LENGTH(CMD_BLOCK.NAME)+1, LENGTH(CMD_BLOCK.LINE) -
      			LENGTH(CMD_BLOCK.NAME));
	end if;
	if STR(TEMP) /= STR(CMD_BLOCK.NAME) then	-- don't get in loop --
          CMD_PARSE(CMD_BLOCK);
          ID_CMD(CMD_BLOCK, false);
	end if;
      end if;
    exception
      when constraint_error => CMD_BLOCK.CODE := ILLEGAL;
    end;
  end if;
       --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

       --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --
  if CMD_BLOCK.CODE = UNKNOWN then	-- check for priviledged command
    CMD_BLOCK.CODE := CONFIG;		-- assume we got a match
    begin
      PRIV_CMD := CONFIG_COMMAND_ID'value(ABBREV);
      CMD_BLOCK.NAME := D_STRING(ABBREV);
    exception
      when constraint_error => CMD_BLOCK.CODE := UNKNOWN;
    end;
  end if;
       --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --
  if CMD_BLOCK.CODE = UNKNOWN then	-- check for user define symbols
    begin
      TEMP := D_STRING(GET_SYMBOL(STR(CMD_BLOCK.NAME)));
      if LENGTH(TEMP) > 0 then		-- got a defined symbol
	TEMP := D_STRING(UPPER(STR(TEMP)));  -- convert to upper case letters
	if LENGTH(CMD_BLOCK.LINE) = LENGTH(CMD_BLOCK.NAME) then
	  CMD_BLOCK.LINE := TEMP;
	else
          CMD_BLOCK.LINE :=TEMP & SUBSTRING(CMD_BLOCK.LINE,
		LENGTH(CMD_BLOCK.NAME)+1, LENGTH(CMD_BLOCK.LINE) -
			LENGTH(CMD_BLOCK.NAME));
	end if;
	if STR(TEMP) /= STR(CMD_BLOCK.NAME) then	-- don't get in loop --
          CMD_PARSE(CMD_BLOCK);
          ID_CMD(CMD_BLOCK, false);
	end if;
      end if;
    exception
      when constraint_error => CMD_BLOCK.CODE := UNKNOWN;
    end;
  end if;
       --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

       --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --
  if CMD_BLOCK.CODE = UNKNOWN then	-- check other possibilities
    if FIND_CMD(STR(CMD_BLOCK.NAME), FAC_FILE) then CMD_BLOCK.CODE := FAC;
    elsif FIND_CMD(STR(CMD_BLOCK.NAME), ENV_FILE) then CMD_BLOCK.CODE := ENV;
    elsif FIND_CMD(STR(CMD_BLOCK.NAME), TEST_FILE) then CMD_BLOCK.CODE := TEST;
    elsif FIND_CMD(STR(CMD_BLOCK.NAME), VERS_FILE) then CMD_BLOCK.CODE := VERS;
    elsif FIND_CMD(STR(CMD_BLOCK.NAME), ILLEGAL_CMDS) then
						CMD_BLOCK.CODE := ILLEGAL_DCL;
    end if;
  end if;

  if CMD_BLOCK.CODE = INDIRECT and STR(CMD_BLOCK.LINE)(1) = '@' then
    CMD_BLOCK.CODE := UNKNOWN;		-- it is a system utility com file --
  elsif CMD_BLOCK.CODE = UNKNOWN and LENGTH(CMD_BLOCK.LINE) >= 1 then
					-- make sure its not a system utility --
    if STR(CMD_BLOCK.LINE)(1) = '$' then -- is a system image? --
      CMD_BLOCK.LINE := D_STRING("RUN ") & SUBSTRING(CMD_BLOCK.LINE, 2,
				LENGTH(CMD_BLOCK.LINE) - 1);
    end if;
  else null;
  end if;

  if SAVE_FLG then			-- only recall legitimate commands --
    CMD_ARRAY_PTR := (CMD_ARRAY_PTR mod 5) + 1;
    COMMAND_ARRAY(CMD_ARRAY_PTR) := CMD_BLOCK;
  end if;

end ID_CMD;

procedure CMD_PARSE(CMD_BLOCK : in out COMMAND_BLOCK) is
  STATUS : system.unsigned_longword := 0;
  SUBBY : integer := 0;
begin
  tparse_actions.CP_LINE_LEN := LENGTH(CMD_BLOCK.LINE);
  tparse_actions.CP_LINE(1 .. 256) := (1..256 => ' ');
  tparse_actions.CP_LINE(1 .. tparse_actions.CP_LINE_LEN):= STR(CMD_BLOCK.LINE);
  tparse_actions.ARG_BLOCK.count := 8;
  tparse_actions.ARG_BLOCK.stringcnt := 
			system.unsigned_longword(tparse_actions.CP_LINE_LEN);
  tparse_actions.ARG_BLOCK.stringptr := 
	system.to_unsigned_longword(tparse_actions.CP_LINE'address);

  SYSTEM_LIBRARY.VMS_TPARSE(STATUS,tparse_actions.ARG_BLOCK,
	tparse.STATE_TABLE'address, tparse.KEY_TABLE'address);

  if integer(STATUS) /= 1 then 
	tparse_actions.ARG_BLOCK := starlet.tpa_type_init; end if;

  CMD_BLOCK.NAME := 
  	D_STRING(tparse_actions.CP_NAME(1 .. tparse_actions.CP_NAME_LEN));
---------------------------------------------------------------------------
  if tparse_actions.P1_LEN > 0 then
    CMD_BLOCK.SWITCH:= 
	    D_STRING(tparse_actions.P1(1 .. tparse_actions.P1_LEN));
  else
    CMD_BLOCK.SWITCH := D_STRING("");
  end if;
---------------------------------------------------------------------------
  if tparse_actions.P2_LEN > 0 then
    CMD_BLOCK.P2 := 
	    D_STRING(tparse_actions.P2(1 .. tparse_actions.P2_LEN));
    SUBBY := INDEX(CMD_BLOCK.P2, D_STRING('/'), 1);
    if SUBBY >= 1 then 
      CMD_BLOCK.SUBSWITCH := SUBSTRING(CMD_BLOCK.P2, SUBBY,
      				LENGTH(CMD_BLOCK.P2) - SUBBY + 1);
      CMD_BLOCK.P2 := SUBSTRING(CMD_BLOCK.P2,1,SUBBY - 1);
    else
      CMD_BLOCK.SUBSWITCH := D_STRING("");
    end if;
  else
    CMD_BLOCK.P2 := D_STRING("");
    CMD_BLOCK.SUBSWITCH := D_STRING("");
  end if;
---------------------------------------------------------------------------
  if tparse_actions.P3_LEN > 0 then
    CMD_BLOCK.P3 := 
	    D_STRING(tparse_actions.P3(1 .. tparse_actions.P3_LEN));
  else
    CMD_BLOCK.P3 := D_STRING("");
  end if;

---------------------------------------------------------------------------
  if tparse_actions.P4_LEN > 0 then
    CMD_BLOCK.P4 := 
	    D_STRING(tparse_actions.P4(1 .. tparse_actions.P4_LEN));
  else
    CMD_BLOCK.P4 := D_STRING("");
  end if;
---------------------------------------------------------------------------
  if tparse_actions.P5_LEN > 0 then
    CMD_BLOCK.P5 := 
	    D_STRING(tparse_actions.P5(1 .. tparse_actions.P5_LEN));
  else
    CMD_BLOCK.P5 := D_STRING("");
  end if;
---------------------------------------------------------------------------
  if tparse_actions.P6_LEN > 0 then
    CMD_BLOCK.P6 := 
	    D_STRING(tparse_actions.P6(1 .. tparse_actions.P6_LEN));
  else
    CMD_BLOCK.P6 := D_STRING("");
  end if;
---------------------------------------------------------------------------

end CMD_PARSE;

begin

	Null;

end COMMAND_PARSER;