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 BLOCK BLOCK DATA ROUTINE -- INITIALIZES STATIC NAMED COMMON C INIT INITIALIZES NAMED COMMON C FILIO FILE-SPECIFICATION PROMPTER -- OPENS FILES C INCSET $INCLUDE DIRECTIVE PROCESSOR -- OPENS INDIRECT FILE BLOCK DATA 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 13-DEC-78 C C THIS BLOCK DATA ROUTINE IS USED TO INITIALIZE NON-VOLATILE STORAGE AREAS C IN THE WIRAP DATA BASE. C C COMPILATION INSTRUCTIONS: C C BLOCK,BLOCK/-SP=BLOCK C [FILE WIRCOM.FTN INCLUDED] C [FILE LEXATT.COM INCLUDED] C [FILE PLAIN.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V02.00 RLA 5-MAY-78 NEW DATA BASE ORGANIZATION AND C INITIALIZATION OF NEW AREAS. C V02.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C V02.02 RLA 7-DEC-78 MINOR CORRECTIONS IN MSG, PLANE, CONFIG C V02.03 RLA 13-DEC-78 NEW VERSION NUMBER INCORPORATES FIXES C IN RDCHAN PLANE HANDLING. C C C PAGE 2 - BLOCK DATA - DOCUMENTATION. C C THIS PROGRAM INITIALIZES THE READ-ONLY AREAS OF NAMED COMMON WITHIN THE C WIRAP DATA BASE. C C C PAGE 3 - BLOCK DATA - DATA STORAGE DESCRIPTIONS. C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'LEXATT.COM' INCLUDE 'PLAIN.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 DATA LEXMX,LEXSP / 8, 9 / C DATA IPTYP / 3, 4, 12, 13, 14, 15 / C DATA ISYSIN, ISYS2, ISYSOU, ISYSER, ISYSAT, ISYSDK / 1, 2, 3, 4, 6, 7 / C DATA VERSN / '4.3' / C END SUBROUTINE INIT 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 1-SEP-78 C C THIS ROUTINE INITIALIZES THE ARRAY STORAGE FOR THE INTERNAL DATA BASE C FOR WIRAP. THE ROUTINE IS CALLED FOR EVERY ITERATION OF THE PROGRAM AND C INSURES THAT THE INTERNAL TABLES ARE TABALA RAZA. C C COMPILATION INSTRUCTIONS: C C INIT,INIT/-SP=INIT C [FILE WIRCOM.FTN INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE SPCING.COM INCLUDED] C [FILE ELECTR.COM INCLUDED] C [FILE ALIAS.COM INCLUDED] C [FILE LEXATT.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE PLAIN.COM INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 20-SEP-75 ORIGINAL CODE C V01.01 RLA 11-APR-78 ADD INITIALIZATION OF CONNECTOR_SYMBOL C ARRAYS. C V02.00 RLA 6-JUN-78 PUT ALL COMMON INITIALIZATION HERE. C V02.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - INIT - DOCUMENTATION. C C THIS ROUTINE INITIALIZES THE INTERNAL DATA BASES OF WIRAP. C THE PROCEDURE IS TO ZERO THE NUMBER OF CHIPS, THE USER-NUMBER TO INTERNAL C NUMBER MAPPING ARRAY, AND THE ARRAYS ISLOC, IELOC, AND IALOC WHICH ARE C POINTERS INTO THE SPACING, ELECTRICAL, AND ALIAS ARRAYS RESPECTIVELY. C C CALLING SEQUENCE: C C CALL BY: CALL INIT C C C C ON EXIT: THE APPROPRIATE ARRAYS ARE CLEARED C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C TRANSF C C PAGE 3 - INIT - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARAM.COM' INCLUDE 'SPCING.COM' INCLUDE 'ELECTR.COM' INCLUDE 'ALIAS.COM' INCLUDE 'LEXATT.COM' INCLUDE 'PARSE.COM' INCLUDE 'PLAIN.COM' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I,J !DO INDEX REAL*4 PNAM(NMPLAN) !DEFAULT PLANE-NAME TABLE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA PNAM / 'PWR ', 'GND ', 'PLUS', 'MNUS', 'AGND', 'OTHR' / C C C PAGE 4 - INIT C C C SET NUMBER OF DEVICES ON CARD TO ZERO. C ALSO RESET THE UNUSED LOCATION POINTERS INTO IPINSP,IPINEL, AND IPINAS C TO THE FIRST CHARACTER IN THESE ARRAYS. C NENT=0 NXOENT=1 NXEENT=1 NXAENT=1 C C INITIALIZE BASIC SCALERS C LEXSP=LEXMX+1 NEWLIN=.TRUE. SLACK=0. NCOL=0 IPAGE=0 ILINE=0 IOPEN=.FALSE. IFATAL=.FALSE. NUMERR=0 NUMMSG=0 NCN=0 C C NOW ZERO THE APPROPRIATE ARRAYS C DO 10 I=1,NMCHIP INUM(I)=0 ILOC(I)=0 IENT(I)=0 ITYPE(I)=0 ISLOC(I)=0 IELOC(I)=0 IALOC(I)=0 DO 8 J=1,8 8 ICNAME(J,I)=0 DO 9 J=1,4 9 SYMBL(J,I)=0 10 CONTINUE C C TAKE CARE OF THE LAST POINTERS OF ISLOC,IELOC, AND IALOC C J=NMCHIP+1 ISLOC(J)=0 IELOC(J)=0 IALOC(J)=0 C C PAGE 5 - INIT C C C CLEAN UP THE PLANE-DEFINITION COMMON AREA "PLAIN". C DO 20 I=1,NMPLAN CALL TRANSF(PNAM(I),4,IPNAM(1,I),4) IPFLG(I)=0 IPDEF(I)=0 IPNUM(I)=0 IPLOC(I)=0 IPENT(I)=0 20 CONTINUE C C COLOR ARRAY C DO 30 J=1,NMCOLR 30 COLORS(J)=0 C C TITLE FIELD C DO 35 J=1,72 35 TITLE(J)=0 C C DATE AND TIME C CALL DATE(IDATE) CALL TIME(ITIME) ELAPS=SECNDS(0.0) DO 38 I=1,9 ICRDAT(I)=' ' 38 IRVDAT(I)=' ' C C CHAIN ARRAYS C DO 40 I=1,NMCHAN ICNLOC(I)=0 ICNCOL(I)=0 40 ICNTYP(I)=0 ICNLOC(NMCHAN+1)=0 DO 45 I=1,NMCHPN ICHAIN(1,I)=0 ICHAIN(2,I)=0 45 ICNLEN(I)=0 C C DONE C RETURN END SUBROUTINE FILIO (ILUN,LTYPE,IERR) 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 MAPS 6-JUN-78 C C THIS ROUTINE PROMPTS FOR A FILE SPECIFICATION C AND OPENS THE APPROPRIATE FILE ON THE INDICATED LUN. C C COMPILATION INSTRUCTIONS: C C FILIO,FILIO/-SP=FILIO C C MODIFICATION HISTORY: C C V01.00 RLA 21-MAR-78 ORIGINAL CODE C V01.01 RLA 26-MAR-76 ADD CNTL/Z RECOGNITION C V01.02 RLA 6-JUN-78 IF NO LISTING FILE IS SPECIFIED, OPEN C A DUMMY FILE ON THE NULL DEVICE. C C C PAGE 2 - FILIO - DOCUMENTATION. C C THE ROUTINE ISSUES A PROMPT MESSAGE AND INPUTS A FILE SPECIFICATION. C THE FORM OF THE PROMPT MESSAGE IS DETERMINED BY "LTYPE". C THE INPUT CHARACTER STRING IS SEARCHED FOR THE EXISTENCE OF A FILE C EXTENSION. IF NONE IS FOUND, A DEFAULT EXTENSION (APPROPRIATE TO THE C TYPE OF FILE REQUESTED) IS ADDED INTO THE PROMPT STRING. ANY VERSION C NUMBER IN THE STRING IS MOVED OVER TO MAKE ROOM FOR THE EXTENSION STRING. C THE INDICATED FILE IS THEN OPENED. C C CALLING SEQUENCE: C C CALL BY: CALL FILIO (ILUN,LTYPE,IERR) C C WHERE: ILUN IS THE LUN UPON WHICH TO OPEN THE FILE C LTYPE INDICATES THE TYPE OF FILE TO BE OPENED. C LEGAL VALUES ARE: C 'LIST' LISTING FILE (OUTPUT--EXT=.LST) C 'WRAP' BINARY FILE (OUTPUT--EXT=.WRP) C 'DATA' INPUT FILE (READONLY--EXT=.WIR) C IERR IS THE ERROR CODE: C 0 - FILE OPENED WITHOUT ERROR C 1 - NO FILE SPECIFIED C 2 - ERROR DETECTED TRYING TO OPEN FILE C 3 - CNTL/Z DETECTED AS RESPONSE TO PROMPT C C ON ENTRY: ILUN MUST BE A LEGAL LUN C LTYPE MUST BE ONE OF THE THREE STRINGS ABOVE C C ON EXIT: IERR IS SET AS INDICATED C IF IERR = 0, THE FILE HAS BEEN OPENED ON THE LUN C C C PAGE 2 A - FILIO - DOCUMENTATION (CONTINUED). C C C C ERROR CONDITIONS: C C ERRORS DETECTED BY THE FILE_OPENING LOGIC C ARE DETECTED AND FLAGGED IN IERR. C IN ADDITION, IERR FLAGS TWO OTHER CONDITIONS WHICH ARE NOT PROPERLY C CONSIDERED ERRORS. IT IS VALID TO SPECIFY NO FILE IN RESPONSE C TO THE PROMPT. IN THIS CASE, THE USER HAS INDICATED THAT HE DOES C NOT DESIRE THE INDICATED OUTPUT. NO FILE ON INPUT, OF COURSE, IS C A LOGIC ERROR AND SHOULD BE CAUGHT. TYPING A CNTL/Z IN RESPONSE C TO THE PROMPT IS USED AS AN EXIT REQUEST BY THE CALLING PROGRAM C AND HENCE IS NOT AN ERROR. C C SPECIAL NOTES: C C IF THE SPECIFIED FILE TYPE IS 'LIST' AND IF THE USER SPECIFIES NO FILE C (FOR EXAMPLE BY TYPING ONLY A CARRIAGE RETURN IN RESPONSE TO THE C PROMPT), THEN AS A SPECIAL CASE, THE FILE 'WIRAP.TMP' WILL BE OPENED C AS A SCRATCH FILE ON THE NULL DEVICE. AN ERROR CODE OF ZERO WILL BE C RETURNED. C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - FILIO - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER ILUN !LUN NUMBER REAL LTYPE !4-BYTE CHARACTER STRING INTEGER IERR !ERROR (OR SPECIAL CONDITION) FLAG C C PARAMETER STATEMENTS C C NOT USED C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C BYTE SPEC(41) !STORAGE FOR FILE SPECIFICATION STRING (ASCIZ) LOGICAL LEXT !FLAG INDICATES EXTENSION SEEN IN SCAN LOGICAL LVER !FLAG INDICATES VERSION SEEN IN SCAN REAL LIST !'LIST' REAL WRAP !'WRAP' REAL INPT !'DATA' BYTE EXT(3,3) !DEFAULT EXTENSION CHARACTER STORAGE BYTE SYM1 !'.' BYTE SYM2 !';' INTEGER ICNT !NUMBER OF CHARACTERS IN INPUT STRING INTEGER IPNT !A POINTER INTO THE SPEC ARRAY INTEGER I !DO INDEX INTEGER ICHR !LENGTH OF VERSION FIELD IN SPEC INTEGER J !DUMMY INDEX C C COMMON AREAS C C NO COMMON USED C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA LIST,WRAP,INPT/'LIST','WRAP','DATA'/ DATA EXT / 'L','S','T','W','R','P','W','I','R' / DATA SYM1,SYM2 / '.',';' / C C PAGE 4 - FILIO C 5 IF (LTYPE .EQ. LIST)TYPE 10 IF (LTYPE .EQ. WRAP)TYPE 11 IF (LTYPE .EQ. INPT)TYPE 12 READ (5,14,END=1050)ICNT,(SPEC(I),I=1,ICNT) LEXT=.FALSE. LVER=.FALSE. IPNT=1 IERR=1 C C *** HANDLE THE SPECIAL CASE OF NO FILE SPECIFIED. C IF (ICNT .NE. 0) GOTO 50 IF (LTYPE .EQ. INPT) GOTO 5 IF (LTYPE .EQ. WRAP) RETURN OPEN (UNIT=ILUN,NAME='NL:WIRAP.TMP',ERR=1000,TYPE='SCRATCH', 1 DISPOSE='DELETE') IERR=0 RETURN C C NOW WE WANT TO SEE IF AN EXTENSION WAS SPECIFIED IN THE FILE C SPECIFICATION. IF IT WAS, WE WILL FALL THROUGH THE CODE TO C THE OPEN STATEMENT. IF IT WAS NOT, HOWEVER, WE WILL INSERT C THE APPROPRIATE EXTENSION INTO THE SPECIFICATION STRING. C C THIS PART OF THE LOGIC WILL ALSO MAKE SURE THAT THE STRING WILL C TERMINATE WITH A ZERO BYTE (CONSISTENT WITH THE REQUIREMENTS OF C OPEN). C 50 DO 100 I=1,ICNT IF (SPEC(I) .EQ. SYM1) LEXT=.TRUE. IF (SPEC(I) .EQ. SYM2) LVER=.TRUE. IF (.NOT. LVER) IPNT=I 100 CONTINUE IF (LEXT) GOTO 200 IPNT=IPNT+1 IF (ICNT .GT. 36 .OR. IPNT .GT. 36) GOTO 1000 IF (.NOT. LVER) GOTO 111 ICHR=ICNT-IPNT+1 DO 110 I=1,ICHR J=ICHR-I SPEC(IPNT+J+4)=SPEC(IPNT+J) 110 CONTINUE 111 SPEC(IPNT)=SYM1 IF (LTYPE .EQ. LIST)I=1 IF (LTYPE .EQ. WRAP)I=2 IF (LTYPE .EQ. INPT)I=3 DO 120 J=1,3 120 SPEC(IPNT+J)=EXT(J,I) ICNT=ICNT+4 200 SPEC(ICNT+1)=0 C C PAGE 5 - FILIO C C C WE NOW OPEN THE FILE C IF (LTYPE .EQ. LIST) OPEN (UNIT=ILUN,NAME=SPEC,ERR=1000) IF (LTYPE .EQ. WRAP) OPEN (UNIT=ILUN,NAME=SPEC,ERR=1000) IF (LTYPE .EQ. INPT) OPEN (UNIT=ILUN,NAME=SPEC,ERR=1000, 1 READONLY,TYPE='OLD') IERR=0 RETURN 1000 IERR=2 RETURN 1050 IERR=3 RETURN C C FORMAT STATEMENTS C 10 FORMAT (1H$,'WIR> ENTER LISTING FILE SPEC: ') 11 FORMAT (1H$,'WIR> ENTER BINARY OUTPUT FILE SPEC: ') 12 FORMAT (1H$,'WIR> ENTER INPUT FILE SPEC: ') 14 FORMAT (Q,40A1) C C END SUBROUTINE INCSET 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 1-SEP-78 C C THIS ROUTINE PROCESSES THE $INCLUDE DIRECTIVE. C C COMPILATION INSTRUCTIONS: C C INCSET,INCSET/-SP=INCSET C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - INCSET - DOCUMENTATION. C C THIS ROUTINE USES THE FILENAME SPECIFIED IN THE $INCLUDE DIRECTIVE C TO OPEN A FILE ON LOGICAL UNIT ISYSAT. C C CALLING SEQUENCE: C C CALL BY: CALL INCSET C C C C ON EXIT: EITHER THERE IS A FILE OPEN ON LUN ISYSAT OR THE C PROGRAM WILL ABORT. C C ERROR CONDITIONS: C C IF THERE IS AN OPEN FAILURE, THE ERROR IS FATAL (IMMEDIATE TERMINATION) C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C CHOP DSKMSG C C PAGE 3 - INCSET - 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 - INCSET C LINBUF(ICHAR+1)=0 OPEN (UNIT=ISYSAT, NAME=LINBUF(NEXCHR), ERR=1000, 1 READONLY, TYPE='OLD') RETURN C C 1000 CALL DSKMSG(9,5) END