SUBROUTINE TDWORK C*********************************************************************** C C Author: Nick Bourgeois Version: 90k01a C 9605 Giddings Ave. NE C Albuquerque, NM 87109 C (505) 828-9566 C C C Description: C C Control the directory making processes. C C Go into a loop. Call a routine to read a record from the tape. C If a tape mark is encountered, call the tape read routine again. C If another tape mark is encountered, exit the loop. If the tape C record is a label record, call a routine to report the data from C that particular label record. If the tape record is the first C saveset record, call a routine to extract the directory data. C Skip over all other tape records. Loop back for another pass. C C If an error condition is returned by any of the called routines, C exit this subroutine. C C C Edit Record: C C 12-Oct-90: Original creation started. C 01-Nov-90: Original creation completed. C C C Calling sequence: C C BtBfLn = C MTDvNm = C Read = C CALL TDWORK C C C Returns: C C ByteBf() C Error C C C Called By: C C TAPEDR C C C Routines Called: C C DOEOF1 C DOHDR1 C DOHDR2 C DORCD1 C MTFOR C C*********************************************************************** INCLUDE 'TAPEDR.DAT' !Common & variables declarations 100 CONTINUE CALL MTFOR (MTDvNm,Read,BtBfLn,ByteBF,Iret) IF (Iret .EQ. 0) THEN CALL MTFOR (MTDvNM,Read,BtBfLn,ByteBf,Iret) IF (Iret .EQ. 0) GOTO 900 END IF IF (LblRcd(1:4) .EQ. 'HDR1') THEN CALL DOHDR1 IF (Error) GOTO 900 ELSE IF (LblRcd(1:4) .EQ. 'HDR2') THEN CALL DOHDR2 IF (Error) GOTO 900 ELSE IF (LblRcd(1:4) .EQ. 'EOF1') THEN CALL DOEOF1 IF (Error) GOTO 900 ELSE IF (LblRcd(1:4) .EQ. 'EOV1') THEN Error = .TRUE. Type *, 'TDWORK: saveset spans a tape volume' GOTO 900 ELSE IF (SSRcNm .EQ. 1) THEN CALL DORCD1 IF (Error) GOTO 900 ELSE ! Simply skip over the record. END IF GO TO 100 900 CONTINUE RETURN END !TDWORK.FOR.