PROGRAM HEADER
C
C	Locate header files on ODS-1 structured disk
C
C	Adapted from W P Helman, "The Multi-Tasker", V11 No2 August 1979
C
C	1. Could edit for owner's UIC before compiling and task-building
C		(marked <?>). This is currently disabled, so ALL files
C		are selected.
C
C	2. For RSX11M the disk must not be logically mounted.
C	   For RSX11M-PLUS or VMS, the disk must be mounted /FOREIGN.
C
C	3. The first column of numbers in the file HEADER.DAT
C		is the logical block number (decimal) of the
C		file named, and will be needed for subsequent
C		programs.
C
C	4. Items marked <*> may be system-dependent. OK for M V3.2, V4.0,
C		 V4.1, M+ V2.1, & VAX-11 V1.0
C
	BYTE B(512),NAME(9),EXT(3)
	LOGICAL*1 VAXVMS
	INTEGER*2 A(256),IPR(6),ISB(2),NBLK(2)
	INTEGER*4 NBLOCK
	EQUIVALENCE (NBLOCK,NBLK),(A,B)
C
	DATA IPR(2)/512/
	DATA IFNAM,IFTYP,IFVER/"30,"33,"34/	! File ID pointers <*>
	DATA JUIC1,JUIC2,JCRDT/"12,"11,"110/	! may be system dependent <*>
	DATA ICHH,IESQN,IUSE/7,"57,"63/		! <*>
	DATA NBLOCK/0/
C
	CALL GETADR(IPR,A)
C
C  See if we are running under VAX/VMS, for version no radix (below)
	CALL GETTSK(A)
	VAXVMS=A(15).EQ.5
C
	TYPE 100
 100	FORMAT('$Corrupted device: ')
	ACCEPT 101,IDEV
 101	FORMAT(1A2)
	TYPE 102
 102	FORMAT('$Unit No. = ')
	ACCEPT *,IUNIT
	CALL ASNLUN(1,IDEV,IUNIT)
	OPEN (UNIT=2,NAME='HEADER.DAT',TYPE='NEW')
C
 10	NBLOCK=NBLOCK+1				! Get next logical block
	IPR(5)=NBLK(1)
	IPR(4)=NBLK(2)
	A(1)=0
	A(4)=0
	CALL WTQIO(512,1,6,,ISB,IPR,IDS)	! Read by logical block
	IF(ISB(1).EQ."354) STOP			! End of disk
D	TYPE *,NBLOCK,ISB,IDS,A(1),A(4)
	IF(ISB(1).NE.1) TYPE 61,NBLOCK,ISB,IDS	! Test for error
	IF((A(1).NE."27027).OR.(A(4).NE."401)) GOTO 10 ! Test for header <*>
D	IF((B(JUIC1).NE."22).OR.(B(JUIC2).NE.2)) GOTO 10 !UIC of owner <?>
D	IF(A(ICHH).LT.0) GOTO 10		! Deleted file
	CALL R50ASC(9,A(IFNAM),NAME)
	CALL R50ASC(3,A(IFTYP),EXT)
	IVERS=A(IFVER)
	IF(VAXVMS) GOTO 40
C  RSX -- version no is octal
	WRITE(5,11) NBLOCK,NAME,EXT,IVERS,(B(I),I=JCRDT,JCRDT+"14),
     1		B(JUIC1),B(JUIC2),A(ICHH)
	WRITE(2,11) NBLOCK,NAME,EXT,IVERS,(B(I),I=JCRDT,JCRDT+"14),
     1		B(JUIC1),B(JUIC2),A(ICHH)
 11	FORMAT(I8,X,9A1,'.',3A1,';',O6,2X,2A1,'-',3A1,'-',2A1,X,2A1,
     1		':',2A1,':',2A1,' [',O3,',',O3,']  ',O7)
	GOTO 10
C  VMS -- version no is decimal
 40	WRITE(5,12) NBLOCK,NAME,EXT,IVERS,(B(I),I=JCRDT,JCRDT+"14),
     1		B(JUIC1),B(JUIC2),A(ICHH)
	WRITE(2,12) NBLOCK,NAME,EXT,IVERS,(B(I),I=JCRDT,JCRDT+"14),
     1		B(JUIC1),B(JUIC2),A(ICHH)
 12	FORMAT(I8,X,9A1,'.',3A1,';',I5,2X,2A1,'-',3A1,'-',2A1,X,2A1,
     1		':',2A1,':',2A1,' [',O3,',',O3,']  ',O7)
	GOTO 10
C
 61	FORMAT(' QIO error, block:',O13,' ISB(1),ISB(2),$DSW =',3O7)
	END