[INHERIT ('SYS$LIBRARY:STARLET.PEN')]
MODULE Edit(OUTPUT);

{ Routines for performing the EDIT command }

(****************** Declare External Variables and Constants ******************)

%INCLUDE 'HEX$DIRECTORY:HEXGLOB.INC/NOLIST'

(********************* External RTL Routine Declarations **********************)

%INCLUDE 'HEX$DIRECTORY:LIB.INC/NOLIST'

(****************** External Homemade Routine Declarations ********************)

[EXTERNAL] PROCEDURE Check_Extra_Chars; EXTERN;

[EXTERNAL] FUNCTION ASCII_Equivalent(Character: Unsigned_Byte): String_80; EXTERN;

[EXTERNAL] FUNCTION Hex_to_Dec(Hex_String: String_80): UNSIGNED; EXTERN;

[EXTERNAL] PROCEDURE Force_Upper(VAR Command_String: String_80); EXTERN;

(******************************************************************************)
(*									      *)
(*			    Function Set_Edit				      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Set_Edit: INTEGER;

{ This procedure sets the With_Param variable as used by the EDIT command. }

TYPE
	String_Body		= PACKED ARRAY [1..80] OF CHAR;

VAR
	Token_Address		: ^String_Body;
	Hex_String		: String_80;
	Addr			: UNSIGNED;
	Ch			: CHAR;
	String			: String_80;

BEGIN

  CASE (Edit_Tparse_Block.TPA$L_PARAM::INTEGER) OF

    1:	BEGIN	{ hex number }
  	  Token_Address::UNSIGNED := Edit_Tparse_Block.TPA$L_TOKENPTR;
	  Hex_String := SUBSTR(Token_Address^,1,Edit_Tparse_Block.TPA$L_TOKENCNT);
	  Addr := Hex_to_Dec(Hex_String);
	  IF (Addr <= 255) THEN
	    BEGIN
	      With_Param := ORD(Addr);
	      Set_Edit := SS$_NORMAL;
	    END
	  ELSE
	    BEGIN
	      LIB$SIGNAL(hex_valrngerr,1,%STDESCR SUBSTR(Hex_String,1,Hex_String.LENGTH));
	      Set_Edit := Error_Signalled;
	    END;
	END;

    2:	BEGIN	{ ^# }
	  With_Param := 127;
	  Set_Edit := SS$_NORMAL;
	END;

    3:  BEGIN	{ ^c }
	  IF ((Edit_Tparse_Block.TPA$B_CHAR < 64) OR (Edit_Tparse_Block.TPA$B_CHAR > 95)) THEN
	    BEGIN
	      String := '^' + CHR(Edit_Tparse_Block.TPA$B_CHAR);
	      LIB$SIGNAL(hex_illegcontcode,1,%STDESCR SUBSTR(String,1,2));
	      Set_Edit := Error_Signalled;
	    END
	  ELSE
	    BEGIN
	      With_Param := Edit_Tparse_Block.TPA$B_CHAR - 64;
	      Set_Edit := SS$_NORMAL;
	    END;
	END;

    4:  BEGIN	{ 'c }
	  Edit_Tparse_Block.TPA$V_BLANKS := FALSE;
	  IF ((Edit_Tparse_Block.TPA$B_CHAR < 32) OR (Edit_Tparse_Block.TPA$B_CHAR > 126)) THEN
	    BEGIN
	      String := '''' + CHR(Edit_Tparse_Block.TPA$B_CHAR);
	      LIB$SIGNAL(hex_illegprntchr,1,%STDESCR SUBSTR(String,1,2));
	      Set_Edit := Error_Signalled;
	    END
	  ELSE
	    BEGIN
	      With_Param := Edit_Tparse_Block.TPA$B_CHAR;
	      Set_Edit := SS$_NORMAL;
	    END;
	END;

    5:	BEGIN	{ ~# }
	  With_Param := 255;
	  Set_Edit := SS$_NORMAL;
	END;

    6:  BEGIN	{ ~c }
	  IF ((Edit_Tparse_Block.TPA$B_CHAR < 64) OR (Edit_Tparse_Block.TPA$B_CHAR > 95)) THEN
	    BEGIN
	      String := '^' + CHR(Edit_Tparse_Block.TPA$B_CHAR);
	      LIB$SIGNAL(hex_illegcontcode,1,%STDESCR SUBSTR(String,1,2));
	      Set_Edit := Error_Signalled;
	    END
	  ELSE
	    BEGIN
	      With_Param := Edit_Tparse_Block.TPA$B_CHAR + 64;
	      Set_Edit := SS$_NORMAL;
	    END;
	END;

    7:  BEGIN	{ -c }
	  Edit_Tparse_Block.TPA$V_BLANKS := FALSE;
	  IF ((Edit_Tparse_Block.TPA$B_CHAR < 32) OR (Edit_Tparse_Block.TPA$B_CHAR > 126)) THEN
	    BEGIN
	      String := '''' + CHR(Edit_Tparse_Block.TPA$B_CHAR);
	      LIB$SIGNAL(hex_illegprntchr,1,%STDESCR SUBSTR(String,1,2));
	      Set_Edit := Error_Signalled;
	    END
	  ELSE
	    BEGIN
	      With_Param := Edit_Tparse_Block.TPA$B_CHAR + 128;
	      Set_Edit := SS$_NORMAL;
	    END;
	END;

  END; { case statement }

END;


(******************************************************************************)
(*									      *)
(*			    Function Set_Edit_Flag			      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Set_Edit_Flag: INTEGER;

{ This function sets the global variable Edit_Flag to TRUE.  This indicates that
  the EDIT function is to set the current cell of virtual memory to the input
  value. }

BEGIN

  Edit_Flag := FALSE;
  Set_Edit_Flag := SS$_NORMAL;

END;


(******************************************************************************)
(*									      *)
(*			    Function Set_Previous			      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Set_Previous: INTEGER;

{ This function sets the global variable Previous to TRUE.  This indicates that
  after editting the current cell of virtual memory, the EDIT command is to edit
  the previous cell of virtual memory. }

BEGIN

  Previous := TRUE;
  IF (Edit_Tparse_Block.TPA$L_PARAM::INTEGER = 0) THEN
    Edit_Flag := FALSE;
  Set_Previous := SS$_NORMAL;

END;

(******************************************************************************)
(*									      *)
(*			    Function From_OK				      *)
(*									      *)
(******************************************************************************)

FUNCTION From_OK: BOOLEAN;

{ This function checks to see if the current FROM parameter is within range. }

BEGIN

  IF ((From - Offset < 0) OR (From - Offset > VM_Size)) THEN
    BEGIN
      LIB$SIGNAL(hex_editrngerr);
      From_OK := FALSE;
    END
  ELSE
    From_OK := TRUE;

END;


(******************************************************************************)
(*									      *)
(*			    Procedure Do_Edit				      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Do_Edit: INTEGER;

{ This function invokes an interactive editing session for the designated
  range of virtual memory. }

TYPE
	Stat_Block = RECORD
                   IO_Stat, Count,Terminator,Term_Size: Unsigned_Word;
                   END;
	String_Body = PACKED ARRAY [1..80] OF CHAR;

VAR
	Exit_Edit		: BOOLEAN;
   	Edit_Line		: [VOLATILE] String_80;
	Temp_String		: String_80;
	Prompt			: PACKED ARRAY [1..18] OF CHAR;
	Qio_Stat		: INTEGER;
	Sys_Stat		: INTEGER;
	Iosb  			: Stat_Block;

	Edit_Tparse_Block	: [EXTERNAL,VOLATILE] TPA$TYPE;
	Edit_Parse_State	: [EXTERNAL] INTEGER;
	Edit_Parse_Key		: [EXTERNAL] INTEGER;

	Edit_Line_Address	: ^String_80;
	Token			: String_80;
   	Token_Address		: ^String_Body;

BEGIN

  IF (Command_File_Flag) THEN
    BEGIN
      LIB$SIGNAL(hex_noninteredit);
      Do_Edit := Error_Signalled;
    END
  ELSE
    BEGIN
      Exit_Edit := FALSE;
      WHILE ((NOT Exit_Edit) AND (From_OK)) DO
	BEGIN
	  Edit_Flag := TRUE;
	  Previous := FALSE;
	  IF (From <= 65535) THEN		{ construct the qio prompt }
	    Prompt := HEX(From,4) + '        ' +
		      HEX(VM[(From-Offset)::INTEGER],2) +
		      '=' + ASCII_Equivalent(VM[(From-Offset)::INTEGER]) + '-'
	  ELSE IF (From <= 16777215) THEN
	    Prompt := HEX(From,6) + '      ' +
		      HEX(VM[(From-Offset)::INTEGER],2) +
		      '=' + ASCII_Equivalent(VM[(From-Offset)::INTEGER]) + '-'
	  ELSE
	    Prompt := HEX(From,8) + '    ' +
		      HEX(VM[(From-Offset)::INTEGER],2) +
	     	      '=' + ASCII_Equivalent(VM[(From-Offset)::INTEGER]) + '-';

	  QIO_Stat := $QIOW(CHAN := Channel,		{ read the edit line }
			    FUNC := IO$_READPROMPT,
			    IOSB := Iosb,
			    P1 := Edit_Line.BODY,
			    P2 := 80,
			    P5 := %REF Prompt,
			    P6 := 18);
	  IF (NOT ODD(Qio_Stat)) THEN LIB$STOP(QIO_Stat);
	  Edit_Line.Length := Iosb.Count;
	  IF (Iosb.Terminator = 26) THEN Exit_Edit := TRUE;	{ look for Control_Z }
	  Temp_String := Edit_Line;
	  Force_Upper(Temp_String);
	  Edit_Line := Temp_String;
	(* set up Argument Block for call to LIB$TPARSE *)

	  Edit_Tparse_Block.TPA$L_COUNT := TPA$K_COUNT0;
	  Edit_Tparse_Block.TPA$V_ABBREV := TRUE;
	  Edit_Tparse_Block.TPA$V_BLANKS := FALSE;
	  Edit_Tparse_Block.TPA$V_ABBRFM := FALSE;
	  Edit_Line_Address := ADDRESS(Edit_Line);
	  Edit_Line_Address::UNSIGNED := Edit_Line_Address::UNSIGNED + 2;
	  Edit_Tparse_Block.TPA$L_STRINGCNT := Edit_Line.LENGTH;
	  Edit_Tparse_Block.TPA$L_STRINGPTR := Edit_Line_Address::unsigned;

	(* Call LIB$TPARSE and signal if return code <> success *)

	  Sys_Stat := LIB$TPARSE(Edit_Tparse_Block,Edit_Parse_State,Edit_Parse_Key);
	  IF (Sys_Stat = LIB$_SYNTAXERR) THEN
	    BEGIN
	      Token_Address::UNSIGNED := Tparse_Block.TPA$L_TOKENPTR;
              Token := SUBSTR(Token_Address^,1,Tparse_Block.TPA$L_TOKENCNT);
	      LIB$SIGNAL(hex_syntax,1,%STDESCR SUBSTR(Token,1,Token.Length));
	      Do_Edit := Error_Signalled;
	    END
	  ELSE
	    BEGIN		{ do the edit }
	      IF (Edit_Flag) THEN VM[From::INTEGER] := With_Param;
	      IF (Previous) THEN
		From := From - Step_Param
	      ELSE
		From := From + Step_Param;
	      Do_Edit := SS$_NORMAL;
	    END;
	END;
    END;

END;

(******************************************************************************)

END. { module edit }