--
with system, starlet;
use starlet;
--
package body TPARSE_ACTIONS is
--+----------------------------------------------------------------------
--
--	Unit Type : PACKAGE BODY 
--	Unit Name : TPARSE_ACTIONS
--	Version   : V01.0F
--
--	Author : Stephen R. Rainier                  Date : 10/17/85
--
--	Purpose : LIB$TPARSE action routines.
--
--
--	Parameters :
--
--	Name		Mode(I,O,IO)	Type/Subtype		Description
--	----		------------	------------		------------
--	ARG_BLOCK	    IO		tpa_type		tparse arg block
--
--
--	Modifications :
--
--	Name			Date		Description of Change
--	----			----		---------------------
--
--
--	Packages "WITH"ed : Ada$Predefined : Starlet, System
--
--
--	Procedure/Function "CALL"s : READ_CMD, READ_SWITCH, SAVE_PARAM
--
--
--	Exceptions :
--
--	Name			Handled/Raised		Description
--	----			--------------		-----------
--
--
--
--	Side Effects :
--
--
--	Comments :
--
--%----------------------------------------------------------------------

--
--		Declarations
--

function READ_CMD return integer is
  TOKEN_LOC : integer := CP_LINE_LEN - integer(ARG_BLOCK.stringcnt) -
				integer(ARG_BLOCK.tokencnt) + 1;
  TOKEN_LEN : integer := integer(ARG_BLOCK.tokencnt);
begin
  CP_NAME(1 .. TOKEN_LEN) := CP_LINE(TOKEN_LOC .. TOKEN_LOC+TOKEN_LEN-1);
  CP_NAME_LEN := TOKEN_LEN;
  P1_LEN := 0;
  P2_LEN := 0;
  P3_LEN := 0;
  P4_LEN := 0;
  P5_LEN := 0;
  P6_LEN := 0;

  return 1;

end READ_CMD;






function READ_SWITCH return integer is
begin
  ARG_BLOCK.OPTIONS.BLANKS := TRUE;
  if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
    ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;

  P1(P1_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
  P1_LEN := P1_LEN + 1;
  return 1;

  if integer(ARG_BLOCK.STRINGCNT) = 1 then
    ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;

end READ_SWITCH;

function SAVE_PARAM return integer is
begin
  ARG_BLOCK.OPTIONS.BLANKS := TRUE;
    case ARG_BLOCK.PARAM is
      when 2 =>
	if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;
	P2(P2_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
	P2_LEN := P2_LEN + 1;
	if integer(ARG_BLOCK.STRINGCNT) = 0 then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; end if;
	return 1;
      when 3 =>
	if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;
	P3(P3_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
	P3_LEN := P3_LEN + 1;
	if integer(ARG_BLOCK.STRINGCNT) = 0 then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; end if;
	return 1;
      when 4 =>
	if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;
	P4(P4_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
	P4_LEN := P4_LEN + 1;
	if integer(ARG_BLOCK.STRINGCNT) = 0 then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; end if;
	return 1;
      when 5 =>
	if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;
	P5(P5_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
	P5_LEN := P5_LEN + 1;
	if integer(ARG_BLOCK.STRINGCNT) = 0 then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; end if;
	return 1;
      when 6 =>
	if (character'val(integer(ARG_BLOCK.CHAR)) <= ' ') then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0; end if;
	P6(P6_LEN + 1) := character'val(integer(ARG_BLOCK.CHAR));
	P6_LEN := P6_LEN + 1;
	if integer(ARG_BLOCK.STRINGCNT) = 0 then
	  ARG_BLOCK.OPTIONS.BLANKS := FALSE; end if;
	return 1;
      when others => ARG_BLOCK.OPTIONS.BLANKS := FALSE; return 0;
    end case;

end SAVE_PARAM;

begin

	Null;

end TPARSE_ACTIONS;