C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C C CONTENTS C -------- C C NAME DESCRIPTION C ____ ___________ C C C GETLIN SOURCE LINE INPUT ROUTINE C HDR LISTING OUTPUT PAGE HEADER GENERATOR C HDRCHK CHECK TO SEE IF NEW PAGE IS NEEDED C MSG ERROR MESSAGE PROCESSOR C SAVLIN SAVE THE CONTENTS OF THE PARSE COMMON AREA SO IT CAN BE REUSED. C RESLIN RESTORE THE CONTENTS OF "PARSE" TO THEIR PREVIOUS VALUE. C DSKMSG PRINT A NUMBERED ERROR MESSAGE FROM A DISK FILE. C LINCLR FILL THE LINE BUFFER WITH SPACES C LISTER FREE FORMAT SOURCE-TO-LISTING ROUTINE C JMPLST PROCESS LIST OF PINS WHICH MUST HAVE JUMPERS ATTACHED C SAVE SAVE INPUT CONTEXT FOR SECONDARY FILE INPUT C RESTOR RESTORE PRIMARY FILE INPUT CONTEXT SUBROUTINE GETLIN C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.03 C C AUTHOR: RL AURBACH MAPC 7-DEC-78 C C THIS ROUTINE IS A UTILITY TO ACCESS A NEW LINE FROM THE ISYSIN C LOGICAL UNIT. IT IS USED BY THE GETLEX ROUTINE. C C COMPILATION INSTRUCTIONS: C C GETLIN,GETLIN/-SP=GETLIN C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V01.01 RLA 12-APR-78 MODIFIED DATA BASE C V01.02 RLA 31-AUG-78 REORGANIZED INCLUDED COMMON AREAS C V01.03 RLA 7-DEC-78 ADD CURRENT TOKEN FIELD TO DATABASE C C C PAGE 2 - GETLIN - DOCUMENTATION. C C THE ROUTINE READS A LINE OF INPUT AND STORES THE NUMBER OF CHARACTERS C FOUND IN THE LINE IN ICHAR. NEWLIN IS SET FALSE TO INDICATE THAT THERE IS C NO NEED TO FETCH A NEW LINE FOR THE NEXT LEXICAL TOKEN. ALSO THE LINE- C NUMBER COUNTER IS INCREMENTED AND THE NEXT-CHARACTER POINTER IS SET TO THE C START OF THE BUFFER. C C C CALLING SEQUENCE: C C CALL BY: CALL GETLIN C C C ON ENTRY: THE "ISYSIN" FIELD OF COMMON BLOCK "PARAM" C CONTAINS THE INPUT LUN. C C ON EXIT: THE VARIOUS ENTRIES OF THE COMMON AREA "PARSE" ARE C SET UP TO INDICATE CONDITIONS FOR A NEW LINE. C LINBUF CONTAINS THE INPUT LINE C ICHAR CONTAINS THE NUMBER OF CHARACTERS INPUT C TOKEN POINTS AT THE FIRST CHARACTER IN LINBUF C NEXCHR POINTS AT THE FIRST CHARACTER IN LINBUF C NEWLIN IS .FALSE. C ICODE HAS THE VALUE: C 0 - IF NEW LINE WAS SUCCESFULLY FETCHED C 1 - IF THE END-OF-FILE WAS FOUND C 2 - IF AN ERROR OCCURRED ATTEMPTING TO C READ THE RECORD C C ERROR CONDITIONS: C C THE VARIABLE ICODE IS USED AS AN ERROR INDICATOR. C ICODE=0 IF THE LINE FETCH WAS SUCCESSFUL C ICODE=1 IF EOF WAS DETECTED C ICODE=2 IF A READ ERROR OCCURRED C C THESE ERRORS ARE ALL SOFT IN THE SENSE THAT THE PROGRAM CONTINUES C AND NO ERROR MESSAGE IS PRINTED. IT IS THE RESPONSIBILITY OF THE C CALLING PROGRAM TO HANDLE ANY ERROR CONDITIONS. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - GETLIN - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - GETLIN C TOKEN=1 NEXCHR=1 READ (ISYSIN,10,END=20,ERR=30) ICHAR,LINBUF NEWLIN=.FALSE. ICODE=0 RETURN C C EOF OCCURRED WHILE TRYING TO READ A RECORD C 20 ICODE=1 RETURN C C ERROR OCCURRED WHILE READING THE RECORD C 30 ICODE=2 RETURN C C FORMAT STATEMENT C 10 FORMAT (Q,132A1) C C END SUBROUTINE HDR (SBTTL) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V02.01 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS ROUTINE IS A LISTING UTILITY ROUTINE. ITS PURPOSE IS TO BEGIN C A FRESH PAGE OF LISTING OUTPUT, WITH A TWO LINE HEADER ON THE TOP OF C THE PAGE. C C COMPILATION INSTRUCTIONS: C C HDR,HDR/-SP=HDR C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 3-JAN-76 ORIGINAL CODE C V02.00 RLA 6-JUN-78 MODIFY HEADER FORMAT C V02.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - HDR - DOCUMENTATION. C C THIS ROUTINE WRITES A HEADER ON THE TOP OF A NEW PAGE OF LISTING. C THE SUBTITLE FIELD IS AN INPUT PARAMETER. C C THE HEADER FORMAT IS: C TITLE WIRAP VERSION DATE TIME PAGE NNN C SUBTITLE CREATED: CRDATE LAST REVISED: RVDATE C C WHERE TITLE IS A 72 BYTE FIELD (FROM $TITLE DIRECTIVE) C VERSION IS THE CURRENT VERSION OF THE WIRAP PROGRAM C DATE IS THE CURRENT DATE C TIME IS THE TIME AT WHICH THIS WIRAP RUN BEGAN C NNN IS THE CURRENT PAGE NUMBER. C SUBTITLE IS THE SUBTITLE FOR THIS PAGE. C CRDATE IS THE CREATION DATE. C RVDATE IS THE DATE OF THE LAST REVISION. C C CALLING SEQUENCE: C C CALL BY: CALL HDR(SBTTL) C C WHERE: SBTTL IS A 24-BYTE STRING CONTAINING THE SUBTITLE FOR THE C PAGE. C C ON ENTRY: SBTTL IS A 24-BYTE FIELD. ALL UNUSED BYTES MUST BE C FILLED WITH NULLS OR SPACES. C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT (NEW PAGE) C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - HDR - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE SBTTL(24) !SUBTITLE STRING C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - HDR C IPAGE=IPAGE+1 WRITE (ISYSOU, 100) TITLE, VERSN, IDATE, ITIME, IPAGE WRITE (ISYSOU, 200) SBTTL, ICRDAT, IRVDAT WRITE (ISYSOU, 300) ILINE=4 RETURN C C C C *** FORMAT STATEMENTS C 100 FORMAT (1H1,72A1,T76,'WIRAP V',A8,T96,9A1,T108,8A1,T120,'PAGE ', 1 I3) C C 200 FORMAT (1H ,24A1, T45, '[ CREATED: ', 9A1, 6X, 1 'LAST REVISED: ', 9A1, ' ]') C C 300 FORMAT (1H0) C C END SUBROUTINE HDRCHK (SBTTL,NL) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS UTILITY ROUTINE INCREMENTS THE LISTING LINE COUNT AND CHECKS FOR C PAGE OVERFLOWS. IF A PAGE OVERFLOW IS DETECTED, A NEW PAGE IS STARTED. C C COMPILATION INSTRUCTIONS: C C HDRCHK,HDRCHK/-SP=HDRCHK C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 3-JAN-78 ORIGINAL CODE C V01.00 RLA 6-JUN-78 COPIED C V01.01 RLA 13-JUN-78 ADDED MULTIPLE-LINE CHECKING C V01.02 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - HDRCHK - DOCUMENTATION. C C THE LINE COUNTER WHICH COUNTS THE NUMBER OF LINES PRINTED ON THE PAGE IS C INCREMENTED. IF THE LINE COUNT DOES NOT EXCEED 56, THE ROUTINE RETURNS TO C THE USER. IF 56 IS EXCEEDED, HOWEVER, THIS IS TAKEN AS A SIGN TO START A C NEW PAGE, WHICH IS DONE USING THE HDR SUBROUTINE. C C CALLING SEQUENCE: C C CALL BY: CALL HDRCHK(SBTTL,NL) C C WHERE: SBTTL IS THE 24-BYTE SUBTITLE TO BE USED ON THE NEW PAGE C IF A NEW PAGE IS REQUIRED. C NL IS THE NUMBER OF LINES WHICH WILL BE PRINTED. C C C ON EXIT: IF NO PAGE OVERFLOW IS DETECTED, ONLY THE LINE COUNTER C IS UPDATED. IF THE PAGE OVERFLOW CONDITION IS DETECTED C HOWEVER, THE ROUTINE GENERATES LISTING OUTPUT. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C HDR C C PAGE 3 - HDRCHK - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE SBTTL(1) !SUBTITLE FIELD INTEGER NL !AMOUNT TO INCREMENT LINE COUNTER C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - HDRCHK C ILINE=ILINE+NL IF (ILINE .LE. 56) RETURN CALL HDR(SBTTL) RETURN END SUBROUTINE MSG (ILEN, IMSG, IOPT) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V02.03 C C AUTHOR: RL AURBACH MAPC 15-MAR-79 C C THIS ROUTINE IS THE SYSTEM ERROR MESSAGE HANDLER. IT PRINTS ERROR C MESSAGES ON THE CONSOLE DEVICE AND WRITES THEM TO A TEMPORARY FILE FOR C LATER INCORPORATION IN THE LISTING OUTPUT. C C COMPILATION INSTRUCTIONS: C C MSG,MSG/-SP=MSG C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 6-JAN-76 ORIGINAL CODE C V02.00 RLA 6-JUN-78 MODIFIED TO SUPPORT TEMPORARY FILE C STORAGE OF THE MESSAGES AND TO C SUPPORT ERROR CLASSES (IOPT). C V02.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C V02.02 RLA 8-DEC-78 ADD LINE TO ERROR PRINTOUT SHOWING C WHERE ERROR OCCURRED C V02.03 RLA 15-MAR-79 MODIFY ERROR-MARKING ALGORITHM C C C PAGE 2 - MSG - DOCUMENTATION. C C THIS ROUTINE SUPPORT SIX CLASSES OF ERROR MESSAGE, DEPENDING ON THE VALUE C OF IOPT. TWO OF THE CLASSES REPRESENT WARNING MESSAGES AND HAVE THE STRING C " *** WARNING *** " ATTACHED TO THE BEGINNING OF THE MESSAGE. THE C OTHER FOUR CLASSES REPRESENT FATAL MESSAGES AND HAVE THE STRING C " *** FATAL ERROR *** " ATTACHED TO THE BEGINNING OF THE MESSAGE. C C BY PROPER CHOICE OF IOPT, THE USER IS ABLE TO SPECIFY WHETHER OR NOT THE C CURRENT CONTENTS OF LINBUF SHOULD BE PRINTED BEFORE THE ERROR MESSAGE. C IF THE ERROR IS DETECTED DURING SYNTAX ANALYSIS, THE LINE IN WHICH THE ERROR C OCCURRED WILL BE LOCATED IN LINBUF. BY PRINTING IT, THE USER IS MORE ABLE C TO LOCATE HIS ERROR. ON THE OTHER HAND, MANY ERRORS OCCUR WHEN NO USEFUL C STRING IS AVAILABLE IN LINBUF, IN WHICH CASE IT WOULD BE CONFUSING TO PRINT C IT. HENCE THE ROUTINE PROVIDES A CHOICE. C C FATAL ERRORS ALWAYS RESULT IN SETTING IFATAL .TRUE.. FOR SOME FATAL ERRORS C IT MAY BE DESIRED TO CONTINUE PROCESSING FOR A WHILE BEFORE ABORTING, WHILE C FOR OTHERS, AN IMMEDIATE ABORT IS NEEDED. THE ROUTINE PROVIDES FOR THIS C OPTION ALSO. C C TO SUMMARIZE, THE FOLLOWING INDICATES THE EFFECTS OF VARIOUS VALUES OF IOPT: C C IOPT = 0 WARNING NO LINBUF PRINTOUT C IOPT = 1 WARNING LINBUF PRINTOUT C IOPT = 2 FATAL NO LINBUF PRINTOUT PROCESSING CONTINUES C IOPT = 3 FATAL LINBUF PRINTOUT PROCESSING CONTINUES C IOPT = 4 FATAL NO LINBUF PRINTOUT PROCESSING ABORTED C IOPT = 5 FATAL LINBUF PRINTOUT PROCESSING ABORTED C C C THE FIRST TIME THAT MSG IS CALLED, IT OPENS A SCRATCH FILE NAMED WIRAP.ERR, C WHICH IS AN UNFORMATTED SEQUENTIAL FILE WHICH WILL BE DELETED WHEN CLOSED. C C EVERY PRINTOUT FROM MSG IS SENT BOTH TO THE USER'S CONSOLE AND TO THIS FILE. C THIS PROVIDES FOR IMMEDIATE OPERATOR NOTIFICATION OF THE ERROR AND FOR C STORAGE OF THIS ERROR INFORMATION FOR PRINTING AT AN APPROPRIATE PLACE IN C THE PRINTOUT. C C PAGE 2 A - MSG - DOCUMENTATION (CONTINUED) C C C CALLING SEQUENCE: C C CALL BY: CALL MSG (ILEN, IMSG, IOPT) C C WHERE: ILEN IS THE LENGTH OF THE ARRAY IMSG IN BYTES. C IMSG IS THE ERROR MESSAGE (SINCE MSG ADDS THE WARNING OR C FATAL STRING AT THE BEGINNING OF THE PRINTOUT, IMSG C SHOULD NOT CONTAIN SUCH A STRING.) C IOPT IS THE ERROR CLASS (DISCUSSED ABOVE) C C C ON EXIT: THE TEMPORARY FILE HAS BEEN OPENED IF NECESSARY. C THE ERROR MESSAGE HAS BEEN DISPLAYED ON THE USER'S C CONSOLE. C THE ERROR MESSAGE HAS BEEN WRITTEN TO THE TEMPORARY C FILE FOR LATER RETRIEVAL. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C TRANSF MSGPRT STATS C C PAGE 3 - MSG - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER ILEN !LENGTH OF IMSG BYTE IMSG(ILEN) !MESSAGE TEXT INTEGER IOPT !ERROR CLASS C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C LOGICAL IPRT !IF .T., PRINT LINBUF LOGICAL IWARN !IF .T., MESSAGE IS A WARNING LOGICAL ISTOP !IF .T., ABORT PROCESSING INTEGER I !DO INDEX INTEGER LENGTH !LENGTH OF ERROR MESSAGE (INCLUDING PREFIX) BYTE BUF(IBF) !BUFFER FOR THE ERROR MESSAGE (WITH PREFIX) REAL*8 WARN(3) !" *** WARNING *** " REAL*8 FATAL(3) !" *** FATAL ERROR *** " BYTE SPACE !ASCII SPACE BYTE TAB !ASCII TAB CHARACTER C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SPACE / ' ' / DATA TAB /9/ DATA WARN / ' *** ', 'WARNING ', ' *** ' / DATA FATAL/ ' *** FA', 'TAL ERRO', 'R *** ' / C C PAGE 4 - MSG C C C *** INITIALIZE LOGICAL VARIABLES C NUMMSG=NUMMSG+1 IPRT=.FALSE. IWARN=.TRUE. ISTOP=.FALSE. C C *** SET LOGICAL VARIABLES ACCORDING TO IOPT C IF (MOD(IOPT,2) .NE. 0) IPRT=.TRUE. IF (IOPT .GE. 2) IWARN=.FALSE. IF (IOPT .GE. 4) ISTOP=.TRUE. C C *** CONDITIONALLY OPEN THE TEMPORARY FILE C IF (IOPEN) GOTO 10 OPEN (UNIT=ISYSER, NAME='WIRAP.ERR', TYPE='SCRATCH', DISPOSE='DELETE', 1 ACCESS='SEQUENTIAL', FORM='UNFORMATTED') IOPEN=.TRUE. NUMERR=0 C C *** IF IPRT IF .T., PRINT THE CONTENTS OF LINBUF C 10 IF (.NOT. IPRT) GOTO 20 WRITE (ISYSER) LINBUF, ICHAR TYPE 1000, (LINBUF(I),I=1,ICHAR) C C *** PRINT A LINE BELOW THE TEXT LINE. C THIS LINE CONTAINS ALL SPACES EXCEPT FOR A CARET "^" IN THE COLUMN C CORRESPONDING TO THE LOCATION OF THE TOKEN WHICH PROMPTED THE C ERROR MESSAGE. C DO 15 I=1,ICHAR BUF(I)=SPACE IF (LINBUF(I) .EQ. TAB) BUF(I)=TAB IF ((I .GE. TOKEN) .AND. (I .LT. NEXCHR)) BUF(I)='^' 15 CONTINUE WRITE (ISYSER) BUF,ICHAR NUMERR=NUMERR+2 TYPE 1000, (BUF(I),I=1,ICHAR) C C PAGE 4 A - MSG C C C *** APPEND THE ERROR PREFIX TO THE ERROR MESSAGE AND CALCULATE THE C TOTAL LENGTH OF THE RESULT. C 20 IF (IWARN) CALL TRANSF(WARN,24,BUF,IBF) IF (.NOT. IWARN) CALL TRANSF(FATAL,24,BUF,IBF) CALL TRANSF(IMSG,ILEN,BUF(25),ILEN) LENGTH=ILEN+24 IF (LENGTH .GT. IBF) LENGTH=IBF C C *** PRINT THE ERROR MESSAGE C WRITE (ISYSER) BUF, LENGTH NUMERR=NUMERR+1 TYPE 1000, (BUF(I),I=1,LENGTH) C C *** INSERT A BLANK LINE (DOUBLE-SPACING THE LISTING) C TYPE 1000, SPACE C C *** IF NO ABORT IS REQUIRED, RETURN. ELSE ABORT THE PROGRAM. C IF (.NOT. ISTOP) RETURN CALL MSGPRT CALL STATS CALL EXIT C C PAGE 5 - MSG C C C C *** FORMAT STATEMENT C 1000 FORMAT (' ',132A1) C C END SUBROUTINE SAVLIN C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 8-DEC-78 C C THIS ROUTINE SAVES THE CONTENTS OF THE COMMON AREA "PARSE" IN THE COMMON C AREA "MSGPAR" SO THAT THE "PARSE" COMMON BLOCK MAY BE REUSED. THIS ROUTINE C HAS A COMPANION UNSAVE ROUTINE WHICH RESTORES THE PREVIOUS CONTENTS OF C "PARSE". THE COMPANION ROUTINE IS CALLED RESLIN. C C COMPILATION INSTRUCTIONS: C C SAVLIN,SAVLIN/-SP=SAVLIN C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE MSGPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUL-78 ORIGINAL CODE C V01.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C V01.02 RLA 8-DEC-78 ADD TOKEN POINTER IN COMMON AREAS C C C PAGE 2 - SAVLIN - DOCUMENTATION. C C THIS ROUTINE IS A COMPLETELY STRAIGHT-FORWARD COPY ROUTINE. C THE CONTENTS OF THE "PARSE" COMMON AREA ARE COPIES INTO THE "MSGPAR" C COMMON AREA. C C CALLING SEQUENCE: C C CALL BY: CALL SAVLIN C C C C ON EXIT: THE CONTENTS OF "PARSE" ARE COPIED TO "MSGBUF" AND C ICODE=0 AND NEWLIN=.TRUE. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - SAVLIN - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' INCLUDE 'MSGPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER M !DO VARIABLE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - SAVLIN C MCHAR=ICHAR MTOKEN=TOKEN MEXCHR=NEXCHR MEWLIN=NEWLIN MCODE=ICODE DO 10 M=1,MCHAR 10 MSGBUF(M)=LINBUF(M) NEWLIN=.TRUE. ICODE=0 RETURN END SUBROUTINE RESLIN C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.03 C C AUTHOR: RL AURBACH MAPC 8-DEC-78 C C THIS ROUTINE RESTORES THE PREVIOUS CONTENTS OF THE NAMED COMMON AREA C "PARSE" TO THEIR CONTENTS BEFORE THE (ASSUMED) PREVIOUS CALL TO SAVLIN. C C COMPILATION INSTRUCTIONS: C C RESLIN,RESLIN/-SP=RESLIN C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE MSGPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUL-78 ORIGINAL CODE C V01.01 RLA 24-AUG-78 INSTEAD OF COPYING MSGBUF INTO LINBUF, C INTERCHANGE THEIR CONTENTS. C V01.02 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C V01.03 RLA 8-DEC-78 ADD TOKEN POINTER INTO COMMON AREA C C C PAGE 2 - RESLIN - DOCUMENTATION. C C THIS ROUTINE INTERCHANGES THE CONTENTS OF THE NAMED COMMON AREA "MSGPAR" C AND THE NAMED COMMON AREA "PARSE", RESTORING THE CONTENTS OF "PARSE" SAVED C BY THE SAVLIN ROUTINE. C C CALLING SEQUENCE: C C CALL BY: CALL RESLIN C C C C ON EXIT: THE CONTENTS OF "PARSE" ARE RESTORED. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - RESLIN - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' INCLUDE 'MSGPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX INTEGER ITMP !TEMPORARY LOCATION USED FOR INTERCHANGE. C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - RESLIN C ITMP=MCHAR MCHAR=ICHAR ICHAR=ITMP ITMP=MTOKEN MTOKEN=TOKEN TOKEN=ITMP ITMP=MEXCHR MEXCHR=NEXCHR NEXCHR=ITMP ITMP=MEWLIN MEWLIN=NEWLIN NEWLIN=ITMP ITMP=ICODE ICODE=MCODE MCODE=ITMP DO 10 I=1,IBF ITMP=MSGBUF(I) MSGBUF(I)=LINBUF(I) 10 LINBUF(I)=ITMP RETURN END SUBROUTINE DSKMSG(MSGNM,ISEV) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS ROUTINE LOOKS UP THE ERROR MESSAGE TEXT ASSOCIATED WITH ERROR MESSAGE C NUMBER MSGNM AND ISSUES A CALL TO MSG WITH THE APPROPRIATE TEXT. C C COMPILATION INSTRUCTIONS: C C DSKMSG,DSKMSG/-SP=DSKMSG C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE MSGPAR.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUL-78 ORIGINAL CODE C V01.01 RLA 24-AUG-78 ALLOW FOR MESSAGES WITH TEXT O/P C V01.02 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - DSKMSG - DOCUMENTATION. C C IN ORDER TO SAVE SPACE IN THE PROGRAM AND TO PROVIDE COMMONALITY OF C DESCRIPTIVE TEXT, ERROR MESSAGES WHICH DO NOT REQUIRE MODIFICATION TO MAKE C THEM FIT THE PARTICULAR CASE ARE STORED ON DISK IN THE FILE ERRNUM.DAT. C C THESE ERROR MESSAGES ARE REFERENCED BY MESSAGE NUMBER. C THE MESSAGE NUMBER HAS TWO PURPOSES: C FIRST, IT ENABLES THE APPROPRIATE MESSAGE TO BE FOUND IN THE FILE. C SECOND, IT ASSISTS DOCUMENTATION ON THE WIRAP PROGRAM BY MAKING IT C POSSIBLE TO REFER TO THE MESSAGE IN THE USER'S GUIDE IN A C SIMPLE WAY. C C THE PROGRAM TAKES THE MESSAGE NUMBER, OPENS THE ERRNUM.DAT FILE, AND FINDS C THE RECORD WHICH HAS THE MESSAGE NUMBER AS THE FIRST NUMBER IN THE RECORD. C IT CONSTRUCTS THE APPROPRIATE CALL TO MSG BASED ON THE TEXT OF THE RECORD. C C CALLING SEQUENCE: C C CALL BY: CALL DSKMSG (MSGNM, ISEV) C C WHERE: MSGNM IS THE NUMBER OF THE ERROR MESSAGE C ISEV IS THE SEVERITY CODE TO BE PASSED TO MSG C C C ON EXIT: THE APPRPRIATE ERROR MESSAGE IS PROCESSED BY THE MSG C LOGIC. C C ERROR CONDITIONS: C C IF THE FILE ERRNUM.DAT IS NOT FOUND OR IF THERE IS NO MESSAGE IN IT C WITH THE APPROPRIATE NUMBER, OR IF ANY OTHER ERROR OCCURS WHICH C PREVENTS THE MESSAGE TEXT FROM BEING USED, A MESSAGE OF THE FORM C "ERROR MESSAGE #MSGNM" IS GENERATED. C C SPECIAL NOTES: C C THE USE OF THIS FILE AND THE ALTERNATE FORM IF THE TEXT IS NOT FOUND C IS SIMILAR TO THE USE OF QIOMSG.TXT AND SIMILAR TEXT FILES. C C SUBROUTINES CALLED: C C MSG POP GETLEX SAVLIN RESLIN C C PAGE 3 - DSKMSG - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER MSGNM !NUMBER OF THE ERROR MESSAGE INTEGER ISEV !SEVERITY CODE (PASSED TO MSG) C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' INCLUDE 'MSGPAR.COM' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !GETLEX ASSOCIATED VARIABLE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - DSKMSG C C C SAVE THE CONTENTS OF LINBUF C CALL SAVLIN C C OPEN THE ERROR FILE C OPEN (UNIT=ISYSDK,NAME='ERRNUM.DAT',TYPE='OLD',READONLY,ERR=50) ITMPIN=ISYSIN ISYSIN=ISYSDK C C SEARCH FOR THE ERROR MESSAGE NUMBER C 10 NEWLIN=.TRUE. 15 CALL GETLEX(ITMP) GOTO (50, 10, 15, 20, 30) ITMP C C IF ALPHANUMERIC FOUND, CLEAN LEXICAL STACK AND GET NEXT RECORD C 20 CALL POP(ITMP) CALL POP(ITMP) GOTO 10 C C ERROR NUMBER FOUND. IF IT IS THE RIGHT NUMBER, PRINT THE MESSAGE. C ELSE, GET THE NEXT RECORD. C 30 CALL POP(ITMP) IF (ITMP .NE. MSGNM) GOTO 10 CLOSE (UNIT=ISYSDK) !CLOSE THE FILE. CALL RESLIN !PUT THE MESSAGE INTO MSGBUF, RESTORING THE !PREVIOUS CONTENTS OF LINBUF. 40 ISYSIN=ITMPIN CALL MSG(MCHAR,MSGBUF,ISEV) RETURN C C PAGE 5 - DSKMSG C C C ERROR -- FILE NOT FOUND, MESSAGE NOT FOUND, ETC. C 50 ENCODE (19,100,MSGBUF) MSGNM MCHAR=19 GOTO 40 C C 100 FORMAT ('ERROR MESSAGE #', I3, '.') C C END SUBROUTINE LINCLR C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS UTILITY ROUTINE CLEARS THE LINE BUFFER (FILLS IT WITH BLANKS). C C COMPILATION INSTRUCTIONS: C C LINCLR,LINCLR/-SP=LINCLR C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 17-MAY-78 ORIGINAL CODE C V01.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - LINCLR - DOCUMENTATION. C C THIS ROUTINE FILLS THE ARRAY LINBUF WITH BLANKS. C C CALLING SEQUENCE: C C CALL BY: CALL LINBUF C C C C ON EXIT: LINBUF CONTAINS ONLY ASCII SPACES. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - LINCLR - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX BYTE ISPC !ASCII SPACE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA ISPC / ' ' / C C PAGE 4 - LINCLR C DO 10 I=1,IBF 10 LINBUF(I)=ISPC RETURN END SUBROUTINE LISTER (SBTTL) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS ROUTINE READS AND PRINTS INPUT LINES UNTIL EITHER AN END-OF-FILE C IS SEEN OR UNTIL THE $ WHICH PREFIXES THE NEXT COMMAND IS SEEN. C C COMPILATION INSTRUCTIONS: C C LISTER,LISTER/-SP=LISTER C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE LEXATT.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - LISTER - DOCUMENTATION. C C THE ROUTINE CONSISTS OF A SIMPLE LOOP. A NEW LINE IS FETCHED. IF AN EOF C WAS DETECTED, RETURN. IF NOT, LOOK AT THE FIRST CHARACTER ON THE LINE. C IF IT IS A $, RETURN. ELSE PRINT THE LINE AND START AGAIN. C C CALLING SEQUENCE: C C CALL BY: CALL LISTER (SBTTL) C C WHERE: SBTTL IS AN ARRAY CAPABLE OF HOLDING 24 CHARACTERS. THIS C ARRAY IS USED AS THE SUBTITLE FIELD OF A PAGE HEADER C IF IT BECOMES NECESSARY AT ANY TIME TO START A NEW C PAGE. C C C ON EXIT: THIS ROUTINE WILL PRODUCE LISTING OUTPUT UNLESS THE C NEW INPUT LINE IT IS TO READ IS A COMMAND-LINE. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C HDRCHK GETLEX C C PAGE 3 - LISTER - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE SBTTL(1) !DUMMY ARRAY SPEC FOR SBTTL FIELD C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' INCLUDE 'IOPAR.COM' INCLUDE 'LEXATT.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !GETLEX ASSOCIATED VARIABLE INTEGER I !DO INDEX C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - LISTER C C C *** READ A NEW LINE AND GET THE FIRST LEXICAL TOKEN C 100 NEWLIN=.TRUE. CALL GETLEX(ITMP) GOTO (300, 120, 110, 120, 120) ITMP C C *** IF THE TOKEN IS A $, RETURN C 110 IF (LINBUF(NEXCHR-1) .EQ. '$') RETURN C C *** CLEAN UP THE LEXICAL STACK C 120 LEXSP=LEXMX+1 C C *** PRINT THE LINE AND GO AGAIN C CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 1000) (LINBUF(I),I=1,ICHAR) GOTO 100 C C 300 RETURN C C C FORMAT STATEMENT C 1000 FORMAT (1H ,132A1) C C END SUBROUTINE JMPLST (IPLANE) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS ROUTINE IS USED BY THE PLCHAN MODULE. IT CAUSES A FORMATTED LIST C OF PINS TO BE APPENDED TO THE WIRAP LISTING OUTPUT FILE. THE LISTED PINS C ARE THOSE WHICH THE USER MUST HARD-WIRE-JUMPER TO THE INDICATED PLANE. C C COMPILATION INSTRUCTIONS: C C JMPLST,JMPLST/-SP=JMPLST C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PLAIN.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE ELECTR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 21-APR-78 ORIGINAL CODE C V01.01 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - JMPLST - DOCUMENTATION. C C THIS ROUTINE WRITES A NEW PAGE. IT PRINTS SOME OUTPUT DESCRIPTION AND C THEN LISTS THE PINS WHICH SHOULD BE JUMPERED TO THE INDICATED PLANE. C C THE PINS WHICH WILL BE INDICATED WILL BE ALL PINS WHICH HAVE THE CORRECT C ELECTRICAL CODE AND WHICH ARE FROM DEVICES OF TYPES 0 OR 1. C C CALLING SEQUENCE: C C CALL BY: CALL JMPLST (IPLANE) C C WHERE: IPLANE IS THE NUMBER OF THE PLANE C C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C HDRCHK HDR C C PAGE 3 - JMPLST - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER IPLANE !PLANE NUMBER C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PLAIN.COM' INCLUDE 'PARAM.COM' INCLUDE 'ELECTR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I,J,K !DO INDICES INTEGER N !NUMBER OF PINS REAL*8 SBTTL(3) !"HARD-WIRED JUMPER LIST" C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'HARD-WIR', 'ED JUMPE', 'R LIST' / C C PAGE 4 - JMPLST C C C *** WRITE OUT THE HEADER (ON A NEW PAGE) C CALL HDR(SBTTL) C C *** WRITE OUT THE COMMENTS. C CALL HDRCHK(SBTTL,10) WRITE (ISYSOU, 100) (IPNAM(I,IPLANE),I=1,4) WRITE (ISYSOU, 120) (IPNAM(I,IPLANE),I=1,4) C C *** NOW LOOP OVER ALL DEVICES OF TYPES 0 AND 1. FOR EACH SUCH DEVICE, C LOOP OVER ALL PINS. IF ANY PIN HAS AN ELECTRICAL CODE WHICH IS EQUAL C TO THE PLANE TYPE, LIST IT. C DO 50 I=1,NENT IF (ITYPE(I) .GT. 1) GOTO 50 N=INUM(I) DO 50 J=1,N IF (IPINEL(1,IELOC(I)+J-1) .NE. IPTYP(IPLANE)) GOTO 50 CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 140) (SYMBL(K,I),K=1,4),J 50 CONTINUE RETURN C C PAGE 5 - JMPLST C C C *** FORMAT STATEMENTS C 100 FORMAT (1H0,4A1,' PLANE'//) C C 120 FORMAT (1H0,'PHYSICALLY CONNECT THE FOLLOWING PINS'/ 1 1H ,'TO THE ',4A1,' PLANE WITH JUMPERS.'//) C C 140 FORMAT (1H ,4A1,'-',I3) C C END SUBROUTINE SAVE C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THE ROUTINE SAVES CERTAIN LINE PROCESSING INDICATORS AND COUNTERS C AND REINITIALIZES THEM. C C COMPILATION INSTRUCTIONS: C C SAVE,SAVE/-SP=SAVE C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 15-DEC-75 ORIGINAL CODE C V01.01 RLA 7-JUN-78 ELIMINATE LINE NUMBERING C V01.02 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - SAVE - DOCUMENTATION. C C THE CURRENT VALUE OF THE ERROR FLAG IS SAVED, AS IS THE CURRENT INPUT LUN. C NEWLIN IS SET .TRUE. C C CALLING SEQUENCE: C C CALL BY: CALL SAVE C C C C ON EXIT: ICODE, AND ISYSIN ARE SAVED IN A COMMON AREA. C A NEW INPUT ENVIRONMENT IS SIMULATED. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - SAVE - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C INTEGER ITMP1 !STORAGE INTEGER ITMP3 !STORAGE COMMON / LOC10 / ITMP1,ITMP3 C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - SAVE C ITMP1=ICODE ITMP3=ISYSIN NEWLIN=.TRUE. RETURN END SUBROUTINE RESTOR C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 31-AUG-78 C C THIS ROUTINE UNDOS THE PROCESS PERFORMED BY SAVE. C C COMPILATION INSTRUCTIONS: C C RESTOR,RESTOR/-SP=RESTOR C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 15-DEC-75 ORIGINAL CODE C V01.01 RLA 7-JUN-78 ELIMINATE LINE NUMBERING C V01.02 RLA 31-AUG-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - RESTOR - DOCUMENTATION. C C THIS ROUTINE RESTORES THE PREVIOUSLY SAVED VALUES OF ICODE, AND C ISYSIN AND SETS NEWLIN .TRUE. SO THAT GETLEX WILL FETCH A NEW LINE FROM THE C RESTORED LUN. C C CALLING SEQUENCE: C C CALL BY: CALL RESTOR C C C ON ENTRY: THE PREVIOUS CONTENTS OF ICODE AND ISYSIN C ARE STORED IN A COMMON AREA C C ON EXIT: THE STORED VALUES FROM THE COMMON AREA ARE LOADED BACK C INTO THE APPROPRIATE LOCATIONS C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - RESTOR - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C INTEGER ITMP1 INTEGER ITMP3 COMMON / LOC10 / ITMP1,ITMP3 C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - RESTOR C ICODE=ITMP1 ISYSIN=ITMP3 NEWLIN=.TRUE. RETURN END