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

{ Routines for performing the WITH form of the COMPARE command.  The other
  form is performed by the READ module. }

(***************** 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] FUNCTION Hex_to_Dec(Hex_String: String_80): UNSIGNED; EXTERN;

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

[EXTERNAL] PROCEDURE Check_Extra_Chars; EXTERN;

(******************************************************************************)
(*									      *)
(*			    Function Check_Compare_With			      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Check_Compare_With: INTEGER;

{ This function is called when a WITH clause is included in a COMPARE or a
  READ command.  If it is called from a COMPARE command (which is legal), it
  returns SS$_NORMAL.  If it is called from a READ command (which is not legal)
  it returns an even return code (Error_Signalled) which causes a syntax
  error to be signalled.  This function is necessary because the same code in
  HEXPARSE.MAR is used to parse both the COMPARE and the READ command. }

BEGIN

  IF (Read_Flag = File_Read) THEN
    Check_Compare_With := Error_Signalled
  ELSE
    Check_Compare_With := SS$_NORMAL;

END;

(******************************************************************************)
(*									      *)
(*			    Function VM_Compare			      	      *)
(*									      *)
(******************************************************************************)

FUNCTION VM_Compare(Index_1: INTEGER; Index_2: INTEGER): INTEGER;

{ This function compares the values stored at the two passed indices in
  virtual memory and reports to the screen if they are different.  If they
  are different it returns a one. If they aren't, it returns a zero. }

VAR
	Address_String_1	: String_80;
	Address_String_2	: String_80;

BEGIN

  IF (VM[Index_1] = VM[Index_2]) THEN
    VM_Compare := 0
  ELSE
    BEGIN
      IF (Index_1 + Offset < 65535) THEN Address_String_1 := 'Address: ' + HEX(Index_1 + Offset,4) + '    '
      ELSE IF (Index_1 + Offset < 16777215) THEN Address_String_1 := 'Address: ' + HEX(Index_1 + Offset,6) + '  '
      ELSE Address_String_1 := 'Address: ' + HEX(Index_1 + Offset,8);
      IF (Index_2 + Offset < 65535) THEN Address_String_2 := 'Address: ' + HEX(Index_2 + Offset,4) + '    '
      ELSE IF (Index_2 + Offset < 16777215) THEN Address_String_2 := 'Address: ' + HEX(Index_2 + Offset,6) + '  '
      ELSE Address_String_2 := 'Address: ' + HEX(Index_2 + Offset,8);
      WRITELN(Address_String_1,HEX(VM[Index_1 + Offset::INTEGER],2),'-',ASCII_Equivalent(VM[Index_1 + Offset::INTEGER]),
	      '          ',
	      Address_String_2,HEX(VM[Index_2 + Offset::INTEGER],2),'-',ASCII_Equivalent(VM[Index_2 + Offset::INTEGER]));
      VM_Compare := 1;
    END;

END;

(******************************************************************************)
(*									      *)
(*			    Function Do_Compare				      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Do_Compare: INTEGER;

{ This function compares the designated range of virtual memory with the
  the data in the specified range. }

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

VAR
	Token			: String_80;
   	Token_Address		: ^String_Body;
	I			: UNSIGNED;
	Compare_Index		: UNSIGNED;
	VM_Index		: INTEGER;
	Out_of_VM		: BOOLEAN;
  	Differences		: INTEGER;
	Hex_Digits		: INTEGER;

BEGIN

  Token_Address::UNSIGNED := Tparse_Block.TPA$L_TOKENPTR;
  Token := SUBSTR(Token_Address^,1,Tparse_Block.TPA$L_TOKENCNT);
  Compare_Index := Hex_to_Dec(Token);

  Out_of_VM := FALSE;
  Compare_Index := Compare_Index - Offset;
  I := From;
  IF (NOT Range_Specified) THEN
    BEGIN
      From := Old_From;
      Thru := Old_Thru;
      Step_Param := Old_Step;
    END;
  Differences := 0;
  WHILE ((I <= Thru) AND (NOT Out_of_VM)) DO
    BEGIN
      VM_Index := (I - Offset)::INTEGER;
      IF ((Compare_Index - Offset) > VM_Size) THEN
	BEGIN
	  LIB$SIGNAL(hex_cmprngerr);
	  Out_of_VM := TRUE;
	END
      ELSE
	Differences := Differences + VM_Compare(VM_Index,Compare_Index::INTEGER);
      I := I + Step_Param;
      Compare_Index := Compare_Index + 1;
    END;

  IF (Differences < 65535) THEN Hex_Digits := 4
  ELSE IF (Differences < 16777215) THEN Hex_Digits := 6
  ELSE Hex_Digits := 8;
  WRITELN(HEX(Differences,Hex_Digits),' Differences');

  Check_Extra_Chars;

  Do_Compare := SS$_NORMAL;

END;

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

END. { module compare }