Google
 

Trailing-Edge - PDP-10 Archives - tops10_integ_tools_v4_10jan-86 - 70,6067/convrt/convrt.for
There are 4 other files named convrt.for in the archive. Click here to see a list.
	PROGRAM READ10

C
C
C	A PROGRAM TO READ DECSYSTEM - 10 BACKUP FORMAT MAGTAPES.
C
C
C	REVISION HISTORY:
C			 (0)	83 JAN 31  20:05 P.J.HURST     INITITIAL VERSION
C			 (1)	83 FEB 02  20:10 P.J.HURST     ADD USER MENU FEATURES
C			 (2)	83 FEB 04  09:20 P.J.HURST     ADD EOT HANDLING
C			 (3)	83 FEB 15  14:38 P.J.HURST     ADD FILENAME HANDELING
C			 (3A)	83 FEB 26  18:10 K.S.LARUE     MV8000 VERSION 
C							       ADDED BUFFER LENGTH HANDLING
C			 (4)	83 MAR 29  09:45 P.J.HURST     ADDED 3A REV TO VAX VERSION
C
C

	PARAMETER	OUTPUT = 16
	
	LOGICAL*1	INPUTBUFFER(2720)
	LOGICAL*1	OUTPUTBUFFER(2560)
	LOGICAL*1	REALDATA(2560)
	LOGICAL*1	NAME(10)
	LOGICAL*1	EXTENTION(5)
	LOGICAL*1	SAVESET(64)
	BYTE		RECORDTYPE
	BYTE		MODEDEPENDENT
	BYTE		HEADERDATA(160)
	INTEGER*4	ITIMES
	INTEGER*4	POSITION
	LOGICAL*1	ONAME(21)
	LOGICAL*1	OPENFLAG
	LOGICAL*1	SSSEARCHFLAG
	LOGICAL*1	DIRFLAG
	LOGICAL*1	CONTFLAG
	LOGICAL*1	EOTFLAG
C....	CHARACTER*10	NSHORTER,NSHORT
C....	CHARACTER*1	NONAME(21)
	CHARACTER*1	DATALENGTH(5)
	CHARACTER*1	DATASKIP(5)
	INTEGER*4	DLENGTH
	INTEGER*4	DSKIP
C
C
C
C	ADDED VARS FOR FAKE OPEN FOR THE MAGTAPE
C
	INTEGER*4	TFUNCT
	CHARACTER*10	MNAME
	INTEGER*4	TAPEDESC(2)
	LOGICAL*1	TAPENAME(64)
	INTEGER*4	TAPECHANNEL
C
C
C

	INTEGER		STATUS,COUNTER,I,BLOCKER
	LOGICAL*1	SSNFLAG,FILEFLAG
	LOGICAL*1	SSNAME(80),SHORT(10),SHORTER(10),CONTINUE

	EQUIVALENCE	(INPUTBUFFER(161),REALDATA(1))
	EQUIVALENCE	(INPUTBUFFER(171),NAME(1))
	EQUIVALENCE	(INPUTBUFFER(181),EXTENTION(1))
	EQUIVALENCE	(INPUTBUFFER(161),SAVESET(1))
	EQUIVALENCE	(INPUTBUFFER(5),RECORDTYPE)
	EQUIVALENCE	(INPUTBUFFER(1),HEADERDATA(1))
	EQUIVALENCE	(INPUTBUFFER(16),MODEDEPENDENT)
C....	EQUIVALENCE	(SHORT,NSHORT)
C....	EQUIVALENCE	(SHORTER,NSHORTER)
C....	EQUIVALENCE	(NONAME(1),ONAME)
	EQUIVALENCE	(INPUTBUFFER(26),DATALENGTH(1))
	EQUIVALENCE	(INPUTBUFFER(31),DATASKIP(1))
C
C
C
C
C	GLOBAL ADDRESSES NEEDED FOR THE FAKE OPEN...
C
C
	INTEGER*4	IO$_SETMODE
	INTEGER*4	IO$_READVBLK
	INTEGER*4	IO$_WRITEBLK
	INTEGER*4	IO$M_CTRLCAST
	INTEGER*4	SS$_NORMAL
	INTEGER*4	SYS$ASSIGN
	INTEGER*4	SYS$QIOW
	INTEGER*4	SYS$TRNLOG
	INTEGER*4	IO$_REWIND
	INTEGER*4	SS$_ENDOFTAPE
C
C
C
	EXTERNAL	IO$_SETMODE
	EXTERNAL	IO$_READVBLK
	EXTERNAL	IO$_WRITEVBLK
	EXTERNAL	IO$M_CTRLCAST
	EXTERNAL	SS$_NORMAL
	EXTERNAL	IO$_REWIND
	EXTERNAL	SS$_ENDOFTAPE
C
C
C
C

C
C	OPEN(UNIT=TAPEIN,FILE='MTA0:',
C	1    STATUS='OLD',ERR=9991,FORM='UNFORMATTED',
C	2    IOSTAT=STATUS,ORGANIZATION='SEQUENTIAL',
C	3    READONLY,RECL=680,BLOCKSIZE=5440 )
C
C
C	OPEN THE MTA: AS THE INPUT UNIT....
C 	USING A KLUDGE METHOD TO REPLACE THE NORMAL FORTRAN OPEN AND
C	READ WHICH DOES NOT WORK VERY WELL WITH ODD SIZED BLOCKS WITH
C	STRANGE DATA THEREIN ... UNDER VMS...
C
C
C
C	PROMPT USER FOR THE NAME OF THE MAGTAPE ,,,
C
920	FORMAT(1X,'DEVICE TO BE READ FROM ?',$)
100	WRITE(6,920)
921	FORMAT(1A10)
	READ(5,921) MNAME
C
C	NOW THAT WE HAVE WHAT WE THINK IS A TAPE DRIVE OPEN IT..
C
	TAPEDESC(1)=64
	TAPEDESC(2)=%LOC(TAPENAME)
C
C	GET THE LOGICAL NAME ASSOCIATION
C
	STATUS=SYS$TRNLOG(MNAME,TAPEDESC,TAPEDESC,,,)
C
C
C	NOW CHECK TO SEE IF THIS NAME EXISTS...
C
	IF(STATUS.NE.%LOC(SS$_NORMAL))THEN
	   CALL ERROR_CHECK(TAPECHANNEL,STATUS)
	END IF

C
C	NOW TO OPEN THE DRIVE...
C
	STATUS=SYS$ASSIGN(TAPEDESC,TAPECHANNEL,,)
C
C	AND CHECK TO SEE IF THIS WAS SUCESSFUL
C
	IF (STATUS.NE.%LOC(SS$_NORMAL)) GO TO 9991
C	
C		;REMOVED BY THE USER MENU 

C	OPEN(UNIT=OUTPUT,FILE='PJH',STATUS='NEW',
C	1    ERR=9992,FORM='UNFORMATTED',IOSTAT=STATUS,
C	2    ORGANIZATION='SEQUENTIAL',
C	3    ASSOCIATEVARIABLE=POSITION,
C	4    ACCESS='DIRECT',RECL=64)
C
	EOTFLAG = .FALSE.
	OPENFLAG= .FALSE.
	SSNFLAG = .FALSE.
	FILEFLAG= .FALSE.
	SSSEARCHFLAG=.FALSE.
	DIRFLAG	= .FALSE.
	CONTFLAG= .FALSE.
	POSITION=1
	COUNTER = 0
	BLOCKER = 0
C
C	NOW TYPE THE COMMAND MENU TO THE USER 1ST BEFORE ANYTHING ELSE HAPPENS
C
	CALL MENU
C
C	REWIND THE TAPE SO WE CAN START PROCESSING THIS TAPE
C
	TFUNCT=%LOC(IO$_REWIND)
	STATUS=SYS$QIOW(,%VAL(TAPECHANNEL),%VAL(TFUNCT),,,,,,,,,,)
C
C	NOW CHECK TO SEE IF ALL IS WELL WITH THE WORLD AND THE TAPE DRIVE
C	HAS GONE TO BOT WITHOUT A WIMPER (ERROR THAT IS)
C	
	IF (STATUS.NE.%LOC(SS$_NORMAL)) THEN
	   CALL ERROR_CHECK(TAPECHANNEL,STATUS)
	END IF

C
C
C
	
C	REWIND(TAPEIN)

C	READ A BLOCK FROM THE 10 TAPE TO BE TRANSLATED...
C
10	COUNTER = COUNTER+1
C	READ(TAPEIN,IOSTAT=STATUS,ERR=9994,END=9993) INPUTBUFFER
C
C
C	KLUDGE TO READ A BLOCK OF DATA FOR A MAGTAPE
C
	TFUNCT=%LOC(IO$_READVBLK)
	STATUS = SYS$QIOW(,%VAL(TAPECHANNEL),%VAL(TFUNCT),,,,INPUTBUFFER,
	1        %VAL(2720),,,,)
C
C	NOW CHECH TO SEE IF THE TAPE READ SUCESSFULLY
C
	IF((STATUS.EQ.%LOC(SS$_ENDOFTAPE)).OR.
	1  ((RECORDTYPE.EQ.3).AND.EOTFLAG)) THEN
C
C	   IF THE PHYSICAL OR LOGICAL EOT IS REACHED, THEN GIVE UP!!!!
C	   THAT IS RESET TAPE AND THE PROGRAM TO THE INITIAL STATE AND 
C	   REWIND TO THE BEGINNING.....
C
C	   1ST THINGS CLOSE THE POSSIBLE OUTPUT FILE .....
C
	   IF(OPENFLAG) THEN
	     CLOSE(OUTPUT)
	     OPENFLAG=.FALSE.
	   END IF
C
C	   NOW RESET ALL FLAGS COUNTERS ET AL TO INDICATE THIS IS A NEW 
C	   TAPE..... IE REINIT IT...
C
	   COUNTER = 0
	   BLOCKER = 0
	   POSITION= 0
	   OPENFLAG=.FALSE.
	   SSNFLAG =.FALSE.
	   FILEFLAG=.FALSE.
	   SSSEARCHFLAG=.FALSE.
	   DIRFLAG =.FALSE.
	   CONTFLAG=.FALSE.
C
C	   NOW ATTEMPT TO REWIND THIS TAPE TO THE BEGINNING
C
	   TFUNCT=%LOC(IO$_REWIND)
	   STATUS=SYS$QIOW(,%VAL(TAPECHANNEL),%VAL(TFUNCT),,,,,,,,,,,)
C
C	   NOW CHECK TO SEE IF ALL IS WELL
C
	   IF(STATUS.NE.%LOC(SS$_NORMAL)) THEN
	     CALL ERROR_CHECK(TAPECHANNEL,STATUS)
	   END IF
C
C	   NOW TAPE SHOULD BE REINITTED
C
935	   FORMAT(/,1X,'EOT REACHED ......... REWIND INITIATED ',/)
	   WRITE(6,935)
	   GO TO 10
	END IF
C
	IF (STATUS.NE.%LOC(SS$_NORMAL)) GO TO 9994
C	.... ....
C		FOR DEBUGGING
C
C900	FORMAT(1X,'FILEFLAG IS ',L5,' , SSNAMEFLAG IS ',L5,
C	1	'  BLOCK IS ',I5,' RECORD TYPE IS ',O3,' MODE IS ',O3,/)
C	WRITE(6,900) FILEFLAG,SSNFLAG,COUNTER,RECORDTYPE,MODEDEPENDENT
C
C
C	NOW LETS DIFFERENTIATE BETWEEN THE DIIFFERENT TYPES OF BLOCKS
C
C		10 RECORD TYPE ID .. WORD #1 .... 1ST 5 BYTES ON THE TAPE
C		
C			RECORD TYPE = 1    LABEL RECORD
C				    = 2    START OF SAVE SET
C				    = 3    END OF SAVE SET
C				    = 4    FILE RECORD
C				    = 5    UFD RECORD
C                                   = 6    END OF VOLUME
C				    = 7    COMMENT
C
C				..  WORD #3 .... BYTE 16
C
C		MODE DEPENDENT(BITS)= 1-8  UNUSED RESERVED FOR  EXPANSION
C				    = 16   THIS IS SET IF 1ST TAPE BLOCK
C				    = 32   NO CHECKSUM FOR THIS BLOCK
C				    = 64   THIS IS A REPEAT OF THE LAST BLOCK
C				    = 128  LAST BLOCK FOR THIS FILE (CAN BE THE 1ST)
C
C

 
C
C
	IF (RECORDTYPE.EQ.2) THEN
	   SSNFLAG=.TRUE.
	   BLOCKER = 0
	    IF(SSSEARCHFLAG.AND.DIRFLAG.AND..NOT.CONTFLAG) DIRFLAG=.FALSE.
	    IF(.NOT.CONTFLAG) SSSEARCHFLAG=.FALSE.
	   CALL CONVRT10(SAVESET,65,SSNAME,80)
C
C	CONVERT THE PIECE OF THE INPUT BUFFER WHICH CONTAINS THE SSNAME TO
C	ASCII AND THEN DISPLAY IT FOR THE USER.
C
901	   FORMAT(/,1X,' -=- THE SAVESET IS : ',80A1,' -=-',/,/)
	   WRITE(6,901) (SSNAME(I),I=1,80)
	END IF
C
C	IF WE ARE SEARCHING FOR A NEW SAVE SET THE RECYCLE 'TILL FOUND
C	IE SKIP 'TILL ALL OTHER PROCESSING (READ A NEW BLOCK) UNLESS
C	DIRECTORY SEARCHING IS IN PROGRESS...
C
C
	IF(SSSEARCHFLAG.AND.(.FALSE..EQ.DIRFLAG)) GO TO 10
C
C	IE RECYCLE
C
C
C
	IF (RECORDTYPE.EQ.3) THEN
	   FILEFLAG=.FALSE.
	   SSNFLAG =.FALSE.
C	   EOTFLAG =.TRUE.
	   IF(OPENFLAG) THEN
C	WERE AT THE END OF THE FILE SO CLOSE THE USERS FILE SO IT IS COMPLETE
	     CLOSE(OUTPUT)
	     OPENFLAG=.FALSE.
	   END IF
	ELSE
	   EOTFLAG =.FALSE.
	END IF
C
C
C
101	IF(RECORDTYPE.EQ.4) THEN
C
C	   IS IT A HEADER???
C	
	   IF(16.EQ.(16.AND.MODEDEPENDENT)) THEN
	     SSNFLAG = .FALSE.
C
C	      CHECK TO MAKE SURE OPEN FILES ARE CLOSED BEFORE NEW ONES
C	      ARE OPENED..
C
	      IF(OPENFLAG) THEN
	        CLOSE(OUTPUT)
	        OPENFLAG=.FALSE.
	      END IF

C	      SET BLOCK COUNT PER FILE TO ZERO 
C
	      BLOCKER=0
C	     
C	     YEP A HEADER SO LETS GO....
C
	     CALL CONVRT10(NAME,10,SHORT,10)
C
C	     AND ALSO GET THE EXTENTION
C
	     CALL CONVRT10(EXTENTION,10,SHORTER,10)
C
C	MAKE FILE && EXTENTION INTO A STRING WITH A DOT DELIMETER
C
C....	ONAME=NSHORT//'.'//NSHORTER
C	ADD A '.' INTO THE FILESPEC
	DO 105 I=1,10
	  ONAME(I)=SHORT(I)
105	CONTINUE
	ONAME(11)='.'
	DO 106 I=1,10
	  ONAME(I+11)=SHORTER(I)
106	CONTINUE
C
C	NOW REMOVE ALL JUNK CHARACTERS
C
	CALL FIXUP(ONAME,ONAME,21)
C
C
C		IS THIS A DIRECTORY MODE OPERATION OR JUST A NORMAL 
C		USER QUERY
C
	    IF(DIRFLAG) THEN
C
C	      NO QUERY IF DIR MODE FLAG IS SET, JUST PRINT THE NAME AND BE DONE
C	      WITH IT.
C
	      WRITE(6,930) COUNTER,ONAME
930	      FORMAT(1X,'FILE AT ',I10,' IS :',21A1,': ',$)
C
	   END IF
C
	   IF(.NOT.DIRFLAG) THEN
C
C
902	     FORMAT(1X,' @ BLOCK: ',I10,'  NAME : ',21A1,' ?',$)
	     WRITE(6,902) COUNTER,ONAME
903	     FORMAT(1A1)
	     READ(5,903) CONTINUE
	     IF((CONTINUE.EQ.'Y').OR.(CONTINUE.EQ.'T').OR.
	1	(CONTINUE.EQ.'A')) THEN
		IF(CONTINUE.NE.'A') THEN
922		   FORMAT(' OUTPUT AS ?',$)
		   WRITE(6,922)
923		   FORMAT(22A1)
		   READ(5,923) ONAME
		   ONAME(22)=00
		END IF
C		 
C		NOW THAT WE HAVE THE FILENAME OPEN THE FILE... (HOPEFULLY)
C
		OPEN(UNIT=OUTPUT,FILE=ONAME,STATUS='NEW',
	1	    ERR=9992,FORM='FORMATTED',
	2	    ORGANIZATION='SEQUENTIAL',IOSTAT=STATUS,
	3	    CARRIAGECONTROL='NONE')
C
C		OPENED THE FILE CORRECTLY NOW INIT ITS POINTER
C
		POSITION=1
C
C		MARK THE FILE AS BEING OPEN 
C
		OPENFLAG=.TRUE.
C
C
C
		FILEFLAG = .TRUE.
	      END IF
	     END IF
C
C	     IS IT A REWIND COMMAND ????? (MAYBE)
C
	     IF(CONTINUE.EQ.'R') THEN
C
C	      	IT IS A REWIND SO DO IT
C
		TFUNCT=%LOC(IO$_REWIND)
		STATUS=SYS$QIOW(,%VAL(TAPECHANNEL),%VAL(TFUNCT),,,,,,,,,,)
C
C		CHECK TO SEE IF TAPE WENT TO BOT IN ONE PIECE
C
		IF(STATUS.NE.%LOC(SS$_NORMAL)) THEN
	         CALL ERROR_CHECK(TAPECHANNEL,STATUS)
	        END IF
C
C		ALL DONE WITH REWIND
C
	    END IF
C
C	IS THE COMMAND TO 'S'KIP THE CURRENT FILE
C
	   IF((CONTINUE.EQ.'S').OR.(CONTINUE.EQ.'N')) THEN
	      FILEFLAG=.FALSE.
	   END IF
C
C
C	IS THE COMMAND 'V' TO SKIP TO THE NEXT SAVESET???
C
	   IF(CONTINUE.EQ.'V')THEN
	      SSSEARCHFLAG=.TRUE.
C	      IF SO, THEN SET THE PROGRAM TO CYCLE THROUGH ALL THE FILES
	   END IF
C
C	   IS THE COMMAND 'L' -- LIST DIRECTORY 'TILL NEXT SAVE SET ????
	   IF(CONTINUE.EQ.'L') THEN
	      DIRFLAG=.TRUE.
	      SSSEARCHFLAG=.TRUE.
C
C	      IF SO THEN SET THE PROGRAM TO CYCLE THROUGH ALL THE FILES
C	      DISPLAYING THERE NAMES 'TILL LIMITED BY THE SAVESET SEARCH
C	      INDICATION.
C
	   END IF
C
C	   IS THE COMMAND 'Z' -- TO LIST ALL THE SAVESETS FROM THE CURRENT
C	   POSITION???
C
	   IF(CONTINUE.EQ.'Z') THEN
	      CONTFLAG=.TRUE.
	      SSSEARCHFLAG=.TRUE.
	      DIRFLAG=.FALSE.
C	      
C	      SET THE PROGRAM TO MOVE CONTINOUSLY THRU THE TAPE 'TILL THE
C	      EOT IS REACHED...
C	
	    END IF
C
C
C	IS THE COMMAND 'D' -- LIST A FULL DIRECTORY OF THE ENTIRE TAPE
C
	   IF(CONTINUE.EQ.'D')THEN
	      CONTFLAG=.TRUE.
	      SSSEARCHFLAG=.TRUE.
	      DIRFLAG=.TRUE.
C
C	      SET THE PROGRAM TO MOVE CONTINUOUSLY THROUGH THE TAPE DOING
C	      A DIRECTORY ALONG THE WAY..
C
	    END IF
C
C	   IS THE COMMAND 'E' -- TO EXIT THIS SILLY PROGRAM
C
	   IF(CONTINUE.EQ.'E') THEN
	     IF(OPENFLAG) THEN
		CLOSE(OUTPUT)
		OPENFLAG=.FALSE.
	     END IF
	     STOP 00
	   END IF
C
C
C	IS THE COMMAND H -- HELP WHICH PRINTS THE MENU FOR THE USER??
C
	   IF(CONTINUE.EQ.'H')THEN
	      CALL MENU
	   END IF
	 END IF
C
	   IF(FILEFLAG.AND.(64.NE.(64.AND.MODEDEPENDENT))) THEN
C
C	     IF FILEFLAG AND A DATA BLOCK THEN IT IS TIME TO BURP THIS
C	     OUT TO THE USER...
C	    
C	     UPDATE THE FILESIZE PARAMETER FOR THE FILE 
C
C
	     DLENGTH=ICHAR(DATALENGTH(4))*16+IAND(15,ICHAR(DATALENGTH(5)))
	     DSKIP  =ICHAR(DATASKIP(4))  *16+IAND(15,ICHAR(DATASKIP(5)))

C		-=- NOW CONNVERT THE ENTIRE BUFFER TO ASCII -=-
C
C
C
C
C
C	WRITE(6,9291) DSKIP,DLENGTH
C
C
	      CALL CONVRT10(REALDATA,2560,OUTPUTBUFFER,2560)
	    IF(DLENGTH.GT.0) WRITE (OUTPUT,9293) (OUTPUTBUFFER(I),
	1     I=DSKIP*5+1,(DLENGTH+DSKIP)*5)
9293	      FORMAT(1A1)
904	      FORMAT(80A1,$)
C
C9291	FORMAT (1X,'.... DSKIP ==',I6,' DLEN ==',I6,/)
C
	     BLOCKER=BLOCKER+1
	  END IF

C
C
	   IF(128.EQ.(128.AND.MODEDEPENDENT)) THEN
C
C	     IS THIS THE LAST BLOCK OF THE FILE?
C
C
C	      NOTIFIY THE USER OF THE BYTE COUNT ET AL
C
	      WRITE(6,941) COUNTER
941	      FORMAT(1X,' FILE EXTENDS TO BLOCK ',I5,$)
942	      FORMAT(1X,' OCCUPYING ',I5,
	1           ' BLOCKS AND ',I10,' BYTES.',/)
943	      FORMAT(1X,' OCCUPYING   1  BLOCK  AND 2560 BYTES.',/)
	      IF(BLOCKER.LE.1) THEN
	        WRITE(6,943)
	      ELSE
	        WRITE(6,942) BLOCKER,(BLOCKER*2560)
	      END IF
C
C	      RESET BLOCK COUNTER
C
	      BLOCKER =0
	      FILEFLAG=.FALSE.
	     IF(OPENFLAG) THEN
	       CLOSE(OUTPUT)
	       OPENFLAG=.FALSE.
	     END IF
	   END IF
	END IF
C
C	RESET OPTION 
C
	CONTINUE=' '
C
C
C
	IF((RECORDTYPE.GE.5).OR.(RECORDTYPE.LT.0)) THEN
905	  FORMAT( '  ENTRY UNKNOWN TYPE OF ENTRY IS =',I5,/)
	  WRITE(6,905) RECORDTYPE
	  SSNFLAG = .TRUE.
	  FILEFLAG = .FALSE.
	END IF
C
C	DO 'TILL DONE
C
	GO TO 10
9991	WRITE(6,906)STATUS
906	FORMAT(' ERROR OPENING TAPE STATUS IS ',I6,/)
	GO TO 100
9992	WRITE(6,907)STATUS
907	FORMAT(' ERROR OPENING OUTPUT FILE STATUS IS ',I6,/)
	GO TO 101
9993	WRITE(6,908) STATUS
908	FORMAT(' END OF TAPE REACHED   ERROR IS ',I8,/)
C	REWIND(TAPEIN)
	CLOSE(OUTPUT)
	STOP
9994	WRITE(6,909) STATUS
909	FORMAT(' TAPE ERROR ... IS ',I6,/)
	GO TO 10
C
9995	WRITE(6,910) STATUS
910	FORMAT(' LOGICAL ASGN ERROR ... IS ',I6,/)
	STOP
9996	WRITE(6,919) STATUS
919	FORMAT(' REWIND ERROR STATUS IS ',I6,/)
	STOP
	END
C
C
C


	SUBROUTINE CONVRT10(INPUT,LENGTH,OUTPUT,LIMIT)
C
C
C	A SUBROUTINE WHICH TRANSLATES THE DEC10'S INTERNAL 7 BIT PACKED 
C	CHARACTER FORMAT INTO 1 CHARACTER PER BYTE AS PER THE VAX
C
C
	INTEGER*4  LENGTH
	INTEGER*4  LIMIT
	LOGICAL*1  INPUT(LENGTH)
	LOGICAL*1  OUTPUT(LENGTH)

	INTEGER*4  BYTE0,BYTE1,BYTE2,BYTE3,BYTE4
	INTEGER*4  COUNT,I,IPACK,XTER

C
C
C	INIT COUNTER (INDEX)
	COUNT=1
C
C
	DO 10 XTER=1,LIMIT,5
C
C
	
	
C	SPLIT THE INDIVIDUAL BYTES FROM THE INPUT TAPE FORMAT...
	
	BYTE0=INPUT(COUNT)
	BYTE1=INPUT(COUNT+1)
	BYTE2=INPUT(COUNT+2)
	BYTE3=INPUT(COUNT+3)
	BYTE4=INPUT(COUNT+4) .AND. '077'O
C
C	NOW RE--POSITION THE SEVEN BIT ASCII SO NOW ALL ARE IN A BYTE WORD
C	BOUNDARY ZERO FILLED ---> INTO IPACK
C
	CALL LIB$INSV(BYTE3,0,8,IPACK)
	CALL LIB$INSV(BYTE2,8,8,IPACK)
	CALL LIB$INSV(BYTE1,16,8,IPACK)
	CALL LIB$INSV(BYTE0,24,8,IPACK)
C
C	NOW PLACE EACH 8 BIT ASCII CHARACTER IN ITS APPROPIATE WORD
C 	(SO WE CAN FILL THE CHARACTER STRING BUFFER)
C
	BYTE0=LIB$EXTZV(25,7,IPACK)
	BYTE1=LIB$EXTZV(18,7,IPACK)
	BYTE2=LIB$EXTZV(11,7,IPACK)
	BYTE3=LIB$EXTZV(04,7,IPACK)
	BYTE4=LIB$EXTZV(00,4,IPACK)*2**3+BYTE4/2
C
C
C	NOW TAKE THE RECOVERED CHARACTERS AND PLACE THEM IN THE OUTPUT
C	BUFFER
C
	OUTPUT(COUNT)=BYTE0
	OUTPUT(COUNT+1)=BYTE1
	OUTPUT(COUNT+2)=BYTE2
	OUTPUT(COUNT+3)=BYTE3
	OUTPUT(COUNT+4)=BYTE4
C
C	FOR DEBUGGING
C1001	FORMAT (1X,'COUNT ',I9,'  LENGTH ',I9,' LIMIT  ',I9,/)
C	WRITE (6,1001) COUNT,LENGTH,LIMIT
C
C	CONTINUE 'TILL DONE WITH THE BUFFER
C
C
C	INDEX INDEX
	COUNT=COUNT+5
C
C
10	CONTINUE
	RETURN
	END
C
C
C
	SUBROUTINE MENU
	
C
C
C	TYPE OUT A MENU FOR THE USER ON THE TERMINAL UNIT == 6
C
C
C
10	FORMAT(11X,'                     CONVRT10 COMMANDS',/,
	1 11X,' ',/,
	2 11X,'   T -- TRANSFER THIS CURRENT FILE TO A VMS DISK FILE',/,
	3 11X,'   R -- REWIND THE MAGTAPE TO THE BOT POSITION ',/,
	4 11X,'   S -- SKIP OVER THE CURRENT FILE TO THE NEXT ONE',/)
20	FORMAT(11X,
	5     '   V -- SKIP TO THE NEXT SAVE SET',/,
	6 11X,'   L -- LIST A DIRECTORY OF ALL FILES IN THE CURRENT',/,
	7 11X,'        SAVE SET <FROM THE CURRENT TAPE POSITION>',/)
30	FORMAT(11X,
	1     '   Z -- LIST SAVE SETS <FROM THE CURRENT TAPE POSITION>',/,
	2 11X,'   D -- LIST A FULL DIRECTORY OF THIS TAPE <FROM THE ',/,
	3 11X,'        CURRENT TAPE POSITION>',/,
	4 11X,'   A -- TRANSFER THIS CURRENT FILE USING NAME FROM TAPE',/)
40	FORMAT(11X,
	1     '   E -- EXIT THIS PROGRAM ',/,
	2 11X,'   H -- THIS TEXT',/,
	3 11X,'   Y -- SAME AS T',/,
	4 11X,'   N -- SAME AS S',/,/)
	
C
C
	WRITE(6,10)
	WRITE(6,20)
	WRITE(6,30)
	WRITE(6,40)
	RETURN
	END
	
	SUBROUTINE ERROR_CHECK(DEVICE_CHANNEL,ERROR_STATUS)
C
C  Report error message as detected by system.
C
C
C  Declare input variables:
C
	INTEGER*4     DEVICE_CHANNEL  ! Assigned output device channel number
	INTEGER*4     ERROR_STATUS    ! System error code for interpretation
C
C  Declare modified variables:
C
C	none
C
C  Declare output variables:
C
C	none
C
C  Declare local variables:
C
	CHARACTER*256 ERROR_MESSAGE   ! Receives error code interpretation
        INTEGER*4     IO_FUNCTION     ! Receives I/O function code to perform
	INTEGER*4     IO_STATUS	      ! Receives I/O status return of function
	INTEGER*4     MESSAGE_LENGTH  ! Receives error interpretation length
	INTEGER*4     NULL_DEVICE     ! Contains code for a null device
C
C  Declare global variables:
C
	INTEGER*4     IO$_WRITEVBLK   ! Write virtual block I/O function code
	INTEGER*4     SS$_NORMAL      ! Successful completion of operation
	INTEGER*4     SYS$GETMSG      ! 
	INTEGER*4     SYS$QIOW	      ! 
C
C  Declare global addresses:
C
	EXTERNAL IO$_WRITEVBLK	      ! 
	EXTERNAL SS$_NORMAL	      ! 
C
C  Define local constants:
C
	DATA NULL_DEVICE/0/
C
C ////////// begin executable statements:
C
C  Define message to tell the user what the error is:
C
	IO_STATUS = SYS$GETMSG(%VAL(ERROR_STATUS),
	1		       MESSAGE_LENGTH,
	2		       %DESCR(ERROR_MESSAGE),
	3		       %VAL(15),)
C
C  If message is not defined, tell the user this instead:
C
	IF (IO_STATUS .NE. %LOC(SS$_NORMAL)) THEN
	   CALL SYS$GETMSG(%VAL(IO_STATUS),
	1		   MESSAGE_LENGTH,
	2		   %DESCR(ERROR_MESSAGE),
	3		   %VAL(15),)
	END IF
C
C  Tell the user what the error message is:
C
	IF (DEVICE_CHANNEL .EQ. NULL_DEVICE) THEN
	   WRITE(5,1000) ERROR_MESSAGE(1:MESSAGE_LENGTH)
	ELSE
	   WRITE(5,1000) ERROR_MESSAGE(1:MESSAGE_LENGTH)
C	   IO_FUNCTION = %LOC(IO$_WRITEVBLK)
C	   CALL SYS$QIOW(,%VAL(DEVICE_CHANNEL),
C	1		  %VAL(IO_FUNCTION),,,,
C	2		  ERROR_MESSAGE,
C	3	 	  %VAL(MESSAGE_LENGTH),,,,)
	END IF
	RETURN
 1000	FORMAT(' ',A)
	END

C
C
C
	SUBROUTINE FIXUP(NAME,XNAME,SIZE)


	INTEGER*4 	SIZE,I,COMP,J,X
	LOGICAL*1	NAME(SIZE)
	LOGICAL*1	XNAME(SIZE)

C
C
C	-=- THIS SUBROUTINE DELETES ILLEGAL CHARACTER FROM A PASSED -=-
C	-=- STRING, RETURNING THE CALLING STRING CORRECTED          -=-
C
C
	NAME(SIZE)=' '
C
	DO 30 X=1,SIZE-2,1
C
	DO 10 I=1,SIZE-1,1
C
C	LOOP THRU ALL THE CHARS THE STRING IS MADE UP OF
C
	   COMP = NAME(I)
C
C	  -=- GET A CHARACTER TO BE WORKED ON I.E. CHECKED -=-
C
	   IF ((COMP.LT.48).OR.(COMP.GT.126)) THEN
C
C	   CHECK FOR SPECIAL CASE CHRS NOW
C
		IF(COMP.NE.46) THEN
C		   ILLEGAL CHARACTER SO REMOVE IT
	           DO 20 J=I,SIZE-1,1
		     NAME(J)=NAME(J+1)
20		   CONTINUE
		END IF
	   END IF
10	CONTINUE
30	CONTINUE
C
C	CONTINUE 'TILL DONE
C
C
C	-=- TERMINATE STRING WITH A NULL -=-
C
C
	NAME(SIZE)=00
C
C
	RETURN
	END