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

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

TYPE
	Texas_Record		= VARYING [512] 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] 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_Name(New_Name: Fixed_String_8); EXTERN;

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

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

[GLOBAL] PROCEDURE Read_Texas;

{ This procedure reads a Texas format object file into virtual memory. }

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Done			: BOOLEAN;
	File_Record		: Texas_Record;
	Sum    			: UNSIGNED;
	Checksum		: UNSIGNED;
	Load_Address	       	: UNSIGNED;
	I			: INTEGER;
	End_of_Record		: BOOLEAN;
	Data_Byte		: Unsigned_Byte;
	Use_Count		: INTEGER;
	Name_Specified		: BOOLEAN;
	Transfer_Specified	: BOOLEAN;
	Temp_Name		: Fixed_String_8;
	Temp_Transfer		: UNSIGNED;

BEGIN

  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;
      Sum := 0;
      Load_Address := 0;
      Temp_Name := '        ';
      Temp_Transfer := 0;
      IF (Plus_Minus_Flag = Plus) THEN
	Load_Address := Load_Address + Plus_Minus_Value
      ELSE
	Load_Address := Load_Address - Plus_Minus_Value;
      Use_Count := 0;
      Init_High_Low;
      Name_Specified := FALSE;
      Transfer_Specified := FALSE;
      WHILE(NOT EOF(Object_File) AND (NOT Error) AND (NOT Done)) DO
	BEGIN
	  READLN(Object_File,File_Record);
	  IF (File_Record.LENGTH > 0) THEN End_of_Record := FALSE ELSE End_of_Record := TRUE;

	  WHILE ((File_Record.LENGTH > 0) AND (NOT Error)) DO		(* Process the record, consuming it as you go *)
	    BEGIN
	      CASE File_Record[1] OF

		'0':  BEGIN
			IF ((File_Record.LENGTH < 13) OR (SUBSTR(File_Record,1,5) <> '00000')) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE
			  BEGIN
			    Temp_Name := SUBSTR(File_Record,6,8);
			    IF (Read_Flag = File_Read) THEN
			      BEGIN
				Name_Specified := TRUE;
				Program_Name := Temp_Name;
			      END;
			    FOR I := 1 TO 13 DO Sum := Sum + ORD(File_Record[I]);
			    IF (File_Record.LENGTH = 13) THEN
			      File_Record := ''
			    ELSE
			      File_Record := SUBSTR(File_Record,14,File_Record.LENGTH - 13);
			  END;
		      END;

		'1':  BEGIN
			IF (File_Record.LENGTH < 5) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE IF (STR$FIND_FIRST_NOT_IN_SET(SUBSTR(File_Record,2,4),'0123456789ABCDEF') <> 0) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE			{ legal transfer address }
			  BEGIN
			    Temp_Transfer := Hex_to_Dec(SUBSTR(File_Record,2,4));
			    IF (Read_Flag = File_Read) THEN
			      BEGIN
				Transfer_Specified := TRUE;
				Transfer := Temp_Transfer;
			      END;
			    FOR I := 1 TO 5 DO Sum := Sum + ORD(File_Record[I]);
			    IF (File_Record.LENGTH = 5) THEN
			      File_Record := ''
			    ELSE
			      File_Record := SUBSTR(File_Record,6,File_Record.LENGTH - 5);
			  END;
		      END;

		'7':  BEGIN
			IF (File_Record.LENGTH < 5) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE IF (STR$FIND_FIRST_NOT_IN_SET(SUBSTR(File_Record,2,4),'0123456789ABCDEF') <> 0) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE			{ check out checksum }
			  BEGIN
			    Checksum := Hex_to_Dec(SUBSTR(File_Record,2,4));
			    Sum := Sum + ORD(File_Record[1]);
			    IF ((Checksum + Sum) MOD 65536 <> 0) THEN
			      BEGIN
				LIB$SIGNAL(hex_readsumerr,1,%STDESCR SUBSTR(File_Record,2,4));
				Error := TRUE;
			      END
			    ELSE IF (File_Record.LENGTH = 5) THEN
			      File_Record := ''
			    ELSE
			      File_Record := SUBSTR(File_Record,6,File_Record.LENGTH - 5);
			    Sum := 0;
			  END;
		      END;

		'9':  BEGIN
			IF (File_Record.LENGTH < 5) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE IF (STR$FIND_FIRST_NOT_IN_SET(SUBSTR(File_Record,2,4),'0123456789ABCDEF') <> 0) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE			{ legal load address }
			  BEGIN
			    Load_Address := Hex_to_Dec(SUBSTR(File_Record,2,4));
			    IF (Plus_Minus_Flag = Plus) THEN
			      Load_Address := Load_Address + Plus_Minus_Value
			    ELSE
			      Load_Address := Load_Address - Plus_Minus_Value;
			    FOR I := 1 TO 5 DO Sum := Sum + ORD(File_Record[I]);
			    IF (File_Record.LENGTH = 5) THEN
			      File_Record := ''
			    ELSE
			      File_Record := SUBSTR(File_Record,6,File_Record.LENGTH - 5);
			  END;
		      END;

		'B':  BEGIN
			IF (File_Record.LENGTH < 5) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE IF (STR$FIND_FIRST_NOT_IN_SET(SUBSTR(File_Record,2,4),'0123456789ABCDEF') <> 0) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE			{ legal memory values }
			  BEGIN
			    Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,2,2)));
			    Use_Count := Use_Count + 1;
			    IF (Use_Count > Use_2) THEN Use_Count := 1;
			    IF (Use_Count = Use_1) THEN
			      BEGIN
				Error := NOT Do_Read_Compare(Data_Byte,Load_Address);
				IF (NOT Error) THEN Byte_Count := Byte_Count + 1;
			      END;
			    Load_Address := Load_Address + Step_Param;
			    Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,4,2)));
			    Use_Count := Use_Count + 1;
			    IF (Use_Count > Use_2) THEN Use_Count := 1;
			    IF (Use_Count = Use_1) THEN
			      BEGIN
				Error := NOT Do_Read_Compare(Data_Byte,Load_Address);
				IF (NOT Error) THEN Byte_Count := Byte_Count + 1;
			      END;
			    Load_Address := Load_Address + Step_Param;
			    FOR I := 1 TO 5 DO Sum := Sum + ORD(File_Record[I]);
			    IF (File_Record.LENGTH = 5) THEN
			      File_Record := ''
			    ELSE
			      File_Record := SUBSTR(File_Record,6,File_Record.LENGTH - 5);
			  END;
		      END;

		'F':  BEGIN
			IF (File_Record.LENGTH > 1) THEN
			  BEGIN
			    LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			    Error := TRUE;
			  END
			ELSE
			  BEGIN
		       	    End_of_Record := TRUE;
			    File_Record := '';
			  END;
		      END;

		':':  BEGIN
			Done := TRUE;
			File_Record := '';
			End_of_Record := TRUE;
		      END;

		OTHERWISE
		      BEGIN
			LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
			Error := TRUE;
		      END;

	      END; { Case statement }

	    END; { while there's still some string left }

	  IF (NOT End_of_Record) THEN
	    BEGIN
	      LIB$SIGNAL(hex_formaterr,1,%STDESCR 'TEXAS');
	      Error := TRUE;
	    END;

	END; { while there's still some file left }

      CLOSE(Object_File);
      IF (Read_Flag = File_Compare) THEN
	BEGIN
	  IF (Program_Name <> Temp_Name) THEN Compare_Name(Temp_Name);
	  IF (Transfer <> Temp_Transfer) THEN Compare_Transfer(Temp_Transfer);
	END;
      IF (Byte_Count > 0) THEN
 	BEGIN
	  IF (Name_Specified) THEN Process_Command('NAME');
	  IF (Transfer_Specified) THEN Process_Command('TRANSFER');
	  Read_Stats;
	END;

    END;

END;

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

FUNCTION Add_Checksum_Texas(String: Texas_Record): Texas_Record;

{ This function appends a checksum entry and an end-of-record entry onto an otherwise complete Texas format object file record. }

VAR
	I		: INTEGER;
	Sum		: UNSIGNED;

BEGIN

  Sum := 0;
  String := String + '7';
  FOR I := 1 TO String.LENGTH DO
    Sum := Sum + ORD(String[I]);
  Add_Checksum_Texas := String + HEX(65536 - (Sum MOD 65536),4) + 'F';

END;

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

PROCEDURE Write_to_File_Texas(Append_Flag: BOOLEAN);

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

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

BEGIN

  IF (ODD(Width)) THEN Width := Width + 1;

  IF ((Program_Name <> '        ') AND (NOT Append_Flag)) THEN		(* write out name record *)
    BEGIN
      Object_Record := '00000' + Program_Name;
      Object_Record := Add_Checksum_Texas(Object_Record);
      WRITELN(Object_File, Object_Record);
    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;
      Object_Record := '9' + HEX(Load_Addr MOD 65536,4);
      J := 0;
      WHILE ((J < Width) AND (I <= Thru)) DO	(* add up to Width bytes to a record *)
	BEGIN
	  Object_Record := Object_Record + 'B' + HEX(VM[(I-Offset)::INTEGER],2);
	  I := I + Step_Param;
	  Byte_Count := Byte_Count + 1;
	  IF (I <= Thru) THEN
	    Object_Record := Object_Record + HEX(VM[(I-Offset)::INTEGER],2)
	  ELSE
	    Object_Record := Object_Record + '00';
	  I := I + Step_Param;
	  Byte_Count := Byte_Count + 1;
	  J := J + 2;
	END;
      Object_Record := Add_Checksum_Texas(Object_Record);
      WRITELN(Object_File,Object_Record);
    END;

  IF ((NOT Partial) AND (Transfer > 0)) THEN			{ add transfer address record }
    BEGIN
      Object_Record := '1' + HEX(Transfer MOD 65536,4);
      Object_Record := Add_Checksum_Texas(Object_Record);
      WRITELN(Object_File, Object_Record);
    END;

  Object_Record := ': HEX Version ' + Rev_Date;
  WRITELN(Object_File, Object_Record);

  CLOSE(Object_File);

  Write_Stats;

END;

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

[GLOBAL] PROCEDURE Write_Texas;

{ This procedure writes the specified range of virtual memory into a Texas 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_Texas(FALSE);
    END;

END;

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

[GLOBAL] PROCEDURE Append_Texas;

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

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Obj_Record		: Texas_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_Texas(TRUE);
    END;

END;

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

END. { module texas_io }