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

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

TYPE
	Intel_Record		= VARYING [511] 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] FUNCTION Do_Read_Compare(Byte: Unsigned_Byte; Location: UNSIGNED): BOOLEAN; EXTERN;

[EXTERNAL] PROCEDURE Init_High_Low; EXTERN;

[EXTERNAL] PROCEDURE Read_Stats; EXTERN;

[EXTERNAL] PROCEDURE Write_Stats; EXTERN;

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

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

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

FUNCTION Intel_Check_Checksum(Input_Record: Intel_Record): BOOLEAN;

{ This function takes an INTEL format record and returns TRUE if the checksum contained in the last two byte of the record
  are correct and FALSE if they are wrong. }

VAR
	Data_Byte	: String_80;
  	Total		: UNSIGNED;
	I		: INTEGER;

BEGIN

  Total := 0;
  I := 1;
  WHILE (I < Input_Record.LENGTH) DO
    BEGIN
      Data_Byte := SUBSTR(Input_Record,I,2);
      Total := Total + Hex_to_Dec(Data_Byte);
      I := I + 2;
    END;

  IF (Total MOD 256 = 0) THEN
    Intel_Check_Checksum := TRUE
  ELSE
    Intel_Check_Checksum := FALSE;

END;

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

[GLOBAL] PROCEDURE Read_Intel;

{ This procedure reads on INTEL format object file into virtual memory. }

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Done			: BOOLEAN;
	File_Record		: Intel_Record;
	Start_of_Record		: INTEGER;
     	Bytes_In_Record		: UNSIGNED;
	Load_Address	      	: UNSIGNED;
	Base_Address		: UNSIGNED;
	Record_Type		: UNSIGNED;
	N			: UNSIGNED;
	Data_Byte		: Unsigned_Byte;
	Temp_Transfer		: UNSIGNED;
	Transfer_Set		: BOOLEAN;

BEGIN

  Transfer_Set := 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,READONLY,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;
      Base_Address := 0;
      Init_High_Low;
      Temp_Transfer := 0;
      WHILE(NOT EOF(Object_File) AND (NOT Error) AND (NOT Done)) DO
	BEGIN
	  READLN(Object_File,File_Record);
	  STR$TRIM(File_Record,File_Record);
	  Start_of_Record := INDEX(File_Record,':');					(* skip comments *)

	  IF ((File_Record.LENGTH > 0) AND (Start_of_Record = 0)) THEN			(* no colon - illegal format *)
	    BEGIN
	      LIB$SIGNAL(hex_formaterr,1,%STDESCR 'INTEL');
	      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,Start_of_Record+1,File_Record.LENGTH - Start_of_Record);

	  IF (NOT Error) AND (ODD(File_Record.LENGTH)) THEN				(* uneven number of hex digits - *)
	    BEGIN									(* illegal format		 *)
	      LIB$SIGNAL(hex_formaterr,1,%STDESCR 'INTEL');
	      Error := TRUE;
	    END;

	  IF ((NOT Error) AND								(* non-hexadecimal characters in *)
	      (File_Record.LENGTH > 0) AND						(* record.			 *)
	      (STR$FIND_FIRST_NOT_IN_SET(File_Record,'0123456789ABCDEF') <> 0)) THEN
	    BEGIN
	      LIB$SIGNAL(hex_readnonhex);
	      Error := TRUE;
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN				(* what about the checksum? *)
	    BEGIN
	      Error := NOT Intel_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				(* How many bytes in record? *)
	    BEGIN
	      Bytes_in_Record := Hex_to_Dec(SUBSTR(File_Record,1,2));
	      IF (2 * Bytes_in_Record <> File_Record.LENGTH - 10) THEN			(* We've got a problem. *)
	        BEGIN
	          LIB$SIGNAL(hex_recformaterr,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
	          Error := TRUE;
	        END;
	      IF (Bytes_in_Record = 0) THEN Done := TRUE;
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN				(* Get load address and record type *)
	    BEGIN
	      Load_Address := Base_Address + Hex_to_Dec(SUBSTR(File_Record,3,4));
	      Record_Type := Hex_to_Dec(SUBSTR(File_Record,7,2));
	      IF ((Record_Type < 0) OR (Record_Type > 4) OR ((Record_Type <> 0) AND (Load_Address - Base_Address <> 0))) THEN
	        BEGIN
	          LIB$SIGNAL(hex_recformaterr,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
	          Error := TRUE;
	        END;
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0) AND (NOT Done)) THEN
	    BEGIN
	      CASE (Record_Type::INTEGER) OF

	      0:  BEGIN						   		(* data record *)
		    N := Use_1;
		    WHILE ((N <= Bytes_in_Record) AND (NOT Error)) DO
		      BEGIN
			Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,9+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;
IF (Error) THEN WRITELN(File_Record);
		  END;

	      1:  BEGIN								(* end-of-file record *)
		    Done := TRUE;
		    IF (Partial) THEN LIB$SIGNAL(hex_unexptrailer);
		  END;

	      2:  BEGIN								(* extended address record *)
		    IF (Bytes_in_Record <> 2) THEN
		      BEGIN
			LIB$SIGNAL(hex_recformaterr,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
			Error := TRUE;
		      END
		    ELSE
		      Base_Address := 16 * Hex_to_Dec(SUBSTR(File_Record,9,4));
		  END;

	      3:  BEGIN								(* transfer address record *)
		    IF (Bytes_in_Record <> 4) THEN
		      BEGIN
			LIB$SIGNAL(hex_recformaterr,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
			Error := TRUE;
		      END
		    ELSE
		      BEGIN
			Temp_Transfer := (16 * Hex_to_Dec(SUBSTR(File_Record,9,4))) + Hex_to_Dec(SUBSTR(File_Record,13,4));
			IF (Read_Flag = File_Read) THEN
			  BEGIN
			    Transfer := Temp_Transfer;
			    Transfer_Set := TRUE;
			  END;
		      END;
		  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 ((Temp_Transfer <> Transfer) AND (Read_Flag = File_Compare)) THEN	{ compare it with the other transfer address }
	Compare_Transfer(Temp_Transfer);
      IF (Byte_Count > 0) THEN Read_Stats;
      IF (Transfer_Set) THEN Process_Command('TRANSFER');
    END;

END;

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

FUNCTION Add_Checksum(String: Intel_Record): Intel_Record;

{ This function takes an INTEL format object record (less the checksum byte) and appends the checksum byte to it. }

VAR
	I		: INTEGER;
	Sum		: UNSIGNED;

BEGIN

  I := 2;				(* skip the colon *)
  Sum := 0;
  WHILE (I < String.LENGTH) DO
    BEGIN
      Sum := Sum + Hex_to_Dec(SUBSTR(String,I,2));
      I := I + 2;
    END;
  Sum := 256 - (Sum MOD 256);
  Add_Checksum := String + HEX(Sum,2);

END;

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

PROCEDURE Write_to_File_Intel;

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

VAR
	Object_Record		: INTEL_Record;
	I			: UNSIGNED;
	J			: INTEGER;
	Load_Addr		: UNSIGNED;

BEGIN

  IF (Addressing_Mode <> Mode_16) THEN		(* write out an extended address record *)
    BEGIN
      Object_Record := ':02000002' + HEX(Offset DIV 16,4);
      Object_Record := Add_Checksum(Object_Record);
      WRITELN(Object_File,Object_Record);
      IF (Offset > 1048575) THEN LIB$SIGNAL(hex_offtrunc);
    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 (Addressing_Mode = Mode_16) THEN		(* Construct load address adding in Offset *)
	Object_Record := HEX(Load_Addr,4) + '00'
      ELSE
	Object_Record := HEX((Offset MOD 256) + (Load_Addr-Offset) ,4) + '00';
      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(J,2) + Object_Record;	(* add the bytes in the record to the record *)
      Object_Record := Add_Checksum(Object_Record);		(* add the checksum to the record *)
      WRITELN(Object_File,Object_Record);
    END;

  IF ((Transfer > 0) AND (NOT Partial)) THEN				(* write a transfer address record *)
    BEGIN
      Object_Record := ':04000003' + HEX((Transfer DIV 65536) MOD 16,4) + HEX(Transfer MOD 65536,4);
      Object_Record := Add_Checksum(Object_Record);
      WRITELN(Object_File,Object_Record);
    END;

  IF (NOT Partial) THEN				(* tack on an end of file record *)
    WRITELN(Object_File,':00000001FF');

  CLOSE(Object_File);

  Write_Stats;

END;

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

[GLOBAL] PROCEDURE Write_Intel;

{ This procedure writes the specified range of virtual memory into an INTEL 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_Intel;
    END;

END;

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

[GLOBAL] PROCEDURE Append_Intel;

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

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Obj_Record		: INTEL_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_Intel;
    END;


END;

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

END. { module intel_io }