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

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

TYPE
	RCA_Record		= VARYING [512] 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 Collapse_String(String: RCA_Record): RCA_Record;

{ This function takes a partial RCA object file record (starting at the first data byte) and returns the record with all of the
  non-hexadecimal characters (expect the last character in the record) removed. }

VAR
	I		: INTEGER;
	Temp_String	: RCA_Record;

BEGIN

  Temp_String := '';
  FOR I := 1 TO  String.LENGTH - 1 DO
    IF (STR$FIND_FIRST_NOT_IN_SET(SUBSTR(String,I,1),'0123456789ABCDEF') = 0) THEN Temp_String := Temp_String + String[I];
  Collapse_String := Temp_String + String[LENGTH(String)];

END;

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

[GLOBAL] PROCEDURE Read_RCA;

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

VAR
       	Object_File_Spec	: String_80;
	Error	       		: BOOLEAN;
	Done			: BOOLEAN;
	File_Record		: RCA_Record;
	Transfer_Set		: BOOLEAN;
	Temp_Transfer		: UNSIGNED;
	Expecting_Marker	: BOOLEAN;
	Expecting_Load_Address	: BOOLEAN;
      	M_Pos			: INTEGER;
	P_Pos			: INTEGER;
	Separator		: INTEGER;
	Load_Address		: UNSIGNED;
	N			: UNSIGNED;
	Data_Byte		: Unsigned_Byte;
	Bytes_in_Record		: UNSIGNED;

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;
      Expecting_Marker := TRUE;
      Expecting_Load_Address := FALSE;
      Init_High_Low;
      WHILE(NOT EOF(Object_File) AND (NOT Error) AND (NOT Done)) DO
	BEGIN
	  READLN(Object_File,File_Record);

	  IF ((Expecting_Marker) AND (File_Record.LENGTH > 0)) THEN
	    BEGIN
	      M_Pos := INDEX(File_Record,'!M');
	      P_Pos := INDEX(File_Record,'$P');
	      IF (M_Pos = 0) AND (P_Pos = 0) THEN
		BEGIN
		  LIB$SIGNAL(hex_formaterr,1,%STDESCR 'RCA');
		  Error := TRUE;
		END
	      ELSE
		BEGIN
		  IF (P_Pos > 0) THEN		{ Trailer Record }
		    BEGIN
		      File_Record := SUBSTR(File_Record,P_Pos+2,File_Record.LENGTH - P_Pos - 1);
		      IF (File_Record.LENGTH > 0) THEN
			BEGIN
			  IF (STR$FIND_FIRST_NOT_IN_SET(File_Record,'0123456789ABCDEF') <> 0) THEN
			    BEGIN
			      LIB$SIGNAL(hex_readnonhex);
			      Error := TRUE;
			    END
			  ELSE IF (File_Record.LENGTH > 4) THEN
			    BEGIN
			      LIB$SIGNAL(hex_illegtransfer,1,%STDESCR SUBSTR(File_Record,1,File_Record.LENGTH));
			      Error := TRUE;
			    END
			  ELSE
			    BEGIN
			      Done := TRUE;
			      Temp_Transfer := Hex_to_Dec(File_Record);
		  	      IF (Read_Flag = File_Read) THEN Transfer := Temp_Transfer;
			      IF (Partial) THEN LIB$SIGNAL(hex_unexptrailer);
			    END;
			END;
		    END
		  ELSE				{ Data Record }
		    BEGIN
		      File_Record := SUBSTR(File_Record,M_Pos+2,File_Record.LENGTH - M_Pos - 1);
		      Expecting_Marker := FALSE;
		      Expecting_Load_Address := TRUE;
		    END;
		END;
	    END;

	  IF ((NOT Error) AND (NOT Done) AND (Expecting_Load_Address) AND (File_Record.LENGTH > 0)) THEN
	    BEGIN
	      Separator := STR$FIND_FIRST_NOT_IN_SET(File_Record,'0123456789ABCDEF');
	      IF (Separator <= 1) THEN
		LIB$SIGNAL(hex_formaterr,1,%STDESCR 'RCA')
	      ELSE
		BEGIN
		  Load_Address := Hex_to_Dec(SUBSTR(File_Record,1,Separator-1));
		  File_Record := SUBSTR(File_Record,Separator+1,File_Record.LENGTH - Separator);
		  Expecting_Load_Address := FALSE;
		END;
	    END;

	  IF ((NOT Error) AND  (NOT Done) AND (NOT Expecting_Load_Address) AND (File_Record.LENGTH > 0)) THEN
	    BEGIN
	      File_Record := Collapse_String(File_Record);
	      Bytes_in_Record := File_Record.LENGTH DIV 2;
	      N := Use_1;
	      WHILE (N <= Bytes_in_Record) DO
	        BEGIN
		  Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,1+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 (File_Record[File_Record.LENGTH] = ';') THEN
		Expecting_Load_Address := TRUE
	      ELSE IF (File_Record[File_Record.LENGTH] <> ',') THEN
		Expecting_Marker := TRUE;
	    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) AND (Temp_Transfer <> Transfer)) THEN Compare_Transfer(Temp_Transfer);
      IF (Byte_Count > 0) THEN Read_Stats;
      IF (Transfer_Set) THEN Process_Command('TRANSFER');
    END;

END;

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

PROCEDURE Write_to_File_RCA;

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

VAR
	First_Time		: BOOLEAN;
	Object_Record		: RCA_Record;
	I			: UNSIGNED;
	J			: INTEGER;
	Load_Addr		: UNSIGNED;

BEGIN

  First_Time := TRUE;
  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 := HEX(Load_Addr MOD 65536,4);
      IF (First_Time) THEN
	BEGIN
	  Object_Record := '!M' + Object_Record;
	  First_Time := FALSE;
	END;
      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;
      IF (I <= Thru) THEN Object_Record := Object_Record + ';';
      WRITELN(Object_File,Object_Record);
    END;

  IF (NOT Partial) THEN				(* tack on an end of file record *)
    BEGIN
      Object_Record := '$P';
      IF (Transfer > 0) THEN Object_Record := Object_Record + HEX(Transfer,4);
      WRITELN(Object_File,Object_Record);
    END;

  CLOSE(Object_File);

  Write_Stats;

END;

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

[GLOBAL] PROCEDURE Write_RCA;

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

END;

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

[GLOBAL] PROCEDURE Append_RCA;

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

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

END;

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

END. { module rca_io }