	SUBROUTINE HDR
C
C	FOR FURTHER INFORMATION CONTACT:
C
C	ROBERT WATSON
C	CISCO, INC.
C	4135 S. 100 E. AVE.
C	TULSA OK 74145
C
	INTEGER*4	IWRK,		PC
	INTEGER*2	BLK(256),	SEGTAB(3,50),	IDEV
	INTEGER*2	Q
	BYTE		BWRK(6),	Z,		UIC(2)
	BYTE		ACC(4),		HEAD,		GOT
	BYTE		SNAM(25),	FILE(24),	FID1(6)
	BYTE		FID2(6),	FID3(6),	FID4(6)
	EQUIVALENCE	(IWD,UIC),		(FILE,IDEV)
	COMMON	/TSKCOM/  BLK, IREC, ISUB, PC, SEGTAB, IZRWRD, SNAM
	HEAD = .TRUE.
	IREC = 1
1	WRITE  (5, 3)
3	FORMAT (/,' RETURN FOR OUTPUT TO TI OR ENTER ANY CHARACTER',
	1	  ' FOR OUTPUT TO PRINTER ',$)
	READ   (5, 5, ERR=1, END=999) Q, Z
5	FORMAT (Q,A1)
	LUN = 5
	IF (Q .NE. 0) LUN = 6
	IF (LUN .EQ. 5) WRITE (5, 7)
7	FORMAT ('  ')
	IF (LUN .EQ. 6) WRITE (6, 10) SNAM
10	FORMAT ('1TASK HEADER INFORMATION FROM FILE ',25A1,//)
	CALL FILL
	DO 11 I = 1, 24
	FILE(I) = ' '
11	CONTINUE
	IDEV = BLK(255) !ASCII DEVICE TYPE
	FILE(3) = BLK(256) !BINARY DEVICE UNIT NO.
	FILE(3) = (FILE(3) .OR. "60) !MAKE IT ASCII
	FILE(4) = ':'
	CALL R50ASC (9, BLK(247), FILE(5)) !FILENAME
	FILE(14) = '.'
	CALL R50ASC (3, BLK(250), FILE(15)) !TYPE
	FILE(18) = ';'
	Z = .FALSE.
	CALL OCTL (BLK(251), FILE(19), Z) !VERSION
	CALL OCTL (BLK(244), FID1, Z) !FILE ID'S OF FILE AND DIRECTORY
	CALL OCTL (BLK(245), FID2, Z)
	CALL OCTL (BLK(252), FID3, Z)
	CALL OCTL (BLK(253), FID4, Z)
	DO 12, I = 1, 24
	IF (FILE(I) .EQ. ' ') FILE(I) = 0 !COMPRESS UNUSED BYTES
12	CONTINUE
	DO 13, I = 1, 6
	IF (FID1(I) .EQ. ' ') FID1(I) = 0
	IF (FID2(I) .EQ. ' ') FID2(I) = 0
	IF (FID3(I) .EQ. ' ') FID3(I) = 0
	IF (FID4(I) .EQ. ' ') FID4(I) = 0
13	CONTINUE
	WRITE  (LUN, 14) FILE, FID1, FID2, FID3, FID4
14	FORMAT (' TASK IMAGE FILE SPECIFICATION: ',24A1,'  (',6A1,
	1	',',6A1,')',/,
	2	' FILE ID OF OWNING DIRECTORY: (',6A1,',',6A1,')')
	CALL R50ASC (3, BLK(1), BWRK)
	CALL R50ASC (3, BLK(2), BWRK(4))
	WRITE  (LUN, 15) BWRK
15	FORMAT (' TASK NAME: ',6A1)
	CALL R50ASC (3, BLK(3), BWRK)
	CALL R50ASC (3, BLK(4), BWRK(4))
	WRITE  (LUN, 20) BWRK
20	FORMAT (' DEFAULT PARTITION: ',6A1)
	Z = 'N'
	IF ((BLK(5).AND."100) .NE. 0) Z = 'Y'
	WRITE  (LUN, 30) Z
30	FORMAT (' MULTI-USER',10X,A1)
	Z = 'N'
	IF ((BLK(5).AND."200) .NE. 0) Z = 'Y'
	WRITE  (LUN, 40) Z
40	FORMAT (' PRIVILEGED',10X,A1)
	Z = 'Y'
	IF ((BLK(5).AND."2000) .NE. 0) Z = 'N'
	WRITE  (LUN, 50) Z
50	FORMAT (' CAN RECEIVE DATA',4X,A1)
	Z = 'Y'
	IF ((BLK(5).AND."4000) .NE. 0) Z = 'N'
	WRITE  (LUN, 60) Z
60	FORMAT (' ABORTABLE',11X,A1)
	Z = 'Y'
	IF ((BLK(5).AND."10000) .NE. 0) Z = 'N'
	WRITE  (LUN, 70) Z
70	FORMAT (' DISABLEABLE',9X,A1)
	Z = 'Y'
	IF ((BLK(5).AND."20000) .NE. 0) Z = 'N'
	WRITE  (LUN, 80) Z
80	FORMAT (' FIXABLE',13X,A1)
	Z = 'Y'
	IF ((BLK(5).AND."40000) .NE. 0) Z = 'N'
	WRITE  (LUN, 90) Z
90	FORMAT (' CHECKPOINTABLE',6X,A1)
	WRITE  (LUN, 100) BLK(6)
100	FORMAT (' DEFAULT PRIORITY: ',I3,'.')
	IWRK = BLK(7)
	IWRK = IWRK * 32
	WRITE  (LUN, 110) IWRK
110	FORMAT (' LOAD SIZE: ',I5,'. BYTES')
	IWRK = BLK(8)
	IWRK = IWRK * 32
	WRITE  (LUN, 120) IWRK
120	FORMAT (' INITIAL SPACE ALLOCATION: ',I5,'. BYTES')
	WRITE  (LUN, 130) BLK(9)
130	FORMAT (' NODE POOL LIMIT: ',I3,'.')
	Z = 'N'
	IF ((BLK(10).AND."1) .NE. 0) Z = 'Y'
	WRITE  (LUN, 140) Z
140	FORMAT (' POSITION INDEPENDENT',2X,A1)
	Z = 'Y'
	IF ((BLK(10).AND."2) .NE. 0) Z = 'N'
	WRITE  (LUN, 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  (LUN, 160) Z
160	FORMAT (' HAS FP SAVE AREA',6X,A1)
	WRITE  (LUN, 170) BLK(12), BLK(13), BLK(11)
170	FORMAT (' CREATION DATE: ',I2,2('/',I2))
	WRITE  (LUN, 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  (LUN, 176) BWRK
176	FORMAT (7X,' NAME: ',6A1)
	IWRK = BLK(ISUB+2)
	IWRK = IWRK * 64
	WRITE  (LUN, 177) IWRK
177	FORMAT (5X,' SIZE: ',I5,'. BYTES')
	WRITE  (LUN, 178) BLK(ISUB+4), BLK(ISUB+5), BLK(ISUB+3)
178	FORMAT (5X,' CREATION DATE: ',I2,2('/',I2))
	WRITE  (LUN, 179) BLK(ISUB+6)
179	FORMAT (5X,' APR NUMBER: ',I1)
	IWD = 'RO'
	IF ((BLK(ISUB+7).AND."100000) .NE. 0) IWD = 'RW'
	WRITE  (LUN, 180) IWD
180	FORMAT (5X,' ACCESS: ',A2)
	Z = 'N'
	IF ((BLK(ISUB+7).AND."4) .NE. 0) Z = 'Y'
	WRITE  (LUN, 181) Z
181	FORMAT (5X,' POSITION IDEPENDENT  ',A1)
	IWRK = 'COM'
	IF ((BLK(ISUB+7).AND."2) .NE. 0) IWRK = 'LIB'
	WRITE  (LUN, 182) IWRK
182	FORMAT (5X,' BLOCK TYPE: ',A4)
200	CONTINUE
210	IF (.NOT. GOT) WRITE (LUN, 215)
215	FORMAT (5X,' NONE')
220	WRITE  (LUN, 221) BLK(71)
221	FORMAT (' STARTING APR NO.: ',I1,' (APPLIES ONLY TO LIBRARIES)')
	WRITE  (LUN, 230) BLK(72)
230	FORMAT (' DEFAULT TASK EXTENSION: ',I5,'.')
	IF (BLK(73) .EQ. 0) GO TO 250
	IWD = BLK(73)
	WRITE  (LUN, 240) UIC(2), UIC(1)
240	FORMAT (' DEFAULT UIC: [',O3,',',O3,']')
	GO TO 270
250	WRITE  (LUN, 260)
260	FORMAT (' DEFAULT UIC: NONE')
270	WRITE  (LUN, 280) BLK(74)
280	FORMAT (' READ-ONLY AREA SIZE: ',I5,'. BYTES')
	Z = .TRUE.
	CALL OCTL (BLK(76), BWRK, Z)
	WRITE  (LUN, 290) BWRK
290	FORMAT (' STARTING ADDR OF RO AREA: ',6A1)
	IWRK = BLK(77)
	IWRK = IWRK * 32
	WRITE  (LUN, 300) IWRK
300	FORMAT (' TOTAL RO REGION SIZE: ',I5,'. BYTES')
	IWRK = BLK(78)
	IWRK = IWRK * 32
	WRITE  (LUN, 310) IWRK
310	FORMAT (' HEADER SIZE: ',I5,'. WORDS')
	WRITE  (LUN, 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
	WRITE  (LUN, 330)
330	FORMAT (' LUN ASSIGNMENTS:')
	ILUN = 0
	DO 350 ISUB = 1, 63, 2
	ILUN = ILUN + 1
	IF (BLK(ISUB) .EQ. 0) GO TO 350
	WRITE  (LUN, 340) ILUN, BLK(ISUB), BLK(ISUB+1)
340	FORMAT (5X,' LUN ',I2,'   ',A2,O2)
350	CONTINUE
360	IREC = ISAV
	CALL FILL
	Z = .TRUE.
	CALL OCTL (BLK(1), BWRK, Z)
	WRITE  (LUN, 370) BWRK
370	FORMAT (' ADDRESS OF FP SAVE AREA: ',6A1)
	CALL OCTL (BLK(52), BWRK, Z)
	WRITE  (LUN, 380) BWRK
380	FORMAT (' INITIAL PSW: ',6A1,/,' INITIAL REGISTERS:')
	CALL OCTL (BLK(45), BWRK, Z)
	WRITE  (LUN, 390) BWRK
390	FORMAT (5X,' R0  ',6A1)
	CALL OCTL (BLK(46), BWRK, Z)
	WRITE  (LUN, 400) BWRK
400	FORMAT (5X,' R1  ',6A1)
	CALL OCTL (BLK(47), BWRK, Z)
	WRITE  (LUN, 410) BWRK
410	FORMAT (5X,' R2  ',6A1)
	CALL OCTL (BLK(48), BWRK, Z)
	WRITE  (LUN, 420) BWRK
420	FORMAT (5X,' R3  ',6A1)
	CALL OCTL (BLK(49), BWRK, Z)
	WRITE  (LUN, 430) BWRK
430	FORMAT (5X,' R4  ',6A1)
	CALL OCTL (BLK(50), BWRK, Z)
	WRITE  (LUN, 440) BWRK
440	FORMAT (5X,' R5  ',6A1)
	CALL OCTL (BLK(54), BWRK, Z)
	WRITE  (LUN, 450) BWRK
450	FORMAT (5X,' SP  ',6A1)
	CALL OCTL (BLK(53), BWRK, Z)
	WRITE  (LUN, 460) BWRK
460	FORMAT (5X,' PC  ',6A1)
	WRITE  (LUN, 470) BLK(67)
470	FORMAT (' NUMBER OF ATTACHMENT DESCRIPTORS: ',I2,'.')
	Z = 'N'
	IF ((BLK(68).AND."1) .NE. 0) Z = 'Y'
	WRITE  (LUN, 480) Z
480	FORMAT (' REQUIRES RECEIVE QUEUES TO BE FLUSHED  ',A1)
	Z = 'Y'
	IF ((BLK(68).AND."2) .NE. 0) Z = 'N'
	WRITE  (LUN, 490) Z
490	FORMAT (' WAIT FOR NODES',25X,A1)
	Z = 'N'
	IF ((BLK(72).AND."1) .NE. 0) Z = 'Y'
	WRITE  (LUN, 500) Z
500	FORMAT (' MCR TO BE RECALLED ON EXIT',13X,A1)
	Z = 'N'
	IF ((BLK(72).AND."2) .NE. 0) Z = 'Y'
	WRITE  (LUN, 510) Z
510	FORMAT (' LUNS ONLY PARTIALLY ASSIGNED',11X,A1)
	Z = 'Y'
	IF ((BLK(75).AND."1) .NE. 0) Z = 'N'
	WRITE  (LUN, 520) Z
520	FORMAT (' CAN ISSUE REAL-TIME DIRECTIVES',9X,A1)
	Z = 'Y'
	IF ((BLK(75).AND."2) .NE. 0) Z = 'N'
	WRITE  (LUN, 530) Z
530	FORMAT (' CAN ISSUE REGION RELATED DIRECTIVES',4X,A1)
	ISUB = ((BLK(66) - "60000) / 2) + 1
	WRITE  (LUN, 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  (LUN, 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  (LUN, 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  (LUN, 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 (LUN, 570)
570	FORMAT (5X,' NONE')
580	RETURN
999	CLOSE (UNIT=1)
	STOP
	END
