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 - 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