PROGRAM HPTAPE C C Program HPTAPE is used for a quick transfer of data, source C files, or any other ascii files to tape to be read by a HP1000. C The records are variable length and due to DEC TE16 problems C are at least 14 bytes long. For transfer to the intel MDS C system the records are an even number of bytes (0 filled). C There is a switch for producing card image records (80bytes). C The command line is: C HPT MMn:[/D:1600][/D:800][/C][/RW][/RO]=FILE[,FILE2,...] C More than one file can be put on the tape by putting them on C the command line. 1600 density can be selected by the /D:1600 switch. C 800 density can be selected by the /D:800 switch. If no C density is selected the current tape density is used. C The /RW will cause a rewind before any files are transfered. C The /RO will cause a rewind and turn offline after the last file. C Up to 132 byte records can be transfered, so that listing files C can be transfered to the hp high speed printer. C This program requires the TAPEIO macro routine. C C THIS QUICK AND DIRTY (no comments) PROGRAM WAS WRITTEN BY: C C JEFF HAMILTON C E-SYSTEMS C P.O.BOX 1056 C GREENVILLE, TEXAS 75401 C (214)457-4175 C C LOGICAL*1 CI,EOL,REWIND,OFFLIN DIMENSION ISTAT(2) BYTE MCRLIN(80),FILE(40),IBUF(200) C IPOS=0 CALL GETMCR(MCRLIN,IDS) CALL DRIVE(MCRLIN,IDS,CI,REWIND,OFFLIN) 10 CALL GETFIL(MCRLIN,IDS,IPOS,FILE,EOL) CALL ASNLUN(2, 'SY', 0) OPEN(UNIT=2,FILE=FILE,STATUS='OLD',READONLY,ERR=40) 15 DO 20,I=1,132 20 IBUF(I)=' ' READ(2,1000,END=30)NCHRS,(IBUF(I),I=1,NCHRS) IF((NCHRS/2)*2.NE.NCHRS)NCHRS=NCHRS+1 IF(NCHRS.LT.14)NCHRS=14 IF(CI)NCHRS=80 CALL TAPEIO(2,1,ISTAT,IBUF,NCHRS) !WRITE BLOCK IF(ISTAT(1).EQ.1)GO TO 15 WRITE(5,*)' HPT - WRITE ERROR' WRITE(5,1001)ISTAT(1) CALL EXIT(4) 30 CALL TAPEIO(5,1,ISTAT,,) !EOF CLOSE(UNIT=2) IF(.NOT.EOL)GO TO 10 IF(OFFLIN)CALL TAPEIO(10,1,ISTAT,,) !RWOFF CALL EXIT(1) 40 WRITE(5,*)' HPT - FILE ERROR' CALL EXIT(4) 1000 FORMAT(Q,132A1) 1001 FORMAT(' I/O STATUS= ',O6) END C SUBROUTINE DRIVE(LINE,LENGTH,CI,REWIND,OFFLIN) BYTE LINE(LENGTH) DIMENSION ISTAT(2) LOGICAL*1 CI, REWIND, OFFLIN CI=.FALSE. REWIND = .FALSE. OFFLIN = .FALSE. IDENS=1 DO 10,I=1,LENGTH IF(LINE(I).EQ.'M')THEN IF(LINE(I+1).EQ.'M')THEN IF(LINE(I+2).EQ.':')IDRV=0 IF(LINE(I+2).EQ.'0')IDRV=0 IF(LINE(I+2).EQ.'1')IDRV=1 END IF END IF IF(LINE(I).EQ.'/')THEN IF(LINE(I+1).EQ.'D'.AND.LINE(I+2).EQ.':' 1 .AND.LINE(I+3).EQ.'8'.AND.LINE(I+4).EQ.'0' 2 .AND.LINE(I+5).EQ.'0')IDENS=0 IF(LINE(I+1).EQ.'D'.AND.LINE(I+2).EQ.':' 1 .AND.LINE(I+3).EQ.'1'.AND.LINE(I+4).EQ.'6' 2 .AND.LINE(I+5).EQ.'0'.AND.LINE(I+6).EQ.'0') 3 IDENS=2048 IF(LINE(I+1).EQ.'C')CI=.TRUE. IF(LINE(I+1).EQ.'R'.AND.LINE(I+2).EQ.'W' 1 )REWIND=.TRUE. IF(LINE(I+1).EQ.'R'.AND.LINE(I+2).EQ.'O' 1 )OFFLIN = .TRUE. END IF 10 CONTINUE CALL ASNLUN(1,'MM',IDRV) ISTAT(1)=1 IF(REWIND)CALL TAPEIO(3,1,ISTAT,,) !REW IF(ISTAT(1).NE.1)THEN WRITE(5,*)' HPT - DRIVE ERROR' CALL EXIT(4) END IF IF(IDENS.NE.1)CALL TAPEIO(6,1,ISTAT,IDENS,) !DENSITY RETURN END C SUBROUTINE GETFIL(LINE,LENGTH,IPOS,FILE,EOL) BYTE LINE(LENGTH) BYTE FILE(40) LOGICAL*1 EOL,UIC UIC=.FALSE. IF(IPOS.GT.1)GO TO 25 DO 10,I=1,LENGTH IF(LINE(I).EQ.'=')GO TO 20 10 CONTINUE WRITE(5,*)' HPT - SYNTAX ERROR' CALL EXIT(4) 20 IPOS=I+1 25 DO 30,I=IPOS,LENGTH IF(LINE(I).EQ.'[')UIC=.TRUE. IF(LINE(I).EQ.']')UIC=.FALSE. IF(LINE(I).EQ.','.AND..NOT.UIC)GO TO 40 FILE(I-IPOS+1)=LINE(I) 30 CONTINUE EOL=.TRUE. 40 FILE(I-IPOS+1)='0'O IPOS=I+1 RETURN END