PROGRAM I2E
C
C	PROGRAM TO TURN INTEL FORMATED OBJECT RECORDS INTO
C	EXTENDED TEKTRONIX HEX RECORDS.
C	
C	JEFF HAMILTON
C	E-SYSTEMS
C	P.O.BOX 1056  CBN27
C	GREENVILLE, TEXAS  75401
C	(214)454-4175
C
	BYTE INLINE(100), SYMLST(6,200)
	BYTE OUTLIN(255)
	INTEGER*2 RECTYP, SYMNUM
	INTEGER*4 SYMADR(200), LOADRS, STADRS, ABSADR, SEGADR
	CHARACTER*255 COTLIN
	LOGICAL*1 SYMBOL, OBJEND
	EQUIVALENCE (COTLIN,OUTLIN(1))
	DATA SYMBOL/.FALSE./
C
	IPRT = 3
	IRDR = 1
	IPCH = 2
	CALL LINKLU(IPRT,IRDR,IPCH)
	DO 5,I = 1,255
		OUTLIN(I) = '0'O
5	CONTINUE
	SEGADR = 0
	LINRED = 0
1	LINRED = LINRED+1
	READ(IRDR,2000,END = 800)N,(INLINE(I),I=1,N)
	DO 6, I=N+1,80
		INLINE(I) = '0'O
6	CONTINUE
	IF(INLINE(1).EQ.':')GO TO 50
C
C	HANDLE SYMBOL TABLE INFO
C
	IF(INLINE(1).EQ.'$'.AND.LINRED.EQ.1)SYMBOL = .TRUE.
	IF(INLINE(1).EQ.'$'.AND.LINRED.NE.1)SYMBOL = .FALSE.
	IF(SYMBOL)THEN
		IF(INLINE(1).EQ.'$')GO TO 1
		INDNT = 4
		IF(INLINE(50).EQ.' ')INDNT = 3
		IF(INLINE(50).EQ.'0'O)INDNT = 3
		IF(INLINE(34).EQ.' ')INDNT = 2
		IF(INLINE(34).EQ.'0'O)INDNT = 2
		IF(INLINE(18).EQ.' ')INDNT = 1
		IF(INLINE(18).EQ.'0'O)INDNT = 1
		IF(INLINE(2).EQ.' ')INDNT = 0
		IF(INLINE(2).EQ.'0'O)INDNT = 0
		DO 10,I = 1,INDNT
			SYMNUM = SYMNUM + 1
			DO 9,J = 1,6
				SYMLST(J,SYMNUM) = INLINE(16*(I-1)+1+J)
9			CONTINUE
			DECODE(5,1005,INLINE((16*I)-6))SYMADR(SYMNUM)
10		CONTINUE
	ELSE
		NUMSYM = SYMNUM
C
C	SECTION DEFINITION
C
		OUTLIN(1) = '%'				!EXTENDED TEK HEX
		OUTLIN(4) = '3'				!SYMBOL BLOCK
		OUTLIN(7) = '6'				!LENGTH OF SECTION NAME
		COTLIN(8:13) = 'MEMORY'			!SECTION NAME
		OUTLIN(14) = '0'			!SECTION DEFINITION
		OUTLIN(15) = '1'			!LENGTH OF BASE ADDRESS
		OUTLIN(16) = '0'			!BASE ADDRESS OF SECTION
		OUTLIN(17) = '6'			!NUMBER OF CHARACTERS IN SECTION
		ENCODE(6,1006,OUTLIN(18)) 1048576	!LENGTH OF SECTION
		OUTLIN(24) = '1'			!SYMBOL DEFINITION
		OUTLIN(25) = '1'			!NUMBER OF CHAR IN SYMBOL
		OUTLIN(26) = '0'			!SYMBOL
		OUTLIN(27) = '1'			!NUMBER OF CHAR IN ADDRESS
		OUTLIN(28) = '0'			!ADDRESS
		CALL CKSUM(OUTLIN,NUMBER)		!CK SUM AND BYTE COUNT
		CALL OUT(OUTLIN,NUMBER,IPCH)		!PUT OUT LINE
C
C	SYMBOL TABLE
C
		DO 40,SYMNUM = 1,NUMSYM
			OUTLIN(1) = '%'			!EXTENDED TEK HEX
			OUTLIN(4) = '3'			!SYMBOL BLOCK
			OUTLIN(7) = '6'			!LENGTH OF SECTION NAME
			COTLIN(8:13) = 'MEMORY'		!SECTION NAME
			OUTLIN(14) = '1'		!GLOBAL ADDRESS
			DO 35,J = 1,6
				IF(SYMLST(J,SYMNUM).EQ.' ')GO TO 35
				LAST = J
				OUTLIN(15+J) = SYMLST(J,SYMNUM)	
35			CONTINUE
			ENCODE(1,1001,OUTLIN(15))LAST
			OUTLIN(16+LAST) = '6'
			ENCODE(6,1006,OUTLIN(17+LAST))SYMADR(SYMNUM)
			CALL CKSUM(OUTLIN,NUMBER)		
			CALL OUT(OUTLIN,NUMBER,IPCH)		
40		CONTINUE
	END IF
	GO TO 1
50	IF(INLINE(8).NE.'0')GO TO 900		
	DECODE(2,1002,INLINE(8))RECTYP
	GO TO (100, 200, 300, 400) RECTYP + 1
C
C	INTEL DATA BLOCK RECORD
C
100	DECODE(4,1004,INLINE(4))LOADRS
	ABSADR  =  LOADRS + ISHFT(SEGADR,4)		
	DECODE(2,1002,INLINE(2))NUMBYT
	OUTLIN(1) = '%'					!EXTENDED TEK HEX
	OUTLIN(4) = '6'					!DATA BLOCK
	OUTLIN(7) = '6'					!LENGTH OF ABS ADDRESS
	ENCODE(6,1006,OUTLIN(8))ABSADR			!ABSOLUTE ADDRESS
	DO 110,I = 1,2*NUMBYT				!COPY THE OBJECT RECORDS
		OUTLIN(13+I) = INLINE(9+I)		!...ALL OF THEM
110	CONTINUE
	CALL CKSUM(OUTLIN,NUMBER)			!CK SUM AND NUM OF BYTES
	CALL OUT(OUTLIN,NUMBER,IPCH)		 	!OUT THE LINE
	GO TO 1						!GET NEXT RECORD
C
C	INTEL TERMINATOR RECORD
C
200	DECODE(4,1004,INLINE(4))LOADRS			!GET LOAD ADDRESS
	IF(LOADRS .NE. 0)GO TO 901			!MUST BE ERROR
	DECODE(2,1002,INLINE(2))NUMBYT			!GET NUMBER OF BYTES
	IF(NUMBYT .NE. 0)GO TO 902			!MUST BE ERROR
	OUTLIN(1) = '%'					!EXTENDED TEK HEX
	OUTLIN(4) = '8'					!TERMINATOR BLOCK
	OUTLIN(7) = '6'					!LENGTH OF START ADDRESS
	ENCODE(6,1006,OUTLIN(8))STADRS			!STARTING ADDRESS
	CALL CKSUM(OUTLIN,NUMBER)			!CK SUM AND NUM OF BYTES
	CALL OUT(OUTLIN,NUMBER,IPCH)		 	!PUT OUT RECORD
	GO TO 1						!GET NEXT RECORD
C
C	INTEL SEGMENT BASE ADDRESS RECORD	(8086 SPECIFIC)
C
300	DECODE(4,1004,INLINE(4))LOADRS			!GET LOAD ADDRESS
	IF(LOADRS .NE. 0)GO TO 901			!MUST BE ERROR
	DECODE(2,1002,INLINE(2))NUMBYT			!GET NUMBER OF BYTES
	IF(NUMBYT .NE. 2)GO TO 902			!MUST BE ERROR
	DECODE(4,1004,INLINE(10))SEGADR			!GET SEGMENT ADDRESS
	GO TO 1						!GET NEXT RECORD
C
C	INTEL STARTING ADDRESS RECORD
C
400	DECODE(4,1004,INLINE(4))LOADRS			!GET LOAD ADDRESS
	IF(LOADRS .NE. 0)GO TO 901			!MUST BE ERROR
	DECODE(2,1002,INLINE(2))NUMBYT			!GET NUMBER OF BYTES
	IF(NUMBYT .NE. 4)GO TO 902			!MUST BE ERROR
	DECODE(4,1004,INLINE(10))SEGADR			!GET SEGMENT ADDRESS
	DECODE(4,1004,INLINE(14))LOADRS			!GET LOAD ADRESSS PART
	STADRS = LOADRS + ISHFT(SEGADR,4)		!STARTING ADDRESS
	GO TO 1						!GET NEXT RECORD
C
C	NORMAL EXIT
C
800	CALL EXIT(1)
C
C	ERRORS
C
900	WRITE(IPRT,1900)LINRED
	CALL EXIT(4)
901	WRITE(IPRT,1901)LINRED
	CALL EXIT(4)
902	WRITE(IPRT,1902)LINRED
	CALL EXIT(4)
C
C	FORMATS
C
1000	FORMAT(255A1)
1001	FORMAT(Z1)
1002	FORMAT(Z2.2)
1003	FORMAT(Z3.3)
1004	FORMAT(Z4.4)
1005	FORMAT(Z5.5)
1006	FORMAT(Z6.6)
1900	FORMAT(' RECORD TYPE ERROR IN RECORD ',I4)
1901	FORMAT(' LOAD ADDRESS ERROR IN RECORD ',I4)
1902	FORMAT(' NUMBER OF BYTES ERROR IN RECORD ',I4)
2000	FORMAT(Q,80A1)
	END

	SUBROUTINE LINKLU(IPRT,IRDR,IPCH)
C
C	COMMAND LINE >I2E FILEOUT=FILEIN
C
C	IF FILE TYPE IS NOT SPECIFIED:
C
C	FILEOUT=.ETX
C	FILEIN=.HEX
C
C	LU=IPRT IS TERMINAL
C
	BYTE BUF(80), FILEIN(30), FILEOT(30)
	LOGICAL*1 FNDPRO, FNDPRI
	CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,15)
	FNDPRO = .FALSE.
	FNDPRI = .FALSE.
	CALL ASNLUN(IPRT,'TI',0)
	CALL GETMCR(BUF,NUM)
	IF(NUM.LE.3)THEN
5		WRITE(IPRT,1001)
		READ(IPRT,1002,END=60)NUM,(BUF(I),I = 5,NUM+4)
		IF(NUM.EQ.0)GO TO 5
	END IF
	DO 10,I = 5,NUM
		IF(BUF(I).EQ.' '.OR.BUF(I).EQ.'=')GO TO 20
		LASTO = I-4
		IF(BUF(I).EQ.'.')FNDPRO = .TRUE.
		FILEOT(I-4) = BUF(I)
10	CONTINUE
20	CONTINUE
	DO 30,J = I+1,NUM
		IF(BUF(J).EQ.' '.OR.BUF(J).EQ.'=')GO TO 40
		LASTI = J-I
		IF(BUF(J).EQ.'.')FNDPRI = .TRUE.
		FILEIN(J-I) = BUF(J)
30	CONTINUE
40	CONTINUE
	IF(.NOT.FNDPRO)THEN
		FILEOT(LASTO+1) = '.'
		FILEOT(LASTO+2) = 'E'
		FILEOT(LASTO+3) = 'T'
		FILEOT(LASTO+4) = 'X'
	END IF
	IF(.NOT.FNDPRI)THEN
		FILEIN(LASTI+1) = '.'
		FILEIN(LASTI+2) = 'H'
		FILEIN(LASTI+3) = 'E'
		FILEIN(LASTI+4) = 'X'
	END IF
	CALL ASNLUN(IRDR,'SY',0)
	CALL ASNLUN(IPCH,'SY',0)
	OPEN(	UNIT = IRDR
	1,	FILE = FILEIN
	2,	STATUS = 'OLD'
	3,	CARRIAGECONTROL = 'LIST'
	4,	ERR = 50)
	OPEN(	UNIT = IPCH
	1,	FILE = FILEOT
	2,	RECL = 255
	3,	STATUS = 'NEW'
	4,	CARRIAGECONTROL = 'LIST')
	RETURN
50	WRITE(IPRT,1000)
	CALL EXIT(4)
60	CALL EXIT(1)
1000	FORMAT(' I2E - NO SUCH FILE')
1001	FORMAT('$I2E>')
1002	FORMAT(Q,80A1)
	END
	SUBROUTINE CKSUM(OUTLIN,NUMBER)
C
C	THIS SUBROUTINE WILL FORM THE CHECKSUM OF THE OUTPUT LINE
C	AND PUT IT IN THE RIGHT PLACE.  IT WILL ALSO CALCULATE
C	THE CORRECT NUMBER OF BYTES IN THE RECORD AND PUT IT IN THE RIGHT
C	PLACE.
C
	BYTE OUTLIN(255)
	INTEGER*2 SUM, VALUE
	DO 10,I = 255,1,-1
		IF(OUTLIN(I).NE.'0'O)THEN
		NUMBER = I
		GO TO 11
		END IF
10	CONTINUE
11	CONTINUE
	ENCODE(2,1002,OUTLIN(2))NUMBER-1
	SUM = 0
	DO 20,I = 2,NUMBER
		IF(I.EQ.5.OR.I.EQ.6)GO TO 20
		SUM = SUM + VALUE(OUTLIN(I))
20	CONTINUE
	ENCODE(2,1002,OUTLIN(5))IMOD(SUM,256)
	RETURN
1002	FORMAT(Z2.2)
	END
	INTEGER*2 FUNCTION VALUE(CHAR)
C
C	THIS FUNCTION WILL RETURN THE CKSUM VALUE FOR THE GIVEN CHARACTER
C
	BYTE CHAR
	VALUE  = 0
	IF(CHAR.GE.'0'.AND.CHAR.LE.'9')THEN
		DECODE(1,1001,CHAR)VALUE
		RETURN
	END IF
	IF(CHAR.GE.'A'.AND.CHAR.LE.'Z')THEN
		VALUE = CHAR - 'A' + 10
		RETURN
	END IF
	IF(CHAR.EQ.'$')VALUE = 36
	IF(CHAR.EQ.'%')VALUE = 37
	IF(CHAR.EQ.'.')VALUE = 38
	IF(CHAR.EQ.'_')VALUE = 39
	IF(CHAR.GE.'a'.AND.CHAR.LE.'z')THEN
		VALUE = CHAR - 'a' + 40
		RETURN
	END IF
	RETURN
1001	FORMAT(I1)
	END
	SUBROUTINE OUT(OUTLIN,NUMBER,IPCH)
C
C	THIS SUBROUTINE WILL SPIT OUT A LINE OF OBJECT CODE
C
	BYTE OUTLIN(255)
	WRITE(IPCH,1000)(OUTLIN(I),I = 1,NUMBER)	
	DO 10,I = 1,255
		OUTLIN(I) = '0'O
10	CONTINUE
	RETURN
1000	FORMAT(255A1)
	END