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 - Translate 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 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 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