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

{ Module containing procedures for READing and WRITEing Extended_Tekhex format
  object files. }

TYPE
	Extended_Tekhex_Record	= VARYING [515] OF CHAR;
	Fixed_String_8		= PACKED ARRAY [1..8] OF CHAR;

VAR
	Object_File		: TEXT;

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

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

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

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

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

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

[EXTERNAL] FUNCTION Get_File_Read(VAR File_Spec: String_80): BOOLEAN; EXTERN;

[EXTERNAL] FUNCTION Get_File_Write(VAR File_Spec: String_80): BOOLEAN; EXTERN;

[EXTERNAL] PROCEDURE Init_High_Low; EXTERN;

[EXTERNAL] FUNCTION Do_Read_Compare(Byte: Unsigned_Byte; Location: UNSIGNED): BOOLEAN; EXTERN;

[EXTERNAL] PROCEDURE Read_Stats; EXTERN;

[EXTERNAL] PROCEDURE Write_Stats; EXTERN;

[EXTERNAL] PROCEDURE Process_Command(Command_Line: String_80); EXTERN;

[EXTERNAL] PROCEDURE Compare_Name(New_Name: Fixed_String_8); EXTERN;

[EXTERNAL] PROCEDURE Compare_Transfer(New_Transfer: UNSIGNED); EXTERN;

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

FUNCTION Extekhex_Check_Checksum(File_Record: Extended_Tekhex_Record): BOOLEAN;

{ This function returns TRUE if the checksum included in the passed record is correct and false otherwise }

VAR
	Checksum	: UNSIGNED;
	Total		: UNSIGNED;
	I		: INTEGER;
	Illegal_Char	: BOOLEAN;

BEGIN

  Total := 0;
  Checksum := Hex_to_Dec(SUBSTR(File_Record,4,2));

  Illegal_Char := FALSE;
  I := 1;
  WHILE ((I <= File_Record.LENGTH) AND (NOT Illegal_Char)) DO
    BEGIN
      IF ((I < 4) OR (I > 5)) THEN		{ skip the checksum itself }
	BEGIN
	  IF ((File_Record[I] >= '0') AND (File_Record[I] <= '9')) THEN
	    Total := Total + ORD(File_Record[I]) - 48
	  ELSE IF ((File_Record[I] >= 'A') AND (File_Record <= 'Z')) THEN
	    Total := Total + ORD(File_Record[I]) - 55
	  ELSE IF (File_Record[I] = '$') THEN
	    Total := Total + 36
	  ELSE IF (File_Record[I] = '.') THEN
	    Total := Total + 38
	  ELSE IF (File_Record[I] = '_') THEN
	    Total := Total + 39
	  ELSE IF ((File_Record[I] >= 'a') AND (File_Record <= 'z')) THEN
	    Total := Total + ORD(File_Record[I]) - 57
	  ELSE
	    Illegal_Char := TRUE;
	END;
      I := I + 1;
    END;

  IF (Illegal_Char) THEN
    BEGIN
      LIB$SIGNAL(hex_illegchar);
      Extekhex_Check_Checksum := FALSE;
    END
  ELSE IF (Total MOD 256 <> Checksum) THEN
    Extekhex_Check_Checksum := FALSE
  ELSE
    Extekhex_Check_Checksum := TRUE;

END;

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

[GLOBAL] PROCEDURE Read_Extended_Tekhex;

{ This procedure reads in Extended Tekhex format object file into virtual memory. }

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Transfer_Set		: BOOLEAN;
	Name_Specified		: BOOLEAN;
	Temp_Name		: Fixed_String_8;
	Done	     		: BOOLEAN;
	File_Record		: Extended_Tekhex_Record;
	Chars_in_Record		: INTEGER;
	Record_Type		: INTEGER;
	Check_Sum		: UNSIGNED;
	Load_Address		: UNSIGNED;
	Address_Length		: UNSIGNED;
	Bytes_in_Record		: UNSIGNED;
	Start_of_Data		: UNSIGNED;
	N			: UNSIGNED;
	Data_Byte		: Unsigned_Byte;
	Temp_Transfer		: UNSIGNED;

BEGIN

  Transfer_Set := FALSE;
  Name_Specified := FALSE;
  Temp_Name := '        ';

  Error :=  NOT Get_File_Read(Object_File_Spec);	(* is the object file there? *)

  IF (NOT Error) THEN	(* open and reset the file *)
    BEGIN
      OPEN(Object_File,Object_File_Spec,OLD,ERROR := CONTINUE);
      IF (STATUS(Object_File) <> 0) THEN
	BEGIN
	  LIB$SIGNAL(hex_openerr,1,%STDESCR SUBSTR(Object_File_Spec,1,Object_File_Spec.LENGTH));
	  Error := TRUE;
	END
      ELSE
        RESET(Object_File);
    END;

  IF (NOT Error) THEN
    BEGIN
      Done := FALSE;
      Init_High_Low;
      WHILE(NOT EOF(Object_File) AND (NOT Error) AND (NOT Done)) DO
	BEGIN
	  READLN(Object_File,File_Record);
	  STR$TRIM(File_Record,File_Record);
	  IF ((File_Record.LENGTH > 0) AND (File_Record[1] <> '%')) THEN		(* no % - illegal format *)
	    BEGIN
	      LIB$SIGNAL(hex_formaterr,1,%STDESCR 'EXTENDED TEKHEX');
	      Error := TRUE;
	    END
	  ELSE										(* you don't need stuff before the *)
	    IF (File_Record.LENGTH > 0) THEN 						(* colon anymore so get rid of it. *)
	      File_Record := SUBSTR(File_Record,2,File_Record.LENGTH - 1);

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN
	    BEGIN
	      Chars_in_Record::UNSIGNED := Hex_to_Dec(SUBSTR(File_Record,1,2));
	      IF (Chars_in_Record <> File_Record.LENGTH) THEN				(* are there the right number of   *)
		BEGIN									(* characters in the record?	   *)
		  LIB$SIGNAL(hex_formaterr,1,%STDESCR 'Extended Tekhex');
		  Error := TRUE;
		END;
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN				(* get the record type *)
	    BEGIN
	      Record_Type::UNSIGNED := Hex_to_Dec(SUBSTR(File_Record,3,1));
	      IF (Record_Type <> 3) AND (Record_Type <> 6) AND (Record_Type <> 8) THEN	(* illegal record type *)
		BEGIN
		  LIB$SIGNAL(hex_formaterr,1,%STDESCR 'Extended Tekhex');
		  Error := TRUE;
		END; 
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN				(* what about the checksum? *)
	    BEGIN
	      Error := NOT Extekhex_Check_Checksum(File_Record);
	      IF (Error) THEN LIB$SIGNAL(hex_readsumerr,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN				(* process the record *)
	    BEGIN
	      Address_Length := Hex_to_Dec(SUBSTR(File_Record,6,1));			(* how long is the address *)
	      CASE Record_Type OF

		3: BEGIN								(* symbol definition record *)
		     IF (Address_Length > 8) THEN Address_Length := 8;
		     Temp_Name := SUBSTR(File_Record,7,Address_Length);
		     IF (Read_Flag = File_Read) THEN
		      BEGIN
			Name_Specified := TRUE;
			Program_Name := Temp_Name;
		      END;
		   END;

		6: BEGIN								(* data record *)
		     Load_Address := Hex_to_Dec(SUBSTR(File_Record,7,Address_Length));
		     Start_of_Data := Address_Length + 7;
		     Bytes_in_Record := ((Chars_in_Record - Start_of_Data) + 1) DIV 2;
		     N := Use_1;
		     WHILE (N <= Bytes_in_Record) DO
		       BEGIN
			 Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,Start_of_Data+2*(N-1),2)));
			 N := N + Use_2;
			 IF (((Load_Address >= From) AND (Load_Address <= Thru)) OR (NOT Range_Specified)) THEN
			   BEGIN
		      	     Error := NOT Do_Read_Compare(Data_Byte,Load_Address);
		       	     IF (NOT Error) THEN Byte_Count := Byte_Count + 1;
			     Load_Address := Load_Address + Step_Param;
			   END
	      	         ELSE Load_Address := Load_Address + 1;
		       END;
		   END;

		8: BEGIN								(* trailer record *)
		     Done := TRUE;
		     Temp_Transfer := Hex_to_Dec(SUBSTR(File_Record,7,Address_Length));
		     IF ((Temp_Transfer > 0) AND (Read_Flag = File_Read)) THEN
		       BEGIN
			 Transfer := Temp_Transfer;
			 Transfer_Set := TRUE;
		       END;
		     IF (Partial) THEN LIB$SIGNAL(hex_unexptrailer);
		   END;

	      END; { case statement }                    
	    END;
	END;

      CLOSE(Object_File);
      IF ((NOT Error) AND (NOT Done) AND (NOT Partial)) THEN			(* was there a trailer record? *)
	LIB$SIGNAL(hex_notrailer);
      IF (Read_Flag = File_Compare) THEN
	BEGIN
	  IF (Temp_Name <> Program_Name) THEN Compare_Name(Temp_Name);
	  IF (Temp_Transfer <> Transfer) THEN Compare_Transfer(Temp_Transfer);
	END;
      IF (Name_Specified) THEN Process_Command('NAME');
      IF (Byte_Count > 0) THEN Read_Stats;
      IF (Transfer_Set) THEN Process_Command('TRANSFER');
    END;

END;

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

FUNCTION Add_Checksum_Extended_Tekhex(VAR File_Record: Extended_Tekhex_Record):BOOLEAN;

{ This procedure adds the checksum byte into the Extended Tekhex object record.  It returns TRUE if it was able to add the
  checksum and FALSE otherwise. }

VAR
	Total		: UNSIGNED;
	I		: INTEGER;
	Illegal_Char	: BOOLEAN;

BEGIN

  Illegal_Char := FALSE;
  Total := 0;

  I := 2;
  WHILE ((I <= File_Record.LENGTH) AND (NOT Illegal_Char)) DO
    BEGIN
      IF ((I < 5) OR (I > 6)) THEN		{ skip the checksum itself }
	BEGIN
	  IF ((File_Record[I] >= '0') AND (File_Record[I] <= '9')) THEN
	    Total := Total + ORD(File_Record[I]) - 48
	  ELSE IF ((File_Record[I] >= 'A') AND (File_Record <= 'Z')) THEN
	    Total := Total + ORD(File_Record[I]) - 55
	  ELSE IF (File_Record[I] = '$') THEN
	    Total := Total + 36
	  ELSE IF (File_Record[I] = '.') THEN
	    Total := Total + 38
	  ELSE IF (File_Record[I] = '_') THEN
	    Total := Total + 39
	  ELSE IF ((File_Record[I] >= 'a') AND (File_Record <= 'z')) THEN
	    Total := Total + ORD(File_Record[I]) - 57
	  ELSE
	    Illegal_Char := TRUE;
	END;
      I := I + 1;
    END;

  IF (Illegal_Char) THEN
    Add_Checksum_Extended_Tekhex := FALSE
  ELSE
    BEGIN
      File_Record := SUBSTR(File_Record,1,4) + HEX(Total MOD 256,2) + SUBSTR(File_Record,7,File_Record.LENGTH-6);
      Add_Checksum_Extended_Tekhex := TRUE;
    END;
END;


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

PROCEDURE Write_to_File_Extended_Tekhex(Append_Flag: BOOLEAN);

{ This procedure writes the desigated range of virtual memory to the file variable Object_File }

VAR
	Object_Record		: Extended_Tekhex_Record;
	Num_Digits		: INTEGER;
	I			: UNSIGNED;
	J			: INTEGER;
	Step_String		: String_80;
	Command_String		: String_80;
  	Error			: BOOLEAN;
      	Name_Specified		: BOOLEAN;
	Load_Addr		: UNSIGNED;

BEGIN

  Error := FALSE;
  Name_Specified := FALSE;

  IF ((Program_Name <> '        ') AND (NOT Append_Flag)) THEN			(* write symbol definition record *)
    BEGIN
      I := INDEX(Program_Name,' ');
      IF (I = 0) THEN I := 8 ELSE I := I - 1;
      Object_Record := HEX(I,1) + SUBSTR(Program_Name,1,I) + '0';
      IF (From = 0) THEN Num_Digits := 1
      ELSE Num_Digits := TRUNC(LN(DBLE(From))/LN(DBLE(16.0))) + 1;
      Object_Record := Object_Record + HEX(Num_Digits,1) + HEX(From,Num_Digits);
      IF (Thru = 0) THEN Num_Digits := 1
      ELSE Num_Digits := TRUNC(LN(DBLE((Thru - From + 1) DIV Step_Param))/LN(DBLE(16.0))) + 1;
      Object_Record := Object_Record + HEX(Num_Digits,1) + HEX((Thru - From + 1) DIV Step_Param, Num_Digits);
      Object_Record := '%' + HEX(Object_Record.LENGTH + 5,2) + '300' + Object_Record;
      Error := NOT Add_Checksum_Extended_Tekhex(Object_Record);
      IF (Error) THEN LIB$SIGNAL(hex_illegnam,2,%STDESCR Program_Name,%STDESCR 'Extended Tekhex');
      WRITELN(Object_File,Object_Record);
      Name_Specified := TRUE;
    END;

  I := From;
  Byte_Count := 0;
  WHILE (I <= Thru) DO					(* write out data records *)
    BEGIN
      IF (Plus_Minus_Flag = Plus) THEN
	Load_Addr := I + Plus_Minus_Value
      ELSE
	Load_Addr := I - Plus_Minus_Value;
      IF (Load_Addr = 0) THEN Num_Digits := 1
      ELSE Num_Digits := TRUNC(LN(DBLE(Load_Addr))/LN(DBLE(16.0))) + 1;
      Object_Record := HEX(Num_Digits,1) + HEX(Load_Addr,Num_Digits);
      J := 0;
      WHILE ((J < Width) AND (I <= Thru)) DO	(* add up to Width bytes to a record *)
	BEGIN
	  J := J + 1;
	  Object_Record := Object_Record + HEX(VM[(I-Offset)::INTEGER],2);
	  I := I + Step_Param;
	  Byte_Count := Byte_Count + 1;
	END;
      Object_Record := '%' + HEX(2*J + Num_Digits + 6,2) + '600' + Object_Record;
      Add_Checksum_Extended_Tekhex(Object_Record);					(* add the checksum to the record *)
      WRITELN(Object_File,Object_Record);
    END;

  IF (NOT Partial) THEN									(* now the trailer record *)
    BEGIN
      IF (Transfer = 0) THEN Num_Digits := 1
      ELSE Num_Digits := TRUNC(LN(DBLE(Transfer))/LN(DBLE(16.0))) + 1;      
      Object_Record := HEX(Num_Digits,1) + HEX(Transfer,Num_Digits);
      Object_Record := '%' + HEX(Num_Digits + 6,2) + '800' + Object_Record;
      Add_Checksum_Extended_Tekhex(Object_Record);					(* add the checksum to the record *)
      WRITELN(Object_File,Object_Record);
    END;

  CLOSE(Object_File);

  IF (Name_Specified) THEN Process_Command('NAME');
  Write_Stats;

END;

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

[GLOBAL] PROCEDURE Write_Extended_Tekhex;

{ This procedure writes the specified range of virtual memory into an Extended Tekhex format object file. }

VAR
	Sys_Stat		: INTEGER;
      	File_Spec		: String_80;

BEGIN

  IF (Get_File_Write(Output_File)) THEN
    BEGIN
      File_Spec := SUBSTR(Output_File,1,INDEX(Output_File,';')-1);	(* strip off the virgin number *)
      OPEN(Object_File, File_Spec, HISTORY := NEW);
      REWRITE(Object_File);
      Write_to_File_Extended_Tekhex(FALSE);				{ your not appending so write out a header record }
    END;

END;

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

[GLOBAL] PROCEDURE Append_Extended_Tekhex;

{ This procedure appends the given range of virtual memory to the specified file. }

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Obj_Record		: Extended_Tekhex_Record;

BEGIN

  Error := FALSE;
  Error :=  NOT Get_File_Read(Object_File_Spec);	(* is the object file there? *)

  IF (NOT Error) THEN	(* open and reset the file *)
    BEGIN
      OPEN(Object_File,Object_File_Spec,OLD,ERROR := CONTINUE);
      IF (STATUS(Object_File) <> 0) THEN
	BEGIN
	  LIB$SIGNAL(hex_openerr,1,%STDESCR SUBSTR(Object_File_Spec,1,Object_File_Spec.LENGTH));
	  Error := TRUE;
	END
      ELSE
        RESET(Object_File);
    END;

  IF (NOT Error) THEN
    BEGIN
      WHILE (NOT EOF(Object_File)) DO READLN(Object_File,Obj_Record);
      TRUNCATE(Object_File);
      Write_to_File_Extended_Tekhex(TRUE);
    END;

END;

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

END. { module extended_tekhex_io }