	PROGRAM PE		  !Translate Error numbers into their
	IMPLICIT INTEGER(A-Z)	  ! corresponding text from SY:PE.BIN.
	LOGICAL * 1	 LINE,LBUF,TFILE(16),BFILE(16),PROMPT(16),T(6,4)
	INTEGER * 4	 HEADER(522)
	COMMON /BIN/	 ID,TABMAX,INDMAX(2),EXTRA,DEFALT(3),TABLE(3,4),
     +			 INDEX(256,4),ENTRY(2048),LINE(80),LBUF(80)
	EQUIVALENCE	(HEADER,ID),(T,TABLE)

C Program to translate error numbers and display verbose error message
C text on the users terminal.  It is required that the file PE.BIN reside
C on SY:.   Loading instructions (Fortran-IV):	.Compile/Fortran PE.FOR
C						.Link PE
C
C    Copyright 1984, 1985, 1986 by Digital Software Systems, Inc.  The
C    information in this file is free to all.  It is not to be sold.
C
C    Author:	Daniel P. Graham		    Written:      14-Mar-84
C		Digital Software Systems Inc.
C		20 Bendix Place			    Latest-Update:25-Apr-86
C		Lindenhurst, NY 11757
C
C Usage:The syntax of the PE command line may be any the following:
C	.PE/D:F4		- Set the default language to Fortran-IV.
C	.PE/D:F77		- Set the default language to Fortran-77.
C	.PE/B			- Create a new SY:PE.BIN binary file. The name
C	 PE-Text file:		  of the source PE-Text file is requested.
C	.PE <error-number>	- Translate <error-number> into text (from the
C				  default table) & display it on the terminal.

C Get the command line switches and arguments (if any)
 10	CALL MOVEB(' Error number: ',PROMPT,14)	!Create a prompt string
	PROMPT(15) = "200			!Terminate it with Octal 200
	CALL GTLIN(LINE,PROMPT)			!Get the error number
	DO 20 I = 1, 80				!Search for the end
	   LENGTH = I-1				! of the string returned
	   IF(LINE(I).EQ.0) GO TO 30		! by the GTLIN routine.
 20	   CONTINUE				!Continue till found

C Check for switches
 30	IF(LINE(1).NE.'/') GO TO 60		!Is there a switch specified?
	   IF(LINE(2).EQ.'B'.OR.LINE(2).EQ.'b') GO TO 35
	   IF(LINE(2).EQ.'D'.OR.LINE(2).EQ.'d') GO TO 40
	   TYPE 72				!Illegal command syntax
	   GO TO 69				!Exit quietly

C Make a new .BIN file from a source PE-Text formatted file.
 35	CALL MOVEB('PE-Text file: ',PROMPT,14)	!Make the input file prompt
	CALL GTLIN(LINE,PROMPT,-1)		!Get the Text file name
	CALL MOVEB(LINE,TFILE,16)		!Save the input file name
	IF(TFILE(1).EQ.0) CALL MOVEB('DK:PE.TXT',TFILE,10) !Default: DK:PE.TXT
C	CALL MOVEB('PE .BIN file: ',PROMPT,14)	!Make the .Bin file prompt
C	CALL GTLIN(LINE,PROMPT,-1)		!Get the .BIN file name
C	CALL MOVEB(LINE,BFILE,16)		!Save the .BIN file name
	IF(BFILE(1).EQ.0) CALL MOVEB('SY:PE.BIN',BFILE,10)!Default: SY:PE.BIN
	CALL CVTEXT(TFILE,BFILE)		!Convert the Text file to .BIN
	GO TO 69				!Exit quietly

C Set the default language (table) name.
 40	OPEN(UNIT=1,NAME='SY:PE.BIN',TYPE='OLD',FORM='UNFORMATTED',
     +	     ACCESS='DIRECT',RECORDSIZE=1,ERR=91)!Open the SY:PE.BIN file
	DO 42 I = 1, 10				!Read the file Header (one
	   REC = I				! word at a time) to get the
 42	   READ(1'REC) HEADER(I)		! index table info.
	DO 44 I = 1, TABMAX			!Search the existing table
	   DO 43 J = 1, 6			! for the language
	      LP = J+3				! specified.
	      IF(LINE(LP).EQ.32.OR.LINE(LP).EQ.9) LINE(LP)=0 !Omit trailing
	      IF(T(J,I).EQ.0.AND.LINE(LP).EQ.0) GO TO 433	! white space.
	      EOS = J				!Save the switch length.
	      IF(T(J,I).NE.LINE(LP)) GO TO 44	!Exact match is required.
 43	      CONTINUE				!Continue for upto 6 chars
 433	   TABNUM = I				!Save the new table number
	   GO TO 46				!Set the new default
 44	   CONTINUE				!Continue for all languages
 45	TYPE 73					!Tell user whats wrong
	GO TO 69				!Exit quietly
 46	CALL FILLB(DEFALT,6,0)			!Remove the old default name
	CALL MOVEB(LINE(4),DEFALT,EOS)		!Set the new language table
	DO 48 I = 1, 10				!Write the file Header (one
	   REC = I				! word at a time) to update
 48	   WRITE(1'REC) HEADER(I)		! the default index table info
	CLOSE(UNIT=1)				!Close the .BIN file
	GO TO 69				!Exit quietly

C Lookup, Decode, and Display the error number.
 60	DECODE(LENGTH,71,LINE) ERROR		!Convert it to binary form
	CALL GETBIN(ERROR)			!Decode & display the error
 69	CALL EXIT				!Exit to monitor quietly
 71	FORMAT(I,79X)				!Format-Decode an error number
 72	FORMAT('+?Illegal PE command syntax.')
 73	FORMAT('+?Unknown language table specified.')
 74	FORMAT('+?Cannot open SY:PE.BIN')

C Error processing
 91	TYPE 74					!Say whats wrong
	GO TO 69				!Exit quietly
	END					!End of Fortran routine PE
	SUBROUTINE GETBIN(ERROR)
	IMPLICIT INTEGER(A-Z)
	LOGICAL * 1	 LINE,LBUF,LEVEL,E(4096),INDEXM(4)
	INTEGER * 4	 HEADER(522),E4(1024)
	COMMON /BIN/	 ID,TABMAX,INDMAX(2),EXTRA,DEFALT(3),TABLE(3,4),
     +			 INDEX(256,4),ENTRY(2048),LINE(80),LBUF(80)
	EQUIVALENCE	(HEADER,ID),(E,E4,ENTRY),(INDEXM,INDMAX)

C Search for the start of the error message
 10	OPEN(UNIT=2,NAME='SY:PE.BIN',TYPE='OLD',FORM='UNFORMATTED',
     +	     ACCESS='DIRECT',RECORDSIZE=1,ERR=91)	!Open the .BIN file
	DO 12 I = 1, 522			!Read the PE.BIN file
	   REC = I				! header information
 12	   READ(2'REC,END=91,ERR=91) HEADER(I)	! and index table.

C Get the the default table number.
 20	DO 24 I = 1, TABMAX			!Search the existing table
	   DO 23 J = 1, 3			! for the language specified.
	      IF(TABLE(J,I).NE.DEFALT(J)) GO TO 24 !Exact match is required.
 23	      CONTINUE				!Continue for upto 6 chars
	   TABNUM = I				!Save the new table number
	   GO TO 30
 24	   CONTINUE				!Continue for all languages
	TYPE 76,DEFALT				!Default table not found; tell
	GO TO 50				! user and exit quietly.

C Table found - Read the appropriate entry.
 30	MIN = 0					!Assume MIN error # is zero
	IF(INDEX(1,TABNUM).EQ.0) MIN = 1	!unless there is no zero entry
	IF(ERROR.LT.MIN.OR.ERROR.GT.INDEXM(TABNUM)) GOTO 92 !Error # in range?
	START = INDEX(ERROR+1,TABNUM)		!Yes-Get start record number
	IF(START.LE.0) GO TO 93			!Error in record number?
	END = 1024				!Set the max entry length
	IF(INDEX(ERROR+2,TABNUM).NE.0)END=INDEX(ERROR+2,TABNUM)-START+1
	DO 35 I = 1, END			!Read as much of the .BIN
	   READ(2'I+START-1,END=40,ERR=40) E4(I)! file is necessary to get one
 35	   CONTINUE				! complete entry.

C Display the entry
 40	CALL QUEST(' ')				!Start in column 2
	CALL QUEST(DEFALT)			!Show the default table name
	IF(E(1).EQ.73) TYPE 71,ERROR		!I - Ignore
	IF(E(1).EQ.70) TYPE 72,ERROR		!F - Fatal
	IF(E(1).EQ.87) TYPE 73,ERROR		!W - Warning
	IF(E(1).EQ.67) TYPE 74,ERROR,E(2)	!C - Count:n
	CALL QUEST(E(3))			!Display the text of the error
 49	CLOSE(UNIT=2)				!Close the PE.BIN file
 50	RETURN					!Return to caller

C Formats.
 71	FORMAT('+  Error ',I3,',  Ignore: ',$)
 72	FORMAT('+  Error ',I3,',  Fatal: ',$)
 73	FORMAT('+  Error ',I3,',  Warning: ',$)
 74	FORMAT('+  Error ',I3,',  Count:',I1,': ',$)
 75	FORMAT(' ?Cannot access SY:PE.BIN')
 76	FORMAT(' ?Default table not found: ',3A2)
 77	FORMAT('  error ',I3,' is out of range ',I1,' thru ',I3)
 78	FORMAT(' ?Error ',I3,' does not exist for ',$)

C Error processing
 91	TYPE 75					!Say can't open SY:PE.TXT
	GO TO 50				!Return to caller
 92	CALL QUEST('?')				!Start in column 2
	CALL QUEST(DEFALT)			!Show the default table name
	TYPE 77,ERROR,MIN,INDEXM(TABNUM)	!Say ERROR # out of range
	GO TO 49				!Return to caller
 93	TYPE 78,ERROR				!Say ERROR # is undefined
	CALL QUEST(DEFALT)			! and give the table name
	CALL CRLF				!Start on a new line
	GO TO 49				!Return to caller
	END					!End of Fortran routine GETBIN
	SUBROUTINE CVTEXT(TFILE,BFILE)
	IMPLICIT INTEGER(A-Z)
	LOGICAL * 1	 LINE,LBUF,E(4096),TFILE(16),BFILE(16),INDEXM(4)
	INTEGER * 4	 HEADER(522),E4(1024)
	COMMON /BIN/	 ID,TABMAX,INDMAX(2),EXTRA,DEFALT(3),TABLE(3,4),
     +			 INDEX(256,4),ENTRY(2048),LINE(80),LBUF(80)
	EQUIVALENCE	(HEADER,ID),(E4,ENTRY),(E,ENTRY),(INDEXM,INDMAX)

C Routine to convert (copy) the text file specified in TFILE (in PE-TEXT file
C	  format) to the file specified in BFILE (in PE-Rapid-Access binary
C	  file format).
C TFILE	- LOGICAL*1 Array containing the name of the source text file in
C	  PE-TEXT file format (Given).
C BFILE	- LOGICAL*1 Array containing the name of the binary file in PE-Rapid-
C	  Access binary file format (Given).

C Search for the start of the error message
 10	OPEN(UNIT=1,NAME=TFILE,TYPE='OLD',ERR=91)	!Open the text file
	OPEN(UNIT=2,NAME=BFILE,TYPE='NEW',FORM='UNFORMATTED',
     +	     ACCESS='DIRECT',RECORDSIZE=1,ERR=91)	!Open the .BIN file
	CALL QUEST(' Creating file: ')		!Say what we're doing
	CALL QUEST(BFILE)			! and give the file name.
	CALL CRLF				!Start on a new line.
	CALL FILLB(ID,2088,0)			!Init the index table
	ID = 'PE'				!Identify as a "PE" .BIN file
	REC = 523				!Set first entry address
 20	READ(1,72,END=92) ERR,Q,LBUF		!Read the next line
 201	IF(ERR.EQ.-1) GO TO 20			!Discard comment lines.
	IF(ERR.NE.-2) GO TO 22			!Is this a new compiler list?
	   TABMAX = TABMAX + 1			!Increment the language count
	   INDEXM(TABMAX) = 0			!Reset the Max-Error-#
	   CALL MOVEB(LBUF,TABLE(1,TABMAX),-6)	!Save the language name
 21	   TYPE 74,(LBUF(I),I=1,Q)		!Say what we're doing
	   GO TO 20				!Get another line
 22	IF(ERR.NE.-3) GO TO 30			!Is this a Default setting?
	   TYPE 73,(LBUF(I),I=1,Q)		!Say what we're doing
	   CALL MOVEB(LBUF,DEFALT,-6)		!Save the language name
	   GO TO 20				!Get another line

C An Error Text Entry has been found-Decode and store it.
 30	DECODE(Q,76,LBUF) E(1),E(2),(E(I),I=3,Q-2) !Decode a Header line
	LEN    = Q				!Set current entry length

C Read the rest of the error message and store the text.
 35	E(LEN-1) = 13				!Insert a Carriage Return
	E(LEN)   = 10				!Insert a LineFeed
	READ(1,72,END=92) ERROR,Q,LBUF		!Get next message line
	IF(Q.LT.4) Q = 4			!Blank lines insert extra CrLf
	IF(ERR.NE.ERROR) GO TO 40		!Are we done yet?
	   CALL MOVEB(LBUF(5),E(LEN+1),Q-4)	!No -Save the error text
	   LEN = LEN + Q-2			!Adjust the Entry length
	   GO TO 35				!Insert <Cr><Lf>

C End of entry found-Write the entry to disk.
 40	IF(ERR.GT.INDEXM(TABMAX)) INDEXM(TABMAX)=ERR !Save the Max-Error-#
	INDEX(ERR+1,TABMAX) = REC		!Save the record number
	E(LEN+1) = 0				!Terminate the error message
	LENGTH = (LEN+4) /4			!Get # Double-Words to write.
	DO 42 I = 1, LENGTH			!Put this entry into the
 42	   WRITE(2'REC+I-1) E4(I)		! .BIN file.
	REC = REC + (LEN+4)/4 + 1		!Update the record number
	CALL FILLB(ENTRY,LEN,0)			!Zero the entry buffer
	ERR = ERROR				!Set the new error number
	GO TO 201				!Parse the next text line

C Finish Up
 65	CLOSE(UNIT=1)				!Close the PE.TXT file
	DO 66 I = 1, 522			! update its header with the
	   REC = I				! new table (switch) names and
 66	   WRITE(2'REC) HEADER(I)		! index table info.
	CLOSE(UNIT=2)				!Close the SY:PE.BIN file
	TYPE 75					!Start on a new line
 69	RETURN					!Return to caller

C Formats
 71	FORMAT(' ?Cannot access file: ',16A1,/)
 72	FORMAT(I3,Q,80A1)
 73	FORMAT('  Set-Default (',6A1,') ',80A1)
 74	FORMAT('  Processing  (',6A1,') ',80A1)
 75	FORMAT(' ',$)
 76	FORMAT(X,A1,X,A1,76A1)
 77	FORMAT(/' [End-of-file] ',16A1)
C79	FORMAT(' Writing records: ',I6,' thru ',I6)

C Error processing
 91	TYPE 71,TFILE				!Say can't open a req. file.
	GO TO 69				!Return to caller
 92	TYPE 77					!Say EOF found
	GO TO 65				!Finish up
	END					!End of Fortran routine CVTEXT

	SUBROUTINE MOVEB(S,D,LENGTH)
	IMPLICIT INTEGER(A-Z)
	LOGICAL * 1	 S(LENGTH),D(LENGTH)

C Routine to move the contents of one byte array to another.
C S	 - The SOURCE array name (Given)
C D	 - The DESTINATION array name (Updated)
C LENGTH - The number of bytes to move from S to D (Given).
C	   If the LENGTH is negative, move at most -LENGTH bytes from
C	   S to D; terminate earily if a blank is found.

 1	NB = 0				!Reset the No-Blank flag
	L = LENGTH			!Get the length of the move
	IF(L.GT.0) GO TO 10		!Is the length negative ?
	   L = -L			!Yes - Set the proger length
	   NB = -1			!      and the No-Blank flag
 10	DO 20 I = 1, L			!For each byte in the source assign it
	   IF(NB.NE.0.AND.S(I).EQ.32) GO TO 30 !  to the destination but stop
	   D(I) = S(I)			!  earily on a space when NB is set.
 20	   CONTINUE			!Continue till finished
 30	RETURN				!Return to caller
	END				!End of Fortran routine MOVEB

	SUBROUTINE QUEST(MSG)
	IMPLICIT INTEGER (A-Z)
	LOGICAL * 1	 MSG(1)

C Routine to type out one line of text on the users terminal.  It is
C	  required that the message in MSG be terminated by a Null
C	  byte and that the message be less than 4097 characters long.

 10	DO 20 I = 1, 4096			!Max string length=4096 bytes
	   IF(MSG(I).EQ.0) GO TO 30		!If the byte is not a Null
 15	   IF(ITTOUR(MSG(I)).NE.0) GO TO 15	! then type it out.
 20	   CONTINUE				!Continue till finished
 30	RETURN					!Return to caller
	END					!End of Fortran routine QUEST

	SUBROUTINE CRLF
	IMPLICIT INTEGER(A-Z)

C Routine to type out a <Cr><Lf> sequence on the controlling terminal.

 10	IF(ITTOUR(13).NE.0) GO TO 10	!Output a Carriage Return
 20	IF(ITTOUR(10).NE.0) GO TO 20	!Output a LineFeed
	RETURN				!Return to caller
	END				!End of Fortran routine CRLF

	SUBROUTINE FILLB(ARRAY,LENGTH,FILLER)
	IMPLICIT INTEGER(A-Z)
	LOGICAL * 1	 ARRAY(LENGTH)

C Routine to fill an array of Bytes with a specified value.
C ARRAY  - The array to be filled (Updated)
C LENGTH - The number of bytes to fill (Given)
C FILLER - The byte value to put into each word of the ARRAY (Given)

 10	DO 20 I = 1, LENGTH		!For each byte in the array,
	   ARRAY(I) = FILLER		! fill it with the
 20	   CONTINUE			! specified value

 30	RETURN				!Return to caller
	END				!End of Fortran routine FILLB
��������������������������������������������������������������������������