home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
modcomp
/
rstore.
< prev
next >
Wrap
Text File
|
1987-01-25
|
13KB
|
487 lines
SUBROUTINE RSTORE
C
C ****************************************************************
C
C KERMIT for the MODCOMP MAXIV operating system
C
C Compliments of:
C
C SETPOINT, Inc.
C 10245 Brecksville Rd.
C Brecksville, Ohio 44141
C
C
C KERMIT is a copyrighted protocol of Columbia Univ. The authors
C of this version hereby grant permission to copy this software
C provided that it is not used for an explicitly commercial
C purpose and that proper credit be given. SETPOINT, Inc. makes
C no warranty whatsoever regarding the accuracy of this package
C and will assume no liability resulting from it's use.
C
C ****************************************************************
C
C Abstract: RSTORE ALLOWS THE OPERATOR TO INDIVIDUALLY RENAME
C AND ASSIGN TO LIBRARIES THE RECEIVED FILE. RSTORE
C MAKES SURE THAT THE FILE NAME IS FIXED UP FOR MAXIV.
C IT ALSO CHECKS THAT EACH LIBRARY NAME IS CAN-CODEABLE.
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C ****************************************************************
C
C Author: BOB BORGESON Version: A.0 Date: Oct-86
C
C Calling Parameters: None
C
C ****************************************************************
C
C Messages generated by this module : None
C
C ****************************************************************
C
C Subroutines called directly : CMRI4, CMR4, CMWI4, CMW4, CTA4
C FXFILE, PACK, REW4, RNOUT, WEOF
C
C ****************************************************************
C
C Files referenced : None
C
C ****************************************************************
C
C Local variable definitions :
C
C AUTO - INDICATES WHETHER ALL DEFAULTS ARE ACCEPTED
C CAT - INDICATES WHETHER TO CAT OR RECAT A FILE
C CHRFND - # OF CHARACTERS FOUND IN LOGICAL FILE NAME
C EFLNM - POINTER TO END OF FILE NAME IN ARRAY
C FFNAM - FILE NAME FIXED UP FOR MAXIV
C MYUSL - CONTAINS PACK USL NAME
C NCHARF - # OF CHARACTERS IN FILE NAME
C NWRDF - # OF WORDS IN FILE NAME
C RFNAM - FILE NAME AS SENT BY OTHER KERMIT
C SCRTCH - SCRATCH ARRAY
C SFLNM - POINTER TO START OF FILE NAME
C SLIB - POINTER TO START OF LIBRARY NAME
C UFFNAM - UNPACKED FIXED UP FILE NAME
C URFNAM - UNPACKED FILE NAME FROM SENDER KERMIT
C USCTCH - UNPACKED SCRATCH
C
C ****************************************************************
C
C Commons referenced : None
C
C ****************************************************************
C
C (*$END.DOCUMENT*)
C
C ****************************************************************
C * *
C * D I M E N S I O N S T A T E M E N T S *
C * *
C ****************************************************************
C
IMPLICIT INTEGER(A-Z)
C
INTEGER*2 MYUSL(3), RFNAM(20), FFNAM(4), URFNAM(40)
INTEGER*2 UFFNAM(8), SCRTCH(40), IUSL(2), USCTCH(80)
C
C ****************************************************************
C * *
C * T Y P E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * C O M M O N S T A T E M E N T S *
C * *
C ****************************************************************
C
INCLUDE USL/KERCOM
INCLUDE USL/KERPMC
INCLUDE USL/UFTTBC
C
C ****************************************************************
C * *
C * E Q U I V A L E N C E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * D A T A S T A T E M E N T S *
C * *
C ****************************************************************
C
DATA KE5 / 3@KE5 /
> ,KE9 / 3@KE9 /
> ,MLEFT / ZFF00 /
> ,MRIGHT / Z00FF /
C
C ****************************************************************
C
C Code starts here :
C
C
C WRITE EOF TO THE FILE NAME SCRATCH FILE
C
CALL WEOF(IUFT(1,5))
C
C INITIALIZE FOR COMPRESSED READ OR WRITE
C
CALL CMWI4(IUFT(2,9),40)
CALL CMRI4(IUFT(2,5),40)
C
C REWIND THEM
C
CALL REW4(IUFT(1,5))
CALL REW4(IUFT(1,9))
C A PROC IS ALWAYS CREATED - THIS IS THE TOP
C
ENCODE(80,100,SCRTCH)
100 FORMAT('$PROC STORE')
C
CALL CMW4(SCRTCH)
C
C READ FIRST FILE NAME, IF EOF, THEN PUNT
C AND PROC DOES NOTHING
C
CALL CMR4(SCRTCH,IEOF,NCHARF)
C
IF(IEOF .EQ. 2)GO TO 9000
C
C REWIND THE FILE CUZ WE'LL ACTUALLY READ
C THE NAME AGAIN BELOW
C
CALL REW4(IUFT(1,5))
C
C MORE OF THE PROC...
C
ENCODE(80,300,SCRTCH)
300 FORMAT('$EXE SED')
C
CALL CMW4(SCRTCH)
C
ENCODE(80,325,SCRTCH)
325 FORMAT('OPT DAT')
C
CALL CMW4(SCRTCH)
C
ENCODE(80,400,SCRTCH)
400 FORMAT('ASS SI KE8')
C
CALL CMW4(SCRTCH)
C
ENCODE(80,425,SCRTCH)
425 FORMAT('REW SI')
C
CALL CMW4(SCRTCH)
C
ENCODE(80,500,SCRTCH)
500 FORMAT('AVF SI,1')
C
CALL CMW4(SCRTCH)
C
C UNCAN-CODE THE DEFAULT USL AND PACK IT
C
CALL CTA4(SUSL,MYUSL,IND)
C
MYUSL(1) = IOR(IAND(MYUSL(1),MLEFT),ISHFT(MYUSL(2),-8))
MYUSL(2) = MYUSL(3)
MYUSL(3) = 0
C
WRITE(LOCALO,600)
600 FORMAT(' This utility will allow you to rename the received',/
> ' files and assign them to the desired library.',//
> ' The default file names are truncated to 8 characters',/
> ' and any character which is not can-codeable will be',/
> ' converted to "$".',///)
C
C OPERATOR MAY CHOOSE ALL DEFAULTS
C
650 CONTINUE
C
WRITE(LOCALO,700)
700 FORMAT(' Do you want to accept all defaults? (Y/N):')
C
CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
AUTO = ISHFT(SCRTCH,-8)
C
IF((AUTO .NE. BIGY) .AND. (AUTO .NE. BIGN))GO TO 650
C
C OPERATOR MAY CHOOSE TO CAT OR RECAT
C
800 CONTINUE
C
IF(AUTO .EQ. BIGN)GO TO 1000
C
WRITE(LOCALO,900)
900 FORMAT(' Do you wish to CAT or RECAT all files? (C/R):')
C
CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
CAT = ISHFT(SCRTCH,-8)
C
IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 800
C
C TOP OF MAIN LOOP
C
1000 CONTINUE
C
C READ NEXT FILE NAME
C
DO 1050 JJ = 1,20
C
RFNAM(JJ) = 999
C
1050 CONTINUE
C
CALL CMR4(RFNAM,IEOF,NCHARF)
C
C EOF MEANS YOU'RE DONE
C
IF(IEOF .EQ. 2)GO TO 8500
C
C UNPACK THE NAME
C
DO 1200 I = 1,20
C
TEMP = ISHFT(IAND(RFNAM(I),MLEFT),-8)
IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
URFNAM(2*(I-1)+1) = TEMP
IF(TEMP .EQ. LF)GO TO 1300
C
TEMP = IAND(RFNAM(I),MRIGHT)
IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
URFNAM(2*I) = TEMP
IF(TEMP .EQ. LF)GO TO 1300
C
1200 CONTINUE
C
1300 CONTINUE
C
C FIX UP NAME TO MAXIV FORMAT
C
CALL FXFILE(URFNAM,UFFNAM,NCHARF,NUMFIX)
C
C PACK THE STRING
C
CALL PACK(UFFNAM,FFNAM)
C
NWRDF = (NCHARF + 1) / 2
C
IF(AUTO .EQ. BIGY)GO TO 5000
C
C WRITE OUT DEFAULTS
C
WRITE(LOCALO,1400)RFNAM,FFNAM,(MYUSL(II),II=1,2)
C
1400 FORMAT(' Received name...........',20A2,/
> ' Acceptable name.........',4A2,/
> ' Default USL.............',2A2,//)
C
1450 CONTINUE
C
WRITE(LOCALO,1500)
1500 FORMAT(' Enter name and library - <CR> accepts defaults:')
C
C
DO 1525 JJ = 1,40
C
SCRTCH(JJ) = 4Z2020
C
1525 CONTINUE
C
CALL READ4(IUFT(1,2),SCRTCH,80,.TRUE.)
C
NCHRC = IUFT(4,2)
C
C NO INPUT MEANS ACCEPT DEFAULT
C
IF(NCHRC .EQ. 0)GO TO 2100
C
C UNPACK THE INPUT
C
DO 1600 I = 1,40
C
USCTCH(2*(I-1)+1) = ISHFT(IAND(SCRTCH(I),MLEFT),-8)
USCTCH(2*I) = IAND(SCRTCH(I),MRIGHT)
C
1600 CONTINUE
C
C NO INPUT ACCEPTS DEFAULTS
C
IF(USCTCH(1) .EQ. 0)GO TO 2100
C
C SKIP BLANKS TO FIND START OF FILE NAME
C
DO 1700 I = 1,80
C
IF(USCTCH(I) .EQ. BLANK)GO TO 1700
C
SFLNM = I
GO TO 1750
C
1700 CONTINUE
C
GO TO 2100
C
1750 CONTINUE
C
C FIND END OF FILE NAME
C
DO 1800 I = SFLNM,80
C
IF(USCTCH(I) .NE. BLANK)GO TO 1800
C
EFLNM = I - 1
EFLNM1 = EFLNM + 1
USCTCH(EFLNM1) = LF
C
GO TO 1850
C
1800 CONTINUE
C
1850 CONTINUE
C
C FIND START OF LIBRARY
C
EFLNM2 = EFLNM1 + 1
C
DO 1900 I = EFLNM2,80
C
IF((USCTCH(I) .EQ. BLANK) .OR. (USCTCH(I) .EQ. 0) .OR.
> (USCTCH(I) .EQ. 2Z0A) .OR. (USCTCH(I) .EQ. LF))GO TO 1900
C
SLIB = I
USCTCH(SLIB+3) = LF
C
GO TO 1950
C
1900 CONTINUE
C
SLIB = I
C
1950 CONTINUE
C
C CHECK FILE NAME FOR LEGALITY
C
NCHARF = EFLNM - SFLNM + 1
C
CALL FXFILE(USCTCH(SFLNM),UFFNAM,NCHARF,NUMFIX)
C
IF(NUMFIX .EQ. 0)GO TO 2000
C
WRITE(LOCALO,1975)
1975 FORMAT(' File name must be A-Z, 1-9, :, ., or $')
GO TO 1450
C
2000 CONTINUE
C
C PACK THE FILE NAME
C
CALL PACK(UFFNAM,FFNAM)
C
C IF NO LIB INPUT, USE DEFAULT
C
IF(SLIB .GE. 80)GO TO 2100
C
C
C CHECK IF WE CAN CAN-CODE THE LIBRARY
C
CHRFND = 0
C
DO 2025 I = 1,3
C
C
IPT = SLIB + 3 - I
C
C TRAILING BLANKS ARE OK
C
IF(((USCTCH(IPT) .EQ. BLANK) .OR. (USCTCH(IPT) .EQ. 0))
> .AND. (CHRFND .EQ. 0))GO TO 2025
C
CHRFND = CHRFND + 1
C
IF(((USCTCH(IPT) .GE. BIGA) .AND. (USCTCH(IPT) .LE. BIGZ)) .OR.
> ((USCTCH(IPT) .GE. DIG0) .AND. (USCTCH(IPT) .LE. DIG9)) .OR.
> (USCTCH(IPT) .EQ. COLON) .OR.
> (USCTCH(IPT) .EQ. PERIOD) .OR.
> (USCTCH(IPT) .EQ. DOLLAR))GO TO 2025
C
GO TO 2030
C
2025 CONTINUE
C
GO TO 2075
C
2030 CONTINUE
C
C
WRITE(LOCALO,2050)
2050 FORMAT(' Improper logical file name')
C
GO TO 1450
C
2075 CONTINUE
C
CALL PACK(USCTCH(SLIB),MYUSL)
C
2100 CONTINUE
C
C ASK CAT OR RECAT THE FILE
C
WRITE(LOCALO,2200)
2200 FORMAT(' CAT or RECAT this file? (C/R):')
C
CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
CAT = ISHFT(SCRTCH,-8)
C
IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 2100
C
5000 CONTINUE
C
C OUTPUT SED COMMANDS TO CAT OR RECAT
C THIS FILE
C
ENCODE(80,5010,SCRTCH)MYUSL
5010 FORMAT('ASS USL ',2A2)
C
CALL CMW4(SCRTCH)
C
IF(CAT .EQ. BIGC)ENCODE(80,5020,SCRTCH)FFNAM
IF(CAT .EQ. BIGR)ENCODE(80,5030,SCRTCH)FFNAM
C
5020 FORMAT('CAT ',4A2)
5030 FORMAT('REC ',4A2)
C
CALL CMW4(SCRTCH)
C
C LOOP BACK FOR MORE FILES
C
GO TO 1000
C
8500 CONTINUE
C
ENCODE(80,8510,SCRTCH)
8510 FORMAT('EXI')
C
CALL CMW4(SCRTCH)
C
C
9000 CONTINUE
C
CALL RNOUT
CALL WEOF(IUFT(1,9))
C
C
C
RETURN
END