home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / rstore. < prev    next >
Text File  |  2020-01-01  |  13KB  |  487 lines
  1.       SUBROUTINE RSTORE
  2. C
  3. C     ****************************************************************
  4. C
  5. C              KERMIT for the MODCOMP MAXIV operating system
  6. C
  7. C        Compliments of:
  8. C
  9. C                         SETPOINT, Inc.
  10. C                      10245 Brecksville Rd.
  11. C                      Brecksville, Ohio 44141
  12. C
  13. C
  14. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  15. C      of this version hereby grant permission to copy this software
  16. C      provided that it is not used for an explicitly commercial
  17. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  18. C      no warranty whatsoever regarding the accuracy of this package
  19. C      and will assume no liability resulting from it's use.
  20. C
  21. C     ****************************************************************
  22. C
  23. C     Abstract: RSTORE ALLOWS THE OPERATOR TO INDIVIDUALLY RENAME
  24. C               AND ASSIGN TO LIBRARIES THE RECEIVED FILE. RSTORE
  25. C               MAKES SURE THAT THE FILE NAME IS FIXED UP FOR MAXIV.
  26. C               IT ALSO CHECKS THAT EACH LIBRARY NAME IS CAN-CODEABLE.
  27. C
  28. C     MODIFICATION HISTORY
  29. C
  30. C     BY            DATE     REASON            PROGRAMS AFFECTED
  31. C
  32. C     ****************************************************************
  33. C
  34. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  35. C
  36. C     Calling Parameters:  None
  37. C
  38. C     ****************************************************************
  39. C
  40. C     Messages generated by this module :  None
  41. C
  42. C     ****************************************************************
  43. C
  44. C     Subroutines called directly : CMRI4, CMR4, CMWI4, CMW4, CTA4
  45. C                                   FXFILE, PACK, REW4, RNOUT, WEOF
  46. C
  47. C     ****************************************************************
  48. C
  49. C     Files referenced :  None
  50. C
  51. C     ****************************************************************
  52. C
  53. C     Local variable definitions :
  54. C
  55. C     AUTO      - INDICATES WHETHER ALL DEFAULTS ARE ACCEPTED
  56. C     CAT       - INDICATES WHETHER TO CAT OR RECAT A FILE
  57. C     CHRFND    - # OF CHARACTERS FOUND IN LOGICAL FILE NAME
  58. C     EFLNM     - POINTER TO END OF FILE NAME IN ARRAY
  59. C     FFNAM     - FILE NAME FIXED UP FOR MAXIV
  60. C     MYUSL     - CONTAINS PACK USL NAME
  61. C     NCHARF    - # OF CHARACTERS IN FILE NAME
  62. C     NWRDF     - # OF WORDS IN FILE NAME
  63. C     RFNAM     - FILE NAME AS SENT BY OTHER KERMIT
  64. C     SCRTCH    - SCRATCH ARRAY
  65. C     SFLNM     - POINTER TO START OF FILE NAME
  66. C     SLIB      - POINTER TO START OF LIBRARY NAME
  67. C     UFFNAM    - UNPACKED FIXED UP FILE NAME
  68. C     URFNAM    - UNPACKED FILE NAME FROM SENDER KERMIT
  69. C     USCTCH    - UNPACKED SCRATCH
  70. C
  71. C     ****************************************************************
  72. C
  73. C     Commons referenced :  None
  74. C
  75. C     ****************************************************************
  76. C
  77. C     (*$END.DOCUMENT*)
  78. C
  79. C     ****************************************************************
  80. C     *                                                              *
  81. C     *         D I M E N S I O N   S T A T E M E N T S              *
  82. C     *                                                              *
  83. C     ****************************************************************
  84. C
  85.       IMPLICIT INTEGER(A-Z)
  86. C
  87.       INTEGER*2   MYUSL(3),    RFNAM(20),   FFNAM(4),    URFNAM(40)
  88.       INTEGER*2   UFFNAM(8),   SCRTCH(40),  IUSL(2),     USCTCH(80)
  89. C
  90. C     ****************************************************************
  91. C     *                                                              *
  92. C     *         T Y P E   S T A T E M E N T S                        *
  93. C     *                                                              *
  94. C     ****************************************************************
  95. C
  96. C
  97. C     ****************************************************************
  98. C     *                                                              *
  99. C     *         C O M M O N   S T A T E M E N T S                    *
  100. C     *                                                              *
  101. C     ****************************************************************
  102. C
  103.       INCLUDE USL/KERCOM
  104.       INCLUDE USL/KERPMC
  105.       INCLUDE USL/UFTTBC
  106. C
  107. C     ****************************************************************
  108. C     *                                                              *
  109. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  110. C     *                                                              *
  111. C     ****************************************************************
  112. C
  113. C
  114. C     ****************************************************************
  115. C     *                                                              *
  116. C     *         D A T A   S T A T E M E N T S                        *
  117. C     *                                                              *
  118. C     ****************************************************************
  119. C
  120.       DATA KE5      / 3@KE5 /
  121.      >    ,KE9      / 3@KE9 /
  122.      >    ,MLEFT    / ZFF00 /
  123.      >    ,MRIGHT   / Z00FF /
  124. C
  125. C     ****************************************************************
  126. C
  127. C     Code starts here :
  128. C
  129. C
  130. C                              WRITE EOF TO THE FILE NAME SCRATCH FILE
  131. C
  132.       CALL WEOF(IUFT(1,5))
  133. C
  134. C                              INITIALIZE FOR COMPRESSED READ OR WRITE
  135. C
  136.       CALL CMWI4(IUFT(2,9),40)
  137.       CALL CMRI4(IUFT(2,5),40)
  138. C
  139. C                              REWIND THEM
  140. C
  141.       CALL REW4(IUFT(1,5))
  142.       CALL REW4(IUFT(1,9))
  143. C                              A PROC IS ALWAYS CREATED - THIS IS THE TOP
  144. C
  145.       ENCODE(80,100,SCRTCH)
  146.   100 FORMAT('$PROC STORE')
  147. C
  148.       CALL CMW4(SCRTCH)
  149. C
  150. C                              READ FIRST FILE NAME, IF EOF, THEN PUNT
  151. C                              AND PROC DOES NOTHING
  152. C
  153.       CALL CMR4(SCRTCH,IEOF,NCHARF)
  154. C
  155.       IF(IEOF .EQ. 2)GO TO 9000
  156. C
  157. C                               REWIND THE FILE CUZ WE'LL ACTUALLY READ
  158. C                               THE NAME AGAIN BELOW
  159. C
  160.       CALL REW4(IUFT(1,5))
  161. C
  162. C                               MORE OF THE PROC...
  163. C
  164.       ENCODE(80,300,SCRTCH)
  165.   300 FORMAT('$EXE SED')
  166. C
  167.       CALL CMW4(SCRTCH)
  168. C
  169.       ENCODE(80,325,SCRTCH)
  170.   325 FORMAT('OPT DAT')
  171. C
  172.       CALL CMW4(SCRTCH)
  173. C
  174.       ENCODE(80,400,SCRTCH)
  175.   400 FORMAT('ASS SI KE8')
  176. C
  177.       CALL CMW4(SCRTCH)
  178. C
  179.       ENCODE(80,425,SCRTCH)
  180.   425 FORMAT('REW SI')
  181. C
  182.       CALL CMW4(SCRTCH)
  183. C
  184.       ENCODE(80,500,SCRTCH)
  185.   500 FORMAT('AVF SI,1')
  186. C
  187.       CALL CMW4(SCRTCH)
  188. C
  189. C                              UNCAN-CODE THE DEFAULT USL AND PACK IT
  190. C
  191.       CALL CTA4(SUSL,MYUSL,IND)
  192. C
  193.       MYUSL(1) = IOR(IAND(MYUSL(1),MLEFT),ISHFT(MYUSL(2),-8))
  194.       MYUSL(2) = MYUSL(3)
  195.       MYUSL(3) = 0
  196. C
  197.       WRITE(LOCALO,600)
  198.   600 FORMAT(' This utility will allow you to rename the received',/
  199.      >       ' files and assign them to the desired library.',//
  200.      >       ' The default file names are truncated to 8 characters',/
  201.      >       ' and any character which is not can-codeable will be',/
  202.      >       ' converted to "$".',///)
  203. C
  204. C                                OPERATOR MAY CHOOSE ALL DEFAULTS
  205. C
  206.   650 CONTINUE
  207. C
  208.       WRITE(LOCALO,700)
  209.   700 FORMAT(' Do you want to accept all defaults? (Y/N):')
  210. C
  211.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  212. C
  213.       AUTO = ISHFT(SCRTCH,-8)
  214. C
  215.       IF((AUTO .NE. BIGY) .AND. (AUTO .NE. BIGN))GO TO 650
  216. C
  217. C                                 OPERATOR MAY CHOOSE TO CAT OR RECAT
  218. C
  219.   800 CONTINUE
  220. C
  221.       IF(AUTO .EQ. BIGN)GO TO 1000
  222. C
  223.       WRITE(LOCALO,900)
  224.   900 FORMAT(' Do you wish to CAT or RECAT all files? (C/R):')
  225. C
  226.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  227. C
  228.       CAT = ISHFT(SCRTCH,-8)
  229. C
  230.       IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 800
  231. C
  232. C                                   TOP OF MAIN LOOP
  233. C
  234.  1000 CONTINUE
  235. C
  236. C                                   READ NEXT FILE NAME
  237. C
  238.       DO 1050 JJ = 1,20
  239. C
  240.         RFNAM(JJ) = 999
  241. C
  242.  1050 CONTINUE
  243. C
  244.       CALL CMR4(RFNAM,IEOF,NCHARF)
  245. C
  246. C                                   EOF MEANS YOU'RE DONE
  247. C
  248.       IF(IEOF .EQ. 2)GO TO 8500
  249. C
  250. C                                   UNPACK THE NAME
  251. C
  252.       DO 1200 I = 1,20
  253. C
  254.         TEMP = ISHFT(IAND(RFNAM(I),MLEFT),-8)
  255.         IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
  256.         URFNAM(2*(I-1)+1) = TEMP
  257.         IF(TEMP .EQ. LF)GO TO 1300
  258. C
  259.         TEMP = IAND(RFNAM(I),MRIGHT)
  260.         IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
  261.         URFNAM(2*I) = TEMP
  262.         IF(TEMP .EQ. LF)GO TO 1300
  263. C
  264.  1200 CONTINUE
  265. C
  266.  1300 CONTINUE
  267. C
  268. C                                   FIX UP NAME TO MAXIV FORMAT
  269. C
  270.       CALL FXFILE(URFNAM,UFFNAM,NCHARF,NUMFIX)
  271. C
  272. C                                   PACK THE STRING
  273. C
  274.       CALL PACK(UFFNAM,FFNAM)
  275. C
  276.       NWRDF = (NCHARF + 1) / 2
  277. C
  278.       IF(AUTO .EQ. BIGY)GO TO 5000
  279. C
  280. C                                      WRITE OUT DEFAULTS
  281. C
  282.       WRITE(LOCALO,1400)RFNAM,FFNAM,(MYUSL(II),II=1,2)
  283. C
  284.  1400 FORMAT(' Received name...........',20A2,/
  285.      >       ' Acceptable name.........',4A2,/
  286.      >       ' Default USL.............',2A2,//)
  287. C
  288.  1450 CONTINUE
  289. C
  290.       WRITE(LOCALO,1500)
  291.  1500 FORMAT(' Enter name and library - <CR> accepts defaults:')
  292. C
  293. C
  294.       DO 1525 JJ = 1,40
  295. C
  296.         SCRTCH(JJ) = 4Z2020
  297. C
  298.  1525 CONTINUE
  299. C
  300.       CALL READ4(IUFT(1,2),SCRTCH,80,.TRUE.)
  301. C
  302.       NCHRC = IUFT(4,2)
  303. C
  304. C                                     NO INPUT MEANS ACCEPT DEFAULT
  305. C
  306.       IF(NCHRC .EQ. 0)GO TO 2100
  307. C
  308. C                                     UNPACK THE INPUT
  309. C
  310.       DO 1600 I = 1,40
  311. C
  312.         USCTCH(2*(I-1)+1) = ISHFT(IAND(SCRTCH(I),MLEFT),-8)
  313.         USCTCH(2*I) = IAND(SCRTCH(I),MRIGHT)
  314. C
  315.  1600 CONTINUE
  316. C
  317. C                                NO INPUT ACCEPTS DEFAULTS
  318. C
  319.       IF(USCTCH(1) .EQ. 0)GO TO 2100
  320. C
  321. C                                SKIP BLANKS TO FIND START OF FILE NAME
  322. C
  323.       DO 1700 I = 1,80
  324. C
  325.         IF(USCTCH(I) .EQ. BLANK)GO TO 1700
  326. C
  327.         SFLNM = I
  328.         GO TO 1750
  329. C
  330.  1700 CONTINUE
  331. C
  332.       GO TO 2100
  333. C
  334.  1750 CONTINUE
  335. C
  336. C                                 FIND END OF FILE NAME
  337. C
  338.       DO 1800 I = SFLNM,80
  339. C
  340.         IF(USCTCH(I) .NE. BLANK)GO TO 1800
  341. C
  342.         EFLNM = I - 1
  343.         EFLNM1 = EFLNM + 1
  344.         USCTCH(EFLNM1) = LF
  345. C
  346.         GO TO 1850
  347. C
  348.  1800 CONTINUE
  349. C
  350.  1850 CONTINUE
  351. C
  352. C                                  FIND START OF LIBRARY
  353. C
  354.       EFLNM2 = EFLNM1 + 1
  355. C
  356.       DO 1900 I = EFLNM2,80
  357. C
  358.         IF((USCTCH(I) .EQ. BLANK) .OR. (USCTCH(I) .EQ. 0) .OR.
  359.      >     (USCTCH(I) .EQ. 2Z0A) .OR. (USCTCH(I) .EQ. LF))GO TO 1900
  360. C
  361.         SLIB = I
  362.         USCTCH(SLIB+3) = LF
  363. C
  364.         GO TO 1950
  365. C
  366.  1900 CONTINUE
  367. C
  368.       SLIB = I
  369. C
  370.  1950 CONTINUE
  371. C
  372. C                                CHECK FILE NAME FOR LEGALITY
  373. C
  374.       NCHARF = EFLNM - SFLNM + 1
  375. C
  376.       CALL FXFILE(USCTCH(SFLNM),UFFNAM,NCHARF,NUMFIX)
  377. C
  378.       IF(NUMFIX .EQ. 0)GO TO 2000
  379. C
  380.       WRITE(LOCALO,1975)
  381.  1975 FORMAT(' File name must be A-Z, 1-9, :, ., or $')
  382.       GO TO 1450
  383. C
  384.  2000 CONTINUE
  385. C
  386. C                                PACK THE FILE NAME
  387. C
  388.       CALL PACK(UFFNAM,FFNAM)
  389. C
  390. C                                IF NO LIB INPUT, USE DEFAULT
  391. C
  392.       IF(SLIB .GE. 80)GO TO 2100
  393. C
  394. C
  395. C                                CHECK IF WE CAN CAN-CODE THE LIBRARY
  396. C
  397.       CHRFND = 0
  398. C
  399.       DO 2025 I = 1,3
  400. C
  401. C
  402.         IPT = SLIB + 3 - I
  403. C
  404. C                                TRAILING BLANKS ARE OK
  405. C
  406.         IF(((USCTCH(IPT) .EQ. BLANK) .OR. (USCTCH(IPT) .EQ. 0))
  407.      >     .AND. (CHRFND .EQ. 0))GO TO 2025
  408. C
  409.         CHRFND = CHRFND + 1
  410. C
  411.         IF(((USCTCH(IPT) .GE. BIGA) .AND. (USCTCH(IPT) .LE. BIGZ)) .OR.
  412.      >     ((USCTCH(IPT) .GE. DIG0) .AND. (USCTCH(IPT) .LE. DIG9)) .OR.
  413.      >     (USCTCH(IPT) .EQ. COLON)                                .OR.
  414.      >     (USCTCH(IPT) .EQ. PERIOD)                               .OR.
  415.      >     (USCTCH(IPT) .EQ. DOLLAR))GO TO 2025
  416. C
  417.         GO TO 2030
  418. C
  419.  2025 CONTINUE
  420. C
  421.       GO TO 2075
  422. C
  423.  2030 CONTINUE
  424. C
  425. C
  426.       WRITE(LOCALO,2050)
  427.  2050 FORMAT(' Improper logical file name')
  428. C
  429.       GO TO 1450
  430. C
  431.  2075 CONTINUE
  432. C
  433.       CALL PACK(USCTCH(SLIB),MYUSL)
  434. C
  435.  2100 CONTINUE
  436. C
  437. C                          ASK CAT OR RECAT THE FILE
  438. C
  439.       WRITE(LOCALO,2200)
  440.  2200 FORMAT(' CAT or RECAT this file? (C/R):')
  441. C
  442.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  443. C
  444.       CAT = ISHFT(SCRTCH,-8)
  445. C
  446.       IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 2100
  447. C
  448.  5000 CONTINUE
  449. C
  450. C                        OUTPUT SED COMMANDS TO CAT OR RECAT
  451. C                        THIS FILE
  452. C
  453.       ENCODE(80,5010,SCRTCH)MYUSL
  454. 5010  FORMAT('ASS USL ',2A2)
  455. C
  456.       CALL CMW4(SCRTCH)
  457. C
  458.       IF(CAT .EQ. BIGC)ENCODE(80,5020,SCRTCH)FFNAM
  459.       IF(CAT .EQ. BIGR)ENCODE(80,5030,SCRTCH)FFNAM
  460. C
  461.  5020 FORMAT('CAT ',4A2)
  462.  5030 FORMAT('REC ',4A2)
  463. C
  464.       CALL CMW4(SCRTCH)
  465. C
  466. C                         LOOP BACK FOR MORE FILES
  467. C
  468.       GO TO 1000
  469. C
  470.  8500 CONTINUE
  471. C
  472.       ENCODE(80,8510,SCRTCH)
  473.  8510 FORMAT('EXI')
  474. C
  475.       CALL CMW4(SCRTCH)
  476. C
  477. C
  478.  9000 CONTINUE
  479. C
  480.       CALL RNOUT
  481.       CALL WEOF(IUFT(1,9))
  482. C
  483. C
  484. C
  485.       RETURN
  486.       END
  487.