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

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

TYPE
	Mostek_Record		= VARYING [512] OF CHAR;
	Fixed_String_8		= PACKED ARRAY [1..8] OF CHAR;

VAR
	Object_File		: TEXT;
	Error	       		: BOOLEAN;
	Block_Count		: UNSIGNED;
	Load_Address		: UNSIGNED;
	Replicate_To		: UNSIGNED;

(******************** 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;

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

FUNCTION Check_Checksum_Mostek(String: Mostek_Record): BOOLEAN;

{ This function returns TRUE if the checksum at the end of the passed MOSTEK format object file record is correct and FALSE
  if it is incorrect. }

VAR
	I		: INTEGER;
	Sum		: UNSIGNED;

BEGIN

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

  IF (Sum MOD 256 = 0) THEN
    Check_Checksum_Mostek := TRUE
  ELSE
    Check_Checksum_Mostek := FALSE;

END;

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

FUNCTION Max(I: UNSIGNED; J: UNSIGNED): INTEGER;

{ Returns the larger of I and J. }

BEGIN

  IF (I >= J) THEN
    Max := I::INTEGER
  ELSE
    Max := J::INTEGER;

END;

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

PROCEDURE Read_Recursive_Mostek(String: Mostek_Record);

{ This procedure is used in reading Mostek format "iterated" data records.  If the block count field of the record body is zero,
  the procedure replicates the specified code the required number of times.  Otherwise it strips out the inner nested repeat
  portion of the data record and uses it as the parameter for a recursive call to itself. }

VAR
	Rep_Factor		: UNSIGNED;
	Bytes_to_Read		: UNSIGNED;
	I			: UNSIGNED;
	J			: UNSIGNED;
	N			: UNSIGNED;
	Data_Byte		: Unsigned_Byte;

BEGIN

  Rep_Factor := Hex_to_Dec(SUBSTR(String,1,4));
  IF (Block_Count = 16) THEN				{ first time through }
    BEGIN
      Block_Count := Hex_to_Dec(SUBSTR(String,5,2));
      IF (Block_Count > 15) THEN
	BEGIN
	  LIB$SIGNAL(hex_mositererr);
	  Error := TRUE;
	END;
    END
  ELSE
    BEGIN
      IF (Hex_to_Dec(SUBSTR(String,5,2)) + 1 <> Block_Count) THEN	{ the block count had better be }
	BEGIN								{ one less than the last time.  }
	  LIB$SIGNAL(hex_mositererr);
	  Error := TRUE;
	END
      ELSE
	Block_Count := Hex_to_Dec(SUBSTR(String,5,2));
    END;

    IF (NOT Error) THEN
      BEGIN
	J := Load_Address;
	IF (Block_Count = 0) THEN
	  BEGIN
  	    Bytes_to_Read := Hex_to_Dec(SUBSTR(String,7,2));
	    J := Load_Address;
	    FOR I := 1 TO Rep_Factor DO
	      BEGIN
                N := Use_1;
		WHILE (N <= Bytes_to_Read) DO
		  BEGIN
		    Data_Byte := ORD(Hex_to_Dec(SUBSTR(String,9+2*(N-1),2)));
		    N := N + Use_2;
		    IF (((J >= From) AND (J <= Thru)) OR (NOT Range_Specified)) THEN
		      BEGIN
		      	Error := NOT Do_Read_Compare(Data_Byte,J);
		       	IF (NOT Error) THEN
			  BEGIN
			    Byte_Count := Byte_Count + 1;
			    Replicate_To := J;
			  END;
			J := J + Step_Param;
		      END
	      	    ELSE J := J + 1;
		  END;
	      END;
	  END
	ELSE
	  BEGIN
	    String := SUBSTR(String,7,String.LENGTH-6);
            Read_Recursive_Mostek(String);			{ make the recursive call }
	    FOR I := 2 TO Rep_Factor DO		{ repeat as necessary }
	      FOR J := Load_Address TO Replicate_To DO
		BEGIN
		  N := Replicate_To + ((I-2)*(Replicate_To - Load_Address + 1)) + J - Load_Address + 1;
	      	  Error := NOT Do_Read_Compare(VM[(J-Offset)::INTEGER],N);
		  IF (NOT Error) THEN Byte_Count := Byte_Count + 1;
		END;
	    Replicate_To := N;
	  END;
      END;

END;

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

[GLOBAL] PROCEDURE Read_Mostek;

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

VAR
       	Object_File_Spec	: String_80;
	Done			: BOOLEAN;
	File_Record		: Mostek_Record;
	Transfer_Set		: BOOLEAN;
	Record_Type		: INTEGER;
	Bytes_in_Record		: UNSIGNED;
	Name_Length		: UNSIGNED;
	Name_Specified		: BOOLEAN;
	I			: INTEGER;
	N			: UNSIGNED;
	Data_Byte		: Unsigned_Byte;
	Temp_Name		: Fixed_String_8;
	Temp_Transfer		: UNSIGNED;

BEGIN

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

  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;
      Init_High_Low;
      Byte_Count := 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);

	  IF ((File_Record.LENGTH > 0) AND (File_Record.LENGTH < 8)) THEN		{ is the record long enough? }
	    BEGIN
	      LIB$SIGNAL(hex_formaterr,1,%STDESCR 'MOSTEK');
	      Error := TRUE;
	    END;

	  IF ((File_Record.LENGTH > 0) AND (NOT Error)) THEN				{ what type of record? }
	    IF (SUBSTR(File_Record,1,2) = 'F0') THEN
	      Record_Type := 0
	    ELSE IF (SUBSTR(File_Record,1,2) = 'F2') THEN
	      Record_Type := 2
	    ELSE IF (SUBSTR(File_Record,1,2) = 'F4') THEN
	      Record_Type := 4
	    ELSE IF (SUBSTR(File_Record,1,2) = 'F6') THEN
	      Record_Type := 6
	    ELSE
	      BEGIN
		LIB$SIGNAL(hex_formaterr,1,%STDESCR 'MOSTEK');
	        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			{ get number of bytes in the record }
	    BEGIN
	      Bytes_in_Record := Hex_to_Dec(SUBSTR(File_Record,3,4));
	      IF (2 * Bytes_in_Record + 6 <> File_Record.LENGTH) THEN
	      BEGIN
		LIB$SIGNAL(hex_formaterr,1,%STDESCR 'MOSTEK');
	        Error := TRUE;
	      END;
	    END;

	  IF ((NOT Error) AND (File_Record.LENGTH > 0)) THEN
	    BEGIN
	      Error := NOT Check_Checksum_Mostek(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
	    CASE (Record_Type) OF

		0:  BEGIN							{ module header block }
		      Name_Length := Hex_to_Dec(SUBSTR(File_Record,7,2));
		      IF (Name_Length > 0) THEN					{ program name defined }
			BEGIN
			  FOR I := 1 TO Max(Name_Length,8) DO
		            Temp_Name[I] := CHR(Hex_to_Dec(SUBSTR(File_Record,2*(I-1) + 9,2)));
			  IF (Read_Flag = File_Read) THEN
			    BEGIN
			      Program_Name := Temp_Name;
			      Name_Specified := TRUE;
			    END;
			END;

		      IF (SUBSTR(File_Record,2*Name_Length+9,2) = '10') THEN	{ addressing mode }
			Addressing_Mode := Mode_16
		      ELSE IF (SUBSTR(File_Record,Name_Length+9,2) = '20') THEN
			Addressing_Mode := Mode_32
		      ELSE
			BEGIN
			  LIB$SIGNAL(hex_formaterr,1,%STDESCR 'MOSTEK');
			  Error := TRUE;
			END;
                     
		      IF (ODD(Hex_to_Dec(SUBSTR(File_Record,2*Name_Length+13,2)))) THEN
			BEGIN
			  IF (Partial) THEN LIB$SIGNAL(hex_nopartindic);
			  Partial := FALSE;
			END
		      ELSE
			BEGIN
			  IF (NOT Partial) THEN LIB$SIGNAL(hex_partindic);
			  Partial := TRUE;
			END;
		    END;

		2:  BEGIN					{ enumerated data record }
		      IF (Addressing_Mode = Mode_16) THEN
			BEGIN
			  Load_Address := Hex_to_Dec(SUBSTR(File_Record,7,4));
			  Bytes_in_Record := Bytes_in_Record - 3;
			END
		      ELSE
			BEGIN
			  Load_Address := Hex_to_Dec(SUBSTR(File_Record,7,8));
			  Bytes_in_Record := Bytes_in_Record - 5;
			END;
		      N := Use_1;
		      WHILE (N <= Bytes_in_Record) DO
		        BEGIN
			  IF (Addressing_Mode = Mode_16) THEN
			    Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,11+2*(N-1),2)))
			  ELSE
			    Data_Byte := ORD(Hex_to_Dec(SUBSTR(File_Record,15+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;
		      
		4:  BEGIN						{ iterated data record }
		      IF (Addressing_Mode = Mode_16) THEN
			BEGIN
			  Load_Address := Hex_to_Dec(SUBSTR(File_Record,7,4));
			  File_Record := SUBSTR(File_Record,11,File_Record.LENGTH - 12);
			END
		      ELSE
			BEGIN
			  Load_Address := Hex_to_Dec(SUBSTR(File_Record,7,8));
		          File_Record := SUBSTR(File_Record,15,File_Record.LENGTH - 16);
			END;
		      Block_Count := 16;
		      Read_Recursive_Mostek(File_Record);
		    END;
                
		6:  BEGIN					{ trailer block }
		      Done := TRUE;
		      IF (Partial) THEN LIB$SIGNAL(hex_unexptrailer);
		      IF (Bytes_in_Record = 3) THEN
			BEGIN
			  Temp_Transfer := Hex_to_Dec(SUBSTR(File_Record,7,4));
			  IF (Read_Flag = File_Read) THEN
			    BEGIN
			      Transfer := Temp_Transfer;
			      Transfer_Set := TRUE;
			    END;
			END
		      ELSE IF (Bytes_in_Record = 5) THEN
			BEGIN
			  Temp_Transfer := Hex_to_Dec(SUBSTR(File_Record,7,4));
			  IF (Read_Flag = File_Read) THEN
			    BEGIN
			      Transfer := Temp_Transfer;
			      Transfer_Set := TRUE;
			    END;
			END
		      ELSE IF (Bytes_in_Record <> 1) THEN
			BEGIN
			  LIB$SIGNAL(hex_formaterr,1,%STDESCR 'MOSTEK');
			  Error := TRUE;
			END;
		    END;

	    END; { Case statement }

	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 (Program_Name <> Temp_Name) THEN Compare_Name(Temp_Name);
	  IF (Transfer <> Temp_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_Mostek(String: Mostek_Record): Mostek_Record;

{ This function appends the checksum on to an otherwise complete Mostek format object record. }

VAR
	I		: UNSIGNED;
	Sum		: UNSIGNED;

BEGIN

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

  Add_Checksum_Mostek := String + HEX(256-(Sum MOD 256),2);

END;

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

PROCEDURE Write_to_File_Mostek(Append_Flag: BOOLEAN);

VAR
	Object_Record	      	: Mostek_Record;
	I			: UNSIGNED;
	J      			: UNSIGNED;
	N			: UNSIGNED;
	Name_Length		: UNSIGNED;
  	Load_Addr		: UNSIGNED;
	All_the_Same		: BOOLEAN;
	Test_Byte		: Unsigned_Byte;
                                
BEGIN

  IF (NOT Append_Flag) THEN
    BEGIN
      IF (Program_Name <> '        ') THEN			{ module header record }
	BEGIN
	  Object_Record := '';
	  Name_Length := 0;
	  FOR I := 1 TO 8 DO
	    IF ((ORD(Program_Name[I::INTEGER]) > 20) AND (ORD(Program_Name[I::INTEGER]) < 127)) THEN
	      BEGIN
		Object_Record := Object_Record + HEX(ORD(Program_Name[I::INTEGER]),2);
		Name_Length := Name_Length + 1;
	      END;
	  Object_Record := 'F0' + HEX(9+Name_Length,4) + HEX(Name_Length,2) + Object_Record;
	END
      ELSE
	BEGIN 
	  Object_Record := 'F0000900';
	END;

      IF (Addressing_Mode = Mode_16) THEN
	Object_Record := Object_Record + '1000'
      ELSE
	Object_Record := Object_Record + '2000';

      IF (Partial) THEN
	Object_Record := Object_Record + '02' + HEX(From,4) + HEX(Thru,4)
      ELSE
	Object_Record := Object_Record + '03' + HEX(From,4) + HEX(Thru,4);

      Object_Record := Add_Checksum_Mostek(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;

      All_the_Same := TRUE;				{ Should you use an iterated data record? }
      Test_Byte := VM[(I-Offset)::INTEGER];
      N := 1;
      WHILE ((N <= Width) AND ((I + N) - Offset <= VM_Size) AND (All_the_Same)) DO
	BEGIN
	  IF (VM[(I+N-Offset)::INTEGER] <> Test_Byte) THEN All_the_Same := FALSE;
	  N := N + Step_Param;
	END;
      
      IF ((Width > 5) AND (All_the_Same)) THEN		{ construct an iterated data record }
	BEGIN
	  Object_Record := HEX(Width,4) + '0001' + HEX(Test_Byte,2);
	  IF (Addressing_Mode = Mode_16) THEN
	    Object_Record := 'F40008' + HEX(Load_Addr,4) + Object_Record
	  ELSE
	    Object_Record := 'F40010' + HEX(Load_Addr,8) + Object_Record;
	  Byte_Count := Byte_Count + Width;
	  I := I + Width;
	END
      ELSE						{ construct an enumerated data record }
	BEGIN
	  IF (Addressing_Mode = Mode_16) THEN
	    Object_Record := HEX(Load_Addr,4)
	  ELSE
	    Object_Record := HEX(Load_Addr,8);
	  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 (Addressing_Mode = Mode_16) THEN
            Object_Record := 'F2' + HEX(J+3,4) + Object_Record
	  ELSE
            Object_Record := 'F2' + HEX(J+5,4) + Object_Record;
	END;
      Object_Record := Add_Checksum_Mostek(Object_Record);
      WRITELN(Object_File,Object_Record);
    END;

  IF (NOT Partial) THEN
    BEGIN
      IF (Transfer = 0) THEN
	Object_Record := 'F60001'
      ELSE
	IF (Addressing_Mode = Mode_16) THEN
	  Object_Record := 'F60003' + HEX(Transfer,4)
	ELSE
	  Object_Record := 'F60005' + HEX(Transfer,8);
      Object_Record := Add_Checksum_Mostek(Object_Record);
      WRITELN(Object_File,Object_Record);
    END;

  CLOSE(Object_File);
  Write_Stats;

END;

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

[GLOBAL] PROCEDURE Write_Mostek;

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

END;

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

[GLOBAL] PROCEDURE Append_Mostek;

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

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

END;

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

END. { module mostek_io }