C MAGTAPE.FTN -- FOREIGN MAGTAPE SUPPORT ROUTINES C C C 23-NOV-77 C L. H. GERHARDSTEIN C BATTELLE NORTHWEST C RICHLAND WA 99352 C C C SUBROUTINES SUMMARY C C C NO PARAMETERS QIO FUNCTIONS C C MTATT( LUN,STAT ) ATTACH HANDLER C MTDET( LUN,STAT ) DETACH HANDLER C MTRWD( LUN,STAT ) REWIND TAPE C MTRWU( LUN,STAT ) REWIND AND UNLOAD TAPE C MTEOF( LUN,STAT ) WRITE END-OF-FILE C MTSEC( LUN,STAT ) SENSE CHARACTERISTICS C C ONE PARAMETER QIO FUNCTIONS C C MTSPB( LUN,NSKP,STAT ) SKIP BLOCK(S) C MTSPF( LUN,NSKP,STAT ) SKIP FILE(S) C MTSTC( LUN,ICHR,STAT ) SET CHARACTERISTICS C MTSMO( LUN,ICHR,STAT ) LOAD PT AND SET CHAR C C TWO PARAMETER QIO FUNCTIONS C C MTWLB( LUN,BUFF,NBYT,STAT ) WRITE LOGICAL BLOCK C MTRLB( LUN,BUFF,NBYT,STAT ) READ LOGICAL BLOCK C C MAGTAPE EVENT FLAG ROUTINES C C MTREF( FLAG,STAT ) READ MAGTAPE EVENT FLAG C MTCEF( STAT ) CLEAR MAGTAPE EVENT FLAG C MTWEF( STAT ) WAIT FOR MAGTAPE EVENT FLAG C CHARACTERISTIC WORD FORMAT C C C BIT WORD ACC MEANING C --- ------ --- ---------------------------------------- C 15 100000 R TAPE IS PAST END-OF-VOLUME C 14 040000 R TAPE IS AT END-OF-VOLUME C 13 020000 R TAPE IS AT LOAD-POINT C 12 010000 R UNIT IS 7-CHANNEL C 11 004000 R/W SET FOR 1600 BPI PE (TU16 ONLY) C 10 002000 R UNIT HARDWARE OR SOFTWARE WRITE LOCKED C 9 001000 R UNIT REWINDING C 8 000400 R UNIT SELECT ERROR C 7 000200 R/W SET TO INHIBIT WRITE WITH EXTENDED GAP C 6 000100 R/W SET TO PROHIBIT WRITING ON UNIT C 5 000040 R LAST COMMAND ENCOUNTERED EOF RECORD C 4 000020 R TAPE IS PAST EOT MARKER C 3 000010 R/W SET FOR EVEN PARITY C 2 000004 R/W SET TO SPECIFY CORE DUMP MODE (7-CH ONLY) C 1 000002 R/W SET FOR 200 BPI NRZ (7-CH ONLY) C 0 000001 R/W SET FOR 556 BPI NRZ (7-CH ONLY) SUBROUTINE MTATT( LUN,STAT ) C C C MTATT -- ATTACH MAGTAPE HANDLER SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTATT( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C INCLUDE 'SY:MTCOMM.FTN' C C ARGUMENT LIST C INTEGER LUN INTEGER STAT C C ATTACH MAGTAPE HANDLER C IOFCN = MTATTF GO TO 10 ENTRY MTDET( LUN,STAT ) C C C MTDET -- DETACH MAGTAPE HANDLER SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTDET( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C DETACH MAGTAPE HANDLER C IOFCN = MTDETF GO TO 10 ENTRY MTRWD( LUN,STAT ) C C C MTRWD -- REWIND MAGTAPE SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTRWD( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C REWIND MAGTAPE C IOFCN = MTRWDF GO TO 10 ENTRY MTRWU( LUN,STAT ) C C C MTRWU -- REWIND AND UNLOAD MAGTAPE SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTRWU( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C REWIND AND UNLOAD MAGTAPE C IOFCN = MTRWUF GO TO 10 ENTRY MTEOF( LUN,STAT ) C C C MTEOF -- WRITE MAGTAPE END-OF-FILE SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTEOF( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C WRITE MAGTAPE END-OF-FILE C IOFCN = MTEOFF GO TO 10 ENTRY MTSEC( LUN,STAT ) C C C MTSEC -- SENSE MAGTAPE CHARACTERISTICS SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C C CALL MTSEC( LUN,STAT ) C C STAT = 0 IF SUCCESSFUL C MTIOS(2) = CHARACTERISTICS WORD C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C SENSE MAGTAPE CHARACTERISTICS C IOFCN = MTSECF GO TO 10 ENTRY MTSPB( LUN,IARG,STAT ) C C C MTSPB -- SKIP BLOCK(S) SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C NSKP = NUMBER BLOCKS TO SKIP C C CALL MTSPB( LUN,NSKP,STAT ) C C STAT = 0 IF SUCCESSFUL C MTIOS(2) = ACTUAL BLOCKS SKIPED C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C SKIP BLOCK(S) C IOFCN = MTSPBF GO TO 11 ENTRY MTSPF( LUN,IARG,STAT ) C C C MTSPF -- SKIP FILE(S) SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C NSKP = NUMBER FILES TO SKIP C C CALL MTSPF( LUN,NSKP,STAT ) C C STAT = 0 IF SUCCESSFUL C MTIOS(2) = ACTUAL FILES SKIPED C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C SKIP FILE(S) C IOFCN = MTSPFF GO TO 11 ENTRY MTSTC( LUN,IARG,STAT ) C C C MTSTC -- SET MAGTAPE CHARACTERISTICS SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C ICHR = CHARACTERISTICS WORD C C CALL MTSTC( LUN,ICHR,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C SET CHARACTERISTICS C IOFCN = MTSTCF GO TO 11 ENTRY MTSMO( LUN,IARG,STAT ) C C C MTSMO -- VERIFY UNIT AT LOAD POINT C C LUN = LOGICAL UNIT NUMBER C ICHR = CHARACTERISTICS WORD C C CALL MTSMO( LUN,ICHR,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C LOAD POINT AND SET CHARACTERISTICS C IOFCN = MTSMOF GO TO 11 ENTRY MTWLB( LUN,IARG1,IARG2,STAT ) C C C MTWLB -- WRITE LOGICAL BLOCK SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C BUFF = BUFFER ADDRESS C NBYT = NUMBER BYTES C C CALL MTWLB( LUN,BUFF,NBYT,STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C WRITE LOGICAL BLOCK C IOFCN = MTWLBF GO TO 12 ENTRY MTRLB( LUN,IARG1,IARG2,STAT ) C C C MTRLB -- READ LOGICAL BLOCK SUBROUTINE C C LUN = LOGICAL UNIT NUMBER C BUFF = BUFFER ADDRESS C NBYT = BUFFER SIZE - BYTES C C CALL MTRLB( LUN,BUFF,NBYT,STAT ) C C STAT = 0 IF SUCCESSFUL C MTIOS(2) = NUMBER BYTES READ C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C READ LOGICAL BLOCK C IOFCN = MTRLBF GO TO 12 ENTRY MTREF( IFLAG,STAT ) C C C MTREF -- READ EVENT FLAG AND I/O STATUS C C C CALL MTREF( FLAG,STAT ) C C FLAG = .FALSE. IF OPERATION NOT COMPLETED C = .TURE. IF OPERATION COMPLETED C STAT = 0 IF SUCCESSFUL C MTIOS = I/O STATUS BLOCK C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C READ MAGTAPE EVENT FLAG C STAT = 0 CALL READEF( MTEFN,MTDSW ) ! READ EVENT FLAG IFLAG = 1 ! INITIALIZE IF( MTDSW.EQ.MTCLRS ) IFLAG = "000000 ! FALSE IF( MTDSW.EQ.MTSETS ) IFLAG = "177777 ! TRUE IF( IFLAG.EQ.1 ) GO TO 51 ! RETURN STAT=1 MTDSW = MTSUCS ! SUCCESSFUL GO TO 50 ! RETURN STAT=0 ENTRY MTCEF( STAT ) C C C MTCEF -- CLEAR EVENT FLAG C C C CALL MTCEF( STAT ) C C STAT = 0 IF SUCCESSFUL C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C C C CLEAR MAGTAPE EVENT FLAG C STAT = 0 CALL CLREF( MTEFN,MTDSW ) ! CLEAR EVENT FLAG IF( MTDSW.LT.0 ) GO TO 51 ! RETURN STAT=1 GO TO 50 ! RETURN STAT=0 ENTRY MTWEF( STAT ) C C C MTWEF -- WAIT FOR EVENT FLAG AND GET I/O STATUS C C C CALL MTWEF( STAT ) C C STAT = 0 IF SUCCESSFUL C MTIOS = I/O STATUS BLOCK C STAT = 1 IF DIRECTIVE ERROR C MTDSW = DIRECTIVE STATUS WORD C STAT = 2 IF DEVICE HANDLER ERROR C MTIOS = I/O STATUS BLOCK C C C WAIT FOR MAGTAPE EVENT FLAG C STAT = 0 CALL WAITFR( MTEFN,MTDSW ) ! WAIT FOR EVENT FLAG IF( MTDSW.NE.MTSUCS ) GO TO 51 ! RETURN STAT=1 IF( MTBYT.NE.MTSUCS ) GO TO 52 ! RETURN STAT=2 GO TO 50 ! RETURN STAT=0 C MAGTAPE COMMON CODE C C C TWO PARAMETERS C 12 CALL GETADR( IADDR,IARG1 ) MTPAR(1) = IADDR MTPAR(2) = IARG2 GO TO 10 C C ONE PARAMETER C 11 MTPAR(1) = IARG C C NO PARAMETERS C 10 STAT = 0 MTIOS(1) = MTSUCS C C EXECUTE QIOW$ OR QIO$ DIRECTIVE C IF( MTWAIT ) GO TO 3 C C NO WAIT QIO C 2 CALL QIO( IOFCN,LUN,MTEFN,,MTIOS,MTPAR,MTDSW ) IF( MTDSW.NE.MTSUCS ) GO TO 51 GO TO 50 C C QIO WITH WAIT C 3 CALL WTQIO( IOFCN,LUN,MTEFN,,MTIOS,MTPAR,MTDSW ) IF( MTDSW.NE.MTSUCS ) GO TO 51 IF( MTBYT.EQ.MTSUCS ) GO TO 50 C C RETURNS C 52 STAT = STAT+1 ! RETURN STAT=2 51 STAT = STAT+1 ! RETURN STAT=1 50 CONTINUE ! RETURN STAT=0 C C TEST END-OF-FILE C MTPNDL = MTBYT .EQ. MTPNDS ! TRUE IF I/O PENDING MTSUCL = MTBYT .EQ. MTSUCS ! TRUE IF I/O SUCCESSFUL MTEOFL = MTBYT .EQ. MTEOFS+"177400 ! TRUE IF END-OF-FILE MTDSEL = MTDSW .NE. MTSUCS ! TRUE IF DIRECTIVE ERROR MTIOEL = .NOT.( MTSUCL.OR.MTPNDL 1 .OR.MTEOFL ) ! TRUE IF I/O ERROR MTERRL = MTDSEL .OR. MTIOEL ! TRUE IF ERROR END