FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 1   

PAX.FTN      	/TR:BLOCKS/WR


        C***************************************************************************************

        C***************************************************************************************

        C

        C

        C

        C

        C

        C

        C

        C  OBJECT MODULE PATCH UTILITY

        C

        C

        C

        C

        C

        C

        C	COPYRIGHT (C) 1976,1977,1978

        C	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

        C

        C	THIS SOFTWARE IS FURNISHED UNDER  A LICENSE FOR USE ONLY  ON  A

        C	SINGLE COMPUTER SYSTEM AND MAY BE  COPIED ONLY WITH  THE INCLU-

        C	SION OF  THE  ABOVE  COPYRIGHT NOTICE.  THIS SOFTWARE,  OR  ANY

        C	OTHER COPIES THEREOF, MAY NOT BE  PROVIDED  OR  OTHERWISE  MADE

        C	AVAILABLE TO ANY OTHER PERSON EXCEPT  FOR  USE  ON  SUCH SYSTEM

        C	AND TO  ONE WHO AGREES  TO  THESE LICENSE  TERMS.  TITLE TO AND

        C	OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.

        C

        C	THE INFORMATION IN THIS SOFTWARE  IS  SUBJECT TO CHANGE WITHOUT

        C	NOTICE AND SHOULD NOT BE CONSTRUED  AS  A COMMITMENT BY DIGITAL

        C	EQUIPMENT CORPORATION.

        C

        C	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS

        C	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

        C

        C

        C	K.D. MORSE  16-AUG-76

        C

        C

        C

        C

        C

        C	THE OBJECT MODULE PATCH UTILITY CREATES A PATCHED OBJECT MODULE

        C	FROM AN INPUT FILE  AND A CORRECTION FILE.  IT PROMPTS FOR A

        C	COMMAND STRING OF "OUTPUT=INPUT,CORRECTION" WITH THE CHARACTERS

        C	"PAX>".   A CHECKSUM SWITCH, "/CS", IS VALID ON ANY OF THE THREE

        C	FILES.  FOR THE RULES ON PATCHING A FILE SEE THE FUNCTIONAL

        C	SPECIFICATION.

        C

        C

        C  MODIFICATIONS:

        C

        C NO		DATE		PROGRAMMER		PURPOSE

        C --		----		----------		-------

        C

        C 01		08-MAY-78	K.D. MORSE		CHANGE TO 17 CHAR DATE/TIME.

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 2   

PAX.FTN      	/TR:BLOCKS/WR


        C

        C

        C***************************************************************************************

        C***************************************************************************************

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 3   

PAX.FTN      	/TR:BLOCKS/WR


         

        C***************************************************************************************

        C

        C

        C  VARIABLES:

        C

        C	CALLOC--ALLOCATION VALUE FROM A CORRECTION FILE PSECT DEFINITION

        C	CCHECK--USER'S CHECKSUM VALUE FOR CORRECTION MODULE

        C	CDFLNG--LENGTH OF THE DEFAULT CORRECTION FILENAME

        C	CGSFL1--FLAG FROM CORRECTION FILE GLOBAL SYMBOL SPECIFICATION 

        C	CLUN--CHANNEL FOR READING CORRECTION FILE

        C	CNMLNG--LENGTH OF THE CORRECTION FILE SPECIFICATION

        C	COLON--VALUE OF ASCII COLON

        C	COMLIN--I/O BUFFER FOR COMMAND LINE

        C	CORAL--ALLOCATION VALUE FROM A CORRECTION FILE PSECT DEFINITION

        C	CORDEF--ARRAY SPECIFYING ASCII DEFAULT CORRECTION FILENAME

        C	CORNAM--CORRECTION FILE SPECIFICATION

        C	CORREC--INPUT BUFFER FOR CORRECTION FILE RECORDS

        C	CORSUM--ACCUMULATOR FOR CORRECTION FILE CHECKSUM

        C	CORTYP--ARRAY SPECIFYING FILE TYPE "CORRECTION"

        C	CSTAT--STATUS OF TYPE OF CLOSE FOR CORRECTION FILE CHANNEL

        C	CSWTCH--INDICATOR FOR CORRECTION FILE CHECKSUM SWITCH:  ON=1, OFF=0

        C	CTYLNG--LENGTH OF THE STRING SPECIFYING THE FILE TYPE "CORRECTION"

        C	CURIND--INDICATOR TO REQUEST MOST CURRENT FILE VERSION

        C	DATIME--DATE AND TIME OF DAY

        C	ENTPNT--VALUE SPECIFYING ENTRY POINT GSD RECORD

        C	EOM--VALUE SPECIFYING EOM RECORD

        C	EOMLNG--LENGTH OF END OF MODULE RECORD USED BY PAX IF NONE IS PROVIDED

        C	EOMREC--END OF MODULE RECORD USED BY PAX IF NONE IS PROVIDED

        C	ERRTYP--ARRAY OF ERROR CODES

        C	FUTIND--INDICATOR TO REQUEST FUTURE FILE VERSION

        C	GSD--VALUE SPECIFYING GLOBAL SYMBOL DEFINITION RECORD

        C	GSDEF--VALUE OF FLAG WHEN EQUAL TO GLOBAL SYMBOL SPECIFICATION INSTEAD OF REFERENCE

        C	GSDLNG--LENGTH OF ONE GSD IN A GSD RECORD

        C	GSDPNT--POINTER INT A CONCATENATED GSD RECORD TO ONE GSD

        C	GSFLG1--INPUT FILE GLOBAL SYMBOL SPECIFICATION FLAG

        C	GSS--VALUE SPECIFYING GLOBAL SYMBOL SPECIFICATION RECORD

        C	IALLOC--VALUE OF ALLOCATION FROM AN INPUT FILE PSECT DEFINITION

        C	ICHECK--USER'S CHECKSUM VALUE FOR INPUT MODULE

        C	ID--U.I.C. EXECUTING THIS PATCH UTILITY

        C	IDFLNG--LENGTH OF THE DEFAULT INPUT FILENAME

        C	IDIF--DIFFERENCE BETWEEN LENGTHS OF CORRECTION AND INPUT FILE MODULE VERSIONS

        C	IGSD--PARAMETER SPECIFYING SIZE OF ARRAY INGSD

        C	ILUN--CHANNEL FOR READING INPUT FILE

        C	INMLNG--LENGTH OF INPUT FILE SPECIFICATION

        C	INDEX--POINTER INTO MAPTBL TO NEXT FREE SLOT

        C	INGSD--TABLE OF GLOBAL SYMBOL SPECIFICATIONS

        C	INMLNG--LENGTH OF THE INPUT FILE SPECIFICATION

        C	INPAL--ALLOCATION VALUE FROM AN INPUT FILE PSECT DEFINITION

        C	INPDEF--ARRAY SPECIFYING ASCII DEFAULT INPUT FILENAME

        C	INPNAM--INPUT FILE SPECIFICATION

        C	INPSEC--TABLE OF PSECT DEFINITIONS

        C	INPSUM--ACCUMULATOR FOR INPUT FILE CHECKSUM

        C	INPTYP--ARRAY SPECIFYING FILE TYPE "INPUT"

        C	IPSEC--PARAMETER SPECIFYING SIZE OF ARRAY INPSEC

        C	IPTR--POINTER TO NEXT FREE SLOT IN INPSEC

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 4   

PAX.FTN      	/TR:BLOCKS/WR


        C	ISUB--POINTER INTO OUTPUT MODULE HEADER RECORD FOR DATE AND TIME

        C	ISWTCH--INDICATOR FOR INPUT FILE CHECKSUM SWITCH:  ON=1, OFF=0

        C	ITIME--TIME OF DAY

        C	ITYLNG--LENGTH OF THE STRING SPECIFYING THE FILE TYPE "INPUT"

        C	JGSD--PARAMETER SPECIFYING SIZE OF ARRAY INGSD

        C	LENCNM--LENGTH OF MODULE NAME FROM CORRECTION FILE HEADER RECORD

        C	LENCOR--LENGTH OF LAST CORRECTION FILE RECORD READ

        C	LENCVR--LENGTH OF MODULE VERSION FROM CORRECTION FILE HEADER RECORD

        C	LENGTH--LENGTH OF INPUT LINE

        C	LENINM--LENGTH OF MODULE NAME FROM INPUT FILE HEADER RECORD

        C	LENINP--LENGTH OF LAST INPUT FILE RECORD READ

        C	LENIVR--LENGTH OF MODULE VERSION FROM INPUT FILE HEADER RECORD

        C	LFBRAC--VALUE OF ASCII LEFT BRACKET

        C	MAINTN--NUMBER OF MAINTENANCE STATUS RECORDS IN THE MODULE BEING PATCHED

        C	MAPTBL--TABLE MAPPING CORRECTION FILE PSECT NUMBERS TO INPUT FILE PSECT NUMBERS

        C	MAXCSZ--MAXIMUM CORRECTION FILE RECORD SIZE

        C	MAXISZ--MAXIMUM INPUT FILE RECORD SIZE

        C	MHD--VALUE SPECIFYING MODULE HEADER RECORD

        C	MNTN--VALUE SPECIFYING MAINTENANCE SUB-HEADER RECORD

        C	MODPTR--POINTER TO MODULE IN INPUT FILE TO BE PATCHED

        C	MOVSUB--SUBSCRIPT INTO OUTPUT MODULE HEADER RECORD FOR VERSION

        C	NBYTES--NUMBER OF BYTES IN A TIR COMMAND

        C	NEWSUB--SUBSCRIPT INTO CORRECTION MODULE HEADER RECORD FOR VERSION

        C	NMMOVS--NUMBER OF BYTES TO MOVE

        C	NTYPE--ARRAY FOR FILE TYPE IN ERROR

        C	NUMSW--NUMBER OF LEGITIMATE SWITCHES

        C	OCHECK--USER'S CHECKSUM VALUE FOR OUTPUT MODULE

        C	ODFLNG--LENGTH OF THE DEFAULT OUTPUT FILENAME

        C	OLUN--CHANNEL FOR WRITING OUTPUT FILE

        C	ONMLNG--LENGTH OF THE OUTPUT FILE SPECIFICATION

        C	OSWTCH--INDICATOR FOR CHECKSUM SWITCH ON OUTPUT FILE:  ON=1, OFF=0

        C	OTYLNG--LENGTH OF THE STRING SPECIFYING THE FILE TYPE "OUTPUT"

        C	OUTDEF--ARRAY SPECIFYING ASCII DEFAULT OUTPUT FILENAME

        C	OUTNAM--OUTPUT FILE SPECIFICATION

        C	OUTSUM--ACCUMULATOR FOR OUTPUT FILE CHECKSUM

        C	OUTTYP--ARRAY SPECIFYING FILE TYPE "OUTPUT"

        C	PATLNG--LENGTH OF NAME OF OBJECT MODULE PATCH UTILITY

        C	PATNAM--NAME OF OBJECT MODULE PATCH UTILITY

        C	PAXVER--VERSION OF OBJECT MODULE PATCH UTILITY

        C	PERIOD--VALUE OF ASCII PERIOD

        C	PROLNG--LENGTH OF PROMPT STRING FOR GCML REQUEST

        C	PROMPT--THE GCML PROMPT STRING FOR REQUESTING COMMAND LINES

        C	PSECT--VALUE SPECIFYING PSECT DEFINITION RECORD

        C	PXVLNG--LENGTH OF VERSION OF OBJECT MODULE PATCH UTILITY

        C	RECORD--INPUT BUFFER FOR INPUT FILE READS

        C	RECSIZ--NUMBER OF CHARACTERS IN AN I/O BUFFER

        C	RELBIT--BIT CONFIGURATION INDICATING RELATIVE NOT ABSOLUTE ALLOCATION

        C	RTBRAC--VALUE OF ASCII RIGHT BRACKET

        C	SEMI--VALUE OF ASCII SEMI-COLON

        C	SUBHDR--NUMBER OF SUBHEADER RECORDS IN THE MODULE BEING PATCHED

        C	SWTABL--BYTE ARRAY OF ASCII SWITCHES

        C	TASKID--STORAGE ARRAY FOR TASK ATTRIBUTES

        C	TIR--VALUE SPECIFYING TEXT AND INFORMATION RECORD

        C	TYPLNG--TYPE OF FILE IN ERROR

        C	VERLNG--LENGTH OF VERSION OF A FILENAME

        C	VERSON--VERSION OF A FILENAME

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 5   

PAX.FTN      	/TR:BLOCKS/WR


        C

        C

        C***************************************************************************************

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 6   

PAX.FTN      	/TR:BLOCKS/WR


         

        C****************************************************************************

        C

        C

        C	IPSEC, IGSD, AND JGSD ARE PARAMETERS WHICH DEFINE THE SIZE OF THE STORAGE

        C	ARRAYS FOR PROGRAM SECTIONS AND GLOBAL SYMBOL SPECIFICATIONS.

        C	TO INCREASE THE SIZE OF MODULE THAT THE OBJECT MODULE PATCH UTILITY

        C	CAN PATCH, MERELY INCREASE THESE TWO PARAMETERS.

        C	JGSD, THE MAXIMUM SIZE OF A GSD RECORD CONTAINED IN INGSD, WAS 

        C	DETERMINED IN THE FOLLOWING WAY:  THE LARGEST ENTRY-POINT GSD IS

        C	28 BYTES, TO THIS IS ADDED ROOM FOR A FORMAL ARGUMENT MIN AND MAX

        C	COUNT (2 BYTES) AND UP TO 5 FORMAL ARGUMENT DESCRIPTORS EACH LIMITED

        C	TO 16 BYTES (80 BYTES).  THUS THE ARRAY INGSD IS SUBSCRIPTED 190.

        C

0001    	PARAMETER IPSEC=50,IGSD=250,JGSD=110

        C

        C

0002    	INTEGER*4 IALLOC,CALLOC

0003    	INTEGER CNMLNG,ONMLNG,ODFLNG,CDFLNG,OTYLNG,CTYLNG,TYPLNG,EOMLNG

0004    	INTEGER OSWTCH,CSWTCH,PROLNG,RECSIZ,ERRTYP(9),IMRK(3),CTYPE,OTYPE

0005    	INTEGER MAPTBL(100),OUTSUM,CORSUM,OLUN,CLUN,OSTAT,CSTAT

0006    	INTEGER TASKID(16),SUBHDR,GSDPNT,GSDLNG,OCHECK,CCHECK,VERLNG

0007    	INTEGER FUTIND,CURIND,ERRCOD,CPTR

         

0008    	BYTE COMLIN(512),RECORD(512),CORREC(512)

0009    	BYTE NTYPE(17),OUTTYP(6),INPTYP(5),CORTYP(10)

0010    	BYTE OUTNAM(42),INPNAM(42),CORNAM(42)

0011    	BYTE INPDEF(4),OUTDEF(10),CORDEF(4)

0012    	BYTE PROMPT(5),SWTABL(5)

0013    	BYTE GSFLG1,INPSEC(25,IPSEC),INGSD(JGSD,IGSD),EOMREC(2)

0014    	BYTE DATIME(18),ITIME(8)

0015    	BYTE GSDEF,RELBIT,CGSFL1,INPAL(4),CORAL(4)

0016    	BYTE ENTPNT,TIR,EOM,MHD,GSD,MNTN,GSS,PSECT,PROARG

0017    	BYTE ID(2),PATNAM(3),PATLNG

0018    	BYTE PAXVER(3),SEMI,COLON,PERIOD,RTBRAC,LFBRAC,RTANGL,LFANGL

0019    	BYTE A(2),B(2),PXVLNG,VERSON(5)

         

0020    	EQUIVALENCE (TASKID(8),ID(1))

0021    	EQUIVALENCE (RECORD(5),GSFLG1)

0022    	EQUIVALENCE (A(1),MAXISZ)

0023    	EQUIVALENCE (B(1),MAXCSZ)

0024    	EQUIVALENCE (CORREC(5),CGSFL1)

0025    	EQUIVALENCE (ITIME(1),DATIME(11))

0026    	EQUIVALENCE (IALLOC,INPAL(1))

0027    	EQUIVALENCE (CALLOC,CORAL(1))

0028    	EQUIVALENCE (COMLIN(1),RECORD(1))

         

0029    	DATA OUTTYP/'O','U','T','P','U','T'/,OTYLNG/6/

0030    	DATA INPTYP/'I','N','P','U','T'/,ITYLNG/5/

0031    	DATA CORTYP/'C','O','R','R','E','C','T','I','O','N'/,CTYLNG/10/

        C

        C	THIS DATA STATEMENT INITIALIZES THE PROMPT STRING AND ITS LENGTH.

        C

0032    	DATA PROMPT/10,'P','A','X','>'/PROLNG/5/

0033    	DATA INPDEF/'.','O','B','J'/IDFLNG/4/

0034    	DATA CORDEF/'.','O','B','J'/CDFLNG/4/

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 7   

PAX.FTN      	/TR:BLOCKS/WR


0035    	DATA SWTABL/'C','S',1,'D',2/,NUMSW/1/

0036    	DATA GSDEF/2/,RELBIT/8/,DATIME(10)/' '/,RECSIZ/512/

0037    	DATA CURIND/0/,FUTIND/1/,PERIOD/'.'/,COLON/':'/,SEMI/';'/

0038    	DATA RTBRAC/']'/,LFBRAC/'['/,LFANGL/'<'/,RTANGL/'>'/

0039    	DATA ERRTYP/-1,-2,-3,-4,-5,-6,-7,-8,-9/

0040    	DATA ENTPNT,MHD,GSD,EOM/2,0,1,3/,TIR,MNTN,GSS,PSECT/2,5,1,0/

0041    	DATA PROARG/3/

0042    	DATA EOMREC/3,1/,EOMLNG/2/

        C

        C	THE OBJECT MODULE PATCH UTILITY USES THE FOLLOWING STRINGS FOR

        C	CREATING A MAINTENANCE STATUS SUBHEADER RECORD.  TO CHANGE

        C	THE VERSION OR NAME OF THIS UTILITY THE ARRAYS PATNAM AND PAXVER

        C	MUST BE DECLARED THEIR NEW SIZES AND INITIALIZED TO ASCII VALUES.

        C	THEIR CORRESPONDING LENGTHS, PATLNG AND VERLNG, MUST ALSO BE SET.

        C

0043    	DATA PATNAM/'P','A','X'/,PATLNG/3/

0044    	DATA PAXVER/'4','.','0'/,PXVLNG/3/

0045    	DATA CTYPE,OTYPE,ITYPE/0,1,0/

        C

        C****************************************************************************

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 8   

PAX.FTN      	/TR:BLOCKS/WR


         

        C****************************************************************************

        C

        C

        C	FORMAT STATEMENTS

        C

        C

        C	INPUT FORMATS

        C

0046    51	FORMAT(Q,130A1,130A1,130A1,130A1)

0047    61	FORMAT(Q,130A1,130A1,130A1,130A1)

0048    71	FORMAT(130A1,130A1,130A1,130A1)

0049    81	FORMAT(130A1,130A1,130A1,130A1)

        C

        C	CHECKSUM AND SEVERITY WARNING MESSAGES

        C

0050    711	FORMAT(' PAX -- WARNING--SEVERITY ERROR OF ',A1,' ON MODULE BEING'

        	1,' PATCHED.')

0051    731	FORMAT(' PAX -- CHECKSUM FOR ',<LENGTH>A1,' IS ',I8)

0052    751	FORMAT(' PAX -- CHECKSUM ON FILE ',<LENGTH>A1,' WAS ',I5,

        	1' AND NOT ',I5)

0053    761	FORMAT(' PAX OUTPUT IN FILE ',<ONMLNG>A1)

        C

        C

        C	ERROR MESSAGES

        C

        C

        C	OBJECT MODULE ERRORS

        C

0054    9006	FORMAT(' PAX -- CANNOT RELOCATE GSD ',<INGSD(11,J)>A1

        	1,' TO A DIFFERENT PSECT.')

0055    9021	FORMAT(' PAX -- CORRECTION FILE VERSION IS ',<LENCVR>A1,

        	1/T16,'AND NOT A VALID PATCH VERSION FOR ',<LENIVR>A1)

0056    9031	FORMAT(' PAX -- EMPTY FILE ',<LENGTH>A1)

0057    9041	FORMAT(' PAX -- FIRST RECORD OF FILE ',<LENGTH>A1,' WAS'

        	1,T16,'NOT A MODULE HEADER RECORD.')

0058    9046	FORMAT(' PAX -- FIRST RECORD OF FILE ',<LENGTH>A1,/T16'WAS'

        	1,' A SUBHEADER RECORD NOT A MODULE HEADER RECORD TYPE 0')

0059    9051	FORMAT(' PAX -- FILE ',<INMLNG>A1,' DOES NOT CONTAIN'

        	1,' MODULE ',<LENCNM>A1)

0060    9061	FORMAT(' PAX -- UNRECOGNIZED GSD RECORD OF TYPE='

        	1,I4,/T16,'IN FILE ',<LENGTH>A1)

0061    9071	FORMAT(' PAX -- UNRECOGNIZED TIR COMMAND TYPE ',I4)

0062    9081	FORMAT(' PAX -- CANNOT CHANGE PSECT ',

        	1<INPSEC(10,J)>A1,' FROM REL TO ABS OR ABS TO REL')

0063    9091	FORMAT(' PAX -- CANNOT CHANGE GLOBAL SYMBOL SPECIFICATION ',

        	1<INGSD(4,J)>A1,/T16,'FROM REL TO ABS OR ABS TO REL')

0064    9101	FORMAT(' PAX -- ALLOTTED PROGRAM TABLES TOO SMALL.'

        	1/' ARRAYS INGSD AND INPSEC SHOULD BE INCREASED IN SIZE.')

0065    9121	FORMAT(' PAX -- WARNING--FILE ',<LENGTH>A1,

        	1' ENDED BEFORE EOM RECORD.')

0066    9151	FORMAT(' PAX -- CANNOT CHANGE GSD TYPE FROM ',I5,' TO ',I5)

0067    9161	FORMAT(' PAX -- GSD TYPE 3 TOO LARGE FOR BUFFER')

        C

        C

        C***************************************************************************************

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 9   

PAX.FTN      	/TR:BLOCKS/WR


         

        C****************************************************************************

        C***

        C***	SET UP FILES FOR OBJECT MODULE PATCH

        C***

        C****************************************************************************

        C

        C

        C	INITIALIZE POINTER INTO INPUT FILE FOR MODULE TO BE PATCHED.

        C	ALSO INITIALIZE ALL VARIABLES THAT MAY HOLD ERROR RETURNS.

        C

0068    10	ONMLNG=0

0069    	INMLNG=0

0070    	CNMLNG=0

0071    	ISTAT=0

0072    	CSTAT=0

0073    	OSTAT=0

0074    	ILUN=1

0075    	OLUN=2

0076    	CLUN=3

        C

        C	ASSIGN THE COMMAND LINE INPUT CHANNEL TO THE TERMINAL.

        C	NOTE:  CHANNEL FOUR SHOULD ONLY BE USED FOR COMMAND LINE I/O.

        C

0077    	CALL ASNLUN(4,'TI',0)

        C

        C	REQUEST A COMMAND LINE.

        C

0078    	CALL GETCML(COMLIN,LENGTH,PROMPT,PROLNG,ERRCOD)

0079    	IF (ERRCOD.LE.0) GOTO 9500

        C

        C	ANALYZE THE SYNTAX OF THE COMMAND LINE.

        C

0080    	CALL SYNTX(COMLIN,LENGTH,ERRCOD)

0081    	IF (ERRCOD.LE.0) GOTO 9510

        C

        C	INITIALIZE THE SWITCH VALUES.

        C

0082    	CALL BLDSWT(NUMSW,SWTABL,ICHECK,ERRCOD)

0083    	IF (ERRCOD.LT.0) GOTO 9550

        C

        C	REQUEST AN INPUT FILE SPECIFICATION.

        C

0084    	CALL SCANI(COMLIN,LENGTH,ISWTCH,INPNAM,INMLNG,INPDEF,IDFLNG,ERRCOD)

0085    	IF (ERRCOD.LT.0) GOTO 9530

        C

        C	CREATE AN OUTPUT DEFAULT FILENAME (I.E., USE THE INPUT FILENAME 

        C	AND NEXT SEQUENTIAL VERSION NUMBER.)

        C

0086    	ODFLNG=1

0087    	DO 20 I=1,INMLNG

0088    	IF ((INPNAM(I).EQ.RTBRAC) .OR. (INPNAM(I).EQ.LFBRAC) .OR.

        	1   (INPNAM(I).EQ.COLON) .OR. (INPNAM(I).EQ.LFANGL) .OR.

        	2   (INPNAM(I).EQ.RTANGL)) GOTO 15

0089    	IF (INPNAM(I).EQ.SEMI) GOTO 25

0090    	OUTDEF(ODFLNG)=INPNAM(I)

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 10  

PAX.FTN      	/TR:BLOCKS/WR


0091    	ODFLNG=ODFLNG + 1

0092    	GOTO 20

0093    15	ODFLNG=1

0094    20	CONTINUE

0095    25	ODFLNG=ODFLNG-1

        C

        C	INITIALIZE THE OUTPUT SWITCH VALUES.

        C

0096    	CALL BLDSWT(NUMSW,SWTABL,OCHECK,ERRCOD)

0097    	IF (ERRCOD.LT.0) GOTO 9550

        C

        C	REQUEST AN OUTPUT FILE SPECIFICATION.

        C

0098    	CALL SCANO(COMLIN,LENGTH,OSWTCH,OUTNAM,ONMLNG,OUTDEF,ODFLNG,ERRCOD)

0099    	IF (ERRCOD.LT.0) GOTO 9520

        C

        C	INITIALIZE THE CORRECTION SWITCH VALUES.

        C

0100    30	CALL BLDSWT(NUMSW,SWTABL,CCHECK,ERRCOD)

0101    	IF (ERRCOD.LT.0) GOTO 9550

        C

        C	REQUEST A CORRECTION FILE SPECIFICATION.

        C

0102    	CALL SCANI(COMLIN,LENGTH,CSWTCH,CORNAM,CNMLNG,CORDEF,CDFLNG,ERRCOD)

0103    	IF (ERRCOD.LT.0) GOTO 9540

        C

        C	OPEN INPUT FILE.

        C

0104    	CALL OPNFIL(INPNAM,INMLNG,ILUN,RECORD,RECSIZ,ITYPE,ERRCOD)

0105    	IF (ERRCOD.LE.0) GOTO 9570

        C

        C	FIND VERSION NUMBER OF INPUT FILE.

        C

0106    	DO 40 I=1,INMLNG

0107    40	IF (INPNAM(I).EQ.SEMI) GOTO 60

0108    	CALL GETVER(ILUN,VERSON,VERLNG,CURIND,ERRCOD)

0109    	IF (ERRCOD.LE.0) GOTO 9800

0110    	INPNAM(INMLNG+1)=SEMI

0111    	INMLNG=INMLNG+1

0112    	DO 50 I=INMLNG+1,INMLNG+VERLNG

0113    50	INPNAM(I)=VERSON(I-INMLNG)

0114    	INMLNG=INMLNG+VERLNG

0115    	INPNAM(INMLNG+1)=0

        C

        C	CHECK IF OUTPUT FILENAME IS THE SAME AS THE INPUT FILENAME.

        C	IF IT IS OR IF A OUTPUT VERSION IS ALREADY SPECIFIED, THE

        C	FILE IS READY TO BE OPENED.

        C

0116    60	DO 70 I=1,ONMLNG

0117    	IF (OUTNAM(I).EQ.SEMI) GOTO 85

0118    70	IF (OUTNAM(I).NE.INPNAM(I)) GOTO 85

        C

        C	BOTH EQUAL, THEREFORE GET VERSION FOR OUTPUT FILE.

        C

0119    	CALL GETVER(ILUN,VERSON,VERLNG,FUTIND,ERRCOD)

0120    	IF (ERRCOD.LE.0) GOTO 9800

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 11  

PAX.FTN      	/TR:BLOCKS/WR


0121    	OUTNAM(ONMLNG+1)=SEMI

0122    	ONMLNG=ONMLNG+1

0123    	DO 80 I=ONMLNG+1,ONMLNG+VERLNG

0124    80	OUTNAM(I)=VERSON(I-ONMLNG)

0125    	ONMLNG=ONMLNG+VERLNG

0126    	OUTNAM(ONMLNG+1)=0

        C

        C	OPEN CORRECTION AND OUTPUT FILES.

        C

0127    85	CALL OPNFIL(CORNAM,CNMLNG,CLUN,CORREC,RECSIZ,CTYPE,ERRCOD)

0128    	IF (ERRCOD.LE.0) GOTO 9590

0129    	CALL OPNFIL(OUTNAM,ONMLNG,OLUN,RECORD,RECSIZE,OTYPE,ERRCOD)

0130    	IF (ERRCOD.LE.0) GOTO 9610

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 12  

PAX.FTN      	/TR:BLOCKS/WR


         

        C****************************************************************************

        C***

        C***	PATCH MODULE HEADER RECORD

        C***

        C****************************************************************************

        C

        C	READ MODULE HEADER RECORD OF CORRECTION FILE.

        C

0131    	CALL GETREC(CLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0132    	IF (ERRCOD.EQ.0) GOTO 9030

0133    	IF (ERRCOD.LT.0) GOTO 9730

0134    	IF (CORREC(1).NE.MHD) GOTO 9040

        C

        C	CHECK IF RECORD IS A SUB-HEADER.

        C

0135    	IF (CORREC(2).NE.MHD) GOTO 9045

0136    	GOTO 100

        C

        C	WRITE OUT ALL MODULE RECORDS UNTIL THE ONE TO BE CORRECTED IS FOUND.

        C

0137    90	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0138    	IF (ERRCOD.LE.0) GOTO 9760

        C

        C	READ INPUT FILE UNTIL YOU FIND A MATCHING MODULE HEADER NAME,

        C	MARKING THE FILE AT EACH RECORD.

        C

0139    100	CALL MRKREC(ILUN,IMRK,ERRCOD)

0140    	IF (ERRCOD.LE.0) GOTO 9770

0141    	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0142    	IF (ERRCOD.EQ.0) GOTO 9050

0143    	IF (ERRCOD.LT.0) GOTO 9700

        C

        C	IS IT A MODULE HEADER?

        C

0144    	IF (RECORD(1).NE.MHD) GOTO 90

        C

        C	IS IT TYPE 0?

        C

0145    	IF (RECORD(2).NE.MHD) GOTO 90

        C

        C	YES, HAS IT THE SAME LENGTH AND NAME?

        C

0146    	LENINM=RECORD(6)

0147    	LENCNM=CORREC(6)

0148    	LENGTH=LENCNM+1

0149    	DO 110 I=6,LENGTH+5

0150    110	IF (CORREC(I).NE.RECORD(I)) GO TO 90

        C

        C	FOUND CORRECT MODULE TO PATCH.

        C	SET UP NEW MODULE HEADER RECORD.  FIRST, CHECK MAXIMUM RECORD SIZE.

        C

0151    	DO 115 I=1,2

0152    	A(I)=RECORD(3+I)

0153    115	B(I)=CORREC(3+I)

0154    	IF (MAXISZ.LT.MAXCSZ) MAXISZ=MAXCSZ

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 13  

PAX.FTN      	/TR:BLOCKS/WR


0155    	RECORD(4)=A(1)

0156    	RECORD(5)=A(2)

        C

        C	COPY STRUCTURE LEVEL

        C

0157    	RECORD(3)=CORREC(3)

        C

        C	FIND MODULE VERSION AND CHANGE IT.

        C

0158    	ISUB=7+LENINM

0159    	LENIVR=RECORD(ISUB)

0160    	LENCVR=CORREC(ISUB)

0161    	IF (LENIVR.NE.LENCVR) GOTO 130

        C

        C	CHECK IF CORRECTION VERSION IS AN INCREMENTAL PATCH VALUE OF

        C	THE INPUT VERSION.

        C

0162    	IF (RECORD(ISUB+LENIVR)+1.NE.CORREC(ISUB+LENCVR)) GOTO 9020

0163    	IF (CORREC(ISUB+LENCVR).GT.'Z'.OR.CORREC(ISUB+LENCVR).LT.'A')

        	1 GOTO 9020

0164    	GOTO 150

        C

        C	MAKE SURE LENGTH OF VERSIONS DIFFER BY NO MORE THAN A PATCH VALUE.

        C

0165    130	IDIF=LENCVR-LENIVR

0166    	IF (IDIF.NE.1) GOTO 9020

        C

        C	NEW VERSION IS LONGER; MOVE REST OF INPUT RECORD DOWN IN BUFFER.

        C

0167    	IF (CORREC(ISUB+LENCVR).NE.'A') GOTO 9020

0168    	IF (CORREC(ISUB+LENCVR-1) .NE. RECORD(ISUB+LENIVR)) GOTO 9020

0169    	NMMOVS=LENINP-7-LENINM-LENIVR

0170    	MOVSUB=LENINP+IDIF+1

0171    	NEWSUB=LENINP+1

0172    	DO 140 I=1,NMMOVS

0173    140	RECORD(MOVSUB-I)=RECORD(NEWSUB-I)

        C

        C	NOW MOVE IN CORRECT MODULE VERSION.

        C

0174    150	DO 160 I=ISUB,ISUB+LENCVR+1

0175    160	RECORD(I)=CORREC(I)

        C

        C	NOW MOVE IN TIME AND DATE OF LAST PATCH (THIS ONE).

        C

0176    	ISUB=25+LENCVR+LENINM

0177    	CALL DATE(DATIME)

0178    	CALL TIME(ITIME)

0179    	DO 170 I=ISUB,ISUB+16

0180    170	RECORD(I)=DATIME(I-ISUB+1)

        C

        C	NOW WRITE OUT THIS MODULE HEADER RECORD.

        C

0181    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENCOR,ERRCOD)

0182    	IF (ERRCOD.LT.0) GOTO 9760

0183    	OUTSUM=LENCOR

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 14  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C****************************************************************************

        C***

        C***	PATCH SUBHEADER RECORDS

        C***

        C****************************************************************************

        C

        C	READ ALL SUBHEADER RECORDS AND WRITE OUT AN ADDITIONAL MAINTENANCE

        C	RECORD.

        C

0184    	MAINTN=0

        C

        C	READ AND WRITE ALL SUBHEADER RECORDS, COUNTING THE NUMBER

        C	OF MAINTENANCE RECORDS.

        C

0185    180	CALL MRKREC(ILUN,IMRK,ERRCOD)

0186    	IF (ERRCOD.LE.0) GOTO 9770

0187    	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0188    	IF (ERRCOD.EQ.0) GOTO 9035

0189    	IF (ERRCOD.LT.0) GOTO 9700

0190    	IF (RECORD(1).NE.MHD) GOTO 190

0191    	IF (RECORD(2).EQ.MNTN) MAINTN=MAINTN+1

0192    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0193    	IF (ERRCOD.LT.0) GOTO 9760

0194    	GOTO 180

        C

        C	CREATE NEW SUBHEADER RECORD.

        C

0195    190	RECORD(1)=MHD

0196    	RECORD(2)=MNTN

        C

        C	GET NAME OF PATCH UTILITY.

        C

0197    	DO 200 I=1,PATLNG

0198    200	RECORD(I+3)=PATNAM(I)

        C

        C	GET LENGTH OF UTILITY NAME.

        C

0199    	RECORD(3)=PATLNG

        C

        C	GET VERSION OF UTILITY.

        C

0200    	ISUB=4+PATLNG

0201    	RECORD(ISUB)=PXVLNG

0202    	DO 205 I=1,PXVLNG

0203    205	RECORD(ISUB+I)=PAXVER(I)

0204    	ISUB=ISUB+1+PXVLNG

        C

        C	GET UIC.

        C

0205    	CALL GETTSK(TASKID)

0206    	RECORD(ISUB)=ID(1)

0207    	RECORD(ISUB+1)=ID(2)

0208    	ISUB=ISUB+2

        C

        C	GET INPUT FILE SPECIFICATION

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 15  

PAX.FTN      	/TR:BLOCKS/WR


        C

0209    	RECORD(ISUB)=INMLNG

0210    	DO 206 I=1,INMLNG

0211    206	RECORD(ISUB+I)=INPNAM(I)

0212    	ISUB=ISUB+INMLNG+1

        C

        C	GET CORRECTION FILE SPECIFICATION

        C

0213    	RECORD(ISUB)=CNMLNG

0214    	DO 207 I=1,CNMLNG

0215    207	RECORD(ISUB+I)=CORNAM(I)

0216    	ISUB=ISUB+CNMLNG

        C

        C	GET TIME AND DATE OF PATCH.

        C

0217    	DO 210 I=1,17

0218    210	RECORD(I+ISUB)=DATIME(I)

        C

        C	GET NUMBER OF PATCHES MADE TO MODULE.

        C

0219    	LENINP=ISUB+18

0220    	RECORD(LENINP)=MAINTN+1

0221    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0222    	IF (ERRCOD.LT.0) GOTO 9760

        C

        C

        C****************************************************************************

        C***

        C***	PATCH GSD RECORDS

        C***

        C****************************************************************************

        C

        C	NOW BUILD GLOBAL SYMBOL AND PSECT DEFINITION TABLES.

        C

        C

        C	READ INPUT FILE FOR GLOBAL SYMBOL AND PSECT DEFINITIONS,

        C	BUILDING TABLES.  FIRST CHECK FOR TABLES OVERFLOWING.

        C

0223    	IPTR=1

0224    	IGSPTR=1

0225    	CALL PNTREC(ILUN,IMRK,ERRCOD)

0226    	IF (ERRCOD.LE.0) GOTO 9770

0227    240	IF (IGSPTR.GT.IGSD.OR.IPTR.GT.IPSEC) GOTO 9100

0228    245	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0229    	IF (ERRCOD.EQ.0) GOTO 300

0230    	IF (ERRCOD.LT.0) GOTO 9700

        C

        C	IS IT EOM RECORD?

        C

0231    	IF (RECORD(1).EQ.EOM) GOTO 300

        C

        C	CHECK FOR MISSING EOM RECORD.

        C

0232    	IF ((RECORD(1).EQ.MHD) .AND. (RECORD(2).EQ.MHD)) GOTO 300

        C

        C	NO, IS IT GSD?

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 16  

PAX.FTN      	/TR:BLOCKS/WR


        C

0233    	IF (RECORD(1).NE.GSD) GOTO 245

        C

        C	POINT TO FIRST OF POSSIBLE CONCATENATED GSD'S.

        C

0234    	GSDPNT=2

        C

        C	IS IT GLOBAL SYMBOL SPECIFICATION?

        C

0235    247	IF ((RECORD(GSDPNT).EQ.GSS) .OR. (RECORD(GSDPNT).EQ.ENTPNT)

        	1 .OR. (RECORD(GSDPNT).EQ.PROARG)) GOTO 270

        C

        C	NO, IS IT A P-SECT DEFINITION?

        C

0236    	IF (RECORD(GSDPNT).NE.PSECT) GOTO 9070

        C

        C	FIND LENGTH OF THIS GSD.

        C

0237    	GSDLNG=9+RECORD(GSDPNT+8)

        C

        C	YES, INSERT INTO TABLE.

        C

0238    	INPSEC(1,IPTR)=RECORD(1)

0239    	DO 250 I=2,GSDLNG+1

0240    250	INPSEC(I,IPTR)=RECORD(GSDPNT+I-2)

        C

        C	INCREMENT POINTER TO NEXT FREE SLOT.

        C

0241    260	IPTR=IPTR+1

        C

        C	INCREMENT GSD POINTER TO NEXT POSSIBLE CONCATENATED GSD.

        C	BRANCH TO ANALYZE THIS GSD OR READ THE FILE FOR THE NEXT GSD.

        C

0242    	GSDPNT=GSDPNT+GSDLNG

0243    	IF (GSDPNT.LE.LENINP) GOTO 247

0244    	GOTO 240

        C

        C	HAVE A GLOBAL SYMBOL SPECIFICATION.

        C

        C

        C	FIND LENGTH OF GLOBAL SYMBOL SPECIFICATION.

        C

0245    270	GSDLNG=5

0246    	IF ((GSDEF.AND.RECORD(GSDPNT+2)).EQ.GSDEF) GSDLNG=GSDLNG+5

0247    	IF ((RECORD(GSDPNT).EQ.ENTPNT) .OR. (RECORD(GSDPNT).EQ.PROARG))

        	1 GSDLNG=GSDLNG+2

0248    	GSDLNG=GSDLNG+RECORD(GSDPNT+GSDLNG-1)

0249    	IF (RECORD(GSDPNT).NE.PROARG) GOTO 275

        C

        C	NOW ADD IN LENGTH OF FORMAL ARGUMENT DESCRIPTORS.

        C

0250    	GSDLNG=GSDLNG+2

0251    	J=RECORD(GSDPNT+GSDLNG-1)

0252    	IF (J.EQ.0) GOTO 275

0253    	DO 274 I=1,J

0254    274	GSDLNG=GSDLNG+2+RECORD(GSDPNT+GSDLNG-1)

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 17  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	INSERT IT INTO TABLE.

        C

0255    275	IF (GSDLNG.GT.JGSD) GOTO 9160

0256    	INGSD(1,IGSPTR)=RECORD(1)

0257    	DO 280 I=2,GSDLNG+1

0258    280	INGSD(I,IGSPTR)=RECORD(GSDPNT+I-2)

        C

        C	INCREMENT TABLE POINTER AND GSD POINTER.

        C

0259    290	IGSPTR=IGSPTR+1

0260    	GSDPNT=GSDPNT+GSDLNG

0261    	IF (GSDPNT.LE.LENINP) GOTO 247

0262    	GOTO 240

        C

        C	FINISHED READING INPUT FILE.  READ CORRECTION FILE AND 

        C	MERGE PSECT AND GLOBAL SYMBOL DEFINITIONS INTO TABLES.

        C

0263    300	INDEX=1

        C

        C

        C

        C	READ CORRECTION FILE, PATCHING P-SECT AND GLOBAL SYMBOL TABLES.

        C

        C

        C

        C

        C	FIRST CHECK IF TABLES OVERFLOWED.

        C

0264    310	IF ((IGSPTR.GT.IGSD) .OR. (IPTR.GT.IPSEC)) GOTO 9100

0265    315	CALL GETREC(CLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0266    	IF (ERRCOD.EQ.0) GOTO 480

0267    	IF (ERRCOD.LT.0) GOTO 9730

        C

        C	IS IT EOM?

        C

0268    	IF (CORREC(1).EQ.EOM) GOTO 480

        C

        C	NO, IS IT GSD?  IF NOT, READ NEXT RECORD.

        C

0269    	IF (CORREC(1).NE.GSD) GOTO 315

        C

        C	POINT TO FIRST OF POSSIBLE CONCATENATED GSD'S.

        C

0270    	GSDPNT=2

        C

        C	IS IT GLOBAL SYMBOL SPECIFICATION?

        C

0271    317	IF ((CORREC(GSDPNT).EQ.GSS) .OR. (CORREC(GSDPNT).EQ.ENTPNT)

        	1 .OR. (CORREC(GSDPNT).EQ.PROARG)) GOTO 380	

        C

        C	IS IT P-SECT DEFINITION?  NO, THEN ERROR.

        C

0272    	IF (CORREC(GSDPNT).NE.PSECT) GOTO 9060

        C

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 18  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	HAVE LEGAL P-SECT DEFINITION.  CHECK TABLE FOR A  MATCHING

        C	INPUT DEFINITION.

        C

        C

        C	GET LENGTH OF GSD.

        C

0273    	GSDLNG=9+CORREC(GSDPNT+8)

        C

        C	ARE THERE ANY OLD PSECT DEFINITIONS FROM THE INPUT FILE?

        C

0274    	IF (IPTR.EQ.1) GOTO 360

        C

        C	YES, LOOK FOR A MATCH.

        C

0275    	DO 360 J=1,IPTR-1

        C

        C	CHECK LENGTH AND NAME.

        C

0276    	DO 320 K=10,INPSEC(10,J)+10

0277    320	IF (INPSEC(K,J).NE.CORREC(GSDPNT+K-2)) GOTO 360

        C

        C	FOUND A MATCH.  CHECK IF BOTH ARE ABS OR REL.

        C

0278    	IF ((INPSEC(4,J).AND.RELBIT).NE.(CORREC(GSDPNT+2).AND.RELBIT))

        	1 GOTO 9080

        C

        C	REBUILD P-SECT DEFINITION.

        C

0279    	INPSEC(3,J)=CORREC(GSDPNT+1)

0280    	INPSEC(4,J)=CORREC(GSDPNT+2)

0281    	INPSEC(5,J)=CORREC(GSDPNT+3)

        C

        C	FIND GREATEST ALLOCATION.

        C

0282    	DO 330 K=1,4

0283    	INPAL(K)=INPSEC(5+K,J)

0284    330	CORAL(K)=CORREC(GSDPNT+3+K)

0285    	IF (CALLOC.LE.IALLOC) GOTO 350

        C

        C	CORRECTION FILE WAS LARGER; RESET ALLOCATION.

        C

0286    	DO 340 K=6,9

0287    340	INPSEC(K,J)=CORREC(GSDPNT+K-2)

0288    350	MAPTBL(INDEX)=J-1

0289    	INDEX=INDEX+1

0290    	GOTO 465

0291    360	CONTINUE

        C

        C	NO OLD MATCH, THIS MUST BE A NEW P-SECT.  ENTER DEFINITION

        C	ON BOTTOM IN INPUT FILE DEFINITION TABLE.

        C

0292    	INPSEC(1,IPTR)=CORREC(1)

0293    	DO 370 M=2,GSDLNG+1

0294    370	INPSEC(M,IPTR)=CORREC(GSDPNT+M-2)

0295    	MAPTBL(INDEX)=IPTR-1

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 19  

PAX.FTN      	/TR:BLOCKS/WR


0296    	INDEX=INDEX+1

0297    	IPTR=IPTR+1

0298    	GOTO 465

        C

        C

        C

        C	FOUND GLOBAL SYMBOL SPECIFICATION.  FIND ITS LENGTH.

        C

        C

        C

0299    380	GSDLNG=5

0300    	IF ((GSDEF.AND.CORREC(GSDPNT+2)). EQ. GSDEF) GSDLNG=GSDLNG+5

0301    	IF ((CORREC(GSDPNT).EQ.ENTPNT) .OR. (CORREC(GSDPNT).EQ.PROARG))

        	1 GSDLNG=GSDLNG+2

0302    	GSDLNG=GSDLNG+CORREC(GSDPNT+GSDLNG-1)

0303    	IF (CORREC(GSDPNT).NE.PROARG) GOTO 385

        C

        C	ADD IN LENGTH OF FORMAL ARGUMENT DESCRIPTORS.

        C

0304    	GSDLNG = GSDLNG + 2

0305    	J=CORREC(GSDPNT+GSDLNG-1)

0306    	IF (J.EQ.0) GOTO 385

0307    	DO 384 I=1,J

0308    384	GSDLNG = GSDLNG+2+CORREC(GSDPNT+GSDLNG-1)

        C

        C	CHECK GLOBAL SYMBOL SPECIFICATION TABLE FOR A MATCH.

        C	FIRST, ARE THERE ANY ENTRIES AT ALL?

        C

0309    385	IF (GSDLNG.GT.JGSD) GOTO 9160

0310    	IF (IGSPTR.EQ.1) GOTO 410

        C

        C	YES, AT LEAST ONE.  LOOK FOR A MATCH.

        C

        C

        C	CHECK FOR CORRECTION FILE REFERENCE INSTEAD OF DEFINITION.

        C

0311    	IF ((CORREC(GSDPNT+2).AND.GSDEF).NE.GSDEF) GOTO 420

0312    	DO 410 J=1,IGSPTR-1

        C

        C	IS TABLE VALUE A REF INSTEAD OF DEF.

        C

0313    	IF ((INGSD(4,J).AND.GSDEF).NE.GSDEF) GOTO 410

        C

        C	YES, IS A DEF.  CHECK LENGTH AND NAME.

        C

0314    	N=0

0315    	L=0

0316    	IF ((CORREC(GSDPNT).EQ.ENTPNT) .OR. (CORREC(GSDPNT).EQ.PROARG)) N=2

0317    	IF ((INGSD(2,J).EQ.ENTPNT) .OR. (INGSD(2,J).EQ.PROARG)) L=2

0318    	DO 390 K=11,INGSD(11+L,J)+11

0319    390	IF (INGSD(K+L,J).NE.CORREC(GSDPNT+K+N-2)) GOTO 410

        C

        C	FOUND A MATCH.  CHECK BOTH ARE ABS OR REL.

        C

0320    	IF ((INGSD(4,J).AND.RELBIT).NE.(CORREC(GSDPNT+2).AND.RELBIT)) GOTO 9090

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 20  

PAX.FTN      	/TR:BLOCKS/WR


        C	DOES GSD TYPE MATCH?

        C

0321    	IF (INGSD(2,J) .NE. CORREC(GSDPNT)) GOTO 9150

        C

        C	MAP P-SECT NUMBER IN CORRECT FILE TABLE INTO INPUT FILE TABLE.

        C	IF PSECT HAS NOT YET BEEN ENTERED INTO MAPPING TABLE, NEGATE

        C	P-SECT NUMBER TO INDICATE A DELAYED MAPPING.

        C

0322    	IF (CORREC(GSDPNT+4)+1.GE.IPTR) GOTO 395

0323    	CORREC(GSDPNT+4)=MAPTBL(CORREC(GSDPNT+4)+1)

0324    	IF (CORREC(GSDPNT+4).NE.INGSD(6,J)) GOTO 9005

0325    	GOTO 396

        C

        C	REBUILD GLOBAL SYMBOL DEFINITION.

        C

0326    395	CORREC(GSDPNT+4)=-CORREC(GSDPNT+4)

0327    396	N=GSDLNG+1

0328    	DO 400 L=3,N

0329    400	INGSD(L,J)=CORREC(GSDPNT+L-2)

0330    	GOTO 465

0331    410	CONTINUE

0332    	GOTO 450

        C

        C	GLOBAL SYMBOL REFERENCE; SEE IF THERE IS AN OLD ONE.

        C

0333    420	DO 440 J=1,IGSPTR-1

0334    	IF ((INGSD(4,J).AND.GSDEF).EQ.GSDEF) GOTO 440

        C

        C	CHECK FOR MATCHING NAME AND LENGTH.

        C

0335    	DO 430 K=6,INGSD(6,J)+6

0336    430	IF (INGSD(K,J).NE.CORREC(GSDPNT+K-2)) GOTO 440

        C

        C	FOUND A MATCH.  IGNORE THIS DUPLICATE REFERENCE.

        C

0337    	GOTO 465

0338    440	CONTINUE

0339    	GOTO 460

        C

        C	NO, IT IS A NEW DEFINITION OR REFERENCE.

        C	ANNEX IT ONTO THE INPUT FILE TABLE.

        C

0340    450	IF (CORREC(GSDPNT+4)+1.GE.IPTR) CORREC(GSDPNT+4)=-CORREC(GSDPNT+4)

0341    	IF (CORREC(GSDPNT+4)+1.LT.IPTR)

        	1 CORREC(GSDPNT+4)=MAPTBL(CORREC(GSDPNT+4)+1)

0342    460	INGSD(1,IGSPTR)=CORREC(1)

0343    	DO 470 M=2,GSDLNG+1

0344    470	INGSD(M,IGSPTR)=CORREC(GSDPNT+M-2)

0345    	IGSPTR=IGSPTR+1

0346    465	GSDPNT=GSDPNT+GSDLNG

0347    	IF (GSDPNT.LE.LENCOR) GOTO 317

0348    	GOTO 310

        C

        C	CHECK FOR ANY DELAYED MAPPINGS.

        C

0349    480	DO 475 I=1,IGSPTR-1

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 21  

PAX.FTN      	/TR:BLOCKS/WR


0350    475	IF (INGSD(6,I).LT.0) INGSD(6,I)=MAPTBL(INGSD(6,I)+1)

        C

        C

        C

        C	ALL TABLES COMPLETE.  CHECK IF ANY P-SECT DEFINITIONS TO WRITE OUT.

        C

        C

        C

0351    	IF (IPTR.EQ.1) GOTO 490

        C

        C	WRITE OUT P-SECT TABLE.

        C

0352    	DO 490 I=1,IPTR-1

        C

        C	FIND LENGTH OF RECORD TO WRITE OUT.

        C

0353    	LENINP=10+INPSEC(10,I)

0354    	CALL PUTREC(OLUN,INPSEC(1,I),RECSIZ,LENINP,ERRCOD)

0355    	IF (ERRCOD.LE.0) GOTO 9760

0356    	OUTSUM=OUTSUM+LENINP

0357    490	CONTINUE

        C

        C	NOW WRITE OUT ALL GLOBAL SYMBOL SPECIFICATIONS.

        C	FIRST CHECKING IF ANY EXIST.

        C

0358    	IF (IGSPTR.EQ.1) GOTO 520

0359    	DO 520 I=1,IGSPTR-1

        C

        C	FIND RECORD LENGTH.

        C

0360    	LENINP=6

        C

        C	CHECK IF RECORD IS REF OR DEF.  ADD 5 EXTRA BYTES FOR DEF.

        C

0361    	IF ((INGSD(4,I).AND.GSDEF).EQ.GSDEF) LENINP=LENINP+5

        C

        C	IF IT HAS AN ENTRY POINT, ADD 2 EXTRA BYTES OF LENGTH.

        C

0362    	IF ((INGSD(2,I).EQ.ENTPNT) .OR. (INGSD(2,I).EQ.PROARG))

        	1 LENINP=LENINP+2

        C

        C	ADD IN NAME LENGTH.

        C

0363    	LENINP=INGSD(LENINP,I)+LENINP

0364    	IF (INGSD(2,I).NE.PROARG) GOTO 510

        C

        C	ADD IN SIZE OF FORMAL ARGUMENT DESCRIPTORS.

        C

0365    	LENINP=LENINP+2

0366    	J=INGSD(LENINP,I)

0367    	IF (J.EQ.0) GOTO 510

0368    	DO 500 JJ=1,J

0369    500	LENINP=LENINP+2+INGSD(LENINP+2,I)

        C

        C	WRITE OUT GSD RECORD.

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 22  

PAX.FTN      	/TR:BLOCKS/WR


0370    510	CALL PUTREC(OLUN,INGSD(1,I),RECSIZ,LENINP,ERRCOD)

0371    	IF (ERRCOD.LE.0) GOTO 9760

0372    	OUTSUM=OUTSUM+LENINP

0373    520	CONTINUE

        C

        C

        C****************************************************************************

        C***

        C***	PATCH TIR'S

        C***

        C****************************************************************************

        C

        C	REPOSITION FILES TO SEARCH THEM FOR TIR'S.

        C

0374    	CLUN=3

0375    	CALL CLSFIL(CLUN,CSTAT,ERRCOD)

0376    	IF (ERRCOD .LE. 0) GOTO 9650

0377    	ILUN=1

0378    	CALL CLSFIL(ILUN,ISTAT,ERRCOD)

0379    	IF (ERRCOD .LE. 0) GOTO 9630

0380    	CALL OPNFIL(INPNAM,INMLNG,ILUN,RECORD,RECSIZ,ITYPE,ERRCOD)

0381    	IF (ERRCOD.LE.0) GOTO 9570

0382    	CALL OPNFIL(CORNAM,CNMLNG,CLUN,CORREC,RECSIZ,CTYPE,ERRCOD)

0383    	IF (ERRCOD.LE.0) GOTO 9590

0384    	CALL PNTREC(ILUN,IMRK,ERRCOD)

0385    	IF (ERRCOD.LE.0) GOTO 9770

        C

        C	SCAN INPUT AND THEN CORRECT FILE--WRITING OUT TIR'S.

        C	FIRST FIND MODULE BEING PATCHED.

        C

0386    530	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0387    	IF (ERRCOD.EQ.0) GOTO 9050

0388    	IF (ERRCOD.LT.0) GOTO 9700

0389    	INPSUM=LENINP

        C

        C	READ CORRECTION FILE MODULE HEADER RECORD.

        C

0390    	CALL GETREC(CLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0391    	IF (ERRCOD.EQ.0) GOTO 9030

0392    	IF (ERRCOD.LT.0) GOTO 9730

0393    	CORSUM=LENCOR

        C

        C	NOW READ NEXT RECORD IN INPUT FILE.

        C

0394    540	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0395    	IF (ERRCOD.EQ.0) GOTO 9120

0396    	IF (ERRCOD.LT.0) GOTO 9700

0397    	INPSUM=INPSUM+LENINP

        C

        C	CHECK IF EOM WAS MISSING.

        C

0398    	IF ((RECORD(1).EQ.MHD) .AND. (RECORD(2).EQ.MHD)) GOTO 9120

        C

        C	CHECK IF INPUT RECORD IS GSD OR MHDR.

        C

0399    	IF ((RECORD(1).EQ.GSD) .OR. (RECORD(1) .EQ. MHD)) GOTO 540

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 23  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	CHECK IF INPUT RECORD IS EOM.

        C

0400    	IF (RECORD(1).EQ.EOM) GOTO 550

        C

        C	FOUND TIR RECORD, WRITE IT OUT.

        C

0401    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0402    	IF (ERRCOD.LT.0) GOTO 9760

0403    	OUTSUM=OUTSUM+LENINP

0404    	GOTO 540

        C

        C

        C

        C	NOW SEARCH CORRECTION FILE FOR TIR'S TO WRITE OUT.

        C

        C

        C

0405    550	CALL GETREC(CLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0406    	IF (ERRCOD.EQ.0) GOTO 9130

0407    	IF (ERRCOD.LT.0) GOTO 9730

0408    	CORSUM=CORSUM+LENCOR

        C

        C	CHECK IF RECORD IS GSD OR MHDR.

        C

0409    	IF ((CORREC(1).EQ.GSD) .OR. (CORREC(1).EQ.MHD)) GOTO 550

        C

        C	CHECK IF RECORD IS EOM.

        C

0410    	IF (CORREC(1).EQ.EOM) GOTO 680

        C

        C	RECORD TYPE IS TIR OR DEB.  SEARCH FOR P-SECT NUMBERS THAT NEED

        C	MAPPING, I.E. FOR COMMAND TYPES 4, 5, AND 6.

        C

0411    	CPTR=2

        C

        C	FIND THE NUMBER OF DATA BYTES FOLLOWING THE COMMAND, I.E. NBYTES.

        C

0412    560	NBYTES=0

0413    	IF (CPTR.GT.LENCOR) GOTO 675

0414    	IF (CORREC(CPTR).LT.0) GOTO 670

0415    	IF (CORREC(CPTR).LE.8) GOTO 590

0416    	IF (CORREC(CPTR).EQ.12) GOTO 600

0417    	IF (CORREC(CPTR).EQ.13) GOTO 665

0418    	IF (CORREC(CPTR).EQ.65) GOTO 600

0419    	IF (CORREC(CPTR).EQ.81) NBYTES=4

0420    	IF (CORREC(CPTR).EQ.60) NBYTES=2

0421    	IF (CORREC(CPTR).EQ.32) NBYTES=2

        C

        C	CHECK FOR UNRECOGNIZED COMMAND.

        C

0422    	IF ((CORREC(CPTR).LE.19) .AND. (CORREC(CPTR).GE.14)) GOTO 9140

0423    	IF ((CORREC(CPTR).LE.49) .AND. (CORREC(CPTR).GE.41)) GOTO 9140

0424    	IF ((CORREC(CPTR).LE.79) .AND. (CORREC(CPTR).GE.66)) GOTO 9140

0425    	IF ((CORREC(CPTR).LE.127) .AND. (CORREC(CPTR).GE.82)) GOTO 9140

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 24  

PAX.FTN      	/TR:BLOCKS/WR


        C	REST OF COMMANDS HAVE NO FOLLOWING DATA.

        C	POINT TO NEXT COMMAND.

        C

0426    580	CPTR=CPTR+1+NBYTES

0427    	GOTO 560

        C

        C	COMMAND FOLLOWED BY SOME DATA.

        C

0428    590	GOTO (600,610,620,630,660,660,660,610,620),CORREC(CPTR)+1

        C

        C	NBYTES IS THE NUMBER OF DATA BYTES FOLLOWING THE COMMAND TYPE.

        C

0429    600	NBYTES=CORREC(CPTR+1)+1

0430    	GOTO 580

0431    610	NBYTES=1

0432    	GOTO 580

0433    620	NBYTES=2

0434    	GOTO 580

0435    630	NBYTES=4

0436    	GOTO 580

0437    640	NBYTES=3

0438    	GOTO 580

0439    650	NBYTES=5

0440    	GOTO 580

0441    660	CORREC(CPTR+1)=MAPTBL(CORREC(CPTR+1)+1)

0442    	GOTO (620,640,650),CORREC(CPTR)-3

0443    665	NBYTES=CORREC(CPTR+1)+4

0444    	NBYTES=NBYTES+CORREC(NBYTES+CPTR)

0445    	GOTO 580

        C

        C	HAVE A STOIM.  FIND LENGTH OF BYTES OF DATA.

        C

0446    670	NBYTES=-CORREC(CPTR)

0447    	NBYTES=NBYTES.AND.255

0448    	GOTO 580

        C

        C	DONE EDITING RECORD, WRITE IT OUT.

        C

0449    675	CALL PUTREC(OLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0450    	IF (ERRCOD.LE.0) GOTO 9760

0451    	OUTSUM=OUTSUM+LENCOR

0452    	GOTO 550

        C

        C

        C****************************************************************************

        C***

        C***	PATCH END OF MODULE RECORD

        C***

        C****************************************************************************

        C

        C	DONE WRITING TIR'S.  WRITE EOM.

        C

0453    680	IF ((RECORD(1).EQ.0) .AND. (CORREC(1).EQ.0)) GOTO 717

0454    	IF (RECORD(1).EQ.0) GOTO 715

0455    	IF (CORREC(1).EQ.0) GOTO 700

0456    	IF (LENINP.LT.LENCOR) GOTO 710

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 25  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	OUTPUT GREATER SEVERITY CODE.

        C

0457    	IF (CORREC(2).GT.RECORD(2)) RECORD(2)=CORREC(2)

        C

        C	CHECK IF A WARNING ON SEVERITY ERROR SHOULD BE WRITTEN.

        C

0458    	IF (RECORD(2).GT.1) WRITE(6,711)RECORD(2)

        C

        C	IF BOTH EOM'S ARE EQUAL TO TWO, BRANCH TO WRITE INPUT EOM.

        C

0459    	IF (LENINP.EQ.2) GOTO 700

        C

        C	IF THE CORRECTION EOM IS SMALLER THAN THE INPUT EOM, BRANCH TO

        C	WRITE OUT INPUT EOM.

        C

0460    	IF (LENCOR.EQ.2) GOTO 700

        C

        C	BOTH THE CORRECTION EOM AND THE INPUT EOM CONTAINED TRANSFER ADDRESSES.

        C	MOVE IN THE NEW TRANSFER ADDRESS.

        C

0461    	CORREC(3)=MAPTBL(CORREC(3)+1)

0462    	DO 690 I=3,7

0463    690	RECORD(I)=CORREC(I)

0464    	IF (RECORD(2).GT.1) WRITE(6,711)RECORD(2)

0465    700	IF ((CORREC(1).EQ.0) .AND. (RECORD(2).LT.1)) RECORD(2)=1

0466    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0467    	IF (ERRCOD.LE.0) GOTO 9760

0468    	OUTSUM=OUTSUM+LENINP

0469    	GOTO 720

        C

        C	CORRECTION EOM CONTAINS A TRANSFER ADDRESS AND INPUT EOM DOES

        C	NOT.  THEREFORE, SET UP HIGHER SEVERITY ERROR, MAP CORRECTION

        C	PSECT NUMBER AND WRITE CORRECTION EOM.

        C

0470    710	IF (RECORD(2).GT.CORREC(2)) CORREC(2)=RECORD(2)

0471    	IF (CORREC(2).GT.1) WRITE(6,711)CORREC(2)

0472    	CORREC(3)=MAPTBL(CORREC(3)+1)

0473    715	IF ((RECORD(1).EQ.0) .AND. (CORREC(2).LT.1)) CORREC(2)=1

0474    	CALL PUTREC(OLUN,CORREC,RECSIZ,LENCOR,ERRCOD)

0475    	IF (ERRCOD.LT.0) GOTO 9760

0476    	OUTSUM=OUTSUM+LENCOR

0477    	GOTO 720

        C

        C	NO EOM RECORD PROVIDED--USE PAX DEFAULT RECORD.

        C

0478    717	CALL PUTREC(OLUN,EOMREC,RECSIZ,EOMLNG,ERRCOD)

0479    	IF (ERRCOD.LT.0) GOTO 9760

0480    	OUTSUM=OUTSUM + EOMLNG

        C

        C

        C****************************************************************************

        C***

        C***	COMPLETE PATCH FILE

        C***

        C****************************************************************************

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 26  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	WRITE OUT REST OF CONCATENATED MODULES IN INPUT FILE.

        C

0481    720	CALL GETREC(ILUN,RECORD,RECSIZ,LENINP,ERRCOD)

0482    	IF (ERRCOD.EQ.0) GOTO 730

0483    	IF (ERRCOD.LT.0) GOTO 9700

0484    	CALL PUTREC(OLUN,RECORD,RECSIZ,LENINP,ERRCOD)

0485    	IF (ERRCOD.LE.0) GOTO 9760

0486    	GOTO 720

        C

        C	CHECK IF CHECK SUMS ARE REQUESTED.

        C

0487    730	IF (ISWTCH.EQ.0) GOTO 740

0488    	LENGTH=INMLNG

0489    	IF (ICHECK.EQ.0) WRITE(6,731)(INPNAM(I),I=1,LENGTH),INPSUM

0490    	IF (ICHECK.EQ.0) GOTO 740

0491    	IF ((ICHECK.NE.0) .AND. (ICHECK.EQ.INPSUM)) GOTO 740

0492    	WRITE(6,751)(INPNAM(I),I=1,LENGTH),INPSUM,ICHECK

0493    	INPSUM=0

0494    740	IF (CSWTCH.EQ.0) GOTO 750

0495    	LENGTH=CNMLNG

0496    	IF (CCHECK.EQ.0) WRITE(6,731)(CORNAM(I),I=1,LENGTH),CORSUM

0497    	IF (CCHECK.EQ.0) GOTO 750

0498    	IF ((CCHECK.NE.0) .AND. (CCHECK.EQ.CORSUM)) GOTO 750

0499    	WRITE(6,751)(CORNAM(I),I=1,LENGTH),CORSUM,CCHECK

0500    	INPSUM=0

0501    750	IF (OSWTCH.EQ.0) GOTO 760

0502    	LENGTH=ONMLNG

0503    	IF (OCHECK.EQ.0) WRITE(6,731)(OUTNAM(I),I=1,LENGTH),OUTSUM

0504    	IF (OCHECK.EQ.0) GOTO 760

0505    	IF ((OCHECK.NE.0) .AND. (OCHECK.EQ.OUTSUM)) GOTO 760

0506    	WRITE(6,751)(OUTNAM(I),I=1,LENGTH),OUTSUM,OCHECK

0507    	INPSUM=0

        C

        C	CHECK FOR VALID OUTPUT, ELSE DELETE FILE WHEN CLOSE.

        C

0508    760	IF (INPSUM.EQ.0) GOTO 9996

0509    	GOTO 9997

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 27  

PAX.FTN      	/TR:BLOCKS/WR


         

        C****************************************************************************

        C***

        C***	OBJECT MODULE PATCH UTILITY ERROR MESSAGES.

        C***

        C****************************************************************************

        C

        C

0510    9005	WRITE(6,9006)(INGSD(K,J),K=12,INGSD(11,J)+12)

0511    	GOTO 9996

0512    9020	WRITE(6,9021)(CORREC(ISUB+K),K=1,LENCVR),(RECORD(ISUB+J),

        	1J=1,LENIVR)

0513    	GOTO 9996

0514    9030	LENGTH=CNMLNG

0515    	WRITE(6,9031)(CORNAM(I),I=1,LENGTH)

0516    	GOTO 9996

0517    9035	LENGTH=INMLNG

0518    	WRITE(6,9031)(INPNAM(I),I=1,LENGTH)

0519    	GOTO 9996

0520    9040	LENGTH=CNMLNG

0521    	WRITE(6,9041)(CORNAM(I),I=1,LENGTH)

0522    	GOTO 9996

0523    9045	LENGTH=CNMLNG

0524    	WRITE(6,9046)(CORNAM(I),I=1,LENGTH)

0525    	GOTO 9996

0526    9050	WRITE(6,662)LENCNM

0527    662	FORMAT(' LENCNM=',I5)

0528    	WRITE(6,9051)(INPNAM(I),I=1,INMLNG),(CORREC(I),I=7,6+LENCNM)

0529    	GOTO 9996

0530    9060	LENGTH=CNMLNG

0531    	WRITE(6,9061)CORREC(2),(CORNAM(I),I=1,LENGTH)

0532    	GOTO 9996

0533    9070	LENGTH=INMLNG

0534    	WRITE(6,9061)RECORD(2),(INPNAM(I),I=1,LENGTH)

0535    	GOTO 9996

0536    9080	WRITE(6,9081)(INPSEC(N,J),N=11,11+INPSEC(10,J))

0537    	GOTO 9996

0538    9090	WRITE(6,9091)(INGSD(N,J),N=5,INGSD(4,J)+5)

0539    	GOTO 9996

0540    9100	WRITE(6,9101)

0541    	GOTO 9996

0542    9120	LENGTH=INMLNG

0543    	WRITE(6,9121)(INPNAM(I),I=1,LENGTH)

0544    	RECORD(1)=0

0545    	ILUN=1

0546    	GOTO 550

0547    9130	LENGTH=CNMLNG

0548    	WRITE(6,9121)(CORNAM(I),I=1,LENGTH)

0549    	CORREC(1)=0

0550    	CLUN=3

0551    	GOTO 680

0552    9140	WRITE(6,9071)CORREC(CPTR)

0553    	GOTO 9996

0554    9150	WRITE(6,9151)INGSD(2,J),CORREC(GSDPNT)

0555    	GOTO 9996

0556    9160	WRITE(6,9161)

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 28  

PAX.FTN      	/TR:BLOCKS/WR


0557    	GOTO 9996

        C

        C

        C***************************************************************************

        C

        C

        C	MACRO ROUTINE ERRORS

        C

        C

        C***************************************************************************

        C

        C	GETCML ERRORS

        C

0558    9500	IF (ERRCOD.EQ.0) GOTO 10000

0559    	CALL ERRORS(ERRTYP(1),ERRCOD,PROMPT(2),NOBYTE,NOINTG,NOBYTE,

        	1NOINTG,NOBYTE)

0560    	GOTO 10

        C

        C

        C	SYNTX ERRORS

        C

        C

0561    9510	CALL ERRORS(ERRTYP(2),ERRCOD,PROMPT(2),COMLIN,-LENGTH,NOBYTE,

        	1NOINTG,NOBYTE)

0562    	GOTO 10

        C

        C

        C	SCANO/SCANI ERRORS

        C

        C

        C	OUTPUT ERROR

        C

0563    9520	CALL ERRORS(ERRTYP(3),ERRCOD,PROMPT(2),OUTTYP,OTYLNG,NOBYTE,

        	1NOINTG,NOBYTE)

0564    	GOTO 10

        C

        C	INPUT ERROR

        C

0565    9530	CALL ERRORS(ERRTYP(3),ERRCOD,PROMPT(2),INPTYP,ITYLNG,NOBYTE,

        	1NOINTG,NOBYTE)

0566    	GOTO 10

        C

        C	CORRECTION ERROR

        C

0567    9540	CALL ERRORS(ERRTYP(3),ERRCOD,PROMPT(2),CORTYP,CTYLNG,NOBYTE,

        	1NOINTG,NOBYTE)

0568    	GOTO 10

        C

        C

        C	SWITCH TABLE ERROR

        C

        C

0569    9550	CALL ERRORS(ERRTYP(4),ERRCOD,PROMPT(2),SWTABL,NOINTG,NOBYTE,

        	1NOINTG,NOBYTE)

0570    	GOTO 1000

        C

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 29  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	OPEN FILE ERRORS

        C

        C

        C

        C	FOR INPUT FILE

        C

0571    9570	CALL ERRORS(ERRTYP(5),ERRCOD,PROMPT(2),INPTYP,ITYLNG,INPNAM,

        	1INMLNG,RECORD(1))

0572    	GOTO 1000

        C

        C	FOR CORRECTION FILE

        C

0573    9590	CALL ERRORS(ERRTYP(5),ERRCOD,PROMPT(2),CORTYP,CTYLNG,CORNAM,

        	1CNMLNG,CORREC(1))

0574    	GOTO 9999

        C

        C	FOR OUTPUT FILE

        C

0575    9610	CALL ERRORS(ERRTYP(5),ERRCOD,PROMPT(2),OUTTYP,OTYLNG,OUTNAM,

        	1ONMLNG,RECORD(1))

0576    	GOTO 9998

        C

        C

        C	CLOSE ERRORS

        C

        C

        C

        C	ON INPUT FILE

        C

0577    9630	CALL ERRORS(ERRTYP(6),ERRCOD,PROMPT(2),INPNAM,INMLNG,NOBYTE,

        	1ISTAT,NOBYTE)

0578    	GOTO 1000

        C

        C	ON CORRECTION FILE

        C

0579    9650	CALL ERRORS(ERRTYP(6),ERRCOD,PROMPT(2),CORNAM,CNMLNG,NOBYTE,

        	1CSTAT,NOBYTE)

0580    	GOTO 9999

        C

        C	ON OUTPUT FILE

        C

0581    9670	CALL ERRORS(ERRTYP(6),ERRCOD,PROMPT(2),OUTNAM,ONMLNG,NOBYTE

        	1,OSTAT,NOBYTE)

0582    	GOTO 9998

        C

        C

        C

        C	READ/WRITE ERRORS

        C

        C

        C	ON INPUT FILE

        C

0583    9700	CALL ERRORS(ERRTYP(7),ERRCOD,PROMPT(2),INPNAM,INMLNG,RECORD,

        	1LENINP,NOBYTE)

0584    	GOTO 9996

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 30  

PAX.FTN      	/TR:BLOCKS/WR


        C

        C	ON CORRECTION FILE

        C

0585    9730	CALL ERRORS(ERRTYP(7),ERRCOD,PROMPT(2),CORNAM,CNMLNG,CORREC,

        	1LENCOR,NOBYTE)

0586    	GOTO 9996

        C

        C	ON OUTPUT FILE

        C

0587    9760	CALL ERRORS(ERRTYP(7),ERRCOD,PROMPT(2),OUTNAM,ONMLNG,RECORD,

        	1LENINP,NOBYTE)

0588    	GOTO 9996

        C

        C

        C

        C	MARK/POINT ERRORS

        C

        C	FOR INPUT FILE

        C

0589    9770	CALL ERRORS(ERRTYP(8),ERRCOD,PROMPT(2),INPNAM,ERRCOD,NOBYTE,

        	1NOINTG,NOBYTE)

0590    	GOTO 9996

        C

        C

        C	VERSION ERRORS

        C

        C

0591    9800	CALL ERRORS(ERRTYP(9),ERRCOD,PROMPT(2),INPNAM,-INMLNG,NOBYTE,

        	1NOINTG,NOBYTE)

0592    	GOTO 9996

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 31  

PAX.FTN      	/TR:BLOCKS/WR


         

        C***************************************************************************

        C***************************************************************************

        C

        C

        C	CLOSE ALL FILES

        C

        C

        C	OSTAT=1 CAUSES THE FILE TO BE DELETED WHEN CLOSED.

        C

0593    9996	OSTAT=1

        C

        C	FILES ARE SAVED OR DELETED DEPENDING ON THIS STAT VARIABLES.

        C

        C

0594    9997	OLUN=2

0595    	CALL CLSFIL(OLUN,OSTAT,ERRCOD)

0596    	IF (ERRCOD.LE.0) GOTO 9670

0597    	IF (OSTAT.EQ.0) WRITE(6,761)(OUTNAM(I),I=1,ONMLNG)

0598    9998	CLUN=3

0599    	CALL CLSFIL(CLUN,CSTAT,ERRCOD)

0600    	IF (ERRCOD.LE.0) GOTO 9650

0601    9999	ILUN=1

0602    	CALL CLSFIL(ILUN,ISTAT,ERRCOD)

0603    	IF (ERRCOD.LE.0) GOTO 9630

0604    1000	GOTO 10

0605    10000	CALL EXIT

0606    	END

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 32  

PAX.FTN      	/TR:BLOCKS/WR


PROGRAM SECTIONS



NUMBER	 NAME	    SIZE		ATTRIBUTES



  1	$CODE1	016720  3816		RW,I,CON,LCL

  2	$PDATA	000050    20		RW,D,CON,LCL

  3	$IDATA	003334   878		RW,D,CON,LCL

  4	$VARS	073322 15209		RW,D,CON,LCL

  5	$TEMPS	000016     7		RW,D,CON,LCL





VARIABLES



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 CALLOC	I*4   4-001000	 CCHECK	I*2   4-002516	 CDFLNG	I*2   4-002104	 CGSFL1	L*1   4-001036	 CLUN	I*2   4-002500

 CNMLNG	I*2   4-002076	 COLON	L*1   4-073175	 CORSUM	I*2   4-002474	 CPTR	I*2   4-002530	 CSTAT	I*2   4-002504

 CSWTCH	I*2   4-002120	 CTYLNG	I*2   4-002110	 CTYPE	I*2   4-002156	 CURIND	I*2   4-002524	 ENTPNT	L*1   4-073154

 EOM	L*1   4-073156	 EOMLNG	I*2   4-002114	 ERRCOD	I*2   4-002526	 FUTIND	I*2   4-002522	 GSD	L*1   4-073160

 GSDEF	L*1   4-073152	 GSDLNG	I*2   4-002512	 GSDPNT	I*2   4-002510	 GSFLG1	L*1   4-000004	 GSS	L*1   4-073162

 I	I*2   4-073246	 IALLOC	I*4   4-001004	 ICHECK	I*2   4-073242	 IDFLNG	I*2   4-073214	 IDIF	I*2   4-073260

 IGSPTR	I*2   4-073274	 ILUN	I*2   4-073240	 INDEX	I*2   4-073276	 INMLNG	I*2   4-073232	 INPSUM	I*2   4-073312

 IPTR	I*2   4-073272	 ISTAT	I*2   4-073236	 ISUB	I*2   4-073256	 ISWTCH	I*2   4-073244	 ITYLNG	I*2   4-073212

 ITYPE	I*2   4-073220	 J	I*2   4-073224	 JJ	I*2   4-073310	 K	I*2   4-073300	 L	I*2   4-073306

 LENCNM	I*2   4-073234	 LENCOR	I*2   4-073250	 LENCVR	I*2   4-073226	 LENGTH	I*2   4-073222	 LENINM	I*2   4-073254

 LENINP	I*2   4-073252	 LENIVR	I*2   4-073230	 LFANGL	L*1   4-073202	 LFBRAC	L*1   4-073200	 M	I*2   4-073302

 MAINTN	I*2   4-073270	 MAXCSZ	I*2   4-002032	 MAXISZ	I*2   4-002034	 MHD	L*1   4-073157	 MNTN	L*1   4-073161

 MOVSUB	I*2   4-073264	 N	I*2   4-073304	 NBYTES	I*2   4-073314	 NEWSUB	I*2   4-073266	 NMMOVS	I*2   4-073262

 NOBYTE	I*2   4-073316	 NOINTG	I*2   4-073320	 NUMSW	I*2   4-073216	 OCHECK	I*2   4-002514	 ODFLNG	I*2   4-002102

 OLUN	I*2   4-002476	 ONMLNG	I*2   4-002100	 OSTAT	I*2   4-002502	 OSWTCH	I*2   4-002116	 OTYLNG	I*2   4-002106

 OTYPE	I*2   4-002160	 OUTSUM	I*2   4-002472	 PATLNG	L*1   4-073170	 PERIOD	L*1   4-073176	 PROARG	L*1   4-073164

 PROLNG	I*2   4-002122	 PSECT	L*1   4-073163	 PXVLNG	L*1   4-073203	 RECSIZ	I*2   4-002124	 RELBIT	L*1   4-073153

 RTANGL	L*1   4-073201	 RTBRAC	L*1   4-073177	 SEMI	L*1   4-073174	 SUBHDR	I*2   4-002506	 TIR	L*1   4-073155

 TYPLNG	I*2   4-002112	 VERLNG	I*2   4-002520





ARRAYS



 NAME   TYPE  ADDRESS	    SIZE 	DIMENSIONS



 A	L*1   4-002034	000002     1	(2)

 B	L*1   4-002032	000002     1	(2)

 COMLIN	L*1   4-000000	001000   256	(512)

 CORAL	L*1   4-001000	000004     2	(4)

 CORDEF	L*1   4-003014	000004     2	(4)

 CORNAM	L*1   4-002724	000052    21	(42)

 CORREC	L*1   4-001032	001000   256	(512)

 CORTYP	L*1   4-002566	000012     5	(10)

 DATIME	L*1   4-001010	000022     9	(18)

 EOMREC	L*1   4-073150	000002     1	(2)

 ERRTYP	I*2   4-002126	000022     9	(9)

 ID	L*1   4-002054	000002     1	(2)

 IMRK	I*2   4-002150	000006     3	(3)

 INGSD	L*1   4-005374	065554 13750	(110,250)

 INPAL	L*1   4-001004	000004     2	(4)

 INPDEF	L*1   4-002776	000004     2	(4)

FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 33  

PAX.FTN      	/TR:BLOCKS/WR


 INPNAM	L*1   4-002652	000052    21	(42)

 INPSEC	L*1   4-003032	002342   625	(25,50)

 INPTYP	L*1   4-002561	000005     2	(5)

 ITIME	L*1   4-001022	000010     4	(8)

 MAPTBL	I*2   4-002162	000310   100	(100)

 NTYPE	L*1   4-002532	000021     8	(17)

 OUTDEF	L*1   4-003002	000012     5	(10)

 OUTNAM	L*1   4-002600	000052    21	(42)

 OUTTYP	L*1   4-002553	000006     3	(6)

 PATNAM	L*1   4-073165	000003     1	(3)

 PAXVER	L*1   4-073171	000003     1	(3)

 PROMPT	L*1   4-003020	000005     2	(5)

 RECORD	L*1   4-000000	001000   256	(512)

 SWTABL	L*1   4-003025	000005     2	(5)

 TASKID	I*2   4-002036	000040    16	(16)

 VERSON	L*1   4-073204	000005     2	(5)





LABELS



 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	



 10	 1-000020	 15	 1-000356	 20	 1-000372	 25	 1-000414	 30	    **   

 40	    **   	 50	    **   	 51'	    **   	 60	 1-000756	 61'	    **   

 70	    **   	 71'	    **   	 80	    **   	 81'	    **   	 85	 1-001172

 90	 1-001326	 100	 1-001356	 110	    **   	 115	    **   	 130	 1-002010

 140	    **   	 150	 1-002234	 160	    **   	 170	    **   	 180	 1-002454

 190	 1-002604	 200	    **   	 205	    **   	 206	    **   	 207	    **   

 210	    **   	 240	 1-003314	 245	 1-003346	 247	 1-003462	 250	    **   

 260	    **   	 270	 1-003670	 274	    **   	 275	 1-004120	 280	    **   

 290	    **   	 300	 1-004264	 310	 1-004300	 315	 1-004332	 317	 1-004422

 320	    **   	 330	    **   	 340	    **   	 350	 1-005150	 360	 1-005206

 370	    **   	 380	 1-005360	 384	    **   	 385	 1-005610	 390	    **   

 395	 1-006306	 396	 1-006324	 400	    **   	 410	 1-006426	 420	 1-006456

 430	    **   	 440	 1-006644	 450	 1-006670	 460	 1-006766	 465	 1-007070

 470	    **   	 475	    **   	 480	 1-007124	 490	 1-007350	 500	    **   

 510	 1-007662	 520	 1-007740	 530	    **   	 540	 1-010224	 550	 1-010376

 560	 1-010506	 580	 1-011010	 590	 1-011036	 600	 1-011072	 610	 1-011122

 620	 1-011140	 630	 1-011156	 640	 1-011174	 650	 1-011212	 660	 1-011230

 662'	 3-002142	 665	 1-011306	 670	 1-011352	 675	 1-011406	 680	 1-011450

 690	    **   	 700	 1-011740	 710	 1-012024	 711'	 3-000000	 715	 1-012130

 717	 1-012214	 720	 1-012252	 730	 1-012330	 731'	 3-000106	 740	 1-012604

 750	 1-013060	 751'	 3-000154	 760	 1-013334	 761'	 3-000244	 1000	 1-016474

 9005	 1-013360	 9006'	 3-000300	 9020	 1-013476	 9021'	 3-000374	 9030	 1-013642

 9031'	 3-000524	 9035	 1-013742	 9040	 1-014042	 9041'	 3-000560	 9045	 1-014142

 9046'	 3-000674	 9050	 1-014242	 9051'	 3-001042	 9060	 1-014422	 9061'	 3-001132

 9070	 1-014532	 9071'	 3-001232	 9080	 1-014642	 9081'	 3-001306	 9090	 1-014760

 9091'	 3-001412	 9100	 1-015076	 9101'	 3-001546	 9120	 1-015130	 9121'	 3-001714

 9130	 1-015242	 9140	 1-015354	 9150	 1-015422	 9151'	 3-002006	 9160	 1-015512

 9161'	 3-002070	 9500	 1-015544	 9510	 1-015600	 9520	 1-015640	 9530	 1-015662

 9540	 1-015704	 9550	 1-015726	 9570	 1-015750	 9590	 1-015772	 9610	 1-016014

 9630	 1-016034	 9650	 1-016056	 9670	 1-016076	 9700	 1-016116	 9730	 1-016136

 9760	 1-016156	 9770	 1-016176	 9800	 1-016216	 9996	 1-016252	 9997	 1-016266

 9998	 1-016404	 9999	 1-016436	 10000	 1-016506





FORTRAN IV-PLUS V02-51D		02:16:28    22-AUG-78		PAGE 34  

PAX.FTN      	/TR:BLOCKS/WR


FUNCTIONS AND SUBROUTINES REFERENCED



 ASNLUN	 BLDSWT	 CLSFIL	 DATE	 ERRORS	 EXIT	 GETCML	 GETREC	 GETTSK	 GETVER	 MRKREC	 OPNFIL	 PNTREC	 PUTREC	 SCANI	 SCANO

 SYNTX	 TIME





TOTAL SPACE ALLOCATED = 115664 19930



NO FPP INSTRUCTIONS GENERATED

FORTRAN IV-PLUS V02-51D		02:20:59    22-AUG-78		PAGE 35  

PAX.FTN      	/TR:BLOCKS/WR


        C***************************************************************************

        C***************************************************************************



OBJ$:PAX,LIS$:PAX/-SP=SRC$:PAX.FTN

