'HEAD' LINKER, PASS 1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4 'OUTFILE' LPASS1GAK.FR SUBROUTINE PASS1 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, 'INCLUDE' IOFILEGAK.IN, LOGICAL ERX, EOF, KEYWD INTEGER I, DUMMY C PASS1 :: X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER PASS1') 'DO' CALL GETFL (ERX, EOF) IF (ERX) GO TO 9998 IF (EOF) GO TO 9999 'IF' (KEYWD(DUMMY)) CALL SETKEY 'NEXT' 'ENDIF' P CALL DEVICE (RBFILE) CALL OPENF (RBCHAN, RBFILE, ECODE) 'IF' (ECODE.NE.1) CALL ERROR(3) 'NEXT' 'ENDIF' X WRITE (DBCHAN, 2) (RBFILE(I),I=1,7) X2 FORMAT (' IN PASS1 AFTER OPEN ', 7A2) 'DO' CALL GRCORD (ERX, EOF) IF (ERX) GO TO 9996 IF (EOF) GO TO 9997 IF (RTYPE .NE. 3) CALL CHCKER X WRITE (DBCHAN, 3) RTYPE, RSTYPE X3 FORMAT (' IN PASS1; RTYPE= ', I6, ' RSTYPE= ', I6) GOTO (100,200,300,400,500,600,700,800,900,^ 1000,1100,1200,1300,1400,1500,1600,1700,^ 1800,1900,2000) RTYPE 100 CALL T01P1 'NEXT' 200 CALL T02P1 'NEXT' 300 CALL T03P1 'NEXT' 400 CALL T04P1 'NEXT' 500 CALL T05P1 'NEXT' 600 CALL T06P1 'NEXT' 700 CALL T07P1 'NEXT' 800 CALL T08P1 'NEXT' 900 CALL T09P1 'NEXT' 1000 CALL T10P1 'NEXT' 1100 CALL T11P1 'NEXT' 1200 CALL T12P1 'NEXT' 1300 CALL T13P1 'NEXT' 1400 CALL T14P1 'NEXT' 1500 CALL T15P1 'NEXT' 1600 CALL T16P1 'NEXT' 1700 CALL T17P1 'NEXT' 1800 CALL T18P1 'NEXT' 1900 CALL T19P1 'NEXT' 2000 CALL T20P1 'END' 9996 CONTINUE CALL ERROR (7) 9997 CONTINUE CALL CLOSF (RBCHAN, ECODE) IF (ECODE.NE.1) CALL ERROR (3) 'END' 9998 CONTINUE 9999 CONTINUE X WRITE (DBCHAN, 4) X4 FORMAT (' EXIT PASS1') RETURN END 'OUTFILE' T01P1GAK.FR SUBROUTINE T01P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.01 C PASS 1 RECORD TYPE 01 'MODULE START' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' DARRAYGAK.IN, 'INCLUDE' LDATAXGAK.IN, 'INCLUDE' IODEFNGAK.IN, INTEGER I INTEGER TITLE DATA TITLE /'$$'/ C T01P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T01P1') NTITLE = NTITLE + 1 CALL GNAME (2) NAME (1) = TITLE CALL EHX (NTITLE, NAME, 3, 6) NSIZE = 3 ID = 0 CALL PUSHMD CALL ENTER 'IF' (IAND(NFLAGS(NLX), RLSBIT).EQ.0) NFLAGS(NLX) = IOR (NFLAGS(NLX),MODBIT+RLSBIT) 'ELSE' NFLAGS(NLX) = IOR (NFLAGS(NLX),MLTBIT) 'ENDIF' X WRITE (DBCHAN, 2) NLX, (NAME(I), I=1,NSIZE) X2 FORMAT (' ', I5, ' ', 16A2) MODNLX = NLX CALL SET (0, DICT, DTSTOP) CKSUM = 0 'IF' (LBMODE) LOADRB = .FALSE. 'ELSE' LOADRB = .TRUE. NFLAGS(NLX) = IOR (NFLAGS(NLX),LDMBIT) 'ENDIF' X WRITE (DBCHAN, 3) X3 FORMAT (' EXIT T01P1') RETURN END 'OUTFILE' T02P1GAK.FR SUBROUTINE T02P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.02 C PASS 1 RECORD TYPE 2 'MODULE END' PROCESS 'INCLUDE' IODEFNGAK.IN, 'INCLUDE' LDATAXGAK.IN, C T02P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T02P1') CALL POPMD 'IF' (LBMODE .AND. .NOT. LOADRB) CALL DNAMES 'ELSE' CALL LNAMES 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T02P1') RETURN END 'OUTFILE' T03P1GAK.FR SUBROUTINE T03P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.03 C PASS 1 RECORD TYPE 3 'CHECKSUM' PROCESS 'INCLUDE' LDATAXGAK.IN, 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T03P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T03P1') IF (RECORD(2).NE.CKSUM) CALL ERROR(9) CKSUM = 0 X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T03P1') RETURN END 'OUTFILE' T04P1GAK.FR SUBROUTINE T04P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.04 C PASS 1 RECORD TYPE 4 'MODULE ID' PROCESS 'INCLUDE' IODEFNGAK.IN, C T04P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T04P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T04P1') RETURN END 'OUTFILE' T05P1GAK.FR SUBROUTINE T05P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.05 C PASS 1 RECORD TYPE 5 'GROUP DEFINITION' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' DARRAYGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T05P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' INTER T05P1') CALL GNAME(4) 'IF'(NSIZE.GT.0) CALL EHX (NTITLE, NAME(NSIZE+1), 1,4) CALL EHX (ID, NAME(NSIZE+3), 1,4) NSIZE = NSIZE + 4 CALL ENTER CALL AREADF NFLAGS (NLX) = IOR (NFLAGS(NLX), GDFBIT) 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T05P1') RETURN END 'OUTFILE' T06P1GAK.FR SUBROUTINE T06P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.06 C PASS 1 RECORD TYPE 6 'COMMON DEFINITION' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T06P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T06P1') CALL GNAME(4) 'IF' (NSIZE.GT.0) CALL ENTER 'IF' (IAND(NFLAGS(NLX),RLSBIT).EQ.0) CALL AREADF NFLAGS(NLX) = IOR(NFLAGS(NLX),COMBIT) 'ELSE' IF (NDATA(NLX).NE.RECORD(3)) CALL ERROR(16) 'ENDIF' 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T06P1') RETURN END 'OUTFILE' T07P1GAK.FR SUBROUTINE T07P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.07 C PASS 1 RECORD TYPE 7 'ENTRY POINT DEFINITION' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T07P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T07P1') CALL GNAME(5) 'IF' (NSIZE.GT.0) CALL ENTER CALL ENPTDF NFLAGS (NLX) = IOR (NFLAGS(NLX), EPTBIT) 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T07P1') RETURN END 'OUTFILE' T08P1GAK.FR SUBROUTINE T08P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.08 C PASS 1 RECORD TYPE 8 'OVERLAY ID' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T08P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T08P1') CALL GNAME(5) 'IF' (NSIZE.GT.0) CALL ENTER CALL ENPTDF NFLAGS (NLX) = IOR (NFLAGS(NLX), OVLBIT) 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T08P1') RETURN END 'OUTFILE' T09P1GAK.FR SUBROUTINE T09P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.09 C PASS 1 RECORD TYPE 9 'EXTERNAL NAME' PROCESS 'INCLUDE' NTABLEGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T09P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T09P1') CALL GNAME(3) 'IF' (NSIZE.NE.0) CALL ENTER 'ENDIF' X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T09P1') RETURN END 'OUTFILE' T10P1GAK.FR SUBROUTINE T10P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.10 C PASS 1 RECORD TYPE 10 'ABSOLUTE DATA' PROCESS 'INCLUDE' IODEFNGAK.IN, C T10P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T10P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T10P1') RETURN END 'OUTFILE' T11P1GAK.FR SUBROUTINE T11P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.11 C PASS 1 RECORD TYPE 11 'RELOCATABLE DATA (1 OR 2 BYTES)' PROCESS 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, INTEGER ISWX, NBYTES C T11P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T11P1') ISWX = RSTYPE + 1 X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T11P1') RETURN END 'OUTFILE' T12P1GAK.FR SUBROUTINE T12P1 C EDIT DATE 01FEB79 17:26 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.12 C PASS 1 RECORD TYPE 12 'RELOCATABLE DATA (2 OR 3 BYTES)' PROCESS 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, INTEGER ISWX, NBYTES C T12P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T12P1') ISWX = RSTYPE + 1 X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T12P1') RETURN END 'OUTFILE' T13P1GAK.FR SUBROUTINE T13P1 C EDIT DATE 01FEB79 17:27 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.13 C PASS 1 RECORD TYPE 13 'COMPUTATION' PROCESS 'INCLUDE' RECORDGAK.IN, 'INCLUDE' IODEFNGAK.IN, INTEGER ISWX, NBYTES C T13P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T13P1') ISWX = RSTYPE + 1 X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T13P1') RETURN END 'OUTFILE' T14P1GAK.FR SUBROUTINE T14P1 C EDIT DATE 01FEB79 17:27 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.14 C PASS 1 RECORD TYPE 14 'SET LOCATION' PROCESS RETURN END 'OUTFILE' T15P1GAK.FR SUBROUTINE T15P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.15 C PASS 1 RECORD TYPE 15 'ADJUST LOCATION' PROCESS 'INCLUDE' IODEFNGAK.IN, C T15P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T15P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T15P1) RETURN END 'OUTFILE' T16P1GAK.FR SUBROUTINE T16P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.16 C PASS 1 RECORD TYPE 16 'CHANGE GROUP' PROCESS 'INCLUDE' IODEFNGAK.IN, C T16P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T16P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T16P1') RETURN END 'OUTFILE' T17P1GAK.FR SUBROUTINE T17P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.17 C PASS 1 RECORD TYPE 17 'ESTABLISH RUN ADDRESS' PROCESS 'INCLUDE' IODEFNGAK.IN, C T17P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T17P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T17P1') RETURN END 'OUTFILE' T18P1GAK.FR SUBROUTINE T18P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.18 C PASS 1 RECORD TYPE 18 'LOCAL NAME DEFINITION' PROCESS 'INCLUDE' IODEFNGAK.IN, C T18P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T18P1') X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T18P1') RETURN END 'OUTFILE' T19P1GAK.FR SUBROUTINE T19P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.19 C PASS 1 RECORD TYPE 19 'LIBRARY START' PROCESS 'INCLUDE' LDATAXGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T19P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T19P1') LBMODE = .TRUE. X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T19P1') RETURN END 'OUTFILE' T20P1GAK.FR SUBROUTINE T20P1 C EDIT DATE 01FEB79 17:28 C SOURCE FILE LPASS1GAK.FS C AUTHOR GARY A. KUDIS C CLUSTER 4.20 C PASS 1 RECORD TYPE 20 'LIBRARY END' PROCESS 'INCLUDE' LDATAXGAK.IN, 'INCLUDE' IODEFNGAK.IN, C T20P1 : X WRITE (DBCHAN, 1) X1 FORMAT (' ENTER T20P1') LBMODE = .FALSE. X WRITE (DBCHAN, 2) X2 FORMAT (' EXIT T20P1') RETURN END