SUBROUTINE HDR (BLK, FNAM) C C ROBERT WATSON C CISCO, INC. C (918)665-2110 C 4135 S. 100TH E. AVE. C TULSA OK 74145 C C THIS PROGRAM HAS BEEN DONATED TO THE PUBLIC DOMAIN C AND IS NOT TO BE COPYRIGHTED. C INTEGER*4 IWRK, PC INTEGER*2 BLK(256) BYTE BWRK(6), Z, UIC(2) BYTE ACC(4), HEAD, GOT BYTE FNAM(25) EQUIVALENCE (IWD,UIC) HEAD = .TRUE. IREC = 1 PC = 0 1 WRITE (5, 3) 3 FORMAT (/,' HEADER INFORMATION TO TI OR PRINTER (T OR P)? ',$) READ (5, 5, END=580) Z 5 FORMAT (A1) IF (Z.NE.'T' .AND. Z.NE.'P') GO TO 1 IF (Z .EQ. 'P') GO TO 7 CALL ASNLUN (4, 'TI', 0, I) IF (I .NE. 1) STOP 'ASNLUN ERROR' GO TO 8 7 CALL ASNLUN (4, 'LP', 0, I) IF (I .NE. 1) STOP 'ASNLUN ERROR' 8 CALL FILL (BLK, IREC, ISUB, PC) CALL R50ASC (3, BLK(1), BWRK) CALL R50ASC (3, BLK(2), BWRK(4)) WRITE (4, 10) FNAM, BWRK 10 FORMAT (/,5X,' TASK HEADER INFORMATION FOR ',25A1,/, 1 ' TASK NAME: ',6A1) CALL R50ASC (3, BLK(3), BWRK) CALL R50ASC (3, BLK(4), BWRK(4)) WRITE (4, 20) BWRK 20 FORMAT (' DEFAULT PARTITION: ',6A1) Z = 'N' IF ((BLK(5).AND."100) .NE. 0) Z = 'Y' WRITE (4, 30) Z 30 FORMAT (' MULTI-USER',10X,A1) Z = 'N' IF ((BLK(5).AND."200) .NE. 0) Z = 'Y' WRITE (4, 40) Z 40 FORMAT (' PRIVILEGED',10X,A1) Z = 'Y' IF ((BLK(5).AND."2000) .NE. 0) Z = 'N' WRITE (4, 50) Z 50 FORMAT (' CAN RECEIVE DATA',4X,A1) Z = 'Y' IF ((BLK(5).AND."4000) .NE. 0) Z = 'N' WRITE (4, 60) Z 60 FORMAT (' ABORTABLE',11X,A1) Z = 'Y' IF ((BLK(5).AND."10000) .NE. 0) Z = 'N' WRITE (4, 70) Z 70 FORMAT (' DISABLEABLE',9X,A1) Z = 'Y' IF ((BLK(5).AND."20000) .NE. 0) Z = 'N' WRITE (4, 80) Z 80 FORMAT (' FIXABLE',13X,A1) Z = 'Y' IF ((BLK(5).AND."40000) .NE. 0) Z = 'N' WRITE (4, 90) Z 90 FORMAT (' CHECKPOINTABLE',6X,A1) WRITE (4, 100) BLK(6) 100 FORMAT (' DEFAULT PRIORITY: ',I3,'.') IWRK = BLK(7) IWRK = IWRK * 32 WRITE (4, 110) IWRK 110 FORMAT (' LOAD SIZE: ',I5,'. BYTES') IWRK = BLK(8) IWRK = IWRK * 32 WRITE (4, 120) IWRK 120 FORMAT (' INITIAL SPACE ALLOCATION: ',I5,'. BYTES') WRITE (4, 130) BLK(9) 130 FORMAT (' NODE POOL LIMIT: ',I3,'.') Z = 'N' IF ((BLK(10).AND."1) .NE. 0) Z = 'Y' WRITE (4, 140) Z 140 FORMAT (' POSITION INDEPENDENT',2X,A1) Z = 'Y' IF ((BLK(10).AND."2) .NE. 0) Z = 'N' WRITE (4, 150) Z 150 FORMAT (' HAS HEADER',12X,A1) IF (Z .EQ. 'N') HEAD = .FALSE. Z = 'N' IF ((BLK(10).AND."4) .NE. 0) Z = 'Y' WRITE (4, 160) Z 160 FORMAT (' HAS FP SAVE AREA',6X,A1) WRITE (4, 170) BLK(12), BLK(13), BLK(11) 170 FORMAT (' CREATION DATE: ',I2,2('/',I2)) WRITE (4, 175) 175 FORMAT (' RESIDENT LIBRARY REQUESTS') GOT = .FALSE. DO 200 ISUB = 14, 62, 8 IF (BLK(ISUB).EQ.0 .AND. BLK(ISUB+2).EQ.0) GO TO 200 GOT = .TRUE. CALL R50ASC (3, BLK(ISUB), BWRK) CALL R50ASC (3, BLK(ISUB+1), BWRK(4)) WRITE (4, 176) BWRK 176 FORMAT (7X,' NAME: ',6A1) IWRK = BLK(ISUB+2) IWRK = IWRK * 64 WRITE (4, 177) IWRK 177 FORMAT (5X,' SIZE: ',I5,'. BYTES') WRITE (4, 178) BLK(ISUB+4), BLK(ISUB+5), BLK(ISUB+3) 178 FORMAT (5X,' CREATION DATE: ',I2,2('/',I2)) WRITE (4, 179) BLK(ISUB+6) 179 FORMAT (5X,' APR NUMBER: ',I1) IWD = 'RO' IF ((BLK(ISUB+7).AND."100000) .NE. 0) IWD = 'RW' WRITE (4, 180) IWD 180 FORMAT (5X,' ACCESS: ',A2) Z = 'N' IF ((BLK(ISUB+7).AND."4) .NE. 0) Z = 'Y' WRITE (4, 181) Z 181 FORMAT (5X,' POSITION IDEPENDENT ',A1) IWRK = 'COM' IF ((BLK(ISUB+7).AND."2) .NE. 0) IWRK = 'LIB' WRITE (4, 182) IWRK 182 FORMAT (5X,' BLOCK TYPE: ',A4) 200 CONTINUE 210 IF (.NOT. GOT) WRITE (4, 215) 215 FORMAT (5X,' NONE') 220 WRITE (4, 221) BLK(71) 221 FORMAT (' STARTING APR NO.: ',I1,' (APPLIES ONLY TO LIBRARIES)') WRITE (4, 230) BLK(72) 230 FORMAT (' DEFAULT TASK EXTENSION: ',I5,'.') IF (BLK(73) .EQ. 0) GO TO 250 IWD = BLK(73) WRITE (4, 240) UIC(2), UIC(1) 240 FORMAT (' DEFAULT UIC: [',O3,',',O3,']') GO TO 270 250 WRITE (4, 260) 260 FORMAT (' DEFAULT UIC: NONE') 270 WRITE (4, 280) BLK(74) 280 FORMAT (' READ-ONLY AREA SIZE: ',I5,'. BYTES') Z = .TRUE. CALL OCTL (BLK(76), BWRK, Z) WRITE (4, 290) BWRK 290 FORMAT (' STARTING ADDR OF RO AREA: ',6A1) IWRK = BLK(77) IWRK = IWRK * 32 WRITE (4, 300) IWRK 300 FORMAT (' TOTAL RO REGION SIZE: ',I5,'. BYTES') IWRK = BLK(78) IWRK = IWRK * 32 WRITE (4, 310) IWRK 310 FORMAT (' HEADER SIZE: ',I5,'. BYTES') WRITE (4, 320) BLK(79) 320 FORMAT (' APR USAGE BITMAP: ',O3,' (BITS 0-7 = APR''S 0-7)') IF (.NOT. HEAD) GO TO 580 ISAV = BLK(70) IREC = 2 CALL FILL (BLK, IREC, ISUB, PC) WRITE (4, 330) 330 FORMAT (' LUN ASSIGNMENTS:') LUN = 0 DO 350 ISUB = 1, 63, 2 LUN = LUN + 1 IF (BLK(ISUB) .EQ. 0) GO TO 350 WRITE (4, 340) LUN, BLK(ISUB), BLK(ISUB+1) 340 FORMAT (5X,' LUN ',I2,' ',A2,O2) 350 CONTINUE 360 IREC = ISAV CALL FILL (BLK, IREC, ISUB, PC) Z = .TRUE. CALL OCTL (BLK(1), BWRK, Z) WRITE (4, 370) BWRK 370 FORMAT (' ADDRESS OF FP SAVE AREA: ',6A1) CALL OCTL (BLK(52), BWRK, Z) WRITE (4, 380) BWRK 380 FORMAT (' INITIAL PSW: ',6A1,/,' INITIAL REGISTERS:') CALL OCTL (BLK(45), BWRK, Z) WRITE (4, 390) BWRK 390 FORMAT (5X,' R0 ',6A1) CALL OCTL (BLK(46), BWRK, Z) WRITE (4, 400) BWRK 400 FORMAT (5X,' R1 ',6A1) CALL OCTL (BLK(47), BWRK, Z) WRITE (4, 410) BWRK 410 FORMAT (5X,' R2 ',6A1) CALL OCTL (BLK(48), BWRK, Z) WRITE (4, 420) BWRK 420 FORMAT (5X,' R3 ',6A1) CALL OCTL (BLK(49), BWRK, Z) WRITE (4, 430) BWRK 430 FORMAT (5X,' R4 ',6A1) CALL OCTL (BLK(50), BWRK, Z) WRITE (4, 440) BWRK 440 FORMAT (5X,' R5 ',6A1) CALL OCTL (BLK(54), BWRK, Z) WRITE (4, 450) BWRK 450 FORMAT (5X,' SP ',6A1) CALL OCTL (BLK(53), BWRK, Z) WRITE (4, 460) BWRK 460 FORMAT (5X,' PC ',6A1) WRITE (4, 470) BLK(67) 470 FORMAT (' NUMBER OF ATTACHMENT DESCRIPTORS: ',I2,'.') Z = 'N' IF ((BLK(68).AND."1) .NE. 0) Z = 'Y' WRITE (4, 480) Z 480 FORMAT (' REQUIRES RECEIVE QUEUES TO BE FLUSHED ',A1) Z = 'Y' IF ((BLK(68).AND."2) .NE. 0) Z = 'N' WRITE (4, 490) Z 490 FORMAT (' WAIT FOR NODES',25X,A1) Z = 'N' IF ((BLK(72).AND."1) .NE. 0) Z = 'Y' WRITE (4, 500) Z 500 FORMAT (' MCR TO BE RECALLED ON EXIT',13X,A1) Z = 'N' IF ((BLK(72).AND."2) .NE. 0) Z = 'Y' WRITE (4, 510) Z 510 FORMAT (' LUNS ONLY PARTIALLY ASSIGNED',11X,A1) Z = 'Y' IF ((BLK(75).AND."1) .NE. 0) Z = 'N' WRITE (4, 520) Z 520 FORMAT (' CAN ISSUE REAL-TIME DIRECTIVES',9X,A1) Z = 'Y' IF ((BLK(75).AND."2) .NE. 0) Z = 'N' WRITE (4, 530) Z 530 FORMAT (' CAN ISSUE REGION RELATED DIRECTIVES',4X,A1) ISUB = ((BLK(66) - "60000) / 2) + 1 WRITE (4, 535) 535 FORMAT (' ATTACHMENT DESCRIPTORS') Z = .TRUE. DO 550 I = ISUB, ISUB+30, 2 IF (BLK(I).EQ.0 .AND. BLK(I+1).EQ.0) GO TO 560 CALL OCTL (BLK(I), BWRK, Z) WRITE (4, 536) BWRK 536 FORMAT (7X,' ADDRESS OF CORRESPONDING GCD NODE: ',6A1) DO 538 J = 1, 4 ACC(J) = ' ' 538 CONTINUE IF ((BLK(I+1).AND."1) .NE. 0) ACC(1) = 'R' IF ((BLK(I+1).AND."2) .NE. 0) ACC(2) = 'W' IF ((BLK(I+1).AND."4) .NE. 0) ACC(3) = 'E' IF ((BLK(I+1).AND."10).NE. 0) ACC(4) = 'D' WRITE (4, 540) ACC 540 FORMAT (5X,' ACCESS: ',4A1) ACC(1) = 'Y' IF ((BLK(I+1).AND."20) .NE. 0) ACC(1) = 'N' ACC(2) = 'N' IF ((BLK(I+1).AND."40) .NE. 0) ACC(2) = 'Y' WRITE (4, 542) ACC(1), ACC(2) 542 FORMAT (5X,' TASK ALLOWED TO DETACH',7X,A1,/, 1 5X,' ATTACH DONE AT INSTALL TIME ',A1) 550 CONTINUE GO TO 580 560 IF (I .EQ. ISUB) WRITE (4, 570) 570 FORMAT (5X,' NONE') 580 CLOSE (UNIT=4) RETURN END