home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / modcmp.asm < prev    next >
Assembly Source File  |  2020-01-01  |  284KB  |  8,578 lines
  1. <<< bldker. >>>
  2. $PROD BLDKER,,,,NONE
  3. $NOP
  4. $IFN %1=HELP,P/$GOTO NOHELP
  5. $GOTO HELP
  6. $TAG ARGERR
  7. $NOP ** MISSING A REQUIRED ARGUMENT **
  8. $TAG HELP
  9. $NOP
  10. $NOP  *****  PROCEDURE TO COMPLETELY BUILD MODCOMP KERMIT *****
  11. $NOP
  12. $NOP    ***   ARG 1  = NAME OF SOURCE LIBRARY (NO DEFAULT)
  13. $NOP    ***   ARG 2  = NAME OF OBJECT LIBRARY (NO DEFAULT)
  14. $NOP    ***   ARG 3  = NAME OF LOAD MODULE FILE (NO DEFAULT)
  15. $NOP    ***   ARG 4  = LIST OPTION; IF <> NONE, FORTRAN LISTINGS
  16. $NOP    ***            AND A LINK MAP ARE PRODUCED (DEFAULT = %4)
  17. $NOP
  18. $NOP    *** EXAMPLE --> $BLDKER USL,UL,LM,LO
  19. $NOP
  20. $ENDDO
  21. $NOP
  22. $TAG NOHELP
  23. $IFM %1,P/$GOTO ARGERR
  24. $IFM %2,P/$GOTO ARGERR
  25. $IFM %3,P/$GOTO ARGERR
  26. $DOFR5 BUFEMP,%1,%4,,%2
  27. $DOFR5 BUFILL,%1,%4,,%2
  28. $DOFR5 CTL,%1,%4,,%2
  29. $DOFR5 CTOI,%1,%4,,%2
  30. $DOFR5 DGETCH,%1,%4,,%2
  31. $DOFR5 DGETLI,%1,%4,,%2
  32. $DOFR5 DPUTCH,%1,%4,,%2
  33. $DOFR5 DPUTLI,%1,%4,,%2
  34. $DOFR5 FINDLN,%1,%4,,%2
  35. $DOFR5 FXFILE,%1,%4,,%2
  36. $DOFR5 GETLIN,%1,%4,,%2
  37. $DOFR5 PACK,%1,%4,,%2
  38. $DOFR5 PARSER,%1,%4,,%2
  39. $IF %4=NONE,P/$DOM5A POSUSL,%1,NOLO,%2
  40. $IFN %4=NONE,P/$DOM5A POSUSL,%1,LO,%2
  41. $DOFR5 RDATA,%1,%4,,%2
  42. $DOFR5 RECSW,%1,%4,,%2
  43. $DOFR5 RFILE,%1,%4,,%2
  44. $DOFR5 RINIT,%1,%4,,%2
  45. $DOFR5 RPACK,%1,%4,,%2
  46. $DOFR5 RPAR,%1,%4,,%2
  47. $DOFR5 RSTORE,%1,%4,,%2
  48. $DOFR5 SBREAK,%1,%4,,%2
  49. $DOFR5 SCONNE,%1,%4,,%2
  50. $DOFR5 SCOPY,%1,%4,,%2
  51. $DOFR5 SDATA,%1,%4,,%2
  52. $DOFR5 SENDSW,%1,%4,,%2
  53. $DOFR5 SEOF,%1,%4,,%2
  54. $DOFR5 SFILE,%1,%4,,%2
  55. $DOFR5 SHELP,%1,%4,,%2
  56. $DOFR5 SINIT,%1,%4,,%2
  57. $DOFR5 SKIPBL,%1,%4,,%2
  58. $DOFR5 SPACK,%1,%4,,%2
  59. $DOFR5 SPAR,%1,%4,,%2
  60. $DOFR5 SQUIT,%1,%4,,%2
  61. $DOFR5 SRECEI,%1,%4,,%2
  62. $DOFR5 SSEND,%1,%4,,%2
  63. $DOFR5 SSET,%1,%4,,%2
  64. $DOFR5 SSTATU,%1,%4,,%2
  65. $DOFR5 TOCHAR,%1,%4,,%2
  66. $DOFR5 TPUTCH,%1,%4,,%2
  67. $DOFR5 UFTINI,%1,%4,,%2
  68. $DOFR5 UNCHAR,%1,%4,,%2
  69. $DOFR5 UPPER,%1,%4,,%2
  70. $DOFR5 KERMIT,%1,%4,,%2,,BLKD
  71. $ASSIGN BI=%2,BO=BO,UL=%2
  72. $REWIND BO
  73. $EXECUTE LIB
  74.  POSITION KERMIT
  75.  GET KERMIT
  76.  POSITION B:KERMIT
  77.  COPY
  78.  WEOF BO
  79.  EXIT
  80. $REWIND BO
  81. $ASSIGN BI=BO
  82. $EXECUTE M4EDIT
  83.  LIB UL
  84.  EDIT MAIN BI
  85.  WEOF BO
  86.  EXIT
  87. $REWIND BO
  88. $ASSIGN BI=BO
  89. $EXECUTE TOC
  90.  FILE %3
  91.  OVERLAY KERMIT
  92.  CATALOG
  93.  EXIT
  94. $ENDDO
  95. <<< bufemp. >>>
  96.       SUBROUTINE BUFEMP(BUFFER,LEN)
  97. C
  98. C     ****************************************************************
  99. C
  100. C              KERMIT for the MODCOMP MAXIV operating system
  101. C
  102. C        Compliments of:
  103. C
  104. C                         SETPOINT, Inc.
  105. C                      10245 Brecksville Rd.
  106. C                      Brecksville, Ohio 44141
  107. C
  108. C
  109. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  110. C      of this version hereby grant permission to copy this software
  111. C      provided that it is not used for an explicitly commercial
  112. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  113. C      no warranty whatsoever regarding the accuracy of this package
  114. C      and will assume no liability resulting from it's use.
  115. C
  116. C     ****************************************************************
  117. C
  118. C     Abstract:  RECOVERS CONTROL CHARACTERS, STRIPS LINE FEEDS, AND
  119. C                CALLS DPUTCH TO WRITE OUT TO DISK
  120. C
  121. C     MODIFICATION HISTORY
  122. C
  123. C     BY            DATE     REASON            PROGRAMS AFFECTED
  124. C
  125. C     ****************************************************************
  126. C
  127. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  128. C
  129. C     Calling Parameters:
  130. C
  131. C     R    BUFFER       - Data to be written to disk
  132. C     R    LEN          - Number of bytes to be written
  133. C
  134. C     ****************************************************************
  135. C
  136. C     Messages generated by this module :  None
  137. C
  138. C     ****************************************************************
  139. C
  140. C     Subroutines called directly :  CTL, DPUTCH
  141. C
  142. C     ****************************************************************
  143. C
  144. C     Files referenced :  None
  145. C
  146. C     ****************************************************************
  147. C
  148. C     Local variable definitions :
  149. C
  150. C     CH     - UFT FOR THE DISK FILE
  151. C
  152. C     ****************************************************************
  153. C
  154. C     Commons referenced :  KER, KERPAR
  155. C
  156. C     ****************************************************************
  157. C
  158. C     (*$END.DOCUMENT*)
  159. C
  160. C     ****************************************************************
  161. C     *                                                              *
  162. C     *         D I M E N S I O N   S T A T E M E N T S              *
  163. C     *                                                              *
  164. C     ****************************************************************
  165. C
  166.       IMPLICIT INTEGER (A-Z)
  167.       INTEGER*2   BUFFER(132)
  168. C
  169. C     ****************************************************************
  170. C     *                                                              *
  171. C     *         T Y P E   S T A T E M E N T S                        *
  172. C     *                                                              *
  173. C     ****************************************************************
  174. C
  175. C
  176. C     ****************************************************************
  177. C     *                                                              *
  178. C     *         C O M M O N   S T A T E M E N T S                    *
  179. C     *                                                              *
  180. C     ****************************************************************
  181. C
  182.       INCLUDE USL/KERCOM
  183.       INCLUDE USL/KERPMC
  184. C
  185. C     ****************************************************************
  186. C     *                                                              *
  187. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  188. C     *                                                              *
  189. C     ****************************************************************
  190. C
  191. C
  192. C     ****************************************************************
  193. C     *                                                              *
  194. C     *         D A T A   S T A T E M E N T S                        *
  195. C     *                                                              *
  196. C     ****************************************************************
  197. C
  198. C
  199. C     ****************************************************************
  200. C
  201. C     Code starts here :
  202. C                                     !UFT  OF RECEIVING DISK FILE
  203.       CH=8
  204. C                                     !START WITH THE VERY FIRST CHARACT
  205.       I=1
  206. C                                     !PUT LEN CHARACTERS INTO DISK FILE
  207.   100 CONTINUE
  208.       IF(I.GT.LEN) GO TO 9000
  209. C                                     !GET THE NEXT CHARACTER FROM BUFFE
  210.          T=BUFFER(I)
  211. C                                     !IS THIS MY QUOTE CHARACTER
  212.          IF(T.NE.MYQUOTE)GO TO 200
  213. C                                     !INCREMENT THE COUNTER
  214.             I=I+1
  215. C                                     !GET NEXT CHARACTER FROM BUFFER
  216.             T=BUFFER(I)
  217. C                                     !IS THIS QUOTE CHARACTER THE
  218.             IF(T.NE.MYQUOTE)T=CTL(T)
  219. C                                     !ACTUAL QUOTE CHARACTER
  220.   200    CONTINUE
  221. C                                     !FILTER OUT LF
  222.          IF(T.NE.LF)CALL DPUTCH(T,CH)
  223.          I=I+1
  224.          GO TO 100
  225. C
  226.  9000 CONTINUE
  227.       RETURN
  228.       END
  229. <<< bufill. >>>
  230.       INTEGER FUNCTION BUFILL (BUFFER)
  231. C
  232. C     ****************************************************************
  233. C
  234. C              KERMIT for the MODCOMP MAXIV operating system
  235. C
  236. C        Compliments of:
  237. C
  238. C                         SETPOINT, Inc.
  239. C                      10245 Brecksville Rd.
  240. C                      Brecksville, Ohio 44141
  241. C
  242. C
  243. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  244. C      of this version hereby grant permission to copy this software
  245. C      provided that it is not used for an explicitly commercial
  246. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  247. C      no warranty whatsoever regarding the accuracy of this package
  248. C      and will assume no liability resulting from it's use.
  249. C
  250. C     ****************************************************************
  251. C
  252. C     Abstract:  Fill up the buffer with character bytes from the
  253. C                sending disk file.
  254. C
  255. C     MODIFICATION HISTORY
  256. C
  257. C     BY            DATE     REASON            PROGRAMS AFFECTED
  258. C
  259. C
  260. C     ****************************************************************
  261. C
  262. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  263. C
  264. C     Calling Parameters:
  265. C
  266. C     R    BUFFER       - Data array to be filled from the disk file
  267. C
  268. C     ****************************************************************
  269. C
  270. C     Messages generated by this module :  None
  271. C
  272. C     ****************************************************************
  273. C
  274. C     Subroutines called directly : CTL, DGETCH
  275. C
  276. C     ****************************************************************
  277. C
  278. C     Files referenced :  None
  279. C
  280. C     ****************************************************************
  281. C
  282. C     Local variable definitions :
  283. C
  284. C     ****************************************************************
  285. C
  286. C     Commons referenced :  KER, KERPAR
  287. C
  288. C     ****************************************************************
  289. C
  290. C     (*$END.DOCUMENT*)
  291. C
  292. C     ****************************************************************
  293. C     *                                                              *
  294. C     *         D I M E N S I O N   S T A T E M E N T S              *
  295. C     *                                                              *
  296. C     ****************************************************************
  297. C
  298.       IMPLICIT INTEGER (A-Z)
  299. C
  300.       INTEGER*2   BUFFER(132)
  301. C
  302. C     ****************************************************************
  303. C     *                                                              *
  304. C     *         T Y P E   S T A T E M E N T S                        *
  305. C     *                                                              *
  306. C     ****************************************************************
  307. C
  308. C
  309. C     ****************************************************************
  310. C     *                                                              *
  311. C     *         C O M M O N   S T A T E M E N T S                    *
  312. C     *                                                              *
  313. C     ****************************************************************
  314. C
  315.       INCLUDE USL/KERCOM
  316.       INCLUDE USL/KERPMC
  317. C
  318. C     ****************************************************************
  319. C     *                                                              *
  320. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  321. C     *                                                              *
  322. C     ****************************************************************
  323. C
  324. C
  325. C     ****************************************************************
  326. C     *                                                              *
  327. C     *         D A T A   S T A T E M E N T S                        *
  328. C     *                                                              *
  329. C     ****************************************************************
  330. C
  331. C
  332. C     ****************************************************************
  333. C
  334. C     Code starts here :
  335. C
  336.       I=1
  337. C                                          !FILE DESCRIPTOR OF THE SENDING
  338. C                                          !DISK FILE
  339.       CH=7
  340.   100 CONTINUE
  341.       IF ((DGETCH(T,CH).EQ.EOF))GO TO 1000
  342. C                                          !KEEP READING BYTE FROM THE DISK
  343. C                                          !FILE UNTIL WE REACH AN EOF,OR
  344. C                                          !WE HAVE ENOUGH BYTE TO FILL
  345. C                                          !BUFFER
  346.          IF((T.GE.BLANK).AND.(T.NE.DEL).AND.(T.NE.QUOTE))GO TO 800
  347. C                                          !IT IS THE LINE DELIMITER OF
  348. C                                          !THIS SYSTEM, INSERT THE LF
  349. C                                          !BEFORE THE CR
  350.              IF(T.NE.LF)GO TO 700
  351.                 BUFFER(I)=QUOTE
  352.                 I=I+1
  353.                 BUFFER(I)=CTL(CR)
  354.                 I=I+1
  355.   700        CONTINUE
  356. C                                          !WE GOT A QUOTE CHARACTER
  357.              BUFFER(I)=QUOTE
  358.              I=I+1
  359.              IF(T.NE.QUOTE)T=CTL(T)
  360.   800    CONTINUE
  361.          BUFFER(I)=T
  362.          I=I+1
  363. C                                    !READ UP TO SPSIZ-8 BYTE FROM DISK
  364.          IF(I.LE.(SPSIZ-8))GO TO 900
  365. C                                    !I BYTE WAS READ
  366.             BUFILL=I-1
  367.             RETURN
  368.   900    CONTINUE
  369. C
  370.          GO TO 100
  371. C
  372.  1000 CONTINUE
  373. C
  374.       IF(I.NE.1)GO TO 1100
  375. C                                    !ZERO BYTE WAS READ
  376.         BUFILL=EOF
  377.         RETURN
  378.  1100 CONTINUE
  379. C                                    !PARTIAL EOF WAS DETECTED
  380.         BUFILL=I-1
  381.         RETURN
  382.       END
  383. <<< cltoc. >>>
  384. $PROD CLTOC KERMIT KER LMU NONE
  385. $ASS USL %2 SI USL SO SO
  386. $POS %1
  387. $IF %4=NONE,P/$EXE FR5,,$23,$4E,NOLO,NOMAP
  388. $IFN %4=NONE,P/$EXE FR5,,$23,$4E
  389. $WEO SO
  390. $REW SO
  391. $ASS SI SO BI BI BO BO
  392. $EXE M5A,,NOLO,NOSC
  393. $WEO BO
  394. $REW BO
  395. $ASS BI BO
  396. $IF %4=NONE,P/$EXE M4EDIT,,NOMAP;$EXE M4EDIT
  397.  ASS UL ULC
  398.  LIB UL
  399.  EDIT MAIN BI
  400.  EXIT
  401. $WEO BO
  402. $REW BO
  403. $ASS BI BO
  404. $EXE TOC
  405.  FIL %3
  406.  NOVERIFY
  407.  OVER %1
  408.  CAT
  409.  EXIT
  410. $ENDDO
  411. <<< ctl. >>>
  412.       INTEGER FUNCTION CTL (T)
  413. C
  414. C     ****************************************************************
  415. C
  416. C              KERMIT for the MODCOMP MAXIV operating system
  417. C
  418. C        Compliments of:
  419. C
  420. C                         SETPOINT, Inc.
  421. C                      10245 Brecksville Rd.
  422. C                      Brecksville, Ohio 44141
  423. C
  424. C
  425. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  426. C      of this version hereby grant permission to copy this software
  427. C      provided that it is not used for an explicitly commercial
  428. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  429. C      no warranty whatsoever regarding the accuracy of this package
  430. C      and will assume no liability resulting from it's use.
  431. C
  432. C     ****************************************************************
  433. C
  434. C     Abstract:  Toggle the control bit of an ASCII character
  435. C                so that a CTRL-A becomes an A and vice versa.
  436. C
  437. C     MODIFICATION HISTORY
  438. C
  439. C     BY            DATE     REASON            PROGRAMS AFFECTED
  440. C
  441. C
  442. C     ****************************************************************
  443. C
  444. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  445. C
  446. C     Calling Parameters:
  447. C
  448. C     R    T    -     CHARACTER TO TOGGLE
  449. C
  450. C     ****************************************************************
  451. C
  452. C     Messages generated by this module :  None
  453. C
  454. C     ****************************************************************
  455. C
  456. C     Subroutines called directly :  None
  457. C
  458. C     ****************************************************************
  459. C
  460. C     Files referenced :  None
  461. C
  462. C     ****************************************************************
  463. C
  464. C     Local variable definitions :  None
  465. C
  466. C     ****************************************************************
  467. C
  468. C     Commons referenced :  None
  469. C
  470. C     ****************************************************************
  471. C
  472. C     (*$END.DOCUMENT*)
  473. C
  474. C     ****************************************************************
  475. C     *                                                              *
  476. C     *         D I M E N S I O N   S T A T E M E N T S              *
  477. C     *                                                              *
  478. C     ****************************************************************
  479. C
  480.       IMPLICIT INTEGER (A-Z)
  481. C
  482. C     ****************************************************************
  483. C     *                                                              *
  484. C     *         T Y P E   S T A T E M E N T S                        *
  485. C     *                                                              *
  486. C     ****************************************************************
  487. C
  488. C
  489. C     ****************************************************************
  490. C     *                                                              *
  491. C     *         C O M M O N   S T A T E M E N T S                    *
  492. C     *                                                              *
  493. C     ****************************************************************
  494. C
  495. C
  496. C     ****************************************************************
  497. C     *                                                              *
  498. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  499. C     *                                                              *
  500. C     ****************************************************************
  501. C
  502. C
  503. C     ****************************************************************
  504. C     *                                                              *
  505. C     *         D A T A   S T A T E M E N T S                        *
  506. C     *                                                              *
  507. C     ****************************************************************
  508. C
  509. C
  510. C     ****************************************************************
  511. C
  512. C     Code starts here :
  513. C
  514. C----->  Do an exclusive OR on the control bit which is
  515. C----->  the seventh bit.
  516. C
  517.       CTL=IEOR(T,64)
  518.       RETURN
  519.       END
  520. <<< ctoi. >>>
  521.       INTEGER FUNCTION CTOI(IN, I)
  522. C
  523. C     ****************************************************************
  524. C
  525. C              KERMIT for the MODCOMP MAXIV operating system
  526. C
  527. C        Compliments of:
  528. C
  529. C                         SETPOINT, Inc.
  530. C                      10245 Brecksville Rd.
  531. C                      Brecksville, Ohio 44141
  532. C
  533. C
  534. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  535. C      of this version hereby grant permission to copy this software
  536. C      provided that it is not used for an explicitly commercial
  537. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  538. C      no warranty whatsoever regarding the accuracy of this package
  539. C      and will assume no liability resulting from it's use.
  540. C
  541. C     ****************************************************************
  542. C
  543. C     Abstract: CONVERT ASCII TO BINARY INTEGER
  544. C
  545. C     MODIFICATION HISTORY
  546. C
  547. C     BY            DATE     REASON            PROGRAMS AFFECTED
  548. C
  549. C     ****************************************************************
  550. C
  551. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  552. C
  553. C     Calling Parameters:
  554. C
  555. C     R    IN      - INPUT ASCII STRING
  556. C     R    I       - POSITION IN STRING TO START CONVERSION
  557. C
  558. C     ****************************************************************
  559. C
  560. C     Messages generated by this module :  None
  561. C
  562. C     ****************************************************************
  563. C
  564. C     Subroutines called directly :  None
  565. C
  566. C     ****************************************************************
  567. C
  568. C     Files referenced :  None
  569. C
  570. C     ****************************************************************
  571. C
  572. C     Local variable definitions :
  573. C
  574. C     S            - Sign flag indicator
  575. C
  576. C     ****************************************************************
  577. C
  578. C     Commons referenced :  KERPAR local common
  579. C
  580. C     ****************************************************************
  581. C
  582. C     (*$END.DOCUMENT*)
  583. C
  584. C     ****************************************************************
  585. C     *                                                              *
  586. C     *         D I M E N S I O N   S T A T E M E N T S              *
  587. C     *                                                              *
  588. C     ****************************************************************
  589. C
  590.       IMPLICIT INTEGER (A-Z)
  591.       INTEGER*2   IN(1)
  592. C
  593. C     ****************************************************************
  594. C     *                                                              *
  595. C     *         T Y P E   S T A T E M E N T S                        *
  596. C     *                                                              *
  597. C     ****************************************************************
  598. C
  599. C
  600. C     ****************************************************************
  601. C     *                                                              *
  602. C     *         C O M M O N   S T A T E M E N T S                    *
  603. C     *                                                              *
  604. C     ****************************************************************
  605. C
  606.       INCLUDE USL/KERPMC
  607. C
  608. C     ****************************************************************
  609. C     *                                                              *
  610. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  611. C     *                                                              *
  612. C     ****************************************************************
  613. C
  614. C
  615. C     ****************************************************************
  616. C     *                                                              *
  617. C     *         D A T A   S T A T E M E N T S                        *
  618. C     *                                                              *
  619. C     ****************************************************************
  620. C
  621. C
  622. C     ****************************************************************
  623. C
  624. C     Code starts here :
  625. C
  626. 23000 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23001
  627.       I = I + 1
  628.       GOTO 23000
  629. 23001 CONTINUE
  630.       IF(.NOT.(IN(I) .EQ. 45 .OR. IN(I) .EQ. 43))GOTO 23002
  631.       S = IN(I)
  632.       I = I + 1
  633.       GOTO 23003
  634. 23002 CONTINUE
  635.       S = 0
  636. 23003 CONTINUE
  637.       CTOI = 0
  638. 23004 IF(.NOT.(IN(I) .NE. 10002))GOTO 23006
  639.       IF(.NOT.(IN(I) .LT. 48 .OR. IN(I) .GT. 57))GOTO 23007
  640.       GOTO 23006
  641. 23007 CONTINUE
  642.       CTOI = 10 * CTOI + IN(I) - 48
  643. 23005 I = I + 1
  644.       GOTO 23004
  645. 23006 CONTINUE
  646.       IF(.NOT.(S .EQ. 45))GOTO 23009
  647.       CTOI = -CTOI
  648. 23009 CONTINUE
  649.       RETURN
  650.       END
  651. <<< dgetch. >>>
  652.       INTEGER FUNCTION DGETCH (XCHAR,CH)
  653. C
  654. C     ****************************************************************
  655. C
  656. C              KERMIT for the MODCOMP MAXIV operating system
  657. C
  658. C        Compliments of:
  659. C
  660. C                         SETPOINT, Inc.
  661. C                      10245 Brecksville Rd.
  662. C                      Brecksville, Ohio 44141
  663. C
  664. C
  665. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  666. C      of this version hereby grant permission to copy this software
  667. C      provided that it is not used for an explicitly commercial
  668. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  669. C      no warranty whatsoever regarding the accuracy of this package
  670. C      and will assume no liability resulting from it's use.
  671. C
  672. C     ****************************************************************
  673. C
  674. C     Abstract:  Get a character from the disk file
  675. C
  676. C     MODIFICATION HISTORY
  677. C
  678. C     BY            DATE     REASON            PROGRAMS AFFECTED
  679. C
  680. C
  681. C     ****************************************************************
  682. C
  683. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  684. C
  685. C     Calling Parameters:
  686. C
  687. C     W    XCHAR        - THE CHARACTER YOU GOT
  688. C     R    CH           - THE CHANNEL TO READ ON
  689. C
  690. C     ****************************************************************
  691. C
  692. C     Messages generated by this module :  None
  693. C
  694. C     ****************************************************************
  695. C
  696. C     Subroutines called directly :  DGETLIN
  697. C
  698. C     ****************************************************************
  699. C
  700. C     Files referenced :  None
  701. C
  702. C     ****************************************************************
  703. C
  704. C     Local variable definitions :
  705. C
  706. C     ****************************************************************
  707. C
  708. C     Commons referenced :  XBYTE and KER local commons
  709. C
  710. C     ****************************************************************
  711. C
  712. C     (*$END.DOCUMENT*)
  713. C
  714. C     ****************************************************************
  715. C     *                                                              *
  716. C     *         D I M E N S I O N   S T A T E M E N T S              *
  717. C     *                                                              *
  718. C     ****************************************************************
  719. C
  720.       IMPLICIT INTEGER*2 (A-Z)
  721. C
  722. C     ****************************************************************
  723. C     *                                                              *
  724. C     *         T Y P E   S T A T E M E N T S                        *
  725. C     *                                                              *
  726. C     ****************************************************************
  727. C
  728. C
  729. C     ****************************************************************
  730. C     *                                                              *
  731. C     *         C O M M O N   S T A T E M E N T S                    *
  732. C     *                                                              *
  733. C     ****************************************************************
  734. C
  735.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  736.       INCLUDE USL/KERPMC
  737. C
  738. C     ****************************************************************
  739. C     *                                                              *
  740. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  741. C     *                                                              *
  742. C     ****************************************************************
  743. C
  744. C
  745. C     ****************************************************************
  746. C     *                                                              *
  747. C     *         D A T A   S T A T E M E N T S                        *
  748. C     *                                                              *
  749. C     ****************************************************************
  750. C
  751. C
  752. C     ****************************************************************
  753. C
  754. C     Code starts here :
  755. C
  756.       IF(XEOF.NE.YES)GO TO 100
  757.          DGETCH=EOF
  758.          RETURN
  759.   100 CONTINUE
  760.       IF(XNEW.NE.YES)GO TO 1000
  761.          X=DGETLIN(XLIN,CH)
  762.          IF(X.NE.EOF)GO TO 800
  763.             DGETCH=EOF
  764.             XEOF=YES
  765.             RETURN
  766.   800    CONTINUE
  767.             IF(XLIN(1).NE.LF)GO TO 900
  768.                XNEW=YES
  769.                DGETCH=OK
  770.                XCHAR=LF
  771.                RETURN
  772.   900       CONTINUE
  773.                XNEW=NO
  774.                DGETCH=OK
  775.                XCHAR=XLIN(1)
  776.                XCOUNT=2
  777.                RETURN
  778.  1000 CONTINUE
  779.           IF(XLIN(XCOUNT).NE.LF)GO TO 1100
  780.              XNEW=YES
  781.              DGETCH=OK
  782.              XCHAR=LF
  783.              RETURN
  784.  1100      CONTINUE
  785.               DGETCH=OK
  786.               XCHAR=XLIN(XCOUNT)
  787.               XCOUNT=XCOUNT+1
  788.               RETURN
  789.       END
  790. <<< dgetli. >>>
  791.       INTEGER FUNCTION DGETLI (ALIN,CH)
  792. C
  793. C     ****************************************************************
  794. C
  795. C              KERMIT for the MODCOMP MAXIV operating system
  796. C
  797. C        Compliments of:
  798. C
  799. C                         SETPOINT, Inc.
  800. C                      10245 Brecksville Rd.
  801. C                      Brecksville, Ohio 44141
  802. C
  803. C
  804. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  805. C      of this version hereby grant permission to copy this software
  806. C      provided that it is not used for an explicitly commercial
  807. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  808. C      no warranty whatsoever regarding the accuracy of this package
  809. C      and will assume no liability resulting from it's use.
  810. C
  811. C     ****************************************************************
  812. C
  813. C     Abstract:  Get a line of compressed source from a disk file and
  814. C                uncompress the line, unpack it (convert to 1 char
  815. C                per word) and put a CR/EOS after the last nonblank
  816. C                character.
  817. C
  818. C     MODIFICATION HISTORY
  819. C
  820. C     BY            DATE     REASON            PROGRAMS AFFECTED
  821. C
  822. C     ****************************************************************
  823. C
  824. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  825. C
  826. C     Calling Parameters:
  827. C
  828. C     W    ALIN         - Line of text to be returned to the caller
  829. C     R    CH           - UFT number to be used for the read
  830. C
  831. C     ****************************************************************
  832. C
  833. C     Messages generated by this module :  None
  834. C
  835. C     ****************************************************************
  836. C
  837. C     Subroutines called directly :  CMR4, IAND, ISHFT
  838. C
  839. C     ****************************************************************
  840. C
  841. C     Files referenced :  None
  842. C
  843. C     ****************************************************************
  844. C
  845. C     Local variable definitions :
  846. C
  847. C     ACOUNT       - Index variable for return array
  848. C     I            - Index variable
  849. C     IEND         - End-of-file indicator
  850. C     LEN          - Length of uncompressed source line
  851. C     MLEFT        - Mask used to extract left byte of a word
  852. C     MRIGHT       - Mask used to extract right byte of a word
  853. C     CLIN(132)    - Uncompressed source read from disk
  854. C
  855. C     ****************************************************************
  856. C
  857. C     Commons referenced :  KERPAR and UFTTBL local commons
  858. C
  859. C     ****************************************************************
  860. C
  861. C     (*$END.DOCUMENT*)
  862. C
  863. C     ****************************************************************
  864. C     *                                                              *
  865. C     *         D I M E N S I O N   S T A T E M E N T S              *
  866. C     *                                                              *
  867. C     ****************************************************************
  868. C
  869.       IMPLICIT INTEGER (A-Z)
  870.       INTEGER*2   ALIN(132),   CLIN(132)
  871. C
  872. C     ****************************************************************
  873. C     *                                                              *
  874. C     *         T Y P E   S T A T E M E N T S                        *
  875. C     *                                                              *
  876. C     ****************************************************************
  877. C
  878. C
  879. C     ****************************************************************
  880. C     *                                                              *
  881. C     *         C O M M O N   S T A T E M E N T S                    *
  882. C     *                                                              *
  883. C     ****************************************************************
  884. C
  885.       INCLUDE USL/KERPMC
  886. C
  887.       INCLUDE USL/UFTTBC
  888. C
  889. C     ****************************************************************
  890. C     *                                                              *
  891. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  892. C     *                                                              *
  893. C     ****************************************************************
  894. C
  895. C
  896. C     ****************************************************************
  897. C     *                                                              *
  898. C     *         D A T A   S T A T E M E N T S                        *
  899. C     *                                                              *
  900. C     ****************************************************************
  901. C
  902.       DATA        MLEFT /Z7F00/,            MRIGHT /Z007F/
  903. C
  904. C     ****************************************************************
  905. C
  906. C     Code starts here :
  907. C
  908.       DO 10 I = 1,132
  909.       ALIN(I) = 0
  910.       CLIN(I) = 0
  911.    10 CONTINUE
  912. C
  913. C----->  Read compressed source from the current file position.
  914. C
  915.       CALL CMR4 (CLIN,IEND,LEN)
  916.       IF (IEND .EQ. 1) GO TO 20
  917.       DGETLI = EOF
  918.       RETURN
  919.    20 CONTINUE
  920. C
  921. C----->  Loop to expand the data to 1 byte per word.
  922. C
  923.       DO 30 I = 1,65
  924.       ACOUNT = I * 2
  925.       ALIN(ACOUNT-1) = ISHFT (IAND (CLIN(I),MLEFT),-8)
  926.       ALIN(ACOUNT) = IAND (CLIN(I),MRIGHT)
  927.    30 CONTINUE
  928. C
  929. C----->  Remove any trailing blanks.
  930. C
  931.       DO 40 I=1,130
  932.       ACOUNT = 131 - I
  933.       IF (ALIN(ACOUNT) .NE.     0 .AND.
  934.      >    ALIN(ACOUNT) .NE. BLANK      ) GO TO 50
  935.    40 CONTINUE
  936.       ACOUNT = 0
  937.    50 CONTINUE
  938. C
  939. C----->  Add LF and EOS at the end.
  940. C
  941.       ALIN(ACOUNT+1) = LF
  942.       ALIN(ACOUNT+2) = EOS
  943.       DGETLI = OK
  944.       RETURN
  945.       END
  946. <<< dofr5. >>>
  947. $PROD DOFR5,,USL,NONE,NOLO,NO,MAP,NOBLK,DIRUL
  948. $IFN %1=HELP,P/$GOTO NOHELP
  949. $NOP
  950. $NOP  ** COMPILE A FORTRAN MODULE AND PLACE OBJECT IN A UL LIBRARY.
  951. $NOP  ** ARG 1 - NAME OF PROGRAM TO BE COMPILED
  952. $NOP  ** ARG 2 - FILE CONTAINING PROGRAM (DEF. %2)
  953. $NOP  ** ARG 3 - LIST OPTION FOR FR5 (DEF. %3)
  954. $NOP  ** ARG 4 - LIST OPTION FOR M5A  (DEF. %4)
  955. $NOP  ** ARG 5 - FILE TO BE USED FOR UL (DEF. %5)
  956. $NOP  ** ARG 6 - IS EXTRA COMPILE OPTION (DEF. %6)
  957. $NOP  ** ARG 7 - IS BLKD IF BLOCK DATA TO DELETE ALSO (DEF. %7)
  958. $NOP  ** ARG 8 - IS DIRUL IF DIRECTORIZED UL (DEF. %8)
  959. $NOP  ** EXAMPLE - $DOFR5 NAME,BSL,LO,,ULU
  960. $NOP
  961. $ENDDO
  962. $TAG NOHELP
  963. $IF %2=SI,7
  964. $ASS USL %2
  965. $IFM %1,5
  966. $EXE SED
  967. ASS SI USL
  968. POS %1
  969. EXI
  970. $REW SO
  971. $NOTE    COMPILING %1 FROM %2 TO %5
  972. $IF %3=NONE,P/$EXE FR5,,NOLO,NOMAP,$23,$4E
  973. $IFN %3=NONE,P/$EXE FR5,,%6,%3,$23,$4E
  974. $WEO SO
  975. $ASS SI SO BO SCA
  976. $REW SI BO
  977. $EXE M5A,,%4,NOSC
  978. $WEO BO
  979. $IF %5=NO,P/$GOTO NOUL
  980. $IFN %8=DIRUL,P/$GOTO NODIR
  981. $ASS SI SCA UL %5
  982. $REW SI
  983. $EXE LIB,,NOLO
  984. REC %1
  985. $IF %7=BLKD,P/REC B:%1
  986. EXIT
  987. $TAG NOUL
  988. $ASS BI BI BO BO
  989. $ENDDO
  990. $TAG NODIR
  991. $ASS SI SCA BI %5 BO SC
  992. $REW BI BO SI
  993. $EXE LIB,,NOLO
  994. LNA
  995. ADD 0
  996. DEL %1
  997. $IF %7=BLKD,P/DEL BLK:D
  998. COP
  999. ASS BI SC BO %5
  1000. REW BI BO
  1001. COP
  1002. EXI
  1003. $ASS BI BI BO BO
  1004. <<< dom5a. >>>
  1005. $PROD DOM5A,,USL,NOLO,NO,DIRUL
  1006. $IFN %1=HELP,P/$GOTO NOHELP
  1007. $NOP
  1008. $NOP  ** PROCEDURE TO ASSEMBLE A SOURCE MODULE AND PLACE
  1009. $NOP  ** IN AN OBJECT LIBRARY.
  1010. $NOP
  1011. $NOP  ** ARG 1 - NAME OF PROGRAM TO BE ASSEMBLED
  1012. $NOP  ** ARG 2 - FILE CONTAINING PROGRAM (DEF. %2)
  1013. $NOP  ** ARG 3 - LISTING OPTION FOR M5A (DEF. %3)
  1014. $NOP  ** ARG 4 - FILE TO BE USED FOR UL (DEF. %4)
  1015. $NOP  ** ARG 5 - UL FILE DIRECTORIZED FLAG (DEF.)%5)
  1016. $NOP
  1017. $NOP  ** EXAMPLE - $DOM5A,NAME,BSL,LO,ULU
  1018. $ENDDO
  1019. $TAG NOHELP
  1020. $ASS USL %2
  1021. $IFM %1,4
  1022. $EXE SED
  1023.  ASS SI USL
  1024.  POS %1
  1025.  EXI
  1026. $ASS  BO SCA
  1027. $REW  BO
  1028. $NOTE     ASSEMBLING %1 FROM %2 TO %4
  1029. $EXE M5A,,%3,NOSC
  1030. $WEO BO
  1031. $IFN %5=DIRUL,P/$GOTO NODIR
  1032. $ASS SI SCA UL %4
  1033. $REW SI
  1034. $EXE LIB,,NOLO
  1035.  REC %1
  1036.  EXIT
  1037. $ASS BI BI BO BO SI SI
  1038. $ENDDO
  1039. $TAG NODIR
  1040. $ASS SI SCA BI %4 BO SC
  1041. $REW BI BO SI
  1042. $EXE LIB,,NOLO
  1043. LNA
  1044. ADD 0
  1045. DEL %1
  1046. COP
  1047. ASS BI SC BO %4
  1048. REW BI BO
  1049. COP
  1050. EXI
  1051. $ASS BI BI BO BO
  1052. <<< dputch. >>>
  1053.       SUBROUTINE DPUTCH (XCHAR,CH)
  1054. C
  1055. C     ****************************************************************
  1056. C
  1057. C              KERMIT for the MODCOMP MAXIV operating system
  1058. C
  1059. C        Compliments of:
  1060. C
  1061. C                         SETPOINT, Inc.
  1062. C                      10245 Brecksville Rd.
  1063. C                      Brecksville, Ohio 44141
  1064. C
  1065. C
  1066. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  1067. C      of this version hereby grant permission to copy this software
  1068. C      provided that it is not used for an explicitly commercial
  1069. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  1070. C      no warranty whatsoever regarding the accuracy of this package
  1071. C      and will assume no liability resulting from it's use.
  1072. C
  1073. C     ****************************************************************
  1074. C
  1075. C     Abstract: STUFFS CHARACTERS INTO ARRAY FOR OUTPUT UNTIL IT
  1076. C               REACHES A <CR> WHEN IT WRITES OUT THE LINE
  1077. C
  1078. C     MODIFICATION HISTORY
  1079. C
  1080. C     BY            DATE     REASON            PROGRAMS AFFECTED
  1081. C
  1082. C
  1083. C     ****************************************************************
  1084. C
  1085. C     Author: BOB BORGESON          Version:  A.0   Date: Oct-86
  1086. C
  1087. C     Calling Parameters:
  1088. C
  1089. C     R    XCHAR        - THE LATEST CHARACTER TO PUT IN ARRAY
  1090. C     R    CH           - UFT FOR THE DISK FILE
  1091. C
  1092. C     ****************************************************************
  1093. C
  1094. C     Messages generated by this module :  None
  1095. C
  1096. C     ****************************************************************
  1097. C
  1098. C     Subroutines called directly :  DPUTLI
  1099. C
  1100. C     ****************************************************************
  1101. C
  1102. C     Files referenced :  None
  1103. C
  1104. C     ****************************************************************
  1105. C
  1106. C     Local variable definitions :
  1107. C
  1108. C     ****************************************************************
  1109. C
  1110. C     Commons referenced :  KERPAR and XBYTE local commons
  1111. C
  1112. C     ****************************************************************
  1113. C
  1114. C     (*$END.DOCUMENT*)
  1115. C
  1116. C     ****************************************************************
  1117. C     *                                                              *
  1118. C     *         D I M E N S I O N   S T A T E M E N T S              *
  1119. C     *                                                              *
  1120. C     ****************************************************************
  1121. C
  1122.       IMPLICIT INTEGER (A-Z)
  1123. C
  1124. C     ****************************************************************
  1125. C     *                                                              *
  1126. C     *         T Y P E   S T A T E M E N T S                        *
  1127. C     *                                                              *
  1128. C     ****************************************************************
  1129. C
  1130. C
  1131. C     ****************************************************************
  1132. C     *                                                              *
  1133. C     *         C O M M O N   S T A T E M E N T S                    *
  1134. C     *                                                              *
  1135. C     ****************************************************************
  1136. C
  1137.       INCLUDE USL/KERPMC
  1138. C
  1139.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  1140. C
  1141. C     ****************************************************************
  1142. C     *                                                              *
  1143. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  1144. C     *                                                              *
  1145. C     ****************************************************************
  1146. C
  1147. C
  1148. C     ****************************************************************
  1149. C     *                                                              *
  1150. C     *         D A T A   S T A T E M E N T S                        *
  1151. C     *                                                              *
  1152. C     ****************************************************************
  1153. C
  1154. C
  1155. C     ****************************************************************
  1156. C
  1157. C     Code starts here :
  1158. C
  1159.       IF(XCHAR.NE.CR)GO TO 100
  1160.          XLIN(XCOUNT)=LF
  1161.          XLIN(XCOUNT+1)=EOS
  1162.          CALL DPUTLIN(XLIN,CH)
  1163.          XCOUNT=1
  1164.          RETURN
  1165.   100 CONTINUE
  1166.           XLIN(XCOUNT)=XCHAR
  1167.           XCOUNT=XCOUNT+1
  1168.       RETURN
  1169.       END
  1170. <<< dputli. >>>
  1171.       SUBROUTINE DPUTLI (ALIN,CH)
  1172. C
  1173. C     ****************************************************************
  1174. C
  1175. C              KERMIT for the MODCOMP MAXIV operating system
  1176. C
  1177. C        Compliments of:
  1178. C
  1179. C                         SETPOINT, Inc.
  1180. C                      10245 Brecksville Rd.
  1181. C                      Brecksville, Ohio 44141
  1182. C
  1183. C
  1184. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  1185. C      of this version hereby grant permission to copy this software
  1186. C      provided that it is not used for an explicitly commercial
  1187. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  1188. C      no warranty whatsoever regarding the accuracy of this package
  1189. C      and will assume no liability resulting from it's use.
  1190. C
  1191. C     ****************************************************************
  1192. C
  1193. C     Abstract:  Write ALIN to a disk file.
  1194. C
  1195. C     MODIFICATION HISTORY
  1196. C
  1197. C     BY            DATE     REASON            PROGRAMS AFFECTED
  1198. C
  1199. C     ****************************************************************
  1200. C
  1201. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  1202. C
  1203. C     Calling Parameters:
  1204. C
  1205. C     R    ALIN         - Unpacked input line to be written to disk
  1206. C     R    CH           - This argument is unused, but is kept for
  1207. C                         compatibility purposes
  1208. C
  1209. C     ****************************************************************
  1210. C
  1211. C     Messages generated by this module :  None
  1212. C
  1213. C     ****************************************************************
  1214. C
  1215. C     Subroutines called directly :  CMW4, PACK
  1216. C
  1217. C     ****************************************************************
  1218. C
  1219. C     Files referenced :  None
  1220. C
  1221. C     ****************************************************************
  1222. C
  1223. C     Local variable definitions :
  1224. C
  1225. C     I            - Index variable
  1226. C     CLIN(65)     - Uncompress, packed ASCII array to be written
  1227. C
  1228. C     ****************************************************************
  1229. C
  1230. C     Commons referenced :  None
  1231. C
  1232. C     ****************************************************************
  1233. C
  1234. C     (*$END.DOCUMENT*)
  1235. C
  1236. C     ****************************************************************
  1237. C     *                                                              *
  1238. C     *         D I M E N S I O N   S T A T E M E N T S              *
  1239. C     *                                                              *
  1240. C     ****************************************************************
  1241. C
  1242.       IMPLICIT INTEGER (A-Z)
  1243.       INTEGER*2   ALIN(132),   CLIN(65)
  1244. C
  1245. C     ****************************************************************
  1246. C     *                                                              *
  1247. C     *         T Y P E   S T A T E M E N T S                        *
  1248. C     *                                                              *
  1249. C     ****************************************************************
  1250. C
  1251. C
  1252. C     ****************************************************************
  1253. C     *                                                              *
  1254. C     *         C O M M O N   S T A T E M E N T S                    *
  1255. C     *                                                              *
  1256. C     ****************************************************************
  1257. C
  1258. C
  1259. C     ****************************************************************
  1260. C     *                                                              *
  1261. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  1262. C     *                                                              *
  1263. C     ****************************************************************
  1264. C
  1265. C
  1266. C     ****************************************************************
  1267. C     *                                                              *
  1268. C     *         D A T A   S T A T E M E N T S                        *
  1269. C     *                                                              *
  1270. C     ****************************************************************
  1271. C
  1272. C
  1273. C     ****************************************************************
  1274. C
  1275. C     Code starts here :
  1276. C
  1277.       DO 10 I=1,65
  1278.       CLIN(I) = 4Z2020
  1279.    10 CONTINUE
  1280.       CALL PACK (ALIN,CLIN)
  1281.       CALL CMW4 (CLIN)
  1282.       RETURN
  1283.       END
  1284. <<< findln. >>>
  1285.       INTEGER FUNCTION FINDLN (LIN,APAT,A1,Z1)
  1286. C
  1287. C     ****************************************************************
  1288. C
  1289. C              KERMIT for the MODCOMP MAXIV operating system
  1290. C
  1291. C        Compliments of:
  1292. C
  1293. C                         SETPOINT, Inc.
  1294. C                      10245 Brecksville Rd.
  1295. C                      Brecksville, Ohio 44141
  1296. C
  1297. C
  1298. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  1299. C      of this version hereby grant permission to copy this software
  1300. C      provided that it is not used for an explicitly commercial
  1301. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  1302. C      no warranty whatsoever regarding the accuracy of this package
  1303. C      and will assume no liability resulting from it's use.
  1304. C
  1305. C     ****************************************************************
  1306. C
  1307. C     Abstract:  This function will try to find the pattern within
  1308. C                a line.  It alse returns the value of where the
  1309. C                pattern begins and ends.
  1310. C
  1311. C     MODIFICATION HISTORY
  1312. C
  1313. C     BY            DATE     REASON            PROGRAMS AFFECTED
  1314. C
  1315. C     ****************************************************************
  1316. C
  1317. C     Author: Bob Borgeson          Version: A.0    Date: Aug-86
  1318. C
  1319. C     Calling Parameters:
  1320. C
  1321. C     R    LIN          - Array that holds the line to search
  1322. C     R    APAT         - Array that holds the pattern to search for
  1323. C     R/W  A1           - Initially tells this routine where to start
  1324. C                         looking for a match.  On return it tells the
  1325. C                         caller where the matched pattern begins.
  1326. C     W    Z1           - Tells the calling program where the matched
  1327. C                         pattern ends. EOS is not counted in the Z1
  1328. C                         value.
  1329. C     W    FINDLN       - Function value, = YES, pattern was found,
  1330. C                         = NO, pattern was not found.
  1331. C
  1332. C     ****************************************************************
  1333. C
  1334. C     Messages generated by this module :  None
  1335. C
  1336. C     ****************************************************************
  1337. C
  1338. C     Subroutines called directly : None
  1339. C
  1340. C     ****************************************************************
  1341. C
  1342. C     Files referenced :  None
  1343. C
  1344. C     ****************************************************************
  1345. C
  1346. C     Local variable definitions :
  1347. C
  1348. C     ****************************************************************
  1349. C
  1350. C     Commons referenced : KERPAR local common
  1351. C
  1352. C     ****************************************************************
  1353. C
  1354. C     (*$END.DOCUMENT*)
  1355. C
  1356. C     ****************************************************************
  1357. C     *                                                              *
  1358. C     *         D I M E N S I O N   S T A T E M E N T S              *
  1359. C     *                                                              *
  1360. C     ****************************************************************
  1361. C
  1362.       IMPLICIT INTEGER (A-Z)
  1363.       INTEGER   LIN(1),      APAT(1)
  1364. C
  1365. C     ****************************************************************
  1366. C     *                                                              *
  1367. C     *         T Y P E   S T A T E M E N T S                        *
  1368. C     *                                                              *
  1369. C     ****************************************************************
  1370. C
  1371. C
  1372. C     ****************************************************************
  1373. C     *                                                              *
  1374. C     *         C O M M O N   S T A T E M E N T S                    *
  1375. C     *                                                              *
  1376. C     ****************************************************************
  1377. C
  1378.       INCLUDE USL/KERPMC
  1379. C
  1380. C     ****************************************************************
  1381. C     *                                                              *
  1382. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  1383. C     *                                                              *
  1384. C     ****************************************************************
  1385. C
  1386. C
  1387. C     ****************************************************************
  1388. C     *                                                              *
  1389. C     *         D A T A   S T A T E M E N T S                        *
  1390. C     *                                                              *
  1391. C     ****************************************************************
  1392. C
  1393. C
  1394. C     ****************************************************************
  1395. C
  1396. C     Code starts here :
  1397. C
  1398. C----->  Assume no match will be found.
  1399. C
  1400.       FINDLN = NO
  1401.       T1=A1
  1402. C
  1403. C----->  Loop to find the next character in the command line
  1404. C----->  that matches the first character in the pattern.
  1405. C
  1406.    10 CONTINUE
  1407.       IF (LIN(T1) .EQ. APAT(1) .OR.
  1408.      >    LIN(T1) .EQ.     EOS     ) GO TO 20
  1409.       T1 = T1 + 1
  1410.       GO TO 10
  1411.    20 CONTINUE
  1412. C
  1413. C----->  If we found the end of the command line then
  1414. C----->  no match was found, so return to caller.
  1415. C
  1416.       IF (LIN(T1) .EQ. EOS) RETURN
  1417. C
  1418. C----->  We found a possible match, so loop through and compare
  1419. C----->  the next characters until a mismatch is found or the
  1420. C----->  pattern ends.
  1421. C
  1422.       A1 = T1
  1423.       T2 = 1
  1424.       T3 = T1
  1425.    30 CONTINUE
  1426.       IF (APAT(T2) .NE. LIN(T1) .OR.
  1427.      >    APAT(T2) .EQ.     EOS     ) GO TO 40
  1428.       T1 = T1 + 1
  1429.       T2 = T2 + 1
  1430.       GO TO 30
  1431.    40 CONTINUE
  1432. C
  1433. C----->  If the pattern is ended, then we have found a match,
  1434. C----->  if not go back and continue looking.
  1435. C
  1436.       IF (APAT(T2) .EQ. EOS) GO TO 50
  1437.       T1 = T3 + 1
  1438.       GO TO 10
  1439.    50 CONTINUE
  1440.       Z1 = T1 - 1
  1441.       FINDLN = YES
  1442.       RETURN
  1443.       END
  1444. <<< fxfile. >>>
  1445.       SUBROUTINE FXFILE(INNAM,OUTNAM,NCHRFX,IND)
  1446. C
  1447. C     ****************************************************************
  1448. C
  1449. C              KERMIT for the MODCOMP MAXIV operating system
  1450. C
  1451. C        Compliments of:
  1452. C
  1453. C                         SETPOINT, Inc.
  1454. C                      10245 Brecksville Rd.
  1455. C                      Brecksville, Ohio 44141
  1456. C
  1457. C
  1458. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  1459. C      of this version hereby grant permission to copy this software
  1460. C      provided that it is not used for an explicitly commercial
  1461. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  1462. C      no warranty whatsoever regarding the accuracy of this package
  1463. C      and will assume no liability resulting from it's use.
  1464. C
  1465. C     ****************************************************************
  1466. C
  1467. C     Abstract: FXFILE TRUNCATES THE FILE TO 8 CHARACTERS AND
  1468. C               REPLACES ANY NON CAN-CODABLE CHARACTER WITH A "$".
  1469. C
  1470. C     MODIFICATION HISTORY
  1471. C
  1472. C     BY            DATE     REASON            PROGRAMS AFFECTED
  1473. C
  1474. C     ****************************************************************
  1475. C
  1476. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  1477. C
  1478. C     Calling Parameters:
  1479. C
  1480. C     R    INNAM   - UNPACKED NAME TO BE FIXED
  1481. C     W    OUTNAM  - UNPACKED FIXED FILE NAME
  1482. C     R    NCHRFX  - # OF CHARACTERS TO CHECK (MAX = 8)
  1483. C     W    IND     - THE # OF CHARACTERS CONVERTED TO $
  1484. C
  1485. C     ****************************************************************
  1486. C
  1487. C     Messages generated by this module :  None
  1488. C
  1489. C     ****************************************************************
  1490. C
  1491. C     Subroutines called directly : None
  1492. C
  1493. C     ****************************************************************
  1494. C
  1495. C     Files referenced :  None
  1496. C
  1497. C
  1498. C     ****************************************************************
  1499. C
  1500. C     Local variable definitions :
  1501. C
  1502. C      CHAR - FLAG INDICATES AT LEAST 1 CHARACTER FOUND
  1503. C
  1504. C     ****************************************************************
  1505. C
  1506. C     Commons referenced : KER local common
  1507. C
  1508. C     ****************************************************************
  1509. C
  1510. C     (*$END.DOCUMENT*)
  1511. C
  1512. C     ****************************************************************
  1513. C     *                                                              *
  1514. C     *         D I M E N S I O N   S T A T E M E N T S              *
  1515. C     *                                                              *
  1516. C     ****************************************************************
  1517. C
  1518.       IMPLICIT INTEGER (A-Z)
  1519. C
  1520.       INTEGER*2   INNAM(1),    OUTNAM(1)
  1521. C
  1522. C     ****************************************************************
  1523. C     *                                                              *
  1524. C     *         T Y P E   S T A T E M E N T S                        *
  1525. C     *                                                              *
  1526. C     ****************************************************************
  1527. C
  1528. C     ****************************************************************
  1529. C     *                                                              *
  1530. C     *         C O M M O N   S T A T E M E N T S                    *
  1531. C     *                                                              *
  1532. C     ****************************************************************
  1533. C
  1534.       INCLUDE USL/KERCOM
  1535.       INCLUDE USL/KERPMC
  1536. C
  1537. C     ****************************************************************
  1538. C     *                                                              *
  1539. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  1540. C     *                                                              *
  1541. C     ****************************************************************
  1542. C
  1543. C
  1544. C     ****************************************************************
  1545. C     *                                                              *
  1546. C     *         D A T A   S T A T E M E N T S                        *
  1547. C     *                                                              *
  1548. C     ****************************************************************
  1549. C
  1550. C
  1551. C     ****************************************************************
  1552. C
  1553. C     Code starts here :
  1554. C
  1555.       IND = 0
  1556. C
  1557. C                             FILL OUTNAM WITH BLANKS
  1558. C
  1559.       DO 100 I = 1,8
  1560. C
  1561.         OUTNAM(I) = 4Z0020
  1562. C
  1563.   100 CONTINUE
  1564. C
  1565. C                             CHECK FOR CAN CODE CHARCTERS AND
  1566. C                             REPLACE NASTY ONES WITH "$"
  1567. C
  1568.       CHAR = 0
  1569. C
  1570.       IF(NCHRFX .GT. 8)NCHRFX = 8
  1571. C
  1572.       NCRFX1 = NCHRFX + 1
  1573. C
  1574.       DO 1000 J = 1,NCHRFX
  1575. C
  1576.         I = NCRFX1 - J
  1577. C
  1578.         IF((INNAM(I) .EQ. BLANK) .AND. (CHAR .EQ. 0))GO TO 300
  1579. C
  1580.         IF(((INNAM(I) .GE. BIGA) .AND. (INNAM(I) .LE. BIGZ)) .OR.
  1581.      >     ((INNAM(I) .GE. DIG0) .AND. (INNAM(I) .LE. DIG9)) .OR.
  1582.      >      (INNAM(I) .EQ. COLON)                            .OR.
  1583.      >      (INNAM(I) .EQ. PERIOD)                           .OR.
  1584.      >      (INNAM(I) .EQ. DOLLAR))GO TO 200
  1585. C
  1586.         OUTNAM(I) = DOLLAR
  1587.         IND = IND + 1
  1588.         CHAR = 1
  1589. C
  1590.         GO TO 1000
  1591. C
  1592.   200   CONTINUE
  1593. C
  1594.         OUTNAM(I) = INNAM(I)
  1595.         CHAR = 1
  1596.         GO TO 1000
  1597. C
  1598.   300   CONTINUE
  1599. C
  1600.         OUTNAM(I) = INNAM(I)
  1601. C
  1602.  1000 CONTINUE
  1603. C
  1604.  1100 CONTINUE
  1605. C
  1606.       RETURN
  1607.       END
  1608. <<< getlin. >>>
  1609.       INTEGER FUNCTION GETLIN (ALIN,CH)
  1610. C
  1611. C     ****************************************************************
  1612. C
  1613. C              KERMIT for the MODCOMP MAXIV operating system
  1614. C
  1615. C        Compliments of:
  1616. C
  1617. C                         SETPOINT, Inc.
  1618. C                      10245 Brecksville Rd.
  1619. C                      Brecksville, Ohio 44141
  1620. C
  1621. C
  1622. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  1623. C      of this version hereby grant permission to copy this software
  1624. C      provided that it is not used for an explicitly commercial
  1625. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  1626. C      no warranty whatsoever regarding the accuracy of this package
  1627. C      and will assume no liability resulting from it's use.
  1628. C
  1629. C     ****************************************************************
  1630. C
  1631. C     Abstract:  Read a line from the specified UFT and unpack the
  1632. C                bytes.
  1633. C
  1634. C     MODIFICATION HISTORY
  1635. C
  1636. C     BY            DATE     REASON            PROGRAMS AFFECTED
  1637. C
  1638. C     ****************************************************************
  1639. C
  1640. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  1641. C
  1642. C     Calling Parameters:
  1643. C
  1644. C     W    ALIN         - Line of input data to return to caller
  1645. C                         Each word contains 1 byte of data, right
  1646. C                         justified in the word.
  1647. C     R    CH           - UFT number to use for the read;
  1648. C                         2 = user's terminal
  1649. C
  1650. C     ****************************************************************
  1651. C
  1652. C     Messages generated by this module :  None
  1653. C
  1654. C     ****************************************************************
  1655. C
  1656. C     Subroutines called directly :  IAND, ISHFT, READ4, WAIT
  1657. C
  1658. C     ****************************************************************
  1659. C
  1660. C     Files referenced :  None
  1661. C
  1662. C     ****************************************************************
  1663. C
  1664. C     Local variable definitions :
  1665. C
  1666. C     ACOUNT       - Index counter for ALIN array.
  1667. C     BCOUNT       - Index counter for BLIN array.
  1668. C     I            - Index variable
  1669. C     LEFT         - Flag to indicate that the left byte should be
  1670. C                    processed
  1671. C     MAXTRY       - # OF TIMES TO WAIT BEFORE TIMEOUT
  1672. C     MLEFT        - Mask to extract the left byte of a word
  1673. C     MRIGHT       - Mask to extract the right byte of a word
  1674. C     NSCH         - UFT # FOR BINARY READ
  1675. C     RIGHT        - Flag to indicate that the right byte should be
  1676. C                    processed
  1677. C     TRYTIM       - MAGNITUDE OF WAIT
  1678. C     TRYUNT       - TIME UNIT FOR WAIT (SECONDS,TICKS, ETC)
  1679. C     TV1          - Temporary variable
  1680. C     TV2          - Temporary variable
  1681. C     WHICHS       - Flag for which byte to extract
  1682. C     BLIN(132)    - Input line read from I/O device which is to
  1683. C                    be unpacked
  1684. C     LEOL         - OUR EOL CHAR SHIFTED TO MSB
  1685. C     UEOL         - BIT MASK CHOSEN TO SEARCH FOR EOL
  1686. C     OLDCHN       - STORAGE FOR OLD READ #
  1687. C     IPNT         - POINTER TO WORD WHERE WE EXPECT EOL
  1688. C     NTFLO        - # OF CHAR TO FOLLOW (SECOND BYTE OF PACKET)
  1689. C     TIMED        - FLAG FOR READ HAS TIMED OUT (IF = 1)
  1690. C
  1691. C     ****************************************************************
  1692. C
  1693. C     Commons referenced :  KERPAR and UFTTBL local commons
  1694. C
  1695. C     ****************************************************************
  1696. C
  1697. C     (*$END.DOCUMENT*)
  1698. C
  1699. C     ****************************************************************
  1700. C     *                                                              *
  1701. C     *         D I M E N S I O N   S T A T E M E N T S              *
  1702. C     *                                                              *
  1703. C     ****************************************************************
  1704. C
  1705.       IMPLICIT INTEGER (A-Z)
  1706.       INTEGER*2   ALIN(1)
  1707. C
  1708. C     ****************************************************************
  1709. C     *                                                              *
  1710. C     *         T Y P E   S T A T E M E N T S                        *
  1711. C     *                                                              *
  1712. C     ****************************************************************
  1713. C
  1714. C
  1715. C     ****************************************************************
  1716. C     *                                                              *
  1717. C     *         C O M M O N   S T A T E M E N T S                    *
  1718. C     *                                                              *
  1719. C     ****************************************************************
  1720. C
  1721.       INCLUDE USL/KERCOM
  1722. C
  1723.       INCLUDE USL/KERPMC
  1724. C
  1725.       INCLUDE USL/UFTTBC
  1726. C
  1727. C     ****************************************************************
  1728. C     *                                                              *
  1729. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  1730. C     *                                                              *
  1731. C     ****************************************************************
  1732. C
  1733. C
  1734. C     ****************************************************************
  1735. C     *                                                              *
  1736. C     *         D A T A   S T A T E M E N T S                        *
  1737. C     *                                                              *
  1738. C     ****************************************************************
  1739. C
  1740.       DATA        MLEFT /ZFF00/,            MRIGHT /Z00FF/
  1741.      >          , TRYTIM / 200 /
  1742.      >          , TRYUNT/ 1 /  ,            NSCH  / 10 /
  1743. C
  1744. C     ****************************************************************
  1745. C
  1746. C     Code starts here :
  1747. C
  1748. C----->  Initialize the line buffers.
  1749. C
  1750.       DO 10 I=1,132
  1751.       ALIN(I) = 0
  1752.    10 CONTINUE
  1753. C
  1754. C----->  Initialize some local variables.
  1755. C
  1756.       LEFT = 1
  1757.       RIGHT = 2
  1758.       WHICHS = LEFT
  1759.       ACOUNT = 1
  1760.       BCOUNT = 1
  1761.       LEOL = ISHFT(EOL,8)
  1762.       TIMED = 0
  1763. C
  1764. C---->    ALL INPUT IS ON UFT 4
  1765. C
  1766.       UFT = 4
  1767. C
  1768. C----->  Get the input line and check for an EOF event.
  1769. C
  1770.       DO 1000 I = 1,20
  1771. C
  1772. C----->        IF NO CHARACTERS HAVE BEEN READ , LOOP
  1773. C
  1774.         IF(IAND(IUFT(1,UFT),8) .NE. 0)GO TO 950
  1775. C
  1776. C----->        GET # OF CHARACTERS TO FOLLOW IN PACKET + EOL
  1777. C
  1778.         NTFLO = UNCHAR(IAND(BLIN(1,CURCHN),MRIGHT)) + 1
  1779.         IF(NTFLO .EQ. -31)GO TO 950
  1780. C
  1781. C----->        CHOOSE BITMASK TO LOOK FOR EOL
  1782. C
  1783.         UEOL = LEOL
  1784.         IF(MOD(NTFLO,2).EQ.0)UEOL = EOL
  1785. C
  1786. C----->        CALCULATE WHICH WORD EOL SHOULD BE IN
  1787. C
  1788.         IPNT = (NTFLO + 1) / 2 + 1
  1789. C
  1790.         IF(IAND(BLIN(IPNT,CURCHN),UEOL) .EQ. UEOL)GO TO 15
  1791. C
  1792. C----->        PACKET IS NOT THERE (OR NOT COMPLETE) SO WAIT
  1793. C
  1794.   950   CONTINUE
  1795. C
  1796.         CALL WAIT(TRYTIM,TRYUNT,IND)
  1797. C
  1798.  1000 CONTINUE
  1799. C
  1800. C----->        WE HAVE TIMED OUT
  1801. C
  1802.       GETLIN = BAD
  1803.       TIMED = 1
  1804.       GO TO 1800
  1805. C
  1806.    15 CONTINUE
  1807. C
  1808. C----->        GOT A PACKET !!!
  1809. C
  1810. C
  1811. C     IF (IAND (IUFT(1,UFT),4Z0020) .NE. 0) GO TO 100
  1812. C
  1813. C----->       START NEW READ, TERMINATE OLD, AND UNPACK
  1814. C
  1815. C
  1816.  1800 CONTINUE
  1817. C
  1818.       IF(CURCHN .NE. 1)GO TO 2000
  1819. C
  1820.         DO 1900 I = 132
  1821. C
  1822.           BLIN(I,2) = 0
  1823. C
  1824.  1900   CONTINUE
  1825. C
  1826.         CALL TERMIN (IUFT(1,UFT),.FALSE.)
  1827.         CALL READ4(IUFT(1,UFT),BLIN(1,2),132,.FALSE.)
  1828.         OLDCHN = CURCHN
  1829.         CURCHN = 2
  1830.         IF(TIMED .EQ. 1)RETURN
  1831.         GO TO 20
  1832. C
  1833.  2000 CONTINUE
  1834. C
  1835.         DO 2100 I = 1,132
  1836. C
  1837.           BLIN(I,1) = 0
  1838. C
  1839.  2100   CONTINUE
  1840.         CALL TERMIN (IUFT(1,UFT),.FALSE.)
  1841.         CALL READ4(IUFT(1,UFT),BLIN(1,1),132,.FALSE.)
  1842.         OLDCHN = CURCHN
  1843.         CURCHN = 1
  1844.         IF(TIMED .EQ. 1)RETURN
  1845. C
  1846. C----->  Unpack the input line.
  1847. C
  1848.    20 CONTINUE
  1849.       IF (WHICHS .NE. RIGHT) GO TO 40
  1850. C
  1851. C----->  Move a char in the right byte of BLIN to a word in ALIN,
  1852. C----->  unless we are finished processing the input line.
  1853. C
  1854.       TV1 = IAND (BLIN(BCOUNT,OLDCHN),MRIGHT)
  1855.       IF (TV1 .NE. 0) GO TO 30
  1856.       ALIN(ACOUNT) = LF
  1857.       ALIN(ACOUNT+1) = EOS
  1858.       GETLIN = OK
  1859.       RETURN
  1860.    30 CONTINUE
  1861.       ALIN(ACOUNT) = TV1
  1862.       ACOUNT = ACOUNT + 1
  1863.       BCOUNT = BCOUNT + 1
  1864.       WHICHS = LEFT
  1865.    40 CONTINUE
  1866. C
  1867. C----->  Move a char in the left byte of BLIN to a word in ALIN,
  1868. C----->  unless we are finished processing the input line.
  1869. C
  1870.       TV1 = IAND (BLIN(BCOUNT,OLDCHN),MLEFT)
  1871.       TV2 = ISHFT (TV1,-8)
  1872.       IF (TV2 .NE. 0) GO TO 50
  1873.       ALIN(ACOUNT) = LF
  1874.       ALIN(ACOUNT+1) = EOS
  1875.       GETLIN = OK
  1876.       RETURN
  1877.    50 CONTINUE
  1878.       ALIN(ACOUNT) = TV2
  1879.       WHICHS = RIGHT
  1880.       ACOUNT = ACOUNT + 1
  1881.    60 CONTINUE
  1882.       GO TO 20
  1883.   100 CONTINUE
  1884.       GETLIN = EOF
  1885.       RETURN
  1886.       END
  1887. <<< kercmp. >>>
  1888. $PROC KERCMP
  1889. $FR5ULC BUFEMP,KER
  1890. $FR5ULC BUFILL,KER
  1891. $FR5ULC CTL,KER
  1892. $FR5ULC CTOI,KER
  1893. $FR5ULC DGETCH,KER
  1894. $FR5ULC DGETLI,KER
  1895. $FR5ULC DPUTCH,KER
  1896. $FR5ULC DPUTLIN,KER
  1897. $FR5ULC FINDLN,KER
  1898. $FR5ULC GETLIN,KER
  1899. $FR5ULC IBMGETLI,KER
  1900. $FR5ULC PACK,KER
  1901. $FR5ULC PARSER,KER
  1902. $M5AUL POSUSL,KER,NOLO,ULC
  1903. $FR5ULC PUTLIN,KER
  1904. $FR5ULC RDATA,KER
  1905. $FR5ULC RECSW,KER
  1906. $FR5ULC RFILE,KER
  1907. $FR5ULC RINIT,KER
  1908. $FR5ULC RPACK,KER
  1909. $FR5ULC RPAR,KER
  1910. $FR5ULC SBREAK,KER
  1911. $FR5ULC SCOPY,KER
  1912. $FR5ULC SDATA,KER
  1913. $FR5ULC SDUMMY,KER
  1914. $FR5ULC SENDSW,KER
  1915. $FR5ULC SEOF,KER
  1916. $FR5ULC SFILE,KER
  1917. $FR5ULC SHELP,KER
  1918. $FR5ULC SINIT,KER
  1919. $FR5ULC SKIPBL,KER
  1920. $FR5ULC SPACK,KER
  1921. $FR5ULC SPAR,KER
  1922. $FR5ULC SRECEIVE,KER
  1923. $FR5ULC SSEND,KER
  1924. $FR5ULC SSET,KER
  1925. $FR5ULC SSTATUS,KER
  1926. $FR5ULC SQUIT,KER
  1927. $FR5ULC TOCHAR,KER
  1928. $FR5ULC TGETCH,KER
  1929. $FR5ULC TPUTCH,KER
  1930. $FR5ULC UFTINI,KER
  1931. $FR5ULC UNCHAR,KER
  1932. $FR5ULC UPPER,KER
  1933. $FR5ULC XDELAY,KER
  1934. $CLTOC KERMIT KER LMU
  1935. <<< kercom. >>>
  1936. C
  1937. C----->  Kermit local common
  1938. C
  1939.       COMMON /KER/ DELAY,      EOL,         ESCHAR,      FD,
  1940.      >             FILNAM(132),HOSTON,      IBMON,       LOCALI,
  1941.      >             LOCALO,     LOCALS,      MAXTRY,      MOREFD,
  1942.      >             MYEOL,      MYPAD,       MYPCHA,      MYQUOT,
  1943.      >             N,          NUMTRY,      OLDTRY,      PACKET(132),
  1944.      >             PAD,        PADCHA,      PAKSIZ,      PARITY,
  1945.      >             PROMPT,     QUOTE,       RECPKT(132), RMTINFD,
  1946.      >             RMTOUT,     RMTTTY(132), RPSIZ,       SBAUD,
  1947.      >             SIZE,       SOH,         SPARITY,     SPEED,
  1948.      >             SPORT,      SPSIZ,       STATE,       SUSL
  1949. <<< kerdef. >>>
  1950. C     DEFINES VARIOUS CONSTANTS FOR THE KERMIT-HP1000 PROGRAM
  1951.       PARAMETER (ATSIGN=64)
  1952.       PARAMETER (BACKSLASH=92)
  1953.       PARAMETER (BACKSPACE=8)
  1954.       PARAMETER (BAD=-3)
  1955.       PARAMETER (BANG=33)
  1956.       PARAMETER (BAR=124)
  1957.       PARAMETER (BIGA=65)
  1958.       PARAMETER (BIGB=66)
  1959.       PARAMETER (BIGC=67)
  1960.       PARAMETER (BIGD=68)
  1961.       PARAMETER (BIGE=69)
  1962.       PARAMETER (BIGF=70)
  1963.       PARAMETER (BIGG=71)
  1964.       PARAMETER (BIGH=72)
  1965.       PARAMETER (BIGI=73)
  1966.       PARAMETER (BIGJ=74)
  1967.       PARAMETER (BIGK=75)
  1968.       PARAMETER (BIGL=76)
  1969.       PARAMETER (BIGM=77)
  1970.       PARAMETER (BIGN=78)
  1971.       PARAMETER (BIGO=79)
  1972.       PARAMETER (BIGP=80)
  1973.       PARAMETER (BIGQ=81)
  1974.       PARAMETER (BIGR=82)
  1975.       PARAMETER (BIGS=83)
  1976.       PARAMETER (BIGT=84)
  1977.       PARAMETER (BIGU=85)
  1978.       PARAMETER (BIGV=86)
  1979.       PARAMETER (BIGW=87)
  1980.       PARAMETER (BIGX=88)
  1981.       PARAMETER (BIGY=89)
  1982.       PARAMETER (BIGZ=90)
  1983.       PARAMETER (BLANK=32)
  1984.       PARAMETER (CARET=94)
  1985.       PARAMETER (COLON=58)
  1986.       PARAMETER (COMMA=44)
  1987.       PARAMETER (CR=13)
  1988.       PARAMETER (DEL=127)
  1989.       PARAMETER (DIG0=48)
  1990.       PARAMETER (DIG1=49)
  1991.       PARAMETER (DIG2=50)
  1992.       PARAMETER (DIG3=51)
  1993.       PARAMETER (DIG4=52)
  1994.       PARAMETER (DIG5=53)
  1995.       PARAMETER (DIG6=54)
  1996.       PARAMETER (DIG7=55)
  1997.       PARAMETER (DIG8=56)
  1998.       PARAMETER (DIG9=57)
  1999.       PARAMETER (DIGIT=2)
  2000.       PARAMETER (DOLLAR=36)
  2001.       PARAMETER (DQUOTE=34)
  2002.       PARAMETER (EOF=10003)
  2003.       PARAMETER (EOS=10002)
  2004.       PARAMETER (HUGE=30000)
  2005.       PARAMETER (LETA=97)
  2006.       PARAMETER (LETB=98)
  2007.       PARAMETER (LETC=99)
  2008.       PARAMETER (LETD=100)
  2009.       PARAMETER (LETE=101)
  2010.       PARAMETER (LETF=102)
  2011.       PARAMETER (LETG=103)
  2012.       PARAMETER (LETH=104)
  2013.       PARAMETER (LETI=105)
  2014.       PARAMETER (LETJ=106)
  2015.       PARAMETER (LETK=107)
  2016.       PARAMETER (LETL=108)
  2017.       PARAMETER (LETM=109)
  2018.       PARAMETER (LETN=110)
  2019.       PARAMETER (LETO=111)
  2020.       PARAMETER (LETP=112)
  2021.       PARAMETER (LETQ=113)
  2022.       PARAMETER (LETR=114)
  2023.       PARAMETER (LETS=115)
  2024.       PARAMETER (LETT=116)
  2025.       PARAMETER (LETU=117)
  2026.       PARAMETER (LETV=118)
  2027.       PARAMETER (LETW=119)
  2028.       PARAMETER (LETX=120)
  2029.       PARAMETER (LETY=121)
  2030.       PARAMETER (LETZ=122)
  2031.       PARAMETER (LF=10)
  2032.       PARAMETER (NO=0)
  2033.       PARAMETER (OK=-2)
  2034.       PARAMETER (PERCENT=37)
  2035.       PARAMETER (PERIOD=46)
  2036.       PARAMETER (PLUS=43)
  2037.       PARAMETER (QMARK=63)
  2038.       PARAMETER (SEMICOL=59)
  2039.       PARAMETER (SHARP=35)
  2040.       PARAMETER (SLASH=47)
  2041.       PARAMETER (SQUOTE=39)
  2042.       PARAMETER (STAR=42)
  2043.       PARAMETER (STDOUT=1)
  2044.       PARAMETER (TAB=9)
  2045.       PARAMETER (TILDE=126)
  2046.       PARAMETER (UNDERLINE=95)
  2047.       PARAMETER (YES=1)
  2048. <<< kermit. >>>
  2049.       PROGRAM KERMIT
  2050. C
  2051. C     ****************************************************************
  2052. C
  2053. C              KERMIT for the MODCOMP MAXIV operating system
  2054. C
  2055. C        Compliments of:
  2056. C
  2057. C                         SETPOINT, Inc.
  2058. C                      10245 Brecksville Rd.
  2059. C                      Brecksville, Ohio 44141
  2060. C
  2061. C
  2062. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  2063. C      of this version hereby grant permission to copy this software
  2064. C      provided that it is not used for an explicitly commercial
  2065. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  2066. C      no warranty whatsoever regarding the accuracy of this package
  2067. C      and will assume no liability resulting from it's use.
  2068. C
  2069. C
  2070. C     ****************************************************************
  2071. C
  2072. C     Abstract:  Kermit communications program for MODCOMP Classic
  2073. C                running MAX IV.  This program and all subroutines
  2074. C                were adapted from a version written by John Lee
  2075. C                of RCA Laboratories.  It was originally written in
  2076. C                FORTRAN 77 for an HP-1000 running RTE-6/VM.  The
  2077. C                bulk of the conversion effort related to removing
  2078. C                the FORTRAN 77 logic constructs, replacing the
  2079. C                RTE system calls with MAX IV system calls, and
  2080. C                modification of the data file I/O to conform to
  2081. C                the requirements of MAX IV.
  2082. C
  2083. C     MODIFICATION HISTORY
  2084. C
  2085. C     BY            DATE     REASON
  2086. C
  2087. C     ****************************************************************
  2088. C
  2089. C     Author:   Rick Burke             Version: A.0    Date: Aug-86
  2090. C
  2091. C     ****************************************************************
  2092. C
  2093. C     Messages generated by this module :  None
  2094. C
  2095. C     ****************************************************************
  2096. C
  2097. C     Subroutines called directly :  EXIT, PARSER, UFTINI
  2098. C
  2099. C     ****************************************************************
  2100. C
  2101. C     Files referenced :  None
  2102. C
  2103. C     ****************************************************************
  2104. C
  2105. C     Local variable definitions :
  2106. C
  2107. C     DELAY        - # of seconds waited before sending out the first
  2108. C                    SINIT packet (only in remote mode).
  2109. C     EOL          - End-of-line delimiter required by other Kermits.
  2110. C     ESCHAR       - The character used to return back to command parser
  2111. C                    from "chat" mode.
  2112. C     FILNAM(132)  - The integer array which holds the current working
  2113. C                    file name.
  2114. C     HOSTON       - Identifies whether this Kermit is running in local
  2115. C                    or "chat" mode.
  2116. C     LOCALI       - Local (TTY) input channel (login line)
  2117. C     LOCALO       - Local (TTY) output channel (login line)
  2118. C     MAXTRY       - Maximum number of retries before giving up
  2119. C     MYEOL        - The end-of-line delimiter selectable by users
  2120. C     MYPAD        - The # of pad characters required by this Kermit
  2121. C     MYPCHA       - The pad character required by this Kermit
  2122. C     MYQUOT       - The quote used for control-S by this Kermit
  2123. C                    This is selectable by the user
  2124. C     N            - The number of the current packet frame number
  2125. C     NUMTRY       - The number of retry attempts so far
  2126. C     OLDTRY       - The number of retries already attempted
  2127. C     PACKET(132)  - An integer array to hold the content of a packet
  2128. C     PAD          - The # of pad characters required by other Kermit
  2129. C     PADCHA       - The pad character to use, if required by other
  2130. C                    Kermit
  2131. C     PAKSIZ       - The maximum packet size selectable by users
  2132. C     PARITY       - One of five parity modes used in sending and
  2133. C                    receiving data (local mode only).  Only ODD,
  2134. C                    EVEN, and NONE are implemented.
  2135. C     PROMPT       - The turnaround control character this Kermit looks
  2136. C                    for in file transfer with IBM.
  2137. C     QUOTE        - The quote character used for control character used
  2138. C                    by the other Kermit.
  2139. C     RECPKT(132)  - An integer array which holds the imcoming packet
  2140. C     RMTINF       - The remote input channel
  2141. C     RMTOUT       - The remote output channel
  2142. C     RPSIZ        - Maximum size of packet to be received.
  2143. C     SBAUD        - Whether this system supports baud switching
  2144. C     SIZE         - Maximum size of data packet to be sent
  2145. C     SOH          - The start of header used in sending packet;
  2146. C                    selectable by the user
  2147. C     SPARIT       - Whether this system supports parity switching
  2148. C     SPEED        - Baud rate of the remote TTY line
  2149. C     SPORT        - Whether this system supports remote line switching
  2150. C     SPSIZ        - Maximum size of packet to be used for sending
  2151. C     STATE        - Current state of the file transfer process
  2152. C
  2153. C     ****************************************************************
  2154. C
  2155. C     Commons referenced :  KER and KERPAR local commons
  2156. C
  2157. C     ****************************************************************
  2158. C
  2159. C     (*$END.DOCUMENT*)
  2160. C
  2161. C     ****************************************************************
  2162. C     *                                                              *
  2163. C     *         D I M E N S I O N   S T A T E M E N T S              *
  2164. C     *                                                              *
  2165. C     ****************************************************************
  2166. C
  2167.       IMPLICIT INTEGER (A-Z)
  2168.       INTEGER*2   ALIN(132),   BLIN(132)
  2169. C
  2170. C     ****************************************************************
  2171. C     *                                                              *
  2172. C     *         T Y P E   S T A T E M E N T S                        *
  2173. C     *                                                              *
  2174. C     ****************************************************************
  2175. C
  2176. C
  2177. C     ****************************************************************
  2178. C     *                                                              *
  2179. C     *         C O M M O N   S T A T E M E N T S                    *
  2180. C     *                                                              *
  2181. C     ****************************************************************
  2182. C
  2183.       INCLUDE USL/KERCOM
  2184.       INCLUDE USL/KERPMC
  2185. C
  2186. C     ****************************************************************
  2187. C     *                                                              *
  2188. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  2189. C     *                                                              *
  2190. C     ****************************************************************
  2191. C
  2192. C
  2193. C     ****************************************************************
  2194. C     *                                                              *
  2195. C     *         D A T A   S T A T E M E N T S                        *
  2196. C     *                                                              *
  2197. C     ****************************************************************
  2198. C
  2199. C
  2200. C     ****************************************************************
  2201. C
  2202. C     Code starts here :
  2203. C
  2204. C----->  Set default parameters.
  2205. C
  2206.       DELAY = 10
  2207.       EOL = 13
  2208.       ESCHAR = 29
  2209.       IBMON = NO
  2210.       QUOTE = 35
  2211.       SOH = 1
  2212.       SPEED = 9600
  2213.       STATE = BIGC
  2214. C
  2215.       MAXTRY = 5
  2216.       MYEOL = 13
  2217.       MYPAD = 0
  2218.       MYPCHAR = 0
  2219.       MYQUOTE = 35
  2220.       PAD = 0
  2221.       PADCHAR = 0
  2222.       PAKSIZ  = 90
  2223. C
  2224. C----->  1=EVEN, 2=ODD 3=SPACE 4=MARK 5=NONE
  2225. C----->  MARK and SPACE not currently implemented.
  2226. C
  2227.       PARITY = 5
  2228. C
  2229. C----->  DC1, IBM mode only.
  2230. C
  2231.       PROMPT = 17
  2232. C
  2233. C----->  Disable all I/O port modifications.
  2234. C
  2235.       SPARITY = NO
  2236.       SBAUD = NO
  2237.       SPORT = NO
  2238. C
  2239. C----->  Initialize the UFTs.
  2240. C
  2241.       CALL UFTINI
  2242. C
  2243. C----->  Initialize UFT numbers for local terminal & Kermit I/O.
  2244. C
  2245.       LOCALO = 3@KE1
  2246.       LOCALI = 3@KE2
  2247.       RMTINF = 4
  2248.       RMTOUT = 3
  2249. C
  2250. C----->  Set default USL to current USL.
  2251. C
  2252.       SUSL = 3@USL
  2253. C
  2254.       WRITE (LOCALO,99)
  2255.       CALL PARSER
  2256.       CALL EXIT
  2257.    99 FORMAT(' MAX IV KERMIT VERSION 1.0')
  2258.       END
  2259.       BLOCK DATA
  2260.       IMPLICIT INTEGER (A-Z)
  2261.       INCLUDE USL/KERPMC
  2262.       INCLUDE USL/KERPMD
  2263.       END
  2264. <<< kermiv. >>>
  2265. $PROD KERMIV,CO,OC
  2266. $ASS KE1=CO KE2=OC KE3=%1 KE4=%2
  2267. $ASS KE5=SCB KE8=SCA KE9=SC KEH=BSL
  2268. $EXE KERMIT LMU
  2269. $WEO LO
  2270. $REW KE9
  2271. $ASS JC KE9
  2272. $STORE
  2273. $ASS JC JC
  2274. $ENDDO
  2275. <<< kerpmc. >>>
  2276.       COMMON /KERPAR/          ATSIGN,      BACKSL,      BACKSP,
  2277.      >            BAD,         BANG,        BAR,         BIGA,
  2278.      >            BIGB,        BIGC,        BIGD,        BIGE,
  2279.      >            BIGF,        BIGG,        BIGH,        BIGI,
  2280.      >            BIGJ,        BIGK,        BIGL,        BIGM,
  2281.      >            BIGN,        BIGO,        BIGP,        BIGQ,
  2282.      >            BIGR,        BIGS,        BIGT,        BIGU,
  2283.      >            BIGV,        BIGW,        BIGX,        BIGY,
  2284.      >            BIGZ,        BLANK,       CARET,       COLON,
  2285.      >            COMMA,       CR,          DEL,         DIG0,
  2286.      >            DIG1,        DIG2,        DIG3,        DIG4,
  2287.      >            DIG5,        DIG6,        DIG7,        DIG8,
  2288.      >            DIG9,        DIGIT,       DOLLAR,      DQUOTE,
  2289.      >            EOF,         EOS,         HUGE,        LETA,
  2290.      >            LETB,        LETC,        LETD,        LETE,
  2291.      >            LETF,        LETG,        LETH,        LETI,
  2292.      >            LETJ,        LETK,        LETL,        LETM,
  2293.      >            LETN,        LETO,        LETP,        LETQ,
  2294.      >            LETR,        LETS,        LETT,        LETU,
  2295.      >            LETV,        LETW,        LETX,        LETY,
  2296.      >            LETZ,        LF,          NO,          OK,
  2297.      >            PERCEN,      PERIOD,      PLUS,        QMARK,
  2298.      >            SEMICO,      SHARP,       SLASH,       SQUOTE,
  2299.      >            STAR,        STDOUT,      TAB,         TILDE,
  2300.      >            UNDERL,      YES
  2301. <<< kerpmd. >>>
  2302. C
  2303. C----->  Block data initialization for Kermit Parameters.
  2304. C
  2305.       DATA        ATSIGN /   64/,           BACKSL /   92/,
  2306.      >            BACKSP /    8/,           BAD    /   -3/,
  2307.      >            BANG   /   33/,           BAR    /  124/,
  2308.      >            BIGA   /   65/,           BIGB   /   66/,
  2309.      >            BIGC   /   67/,           BIGD   /   68/,
  2310.      >            BIGE   /   69/,           BIGF   /   70/,
  2311.      >            BIGG   /   71/,           BIGH   /   72/,
  2312.      >            BIGI   /   73/,           BIGJ   /   74/,
  2313.      >            BIGK   /   75/,           BIGL   /   76/,
  2314.      >            BIGM   /   77/,           BIGN   /   78/,
  2315.      >            BIGO   /   79/,           BIGP   /   80/,
  2316.      >            BIGQ   /   81/,           BIGR   /   82/,
  2317.      >            BIGS   /   83/,           BIGT   /   84/,
  2318.      >            BIGU   /   85/,           BIGV   /   86/,
  2319.      >            BIGW   /   87/,           BIGX   /   88/,
  2320.      >            BIGY   /   89/,           BIGZ   /   90/,
  2321.      >            BLANK  /   32/,           CARET  /   94/,
  2322.      >            COLON  /   58/,           COMMA  /   44/,
  2323.      >            CR     /   13/,           DEL    /  127/,
  2324.      >            DIG0   /   48/,           DIG1   /   49/,
  2325.      >            DIG2   /   50/,           DIG3   /   51/,
  2326.      >            DIG4   /   52/,           DIG5   /   53/,
  2327.      >            DIG6   /   54/,           DIG7   /   55/,
  2328.      >            DIG8   /   56/,           DIG9   /   57/,
  2329.      >            DIGIT  /    2/,           DOLLAR /   36/,
  2330.      >            DQUOTE /   34/,           EOF    /10003/,
  2331.      >            EOS    /10002/,           HUGE   /30000/,
  2332.      >            LETA   /   97/,           LETB   /   98/,
  2333.      >            LETC   /   99/,           LETD   /  100/,
  2334.      >            LETE   /  101/,           LETF   /  102/,
  2335.      >            LETG   /  103/,           LETH   /  104/,
  2336.      >            LETI   /  105/,           LETJ   /  106/,
  2337.      >            LETK   /  107/,           LETL   /  108/,
  2338.      >            LETM   /  109/,           LETN   /  110/,
  2339.      >            LETO   /  111/,           LETP   /  112/,
  2340.      >            LETQ   /  113/,           LETR   /  114/,
  2341.      >            LETS   /  115/,           LETT   /  116/,
  2342.      >            LETU   /  117/,           LETV   /  118/,
  2343.      >            LETW   /  119/,           LETX   /  120/,
  2344.      >            LETY   /  121/,           LETZ   /  122/,
  2345.      >            LF     /   10/,           NO     /    0/,
  2346.      >            OK     /   -2/,           PERCEN /   37/,
  2347.      >            PERIOD /   46/,           PLUS   /   43/,
  2348.      >            QMARK  /   63/,           SEMICO /   59/,
  2349.      >            SHARP  /   35/,           SLASH  /   47/,
  2350.      >            SQUOTE /   39/,           STAR   /   42/,
  2351.      >            STDOUT /    1/,           TAB    /    9/,
  2352.      >            TILDE  /  126/,           UNDERL /   95/,
  2353.      >            YES    /    1/
  2354. <<< lckermit. >>>
  2355. $PRODEFAULT LCKERMIT,NOM
  2356. $ASS BI ULC UL ULC
  2357. $LINK KERMIT,%1,ONE,2,,,,,,,,,,,,,,BLKD
  2358. $ASS BI BO
  2359. $REW BI BO
  2360. $TOCCAT KERMIT,LMU,OVER
  2361. $ENDDO
  2362. <<< pack. >>>
  2363.       SUBROUTINE PACK (ALIN,BLIN)
  2364. C
  2365. C     ****************************************************************
  2366. C
  2367. C              KERMIT for the MODCOMP MAXIV operating system
  2368. C
  2369. C        Compliments of:
  2370. C
  2371. C                         SETPOINT, Inc.
  2372. C                      10245 Brecksville Rd.
  2373. C                      Brecksville, Ohio 44141
  2374. C
  2375. C
  2376. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  2377. C      of this version hereby grant permission to copy this software
  2378. C      provided that it is not used for an explicitly commercial
  2379. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  2380. C      no warranty whatsoever regarding the accuracy of this package
  2381. C      and will assume no liability resulting from it's use.
  2382. C
  2383. C     ****************************************************************
  2384. C
  2385. C     Abstract:  Pack the INTEGER array ALIN into the array BLIN
  2386. C                with the right side of the byte ending with a
  2387. C                BLANK, in case there are an odd number of bytes.
  2388. C
  2389. C     MODIFICATION HISTORY
  2390. C
  2391. C     BY            DATE     REASON            PROGRAMS AFFECTED
  2392. C
  2393. C     ****************************************************************
  2394. C
  2395. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  2396. C
  2397. C     Calling Parameters:
  2398. C
  2399. C     R    ALIN         - Array to be packed
  2400. C     W    BLIN         - Packed array to be returned to the user
  2401. C
  2402. C     ****************************************************************
  2403. C
  2404. C     Messages generated by this module :  None
  2405. C
  2406. C     ****************************************************************
  2407. C
  2408. C     Subroutines called directly : IAND, IOR, ISHFT
  2409. C
  2410. C     ****************************************************************
  2411. C
  2412. C     Files referenced :  None
  2413. C
  2414. C     ****************************************************************
  2415. C
  2416. C     Local variable definitions :
  2417. C
  2418. C     ACOUNT       - Index pointer into ALIN
  2419. C     BCOUNT       - Index pointer into BLIN
  2420. C     LEFT         - Symbolic constant for LEFT byte
  2421. C     RIGHT        - Symbolic constant for RIGHT byte
  2422. C     WHICHS       - Indicator for left/right side to be processed
  2423. C
  2424. C     ****************************************************************
  2425. C
  2426. C     Commons referenced :  KERPAR local common
  2427. C
  2428. C     ****************************************************************
  2429. C
  2430. C     (*$END.DOCUMENT*)
  2431. C
  2432. C     ****************************************************************
  2433. C     *                                                              *
  2434. C     *         D I M E N S I O N   S T A T E M E N T S              *
  2435. C     *                                                              *
  2436. C     ****************************************************************
  2437. C
  2438.       IMPLICIT INTEGER (A-Z)
  2439.       INTEGER*2   ALIN(1),     BLIN(1)
  2440. C
  2441. C     ****************************************************************
  2442. C     *                                                              *
  2443. C     *         T Y P E   S T A T E M E N T S                        *
  2444. C     *                                                              *
  2445. C     ****************************************************************
  2446. C
  2447. C
  2448. C     ****************************************************************
  2449. C     *                                                              *
  2450. C     *         C O M M O N   S T A T E M E N T S                    *
  2451. C     *                                                              *
  2452. C     ****************************************************************
  2453. C
  2454.       INCLUDE USL/KERPMC
  2455. C
  2456. C     ****************************************************************
  2457. C     *                                                              *
  2458. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  2459. C     *                                                              *
  2460. C     ****************************************************************
  2461. C
  2462. C
  2463. C     ****************************************************************
  2464. C     *                                                              *
  2465. C     *         D A T A   S T A T E M E N T S                        *
  2466. C     *                                                              *
  2467. C     ****************************************************************
  2468. C
  2469.       DATA        LEFT /0/,    RIGHT /1/
  2470. C
  2471. C     ****************************************************************
  2472. C
  2473. C     Code starts here :
  2474. C
  2475.       WHICHS = LEFT
  2476.       ACOUNT = 1
  2477.       BCOUNT = 1
  2478. C
  2479.       BLIN(1) = 4Z2020
  2480.       IF (ALIN(ACOUNT) .EQ. LF) GO TO 40
  2481. C
  2482. C----->  Pack the output line, until LF char is reached.
  2483. C
  2484.    10 CONTINUE
  2485.       IF (WHICHS .NE. LEFT) GO TO 20
  2486.       BLIN(BCOUNT) = IOR (ISHFT (ALIN(ACOUNT),8),4Z0020)
  2487.       WHICHS = RIGHT
  2488.       GO TO 30
  2489.    20 CONTINUE
  2490.       BLIN(BCOUNT) = IOR (IAND (BLIN(BCOUNT),4ZFF00),ALIN(ACOUNT))
  2491.       BCOUNT = BCOUNT + 1
  2492.       WHICHS = LEFT
  2493.    30 CONTINUE
  2494.       ACOUNT = ACOUNT + 1
  2495.       IF (ALIN(ACOUNT) .NE. LF) GO TO 10
  2496.    40 CONTINUE
  2497.       RETURN
  2498.       END
  2499. <<< parser. >>>
  2500.       SUBROUTINE PARSER
  2501. C
  2502. C     ****************************************************************
  2503. C
  2504. C              KERMIT for the MODCOMP MAXIV operating system
  2505. C
  2506. C        Compliments of:
  2507. C
  2508. C                         SETPOINT, Inc.
  2509. C                      10245 Brecksville Rd.
  2510. C                      Brecksville, Ohio 44141
  2511. C
  2512. C
  2513. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  2514. C      of this version hereby grant permission to copy this software
  2515. C      provided that it is not used for an explicitly commercial
  2516. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  2517. C      no warranty whatsoever regarding the accuracy of this package
  2518. C      and will assume no liability resulting from it's use.
  2519. C
  2520. C     ****************************************************************
  2521. C
  2522. C     Abstract:  Main Command Parser
  2523. C
  2524. C     MODIFICATION HISTORY
  2525. C
  2526. C     BY            DATE     REASON            PROGRAMS AFFECTED
  2527. C
  2528. C     ****************************************************************
  2529. C
  2530. C     Author:  Rick Burke           Version: A.0    Date:  Aug-86
  2531. C
  2532. C     Calling Parameters:  None
  2533. C
  2534. C     ****************************************************************
  2535. C
  2536. C     Messages generated by this module :  None
  2537. C
  2538. C     ****************************************************************
  2539. C
  2540. C     Subroutines called directly :  IAND, ISHFT, READ4, SCONNE,
  2541. C                                    SHELP, SKIPBL, SQUIT, SRECEI,
  2542. C                                    SSEND, SSET, SSTATU, UPPER
  2543. C
  2544. C     ****************************************************************
  2545. C
  2546. C     Files referenced :  None
  2547. C
  2548. C     ****************************************************************
  2549. C
  2550. C     Local variable definitions :
  2551. C
  2552. C     ACOUNT       - Index variable into ALIN
  2553. C     CCOUNT       - Index variable into CLIN
  2554. C     CMDLEN       - Max length of each command in CMDTBL
  2555. C     FOUND        - Number of matches - 1 found in CMDTBL
  2556. C     I            - Index variable
  2557. C     IEND         - Number of chars in CLIN to search for the
  2558. C                    the end of the user-entered word
  2559. C     J            - Index variable
  2560. C     NDX          - Index variable
  2561. C     NUMCMD       - Number of commands in CMDTBL
  2562. C     TV1          - Temporary variable
  2563. C     WCHCMD       - Index into CMDTBL to command requested by the
  2564. C                    the user
  2565. C     ALIN(132)    - Command line entered by user
  2566. C     CLIN(132)    - Upper case command line entered by user
  2567. C     CMDTBL(8,8)  - Table of commands allowed by Kermit
  2568. C
  2569. C     ****************************************************************
  2570. C
  2571. C     Commons referenced : KER, KERPAR, and UFTTBL local commons
  2572. C
  2573. C     ****************************************************************
  2574. C
  2575. C     (*$END.DOCUMENT*)
  2576. C
  2577. C     ****************************************************************
  2578. C     *                                                              *
  2579. C     *         D I M E N S I O N   S T A T E M E N T S              *
  2580. C     *                                                              *
  2581. C     ****************************************************************
  2582. C
  2583.       IMPLICIT INTEGER (A-Z)
  2584.       INTEGER*2   CMDTBL(8,8)
  2585.       INTEGER*2   ALIN(132),   CLIN(132)
  2586. C
  2587. C     ****************************************************************
  2588. C     *                                                              *
  2589. C     *         T Y P E   S T A T E M E N T S                        *
  2590. C     *                                                              *
  2591. C     ****************************************************************
  2592. C
  2593. C
  2594. C     ****************************************************************
  2595. C     *                                                              *
  2596. C     *         C O M M O N   S T A T E M E N T S                    *
  2597. C     *                                                              *
  2598. C     ****************************************************************
  2599. C
  2600.       INCLUDE USL/KERCOM
  2601.       INCLUDE USL/KERPMC
  2602.       INCLUDE USL/UFTTBC
  2603. C
  2604. C     ****************************************************************
  2605. C     *                                                              *
  2606. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  2607. C     *                                                              *
  2608. C     ****************************************************************
  2609. C
  2610. C
  2611. C     ****************************************************************
  2612. C     *                                                              *
  2613. C     *         D A T A   S T A T E M E N T S                        *
  2614. C     *                                                              *
  2615. C     ****************************************************************
  2616. C
  2617. C----->  Implemented commands are:
  2618. C
  2619. C                 1) CONNECT - hooks to a dummy routine provided
  2620. C                 2) EXIT
  2621. C                 3) HELP
  2622. C                 4) QUIT
  2623. C                 5) RECEIVE
  2624. C                 6) SET
  2625. C                 7) SEND
  2626. C                 8) STATUS
  2627. C
  2628.       DATA        CMDTBL   /67,79,78,78,69,67,84,10002,
  2629.      >                      69,88,73,84,10002,0,0,0,
  2630.      >                      72,69,76,80,10002,0,0,0,
  2631.      >                      81,85,73,84,10002,0,0,0,
  2632.      >                      82,69,67,69,73,86,69,10002,
  2633.      >                      83,69,84,10002,0,0,0,0,
  2634.      >                      83,69,78,68,10002,0,0,0,
  2635.      >                      83,84,65,84,85,83,10002,0/
  2636.       DATA        NUMCMD /8/,  CMDLEN /8/
  2637. C
  2638. C     ****************************************************************
  2639. C
  2640. C     Code starts here :
  2641. C
  2642.    10 CONTINUE
  2643.       WRITE (LOCALO,1000)
  2644.  1000 FORMAT (' KERMIT MAXIV> ')
  2645. C
  2646. C----->  Read a line from the keyboard and convert it to
  2647. C----->  uppercase.
  2648. C
  2649.       DO 11 I=1,32
  2650.       ALIN(I) = 0
  2651.       CLIN(I) = 0
  2652.    11 CONTINUE
  2653.       CALL READ4 (IUFT(1,2),CLIN,132,.TRUE.)
  2654.       IF (IAND (IUFT(1,2),4Z0020) .NE. 0) CALL SQUIT
  2655. C
  2656. C----->  Unpack the line so the other character manipulation
  2657. C----->  routines will work.
  2658. C
  2659.       ACOUNT = 1
  2660.       CCOUNT = 1
  2661.    12 CONTINUE
  2662.       TV1 = ISHFT (CLIN(CCOUNT),-8)
  2663.       IF (TV1 .EQ. 0) GO TO 13
  2664.       ALIN(ACOUNT) = TV1
  2665.       ACOUNT = ACOUNT + 1
  2666.       TV1 = IAND (CLIN(CCOUNT),4Z00FF)
  2667.       IF (TV1 .EQ. 0) GO TO 13
  2668.       ALIN(ACOUNT) = TV1
  2669.       ACOUNT = ACOUNT + 1
  2670.       CCOUNT = CCOUNT + 1
  2671.       GO TO 12
  2672.    13 CONTINUE
  2673.       IF (ALIN(ACOUNT-1) .EQ. BLANK) ACOUNT = ACOUNT - 1
  2674.       ALIN(ACOUNT) = LF
  2675.       ALIN(ACOUNT+1) = EOS
  2676. C
  2677.       CALL UPPER (ALIN,CLIN)
  2678. C
  2679. C----->  Extract the first word in the command line and remove
  2680. C----->  any leading blanks.
  2681. C
  2682.       TV1 = 1
  2683.       CALL SKIPBL (CLIN,TV1)
  2684.       DO 20 I=1,132
  2685.       ALIN(I) = 0
  2686.    20 CONTINUE
  2687.       IEND = 81 - TV1
  2688.       DO 30 NDX=1,IEND
  2689.       ALIN(NDX) = CLIN(NDX+TV1-1)
  2690.       IF (ALIN(NDX) .EQ.   LF .OR.
  2691.      >    ALIN(NDX) .EQ. BLANK     ) GO TO 40
  2692.    30 CONTINUE
  2693.       NDX = IEND + 1
  2694.    40 CONTINUE
  2695.       ALIN(NDX) = LF
  2696.       ALIN(NDX+1) = EOS
  2697. C
  2698. C----->  Loop to compare word from command line to all commands.
  2699. C
  2700.       FOUND = -1
  2701.       WCHCMD = 0
  2702.       DO 70 J=1,NUMCMD
  2703.       DO 50 I=1,CMDLEN
  2704. C
  2705. C----->  Check for end of word. If end of word then we have a match.
  2706. C
  2707.       IF (ALIN(I) .EQ. LF) GO TO 60
  2708. C
  2709. C----->  Check for end of key word. If end of key word found then
  2710. C----->  we don't have a match.
  2711. C
  2712.       IF (CMDTBL(I,J) .EQ. EOS) GO TO 70
  2713. C
  2714. C----->  Compare the characters.
  2715. C
  2716.       IF (ALIN(I) .NE. CMDTBL(I,J)) GO TO 70
  2717.    50 CONTINUE
  2718.       GO TO 70
  2719.    60 CONTINUE
  2720. C
  2721. C----->  Here user's command matches a keyword, so remember which
  2722. C----->  command was matched and bump the counter for number of
  2723. C----->  matches found and loop back to check the next command.
  2724. C
  2725.       WCHCMD = J
  2726.       FOUND = FOUND + 1
  2727.    70 CONTINUE
  2728. C
  2729. C----->  Branch based on the number of matches found between the
  2730. C----->  user's command and the command table.
  2731. C
  2732.       IF (FOUND) 200,100,300
  2733.   100 CONTINUE
  2734. C
  2735. C----->  User's command matched only one keyword, so process it.
  2736. C
  2737.       GOTO (110,120,130,120,150,160,170,180),WCHCMD
  2738.   110 CONTINUE
  2739. C
  2740. C----->  CONNECT keyword.
  2741. C
  2742.       CALL SCONNE
  2743.       GO TO 10
  2744.   120 CONTINUE
  2745. C
  2746. C----->  EXIT keyword.
  2747. C
  2748.       CALL SQUIT
  2749.   130 CONTINUE
  2750. C
  2751. C----->  HELP keyword.
  2752. C
  2753.       CALL SHELP
  2754.       GO TO 10
  2755.   150 CONTINUE
  2756. C
  2757. C----->  RECEIVE keyword.
  2758. C
  2759.       CALL SRECEI
  2760.       GO TO 10
  2761.   160 CONTINUE
  2762. C
  2763. C----->  SET keyword.
  2764. C
  2765.       CALL SSET (CLIN(TV1+NDX-1))
  2766.       GO TO 10
  2767.   170 CONTINUE
  2768. C
  2769. C----->  SEND keyword.
  2770. C
  2771.       CALL SSEND (CLIN(TV1+NDX-1))
  2772.       GO TO 10
  2773.   180 CONTINUE
  2774. C
  2775. C----->  STATUS keyword.
  2776. C
  2777.       CALL SSTATU
  2778.       GO TO 10
  2779.   200 CONTINUE
  2780. C
  2781. C----->  User's command does not match any valid key word.
  2782. C
  2783.       WRITE (LOCALO,1010)
  2784.  1010 FORMAT (' UNRECOGNIZED COMMAND - TYPE "HELP"')
  2785.       GO TO 10
  2786.   300 CONTINUE
  2787. C
  2788. C----->  User's command word matches more than 1 valid keyword.
  2789. C
  2790.       WRITE (LOCALO,1020)
  2791.  1020 FORMAT (' AMBIGUOUS COMMAND - TYPE "HELP"')
  2792.       GO TO 10
  2793.   400 CONTINUE
  2794.       RETURN
  2795.       END
  2796. <<< posusl. >>>
  2797.           PGM         POSUSL
  2798.           INT         POSUSL
  2799. *
  2800. *         SUBROUTINE POSUSL (FILNUM,MEMBER,FOUND)
  2801. *
  2802. *     ****************************************************************
  2803. *
  2804. *              KERMIT for the MODCOMP MAXIV operating system
  2805. *
  2806. *        Compliments of:
  2807. *
  2808. *                         SETPOINT, Inc.
  2809. *                      10245 Brecksville Rd.
  2810. *                      Brecksville, Ohio 44141
  2811. *
  2812. *
  2813. *      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  2814. *      of this version hereby grant permission to copy this software
  2815. *      provided that it is not used for an explicitly commercial
  2816. *      purpose and that proper credit be given. SETPOINT, Inc. makes
  2817. *      no warranty whatsoever regarding the accuracy of this package
  2818. *      and will assume no liability resulting from it's use.
  2819. *
  2820. *     ****************************************************************
  2821. *
  2822. *     Abstract: Position a FORTRAN file to a SED directory entry.
  2823. *
  2824. *     MODIFICATION HISTORY
  2825. *
  2826. *     BY            DATE     REASON            PROGRAMS AFFECTED
  2827. *
  2828. *     ****************************************************************
  2829. *
  2830. *     Author:  Rick Burke           Version:  A.0   Date: Aug-86
  2831. *
  2832. *     Calling Parameters:
  2833. *
  2834. *     FILNUM       - Integer FORTRAN file number to be positioned
  2835. *                    If FILNUM < 1600 then it is assumed to be an
  2836. *                    integer FORTRAN logical unit number.  If it
  2837. *                    is >= 1600 it is assumed to be the CAN code
  2838. *                    of the logical device name.
  2839. *
  2840. *     MEMBER       - 8 character member name
  2841. *
  2842. *     FOUND        - Logical status for position,
  2843. *                    .TRUE.  = Successful
  2844. *                    .FALSE. = Error condition
  2845. *
  2846. *     ****************************************************************
  2847. *
  2848. *     Messages generated by this module :  None
  2849. *
  2850. *     ****************************************************************
  2851. *
  2852. *     Subroutines called directly : None
  2853. *
  2854. *     ****************************************************************
  2855. *
  2856. *     Files referenced :  None
  2857. *
  2858. *     ****************************************************************
  2859. *
  2860. *     Local variable definitions :
  2861. *
  2862. *     ATTACH       - Name of an attached USL directory
  2863. *     POSUFT       - UFT assigned to logical file containing
  2864. *                    requested entry
  2865. *     BUFFER       - Sector-sized file buffer
  2866. *
  2867. *     ****************************************************************
  2868. *
  2869. *     Commons referenced :  None
  2870. *
  2871. *     ****************************************************************
  2872. *
  2873. *     (*$END.DOCUMENT*)
  2874. *
  2875. *     ****************************************************************
  2876. *
  2877. *     Code starts here :
  2878. *
  2879. POSUSL    TRR,1,8                       SAVE LINKKAGE
  2880.           ADX,8,8                       GENERATE RETURN ADDRESS
  2881.           ABR,8,15                       *
  2882.           LDS,2,0                       CHECK ARGUMENT COUNT
  2883.           SBR,2,14                       *
  2884.           SBRB,2,15   BADARG             *
  2885.           LDS,9,3                       GET "FOUND" ADDRESS
  2886.           LDS,3,1                       GET FILE NUMBER
  2887.           LDX,3,3                        *
  2888.           HNS,FILNAM                    CHECK FILE NUMBER OR NAME
  2889.           CRI,3       #0640             CHECK FILE NUMBER / NAME
  2890.           HGE,FILNAM                     *
  2891.           REX,#3A                       CONVERT TO ASCII
  2892.           LLD,2,8                       REPOSIION
  2893.           REX,#37                       CONVERT TO CAN CODE
  2894.           DFC         RETURN            ERROR - BAD NUMBER
  2895. FILNAM    STM,3       POSUFT+1          PLACE IN UFT
  2896.           LDS,2,2                       GET MEMBER NAME ADDRESS
  2897.           LFX,2,2                       GET MEMBER NAME
  2898.           REX,#37                       CAN BYTES 1-3
  2899.           DFC         ERROR              *
  2900.           XOR,3,4                       SWAP R3 & R4
  2901.           XOR,4,3                        *
  2902.           XOR,3,4                        *
  2903.           LLD,2,8                       POSITION BYTES 4-6
  2904.           REX,#37                       CAN BYTES 4-6
  2905.           DFC         ERROR              *
  2906.           TRR,2,5                       GET BYTES 7-8
  2907.           TRR,5,3                       HOLD BYTES 4-6 IN R5
  2908.           LBR,3,2                       LAST BYTE IS SPACE
  2909.           REX,#37                       CAN BYTES 7-8
  2910.           DFC         ERROR              *
  2911.           TRR,6,3                       MOVE BYTES 7-8 TO R6
  2912.           LDI,2       POSUFT            LOAD UFT
  2913.           ZRR,3                         AND RESET IT
  2914.           STM,3,2     5                  *
  2915.           STM,3       ATTACH            AND RESET ATTACHED FILE
  2916.           REX,2                         REWIND INPUT FILE
  2917.           REX,0                         READ FIRST RECORD
  2918.           DFC         BUFFER             *
  2919.           DFC         256                *
  2920.           LDM,3       BUFFER            LOAD FIRST WORD
  2921.           ABRB,3,15   ERROR             CHECK DIRECTORY PRESENT
  2922.           LDM,3       BUFFER+2          GET # ENTRIES PER SECTOR
  2923. NXSCTR    LDI,1       BUFFER            LOAD BUFFER ADDRESS
  2924.           TRR,8,3                       NUMBER OF ENTRIES PER SECTOR
  2925. NXNTRY    LFS,12,2                      LOAD ENTRY NAME
  2926.           TRR,2,12                      CHECK END OF LIST
  2927.           ABRB,2,15   MORE               *
  2928. ERROR     GMR,2,15                      RETURN FOUND = .FALSE.
  2929. RETURN    STX,2,9                        *
  2930.           BRX,10                         *
  2931. MORE      CRI,12      #FEFE             CHECK FILE ENTRY
  2932.           HZR,CKNAME                     *
  2933.           STM,13      ATTACH            SAVE FILE ENTRY FILE NAME
  2934.           HOP,NOTIT                     AND KEEP CHECKING
  2935. CKNAME    CRRT,4,12                     CHECK NAME = MEMBER WANTED
  2936.           HZR,NOTIT                      *
  2937.           LDS,5,8                       LOAD SECTOR ADDRESS OF ENTRY
  2938.           LDM,2       ATTACH            CHECK USL FILE
  2939.           HZS,POSIT                      *
  2940.           STM,2       $+5               NO - ATTACHED FILE
  2941.           LDI,2       POSUFT            ASSIGN TO THE ATTACHED FILE
  2942.           REX,#A                         *
  2943.           DFC         $$                 *
  2944. POSIT     LDI,2       POSUFT            POSITION THE FILE
  2945.           STM,5,2     3                 SET THE RECORD POSITION
  2946.           REX,5                         ADVANCE RECORD
  2947.           REX,4                         BACKSPACE RECORD
  2948.           ZRR,2                         SET FOUND = .TRUE.
  2949.           HOP,RETURN                     *
  2950. NOTIT     ADI,1       9                 POINT TO NEXT ENTRY
  2951.           SBRB,8,15   NXNTRY            CHECK MORE ENTRIES
  2952.           LDM,2       BUFFER+1          LOAD NEXT SECTOR ADDRESS
  2953.           STM,2       POSUFT+3          NEXT SECTOR TO READ
  2954.           LDI,2       POSUFT            READ NEXT SECTOR
  2955.           REX,0                          *
  2956.           DFC         BUFFER             *
  2957.           DFC         256                *
  2958.           BRU         NXSCTR            GO SEARCH NEXT DIRECTORY SECTOR
  2959. BADARG    REX,#13                       ABORT
  2960.           DFC         @ARG              REASON = "ARG"
  2961. ATTACH    DFC         $$
  2962. POSUFT    DFC         0,$$,#A400,0,0,0
  2963. BUFFER    RES         128
  2964.           END
  2965. <<< rdata. >>>
  2966.       INTEGER FUNCTION RDATA (X)
  2967. C
  2968. C     ****************************************************************
  2969. C
  2970. C              KERMIT for the MODCOMP MAXIV operating system
  2971. C
  2972. C        Compliments of:
  2973. C
  2974. C                         SETPOINT, Inc.
  2975. C                      10245 Brecksville Rd.
  2976. C                      Brecksville, Ohio 44141
  2977. C
  2978. C
  2979. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  2980. C      of this version hereby grant permission to copy this software
  2981. C      provided that it is not used for an explicitly commercial
  2982. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  2983. C      no warranty whatsoever regarding the accuracy of this package
  2984. C      and will assume no liability resulting from it's use.
  2985. C
  2986. C     ****************************************************************
  2987. C
  2988. C     Abstract:  Read a data packet from the other KERMIT.
  2989. C
  2990. C     MODIFICATION HISTORY
  2991. C
  2992. C     BY            DATE     REASON            PROGRAMS AFFECTED
  2993. C
  2994. C     ****************************************************************
  2995. C
  2996. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  2997. C
  2998. C     Calling Parameters:
  2999. C
  3000. C           X           - JUNK VARIABLE NEEDED FOR FORTRAN
  3001. C
  3002. C     ****************************************************************
  3003. C
  3004. C     Messages generated by this module :  None
  3005. C
  3006. C     ****************************************************************
  3007. C
  3008. C     Subroutines called directly :  BUFEMP, CMWI4, DPUTLI, RNOUT,
  3009. C                                    RPACK, SPACK, SPAR
  3010. C
  3011. C     ****************************************************************
  3012. C
  3013. C     Files referenced :  None
  3014. C
  3015. C     ****************************************************************
  3016. C
  3017. C     Local variable definitions :
  3018. C
  3019. C      MAXTRY - MAXIMUM NUMBER OF TRIES TO GET PACKET
  3020. C      N      - PACKET # MODULO 64
  3021. C      NUMTRY - # OF TRIES ON THIS PACKET
  3022. C      OLDTRY - # OF TRIES ON LAST PACKET
  3023. C
  3024. C     ****************************************************************
  3025. C
  3026. C     Commons referenced :  None
  3027. C
  3028. C     ****************************************************************
  3029. C
  3030. C     (*$END.DOCUMENT*)
  3031. C
  3032. C     ****************************************************************
  3033. C     *                                                              *
  3034. C     *         D I M E N S I O N   S T A T E M E N T S              *
  3035. C     *                                                              *
  3036. C     ****************************************************************
  3037. C
  3038.       IMPLICIT INTEGER (A-Z)
  3039. C
  3040. C     ****************************************************************
  3041. C     *                                                              *
  3042. C     *         T Y P E   S T A T E M E N T S                        *
  3043. C     *                                                              *
  3044. C     ****************************************************************
  3045. C
  3046. C
  3047. C     ****************************************************************
  3048. C     *                                                              *
  3049. C     *         C O M M O N   S T A T E M E N T S                    *
  3050. C     *                                                              *
  3051. C     ****************************************************************
  3052. C
  3053.       INCLUDE USL/KERCOM
  3054.       INCLUDE USL/KERPMC
  3055.       INCLUDE USL/UFTTBC
  3056. C
  3057. C     ****************************************************************
  3058. C     *                                                              *
  3059. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  3060. C     *                                                              *
  3061. C     ****************************************************************
  3062. C
  3063. C
  3064. C     ****************************************************************
  3065. C     *                                                              *
  3066. C     *         D A T A   S T A T E M E N T S                        *
  3067. C     *                                                              *
  3068. C     ****************************************************************
  3069. C
  3070. C
  3071. C     ****************************************************************
  3072. C
  3073. C     Code starts here :
  3074. C
  3075.       IF(NUMTRY.LE.MAXTRY)GO TO 200
  3076. C                                     !EXCEEDED MAXTRY , GIVES UP
  3077.          RDATA=BIGA
  3078.          RETURN
  3079.   200 CONTINUE
  3080. C                                     !TRY IT AGAIN
  3081.           NUMTRY=NUMTRY+1
  3082. C                                     !READ A PACKET
  3083.       STATUS=RPACK(LEN,NUM,PACKET)
  3084. C                                     !IF WE ARE RUNNING IN REMOTE
  3085. C                                     !MODE DISPLAY THE PACKET #
  3086.       IF(HOSTON.EQ.NO) WRITE(LOCALO,100)NUM
  3087. C                                     !WE GOT THE DATA PACKET
  3088.       IF(STATUS.NE.BIGD)GO TO 1000
  3089.          IF(NUM.EQ.N)GO TO 900
  3090.             IF(OLDTRY.LE.MAXTRY)GO TO 300
  3091.                RDATA=BIGA
  3092.                RETURN
  3093.   300       CONTINUE
  3094.                 OLDTRY=OLDTRY+1
  3095.             IF(NUM.NE.(N-1))GO TO 400
  3096. C                                     !WE GOT A DUPLICTED PACKET
  3097.                CALL SPAR(PACKET)
  3098. C                                     !JUST ACK IT
  3099.                TV1=BIGY
  3100.                TV2=6
  3101.                CALL SPACK(TV1,NUM,TV2,PACKET)
  3102.                NUMTRY=0
  3103.                RDATA=STATE
  3104.                RETURN
  3105.   400       CONTINUE
  3106.                 RDATA=BIGA
  3107.                 RETURN
  3108. C                                    !WRITE THE DATA PACKET JUST RECEIVE
  3109.   900     CONTINUE
  3110.          CALL BUFEMP(PACKET,LEN)
  3111. C                                    !INTO THE RECEIVING DISK FILE
  3112.          TNUM=N
  3113.          TV1=BIGY
  3114.          TV2=TNUM
  3115.          TV3=0
  3116.          TV4=0
  3117. C                                    !ACK THE JUST RECEIVED PACKET
  3118.          CALL SPACK(TV1,TV2,TV3,TV4)
  3119.          OLDTRY=NUMTRY
  3120.          NUMTRY=0
  3121.          N=MOD((N+1),64)
  3122.          RDATA=BIGD
  3123.          RETURN
  3124.  1000 CONTINUE
  3125. C
  3126.       IF(STATUS.NE.BIGF)GO TO 2000
  3127. C                                        !THE PACKET IS THE FILE HEADER
  3128. C                                        !WE SHOULD HAVE ALREADY GOTTEN
  3129.               IF(OLDTRY.LE.MAXTRY)GO TO 1100
  3130. C                                        !EXCEEDED NUMBER OF RETRY, GIVE
  3131.                  RDATA=BIGA
  3132.                  RETURN
  3133.  1100         CONTINUE
  3134.                   OLDTRY=OLDTRY+1
  3135. C                                        !WE GOT DUPLICATE FILE HEADER P
  3136.               IF(NUM.NE.(N-1))GO TO 1200
  3137.                  TV1=BIGY
  3138.                  TV2=0
  3139.                  TV3=0
  3140. C                                             !JUST ACK IT
  3141.                  CALL SPACK(TV1,NUM,TV2,TV3)
  3142.                  NUMTRY=0
  3143.                  RDATA=STATE
  3144.                  RETURN
  3145.  1200         CONTINUE
  3146.                   RDATA=BIGA
  3147.                   RETURN
  3148. C                                             !WE GOT THE EOF PACKET
  3149.  2000 CONTINUE
  3150.       IF(STATUS.NE.BIGZ)GO TO 3000
  3151.               IF(NUM.EQ.N)GO TO 2100
  3152.                  RDATA=BIGA
  3153.                  RETURN
  3154.  2100         CONTINUE
  3155.               TNUM=N
  3156.               TV1=BIGY
  3157.               TV2=0
  3158.               TV3=0
  3159. C                                           !ACK IT
  3160.               CALL SPACK(TV1,TNUM,TV2,TV3)
  3161. C                                           !CLOSE THE RECEIVING DISK FI
  3162.              CALL RNOUT
  3163.              CALL WEOF4 (IUFT(1,8))
  3164. C                                          WRITE OUT THE FILE NAME
  3165. C
  3166.              CALL CMWI4(IUFT(2,5),40)
  3167.              CALL DPUTLIN(FILNAM,5)
  3168.              CALL RNOUT
  3169. C
  3170.               N=MOD((N+1),64)
  3171. C                                           !CHANGE THE STATE TO LOOK FO
  3172.               RDATA=BIGF
  3173. C                                           !ANOTHER FILE HEADER
  3174.               RETURN
  3175. C
  3176.  3000 CONTINUE
  3177. C
  3178.       IF(STATUS.NE.BAD)GO TO 4000
  3179. C                                           !THERE WAS AN ERROR IN THE
  3180.               RDATA=STATE
  3181. C                                           !CHECKSUM
  3182.               TNUM=N
  3183.               TV1=BIGN
  3184.               TV2=0
  3185.               TV3=0
  3186. C                                           !NAK IT
  3187.               CALL SPACK(TV1,TNUM,TV2,TV3)
  3188.               RETURN
  3189.  4000 CONTINUE
  3190. C                                        !WE GOT A UNKNOWN PACKET TYPE
  3191.           RDATA=BIGA
  3192. C                                        !GIVES UP
  3193.       RETURN
  3194. 100   FORMAT('+PACKET #',I3,'  ')
  3195.       END
  3196. <<< recsw. >>>
  3197.       INTEGER FUNCTION RECSW (X)
  3198. C
  3199. C     ****************************************************************
  3200. C
  3201. C              KERMIT for the MODCOMP MAXIV operating system
  3202. C
  3203. C        Compliments of:
  3204. C
  3205. C                         SETPOINT, Inc.
  3206. C                      10245 Brecksville Rd.
  3207. C                      Brecksville, Ohio 44141
  3208. C
  3209. C
  3210. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  3211. C      of this version hereby grant permission to copy this software
  3212. C      provided that it is not used for an explicitly commercial
  3213. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  3214. C      no warranty whatsoever regarding the accuracy of this package
  3215. C      and will assume no liability resulting from it's use.
  3216. C
  3217. C     ****************************************************************
  3218. C
  3219. C     Abstract:  Receive a file or group of files from the
  3220. C                other Kermit.
  3221. C
  3222. C     MODIFICATION HISTORY
  3223. C
  3224. C     BY            DATE     REASON            PROGRAMS AFFECTED
  3225. C
  3226. C
  3227. C     ****************************************************************
  3228. C
  3229. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  3230. C
  3231. C     Calling Parameters:
  3232. C
  3233. C          X        - REQUIRED BY FORTRAN
  3234. C
  3235. C     ****************************************************************
  3236. C
  3237. C     Messages generated by this module :  None
  3238. C
  3239. C     ****************************************************************
  3240. C
  3241. C     Subroutines called directly : RINIT , RDATA , RFILE , PUTLIN
  3242. C                                   SPACK , BKFILE , AVFILE
  3243. C
  3244. C     ****************************************************************
  3245. C
  3246. C     Files referenced :  None
  3247. C
  3248. C     ****************************************************************
  3249. C
  3250. C     Local variable definitions :
  3251. C
  3252. C     UFTFIL       UFT# FOR THE FILE NAMES SCRATCH
  3253. C     UFTDAT       UFT# FOR THE FILE DATA SCRATCH
  3254. C
  3255. C     ****************************************************************
  3256. C
  3257. C     Commons referenced :  KERCOM, KERPMC, UFTTBL, XBYTE local commons
  3258. C
  3259. C     ****************************************************************
  3260. C
  3261. C     (*$END.DOCUMENT*)
  3262. C
  3263. C     ****************************************************************
  3264. C     *                                                              *
  3265. C     *         D I M E N S I O N   S T A T E M E N T S              *
  3266. C     *                                                              *
  3267. C     ****************************************************************
  3268. C
  3269.       IMPLICIT INTEGER (A-Z)
  3270. C
  3271.       INTEGER*2   FILNM(50)
  3272. C
  3273. C     ****************************************************************
  3274. C     *                                                              *
  3275. C     *         T Y P E   S T A T E M E N T S                        *
  3276. C     *                                                              *
  3277. C     ****************************************************************
  3278. C
  3279. C
  3280. C     ****************************************************************
  3281. C     *                                                              *
  3282. C     *         C O M M O N   S T A T E M E N T S                    *
  3283. C     *                                                              *
  3284. C     ****************************************************************
  3285. C
  3286.       INCLUDE USL/KERCOM
  3287.       INCLUDE USL/KERPMC
  3288.       INCLUDE USL/UFTTBC
  3289.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  3290. C
  3291. C     ****************************************************************
  3292. C     *                                                              *
  3293. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  3294. C     *                                                              *
  3295. C     ****************************************************************
  3296. C
  3297. C
  3298. C     ****************************************************************
  3299. C     *                                                              *
  3300. C     *         D A T A   S T A T E M E N T S                        *
  3301. C     *                                                              *
  3302. C     ****************************************************************
  3303. C
  3304.       DATA UFTFIL / 5 /
  3305.       DATA UFTDAT / 8 /
  3306. C
  3307. C     ****************************************************************
  3308. C
  3309. C     Code starts here :
  3310. C
  3311.       STATUS=YES
  3312.       STATE=BIGR
  3313.       XNEW=YES
  3314.       XCOUNT=1
  3315.       N=0
  3316.       NUMTRY=0
  3317. C
  3318.   100 CONTINUE
  3319. C
  3320.       IF(STATUS.NE.YES)GO TO 9000
  3321. C                                                   !READ A DATA PACKET
  3322.                IF(STATE.NE.BIGD)GO TO 200
  3323.                   STATE=RDATA(X)
  3324.                   GO TO 1000
  3325.   200          CONTINUE
  3326. C                                                   !READ A SINIT PACKET
  3327.                IF(STATE.NE.BIGR)GO TO 300
  3328.                   STATE=RINIT(X)
  3329.                   GO TO 1000
  3330.   300          CONTINUE
  3331. C                                                   !READ A FILE HEADER
  3332.                IF(STATE.NE.BIGF)GO TO 400
  3333.                   STATE=RFILE(FILNM)
  3334.                   IF (STATE .EQ. BIGD) CALL CMWI4 (IUFT(2,UFTDAT),40)
  3335.                   GO TO 1000
  3336.   400          CONTINUE
  3337. C                                                   !FILE TRANSFER DONE
  3338.                IF(STATE.NE.BIGC)GO TO 500
  3339.                   RECSW=YES
  3340. C
  3341.                   IF (HOSTON .EQ. YES) CALL TERMIN (IUFT(1,4),.FALSE.)
  3342.                   RETURN
  3343.   500           CONTINUE
  3344. C                                                   !WE GOT AN ERROR
  3345.                 IF(STATE.NE.BIGA)GO TO 1000
  3346.                        RECSW=NO
  3347.                        TV1=BIGE
  3348.                        TV2=N
  3349.                        TV3=0
  3350.                        TV4=0
  3351. C                                                 !SEND AN ERROR PACKET
  3352.                        CALL SPACK(TV1,TV2,TV3,TV4)
  3353. C                                                  BACK UP SCRATCH TO GET
  3354. C                                                   RID OF JUNK
  3355.                    CALL BKFILE(IUFT(1,UFTDAT))
  3356.                    CALL AVFILE(IUFT(1,UFTDAT))
  3357.                    RETURN
  3358.  1000           CONTINUE
  3359. C
  3360.                 GO TO 100
  3361. C
  3362.  9000 CONTINUE
  3363.       RETURN
  3364.       END
  3365. <<< rfile. >>>
  3366.       INTEGER FUNCTION RFILE (X)
  3367. C
  3368. C     ****************************************************************
  3369. C
  3370. C              KERMIT for the MODCOMP MAXIV operating system
  3371. C
  3372. C        Compliments of:
  3373. C
  3374. C                         SETPOINT, Inc.
  3375. C                      10245 Brecksville Rd.
  3376. C                      Brecksville, Ohio 44141
  3377. C
  3378. C
  3379. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  3380. C      of this version hereby grant permission to copy this software
  3381. C      provided that it is not used for an explicitly commercial
  3382. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  3383. C      no warranty whatsoever regarding the accuracy of this package
  3384. C      and will assume no liability resulting from it's use.
  3385. C
  3386. C     ****************************************************************
  3387. C
  3388. C     Abstract:  Read a file header packer from the other Kermit.
  3389. C
  3390. C     MODIFICATION HISTORY
  3391. C
  3392. C     BY            DATE     REASON            PROGRAMS AFFECTED
  3393. C
  3394. C
  3395. C     ****************************************************************
  3396. C
  3397. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  3398. C
  3399. C     Calling Parameters:
  3400. C
  3401. C       X   - REQUIRED BY FORTRAN
  3402. C
  3403. C     ****************************************************************
  3404. C
  3405. C     Messages generated by this module :  None
  3406. C
  3407. C     ****************************************************************
  3408. C
  3409. C     Subroutines called directly :  PUTLIN, RPACK, SPACK
  3410. C
  3411. C     ****************************************************************
  3412. C
  3413. C     Files referenced :  None
  3414. C
  3415. C     ****************************************************************
  3416. C
  3417. C     Local variable definitions :
  3418. C
  3419. C     N      - CURRENT PACKET SEQUENCE #
  3420. C     NUM    - LAST PACKET SEQUENCE #
  3421. C     FILNM  - UNPACKED ASCII FILE NAME TO BE RECEIVED
  3422. C
  3423. C     ****************************************************************
  3424. C
  3425. C     Commons referenced :  KER, KERPAR local commons
  3426. C
  3427. C     ****************************************************************
  3428. C
  3429. C     (*$END.DOCUMENT*)
  3430. C
  3431. C     ****************************************************************
  3432. C     *                                                              *
  3433. C     *         D I M E N S I O N   S T A T E M E N T S              *
  3434. C     *                                                              *
  3435. C     ****************************************************************
  3436. C
  3437.       IMPLICIT INTEGER (A-Z)
  3438. C
  3439.       INTEGER*2   ANAME(132)
  3440. C
  3441. C     ****************************************************************
  3442. C     *                                                              *
  3443. C     *         T Y P E   S T A T E M E N T S                        *
  3444. C     *                                                              *
  3445. C     ****************************************************************
  3446. C
  3447. C
  3448. C     ****************************************************************
  3449. C     *                                                              *
  3450. C     *         C O M M O N   S T A T E M E N T S                    *
  3451. C     *                                                              *
  3452. C     ****************************************************************
  3453. C
  3454.       INCLUDE USL/KERCOM
  3455.       INCLUDE USL/KERPMC
  3456. C
  3457. C     ****************************************************************
  3458. C     *                                                              *
  3459. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  3460. C     *                                                              *
  3461. C     ****************************************************************
  3462. C
  3463. C
  3464. C     ****************************************************************
  3465. C     *                                                              *
  3466. C     *         D A T A   S T A T E M E N T S                        *
  3467. C     *                                                              *
  3468. C     ****************************************************************
  3469. C
  3470. C
  3471. C     ****************************************************************
  3472. C
  3473. C     Code starts here :
  3474. C
  3475. C
  3476.       IF(NUMTRY.LE.MAXTRY)GO TO 100
  3477. C                                            !EXCEEDED MAX. # OF RE-TRY
  3478.          RFILE=BIGA
  3479. C                                            !GIVES UP
  3480.          RETURN
  3481.   100 CONTINUE
  3482.           NUMTRY=NUMTRY+1
  3483. C
  3484. C                                            PICK UP A PACKET
  3485. C
  3486.       STATUS=RPACK(LEN,NUM,PACKET)
  3487. C                                            !WE GOT A SINIT PACKET
  3488.       IF(STATUS.NE.BIGS)GO TO 1000
  3489.          IF(OLDTRY.LE.MAXTRY)GO TO 200
  3490. C                                            !RE-TRY IT AGAIN
  3491.             RFILE=BIGA
  3492.             RETURN
  3493.   200    CONTINUE
  3494.              OLDTRY=OLDTRY+1
  3495.          IF(NUM.NE.(N-1))GO TO 300
  3496. C                                            !WE ALREADY GOT THE SINIT
  3497. C                                            !PACKET, GET MY FILE-TRANSFER
  3498. C                                            !REQUIREMENT/PARAMETERS
  3499.             CALL SPAR(PACKET)
  3500.             TV1=BIGY
  3501.             TV2=6
  3502. C                                            !ACK IT
  3503.             CALL SPACK(TV1,NUM,TV2,PACKET)
  3504.             NUMTRY=0
  3505.             RFILE=STATE
  3506.             RETURN
  3507.   300    CONTINUE
  3508. C                                            !UNEXPECTED SEQUENCE #
  3509.              RFILE=BIGA
  3510. C                                            !GIVES UP
  3511.              RETURN
  3512. C
  3513.  1000 CONTINUE
  3514. C                                            !WE GOT A EOF PACKET
  3515.       IF(STATUS.NE.BIGZ)GO TO 2000
  3516.               IF(OLDTRY.LE.MAXTRY)GO TO 1100
  3517. C                                            !EXCEEDED MAX # OF RE-TRY
  3518.                  RFILE=BIGA
  3519. C                                            !GIVES UP
  3520.                  RETURN
  3521.  1100         CONTINUE
  3522. C                                            !RE-TRY ONE MORE TIME
  3523.                   OLDTRY=OLDTRY+1
  3524.               IF(NUM.NE.(N-1))GO TO 1200
  3525. C                                            !WE ALREADY GOT THE EOF PACKET
  3526.                  TV1=BIGY
  3527.                  TV2=0
  3528.                  TV3=0
  3529. C                                            !JUST ACK IT
  3530.                  CALL SPACK(TV1,NUM,TV2,TV3)
  3531.                  NUMTRY=0
  3532.                  RFILE=STATE
  3533.                  RETURN
  3534.  1200         CONTINUE
  3535. C                                            !UNEXPECTED SEQUENCE #
  3536.                   RFILE=BIGA
  3537.                   RETURN
  3538. C
  3539.  2000 CONTINUE
  3540. C                                            !WE GOT THE FILE HEADER PACKET
  3541.       IF(STATUS.NE.BIGF)GO TO 3000
  3542.               IF(NUM.EQ.N)GO TO 2100
  3543. C                                            !UNEXPECTED SEQUENCE #,NAK IT
  3544.                  RFILE=BIGA
  3545.                  RETURN
  3546.  2100         CONTINUE
  3547. C                                            !PACKET(LEN) HAS THE INCOMING
  3548. C                                            !FILENAME PACKET
  3549.               PACKET(LEN+1)=LF
  3550.               PACKET(LEN+2)=EOS
  3551. C
  3552. C                                             STORE FILENAME FOR LATER
  3553. C                                             WRITE TO DISK
  3554. C
  3555.               DO 2125 I = 1,132
  3556. C
  3557.                 FILNAM(I) = 0
  3558.                 ANAME(I) = 0
  3559. C
  3560.  2125         CONTINUE
  3561. C
  3562.               DO 2150 I = 1,LEN
  3563. C
  3564.                FILNAM(I) = PACKET(I)
  3565.                ANAME(I) = ISHFT (PACKET(I),8)
  3566. C
  3567.  2150         CONTINUE
  3568. C
  3569.               FILNAM(I+1) = LF
  3570.               FILNAM(I+2) = EOS
  3571.               IF(HOSTON.NE.NO)GO TO 2300
  3572.                  WRITE (LOCALO,2175) (ANAME(I),I=1,LEN)
  3573.  2175            FORMAT( ' RECEIVING FILE--> ',60A1)
  3574.                  WRITE (LOCALO,2176)
  3575.  2176            FORMAT (/)
  3576.  2300         CONTINUE
  3577.               TNUM=N
  3578.               TV1=BIGY
  3579.               TV2=0
  3580.               TV3=0
  3581. C                                            !ACK THE FILE HEADER PACKET
  3582.               CALL SPACK(TV1,TNUM,TV2,TV3)
  3583.               OLDTRY=NUMTRY
  3584.               NUMTRY=0
  3585.               N=MOD((N+1),64)
  3586. C                                           !CHANGE STATE TO LOOK FOR DATA
  3587. C                                           !PACKET
  3588.               RFILE=BIGD
  3589.               RETURN
  3590. C
  3591.  3000      CONTINUE
  3592. C                                           !WE GOT A BREAK TRANSMISSION
  3593.       IF(STATUS.NE.BIGB)GO TO 4000
  3594.               IF(NUM.EQ.N)GO TO 3100
  3595.                  RFILE=BIGA
  3596.                  RETURN
  3597.  3100         CONTINUE
  3598.               TNUM=N
  3599.               TV1=BIGY
  3600.               TV2=0
  3601.               TV3=0
  3602. C                                          !ACK THE BREAK PACKET
  3603.               CALL SPACK(TV1,TNUM,TV2,TV3)
  3604. C                                          !CHANGE STATE TO COMPLETE STATUS
  3605.               RFILE=BIGC
  3606.               RETURN
  3607.  4000 CONTINUE
  3608. C                                          !WE GOT AN ERROR ON THE CHECK SUM
  3609.       IF(STATUS.NE.BAD)GO TO 5000
  3610.               RFILE=STATE
  3611.               TNUM=N
  3612.               TV1=BIGN
  3613.               TV2=0
  3614.               TV3=0
  3615. C                                         !NAK IT
  3616.               CALL SPACK(TV1,TNUM,TV2,TV3)
  3617.               RETURN
  3618.  5000 CONTINUE
  3619. C                                          !UNEXPECTED PACKET TYPE, GIVE UP
  3620.           RFILE=BIGA
  3621.       RETURN
  3622.       END
  3623. <<< rinit. >>>
  3624.       INTEGER FUNCTION RINIT (X)
  3625. C
  3626. C     ****************************************************************
  3627. C
  3628. C              KERMIT for the MODCOMP MAXIV operating system
  3629. C
  3630. C        Compliments of:
  3631. C
  3632. C                         SETPOINT, Inc.
  3633. C                      10245 Brecksville Rd.
  3634. C                      Brecksville, Ohio 44141
  3635. C
  3636. C
  3637. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  3638. C      of this version hereby grant permission to copy this software
  3639. C      provided that it is not used for an explicitly commercial
  3640. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  3641. C      no warranty whatsoever regarding the accuracy of this package
  3642. C      and will assume no liability resulting from it's use.
  3643. C
  3644. C     ****************************************************************
  3645. C
  3646. C     Abstract:  Receive the initial packet from the remote Kermit.
  3647. C
  3648. C     MODIFICATION HISTORY
  3649. C
  3650. C     BY            DATE     REASON            PROGRAMS AFFECTED
  3651. C
  3652. C
  3653. C     ****************************************************************
  3654. C
  3655. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  3656. C
  3657. C     Calling Parameters:
  3658. C
  3659. C          X            - REQUIRED BY FORTRAN
  3660. C
  3661. C     ****************************************************************
  3662. C
  3663. C     Messages generated by this module :  None
  3664. C
  3665. C     ****************************************************************
  3666. C
  3667. C     Subroutines called directly : RPACK, RPAR, SPACK, SPAR
  3668. C
  3669. C     ****************************************************************
  3670. C
  3671. C     Files referenced :  None
  3672. C
  3673. C     ****************************************************************
  3674. C
  3675. C     Local variable definitions :
  3676. C
  3677. C      STATUS  - RECEIVES KERMIT STATE FLAG
  3678. C
  3679. C     ****************************************************************
  3680. C
  3681. C     Commons referenced :  KERCOM , KERPMC
  3682. C
  3683. C     ****************************************************************
  3684. C
  3685. C     (*$END.DOCUMENT*)
  3686. C
  3687. C     ****************************************************************
  3688. C     *                                                              *
  3689. C     *         D I M E N S I O N   S T A T E M E N T S              *
  3690. C     *                                                              *
  3691. C     ****************************************************************
  3692. C
  3693.       IMPLICIT INTEGER (A-Z)
  3694. C
  3695. C     ****************************************************************
  3696. C     *                                                              *
  3697. C     *         T Y P E   S T A T E M E N T S                        *
  3698. C     *                                                              *
  3699. C     ****************************************************************
  3700. C
  3701. C
  3702. C     ****************************************************************
  3703. C     *                                                              *
  3704. C     *         C O M M O N   S T A T E M E N T S                    *
  3705. C     *                                                              *
  3706. C     ****************************************************************
  3707. C
  3708.       INCLUDE USL/KERCOM
  3709.       INCLUDE USL/KERPMC
  3710. C
  3711. C     ****************************************************************
  3712. C     *                                                              *
  3713. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  3714. C     *                                                              *
  3715. C     ****************************************************************
  3716. C
  3717. C
  3718. C     ****************************************************************
  3719. C     *                                                              *
  3720. C     *         D A T A   S T A T E M E N T S                        *
  3721. C     *                                                              *
  3722. C     ****************************************************************
  3723. C
  3724. C
  3725. C     ****************************************************************
  3726. C
  3727. C     Code starts here :
  3728. C
  3729.       IF(NUMTRY.LE.MAXTRY)GO TO 100
  3730. C                                             !EXCEEDED MAX. # OF RE-TRY
  3731. C                                             !GIVES UP
  3732.          RINIT=BIGA
  3733.          RETURN
  3734.   100 CONTINUE
  3735. C                                             !TRY-IT AGAIN
  3736.           NUMTRY=NUMTRY+1
  3737.       DO 200 I=1,40
  3738.          PACKET(I)=0
  3739.   200 CONTINUE
  3740. C                                             !READ A PACKET
  3741.       STATUS=RPACK(LEN,NUM,PACKET)
  3742. C                                             !WE GOT A SINIT PACKET
  3743.       IF(STATUS.NE.BIGS)GO TO 300
  3744. C                                  !STORE OTHER KERMIT'S REQUIREMENTS
  3745.          CALL RPAR(PACKET)
  3746. C                                  !GET OUR PARAMETERS/REQUIRMENTS
  3747.          CALL SPAR(PACKET)
  3748.          TNUM=N
  3749.          TV1=BIGY
  3750.          TV2=6
  3751. C                                             !SEND OUT REQUIREMENT AND
  3752. C                                             !ACK IT ON ONE SHOT
  3753.          CALL SPACK(TV1,TNUM,TV2,PACKET)
  3754.          OLDTRY=NUMTRY
  3755.          NUMTRY=0
  3756.          N=MOD((N+1),64)
  3757. C                                             !CHANGE STATE TO LOOK FOR
  3758. C                                             !THE FILE HEADER PACKET
  3759.          RINIT=BIGF
  3760.          RETURN
  3761. C
  3762.   300 CONTINUE
  3763. C                                             !WE GOT A CHECKSUM ERROR
  3764.       IF(STATUS.NE.BAD)GO TO 400
  3765.            RINIT=STATE
  3766.            TNUM=N
  3767.            TV1=BIGN
  3768.            TV2=1
  3769.            TV3=0
  3770. C                                             !NAK IT
  3771.            CALL SPACK(TV1,TNUM,TV2,TV3)
  3772.            RETURN
  3773.   400 CONTINUE
  3774. C                                             !WE GOT AN UNEXPECTED PACK
  3775. C                                             !TYPE, GIVES UP
  3776.           RINIT=BIGA
  3777.       RETURN
  3778.       END
  3779. <<< rpack. >>>
  3780.       INTEGER FUNCTION RPACK (LEN,NUM,XDATA)
  3781. C
  3782. C     ****************************************************************
  3783. C
  3784. C              KERMIT for the MODCOMP MAXIV operating system
  3785. C
  3786. C        Compliments of:
  3787. C
  3788. C                         SETPOINT, Inc.
  3789. C                      10245 Brecksville Rd.
  3790. C                      Brecksville, Ohio 44141
  3791. C
  3792. C
  3793. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  3794. C      of this version hereby grant permission to copy this software
  3795. C      provided that it is not used for an explicitly commercial
  3796. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  3797. C      no warranty whatsoever regarding the accuracy of this package
  3798. C      and will assume no liability resulting from it's use.
  3799. C
  3800. C     ****************************************************************
  3801. C
  3802. C     Abstract:  Read a packet from the other Kermit.
  3803. C
  3804. C     MODIFICATION HISTORY
  3805. C
  3806. C     BY            DATE     REASON            PROGRAMS AFFECTED
  3807. C
  3808. C
  3809. C     ****************************************************************
  3810. C
  3811. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  3812. C
  3813. C     Calling Parameters:
  3814. C
  3815. C     W  LEN       - LENGTH OF PACKET
  3816. C     W  NUM       - PACKET SEQUENCE NUMBER
  3817. C     W  XDATA     - THE PACKET
  3818. C
  3819. C     ****************************************************************
  3820. C
  3821. C     Messages generated by this module :  None
  3822. C
  3823. C     ****************************************************************
  3824. C
  3825. C     Subroutines called directly :  GETLIN, UNCHAR
  3826. C
  3827. C     ****************************************************************
  3828. C
  3829. C     Files referenced :  None
  3830. C
  3831. C     ****************************************************************
  3832. C
  3833. C     Local variable definitions :
  3834. C
  3835. C      CHKSUM  - CALCULATED VALUE OF CHECKSUM
  3836. C      GAPTRY  - # OF TIMES WE'VE LOOKED FOR PACKET STARTING WIT SOH
  3837. C      MGAPTRY - MAXIMUM ALLOWED VALUE OF GAPTRY
  3838. C      XTYPE   - CODE FOR TYPE OF PACKET
  3839. C
  3840. C     ****************************************************************
  3841. C
  3842. C     Commons referenced :  KER, KERPAR
  3843. C
  3844. C     ****************************************************************
  3845. C
  3846. C     (*$END.DOCUMENT*)
  3847. C
  3848. C     ****************************************************************
  3849. C     *                                                              *
  3850. C     *         D I M E N S I O N   S T A T E M E N T S              *
  3851. C     *                                                              *
  3852. C     ****************************************************************
  3853. C
  3854.       IMPLICIT INTEGER (A-Z)
  3855.       INTEGER*2   XDATA(1),    BUFFER(132)
  3856. C
  3857. C     ****************************************************************
  3858. C     *                                                              *
  3859. C     *         T Y P E   S T A T E M E N T S                        *
  3860. C     *                                                              *
  3861. C     ****************************************************************
  3862. C
  3863. C
  3864. C     ****************************************************************
  3865. C     *                                                              *
  3866. C     *         C O M M O N   S T A T E M E N T S                    *
  3867. C     *                                                              *
  3868. C     ****************************************************************
  3869. C
  3870.       INCLUDE USL/KERCOM
  3871.       INCLUDE USL/KERPMC
  3872. C
  3873. C     ****************************************************************
  3874. C     *                                                              *
  3875. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  3876. C     *                                                              *
  3877. C     ****************************************************************
  3878. C
  3879. C
  3880. C     ****************************************************************
  3881. C     *                                                              *
  3882. C     *         D A T A   S T A T E M E N T S                        *
  3883. C     *                                                              *
  3884. C     ****************************************************************
  3885. C
  3886. C
  3887. C     ****************************************************************
  3888. C
  3889. C     Code starts here :
  3890. C
  3891. C                                     !THIS IS THE INPUT CHANNEL TO READ
  3892. C                                     !A PACKET FROM
  3893.       CH=4
  3894.       GAPTRY=1
  3895.       MGAPTRY=2
  3896.       CHKSUM=0
  3897. C
  3898. C     READ ME A PACKET THAT BEGINS WITH A SOH AND ENDS WITH MYEOL
  3899. C
  3900.   100 CONTINUE
  3901. C
  3902.       IF(GAPTRY.GT.MGAPTRY)GO TO 9000
  3903. C                                          !GET A PACKET WITHOUT WAITING
  3904. C                                          !FOR A PROMPT
  3905.          IF(IBMON .NE. YES)STATUS=GETLIN(BUFFER,CH)
  3906. C
  3907. C                                           IF TIMEOUT, LOOP
  3908. C
  3909.          IF(STATUS .EQ. BAD)GO TO 1000
  3910. C
  3911.          COUNT=1
  3912. C
  3913. C        SKIPS ALL OTHER CHARACTERS UNTIL WE SEE ONE WITH A SOH IN IT
  3914. C
  3915.   200    CONTINUE
  3916. C
  3917.          IF((BUFFER(COUNT).EQ.SOH).OR.(BUFFER(COUNT).EQ.EOS))GO TO 300
  3918. C                                          !WAIT FOR A SOH OR EOS
  3919.             COUNT=COUNT+1
  3920.             GO TO 200
  3921.   300    CONTINUE
  3922. C                                          !WE GOT THE SOH
  3923.          IF(BUFFER(COUNT).NE.SOH)GO TO 1000
  3924. C
  3925. C           WE GOT A LINE THAT BEGINS WITH A SOH
  3926. C
  3927.             K=COUNT+1
  3928.             CHKSUM=BUFFER(K)
  3929. C                                          !GET THE LENGTH OF THE PACKET
  3930.             LEN=UNCHAR(BUFFER(K))-3
  3931.             K=K+1
  3932.             CHKSUM=CHKSUM+BUFFER(K)
  3933. C                                          !GET THE SEQUENCE NUMBER OF
  3934. C                                          !THE FRAME PACKET
  3935.             NUM=UNCHAR(BUFFER(K))
  3936.             K=K+1
  3937. C                                          !GET THE DATA TYPE
  3938.             XTYPE=BUFFER(K)
  3939.             CHKSUM=CHKSUM+BUFFER(K)
  3940.             K=K+1
  3941. C
  3942. C           GET THE DATA
  3943. C
  3944. C           ZERO OUT THE XDATA ARRAY
  3945.             DO 400 I=1,132
  3946.                XDATA(I)=0
  3947.   400       CONTINUE
  3948.             IF (LEN .LT. 1) GO TO 510
  3949.             DO 500 J=1,LEN
  3950.                XDATA(J)=BUFFER(K)
  3951.                CHKSUM=CHKSUM+BUFFER(K)
  3952.                K=K+1
  3953.                COUNT=J
  3954.   500       CONTINUE
  3955.   510       CONTINUE
  3956. C
  3957.             XDATA(COUNT+1)=EOS
  3958.             T=BUFFER(K)
  3959. C
  3960. C           CALCULATE THE CHECKSUM OF THE INCOMING PACKET
  3961. C
  3962.             TV1=IAND(CHKSUM,192)
  3963.             TV2=TV1/64
  3964.             TV3=CHKSUM+TV2
  3965.             CHKSUM=IAND(TV3,63)
  3966. C
  3967. C           DOES THE CHECKSUM MATCH?
  3968. C
  3969.             IF(CHKSUM.EQ.UNCHAR(T))GO TO 600
  3970. C                                          !BAD CHECKSUM
  3971.                RPACK=BAD
  3972.                RETURN
  3973.   600       CONTINUE
  3974.                 RPACK=XTYPE
  3975.                 RETURN
  3976.  1000    CONTINUE
  3977. C
  3978. C        WE GOT THE EOS, THE PACKET HAS NO SOH, READ ANOTHER ONE
  3979. C
  3980.          GAPTRY=GAPTRY+1
  3981.          GO TO 100
  3982.  9000 CONTINUE
  3983.       RPACK=BAD
  3984.       RETURN
  3985.       END
  3986. <<< rpar. >>>
  3987.       SUBROUTINE RPAR (XDATA)
  3988. C
  3989. C     ****************************************************************
  3990. C
  3991. C              KERMIT for the MODCOMP MAXIV operating system
  3992. C
  3993. C        Compliments of:
  3994. C
  3995. C                         SETPOINT, Inc.
  3996. C                      10245 Brecksville Rd.
  3997. C                      Brecksville, Ohio 44141
  3998. C
  3999. C
  4000. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  4001. C      of this version hereby grant permission to copy this software
  4002. C      provided that it is not used for an explicitly commercial
  4003. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  4004. C      no warranty whatsoever regarding the accuracy of this package
  4005. C      and will assume no liability resulting from it's use.
  4006. C
  4007. C     ****************************************************************
  4008. C
  4009. C     Abstract:  EXTRACT REQUIREMENTS FROM INIT PACKET
  4010. C
  4011. C     MODIFICATION HISTORY
  4012. C
  4013. C     BY            DATE     REASON            PROGRAMS AFFECTED
  4014. C
  4015. C     ****************************************************************
  4016. C
  4017. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  4018. C
  4019. C     Calling Parameters:
  4020. C
  4021. C     R    XDATA    -- THE DATA PACKET
  4022. C
  4023. C     ****************************************************************
  4024. C
  4025. C     Messages generated by this module :  None
  4026. C
  4027. C     ****************************************************************
  4028. C
  4029. C     Subroutines called directly :  CTL, UNCHAR
  4030. C
  4031. C     ****************************************************************
  4032. C
  4033. C     Files referenced :  None
  4034. C
  4035. C     ****************************************************************
  4036. C
  4037. C     Local variable definitions :
  4038. C
  4039. C     ****************************************************************
  4040. C
  4041. C     Commons referenced :  KER, KERPAR
  4042. C
  4043. C     ****************************************************************
  4044. C
  4045. C     (*$END.DOCUMENT*)
  4046. C
  4047. C     ****************************************************************
  4048. C     *                                                              *
  4049. C     *         D I M E N S I O N   S T A T E M E N T S              *
  4050. C     *                                                              *
  4051. C     ****************************************************************
  4052. C
  4053.       IMPLICIT INTEGER*2 (A-Z)
  4054. C
  4055.       INTEGER*2   XDATA(1)
  4056. C
  4057. C     ****************************************************************
  4058. C     *                                                              *
  4059. C     *         T Y P E   S T A T E M E N T S                        *
  4060. C     *                                                              *
  4061. C     ****************************************************************
  4062. C
  4063. C
  4064. C     ****************************************************************
  4065. C     *                                                              *
  4066. C     *         C O M M O N   S T A T E M E N T S                    *
  4067. C     *                                                              *
  4068. C     ****************************************************************
  4069. C
  4070.       INCLUDE USL/KERCOM
  4071.       INCLUDE USL/KERPMC
  4072. C
  4073. C     ****************************************************************
  4074. C     *                                                              *
  4075. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  4076. C     *                                                              *
  4077. C     ****************************************************************
  4078. C
  4079. C
  4080. C     ****************************************************************
  4081. C     *                                                              *
  4082. C     *         D A T A   S T A T E M E N T S                        *
  4083. C     *                                                              *
  4084. C     ****************************************************************
  4085. C
  4086. C
  4087. C     ****************************************************************
  4088. C
  4089. C     Code starts here :
  4090. C
  4091. C     STORE THE OTHER KERMIT'S FILE TRANSFER REQUIREMENTS AWAY
  4092. C
  4093.       IF(XDATA(1).NE.0)GO TO 100
  4094.          SPSIZ=PAKSIZ
  4095.          GO TO 200
  4096.   100 CONTINUE
  4097.            SPSIZ=UNCHAR(XDATA(1))
  4098.   200 CONTINUE
  4099.       IF(XDATA(3).NE.0)PAD=UNCHAR(XDATA(3))
  4100.       IF(XDATA(4).NE.0)PADCHAR=CTL(XDATA(4))
  4101.       IF(XDATA(5).NE.0)EOL=UNCHAR(XDATA(5))
  4102.       IF(XDATA(6).NE.0)QUOTE=XDATA(6)
  4103.       RETURN
  4104.       END
  4105. <<< rstore. >>>
  4106.       SUBROUTINE RSTORE
  4107. C
  4108. C     ****************************************************************
  4109. C
  4110. C              KERMIT for the MODCOMP MAXIV operating system
  4111. C
  4112. C        Compliments of:
  4113. C
  4114. C                         SETPOINT, Inc.
  4115. C                      10245 Brecksville Rd.
  4116. C                      Brecksville, Ohio 44141
  4117. C
  4118. C
  4119. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  4120. C      of this version hereby grant permission to copy this software
  4121. C      provided that it is not used for an explicitly commercial
  4122. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  4123. C      no warranty whatsoever regarding the accuracy of this package
  4124. C      and will assume no liability resulting from it's use.
  4125. C
  4126. C     ****************************************************************
  4127. C
  4128. C     Abstract: RSTORE ALLOWS THE OPERATOR TO INDIVIDUALLY RENAME
  4129. C               AND ASSIGN TO LIBRARIES THE RECEIVED FILE. RSTORE
  4130. C               MAKES SURE THAT THE FILE NAME IS FIXED UP FOR MAXIV.
  4131. C               IT ALSO CHECKS THAT EACH LIBRARY NAME IS CAN-CODEABLE.
  4132. C
  4133. C     MODIFICATION HISTORY
  4134. C
  4135. C     BY            DATE     REASON            PROGRAMS AFFECTED
  4136. C
  4137. C     ****************************************************************
  4138. C
  4139. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  4140. C
  4141. C     Calling Parameters:  None
  4142. C
  4143. C     ****************************************************************
  4144. C
  4145. C     Messages generated by this module :  None
  4146. C
  4147. C     ****************************************************************
  4148. C
  4149. C     Subroutines called directly : CMRI4, CMR4, CMWI4, CMW4, CTA4
  4150. C                                   FXFILE, PACK, REW4, RNOUT, WEOF
  4151. C
  4152. C     ****************************************************************
  4153. C
  4154. C     Files referenced :  None
  4155. C
  4156. C     ****************************************************************
  4157. C
  4158. C     Local variable definitions :
  4159. C
  4160. C     AUTO      - INDICATES WHETHER ALL DEFAULTS ARE ACCEPTED
  4161. C     CAT       - INDICATES WHETHER TO CAT OR RECAT A FILE
  4162. C     CHRFND    - # OF CHARACTERS FOUND IN LOGICAL FILE NAME
  4163. C     EFLNM     - POINTER TO END OF FILE NAME IN ARRAY
  4164. C     FFNAM     - FILE NAME FIXED UP FOR MAXIV
  4165. C     MYUSL     - CONTAINS PACK USL NAME
  4166. C     NCHARF    - # OF CHARACTERS IN FILE NAME
  4167. C     NWRDF     - # OF WORDS IN FILE NAME
  4168. C     RFNAM     - FILE NAME AS SENT BY OTHER KERMIT
  4169. C     SCRTCH    - SCRATCH ARRAY
  4170. C     SFLNM     - POINTER TO START OF FILE NAME
  4171. C     SLIB      - POINTER TO START OF LIBRARY NAME
  4172. C     UFFNAM    - UNPACKED FIXED UP FILE NAME
  4173. C     URFNAM    - UNPACKED FILE NAME FROM SENDER KERMIT
  4174. C     USCTCH    - UNPACKED SCRATCH
  4175. C
  4176. C     ****************************************************************
  4177. C
  4178. C     Commons referenced :  None
  4179. C
  4180. C     ****************************************************************
  4181. C
  4182. C     (*$END.DOCUMENT*)
  4183. C
  4184. C     ****************************************************************
  4185. C     *                                                              *
  4186. C     *         D I M E N S I O N   S T A T E M E N T S              *
  4187. C     *                                                              *
  4188. C     ****************************************************************
  4189. C
  4190.       IMPLICIT INTEGER(A-Z)
  4191. C
  4192.       INTEGER*2   MYUSL(3),    RFNAM(20),   FFNAM(4),    URFNAM(40)
  4193.       INTEGER*2   UFFNAM(8),   SCRTCH(40),  IUSL(2),     USCTCH(80)
  4194. C
  4195. C     ****************************************************************
  4196. C     *                                                              *
  4197. C     *         T Y P E   S T A T E M E N T S                        *
  4198. C     *                                                              *
  4199. C     ****************************************************************
  4200. C
  4201. C
  4202. C     ****************************************************************
  4203. C     *                                                              *
  4204. C     *         C O M M O N   S T A T E M E N T S                    *
  4205. C     *                                                              *
  4206. C     ****************************************************************
  4207. C
  4208.       INCLUDE USL/KERCOM
  4209.       INCLUDE USL/KERPMC
  4210.       INCLUDE USL/UFTTBC
  4211. C
  4212. C     ****************************************************************
  4213. C     *                                                              *
  4214. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  4215. C     *                                                              *
  4216. C     ****************************************************************
  4217. C
  4218. C
  4219. C     ****************************************************************
  4220. C     *                                                              *
  4221. C     *         D A T A   S T A T E M E N T S                        *
  4222. C     *                                                              *
  4223. C     ****************************************************************
  4224. C
  4225.       DATA KE5      / 3@KE5 /
  4226.      >    ,KE9      / 3@KE9 /
  4227.      >    ,MLEFT    / ZFF00 /
  4228.      >    ,MRIGHT   / Z00FF /
  4229. C
  4230. C     ****************************************************************
  4231. C
  4232. C     Code starts here :
  4233. C
  4234. C
  4235. C                              WRITE EOF TO THE FILE NAME SCRATCH FILE
  4236. C
  4237.       CALL WEOF(IUFT(1,5))
  4238. C
  4239. C                              INITIALIZE FOR COMPRESSED READ OR WRITE
  4240. C
  4241.       CALL CMWI4(IUFT(2,9),40)
  4242.       CALL CMRI4(IUFT(2,5),40)
  4243. C
  4244. C                              REWIND THEM
  4245. C
  4246.       CALL REW4(IUFT(1,5))
  4247.       CALL REW4(IUFT(1,9))
  4248. C                              A PROC IS ALWAYS CREATED - THIS IS THE TOP
  4249. C
  4250.       ENCODE(80,100,SCRTCH)
  4251.   100 FORMAT('$PROC STORE')
  4252. C
  4253.       CALL CMW4(SCRTCH)
  4254. C
  4255. C                              READ FIRST FILE NAME, IF EOF, THEN PUNT
  4256. C                              AND PROC DOES NOTHING
  4257. C
  4258.       CALL CMR4(SCRTCH,IEOF,NCHARF)
  4259. C
  4260.       IF(IEOF .EQ. 2)GO TO 9000
  4261. C
  4262. C                               REWIND THE FILE CUZ WE'LL ACTUALLY READ
  4263. C                               THE NAME AGAIN BELOW
  4264. C
  4265.       CALL REW4(IUFT(1,5))
  4266. C
  4267. C                               MORE OF THE PROC...
  4268. C
  4269.       ENCODE(80,300,SCRTCH)
  4270.   300 FORMAT('$EXE SED')
  4271. C
  4272.       CALL CMW4(SCRTCH)
  4273. C
  4274.       ENCODE(80,325,SCRTCH)
  4275.   325 FORMAT('OPT DAT')
  4276. C
  4277.       CALL CMW4(SCRTCH)
  4278. C
  4279.       ENCODE(80,400,SCRTCH)
  4280.   400 FORMAT('ASS SI KE8')
  4281. C
  4282.       CALL CMW4(SCRTCH)
  4283. C
  4284.       ENCODE(80,425,SCRTCH)
  4285.   425 FORMAT('REW SI')
  4286. C
  4287.       CALL CMW4(SCRTCH)
  4288. C
  4289.       ENCODE(80,500,SCRTCH)
  4290.   500 FORMAT('AVF SI,1')
  4291. C
  4292.       CALL CMW4(SCRTCH)
  4293. C
  4294. C                              UNCAN-CODE THE DEFAULT USL AND PACK IT
  4295. C
  4296.       CALL CTA4(SUSL,MYUSL,IND)
  4297. C
  4298.       MYUSL(1) = IOR(IAND(MYUSL(1),MLEFT),ISHFT(MYUSL(2),-8))
  4299.       MYUSL(2) = MYUSL(3)
  4300.       MYUSL(3) = 0
  4301. C
  4302.       WRITE(LOCALO,600)
  4303.   600 FORMAT(' This utility will allow you to rename the received',/
  4304.      >       ' files and assign them to the desired library.',//
  4305.      >       ' The default file names are truncated to 8 characters',/
  4306.      >       ' and any character which is not can-codeable will be',/
  4307.      >       ' converted to "$".',///)
  4308. C
  4309. C                                OPERATOR MAY CHOOSE ALL DEFAULTS
  4310. C
  4311.   650 CONTINUE
  4312. C
  4313.       WRITE(LOCALO,700)
  4314.   700 FORMAT(' Do you want to accept all defaults? (Y/N):')
  4315. C
  4316.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  4317. C
  4318.       AUTO = ISHFT(SCRTCH,-8)
  4319. C
  4320.       IF((AUTO .NE. BIGY) .AND. (AUTO .NE. BIGN))GO TO 650
  4321. C
  4322. C                                 OPERATOR MAY CHOOSE TO CAT OR RECAT
  4323. C
  4324.   800 CONTINUE
  4325. C
  4326.       IF(AUTO .EQ. BIGN)GO TO 1000
  4327. C
  4328.       WRITE(LOCALO,900)
  4329.   900 FORMAT(' Do you wish to CAT or RECAT all files? (C/R):')
  4330. C
  4331.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  4332. C
  4333.       CAT = ISHFT(SCRTCH,-8)
  4334. C
  4335.       IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 800
  4336. C
  4337. C                                   TOP OF MAIN LOOP
  4338. C
  4339.  1000 CONTINUE
  4340. C
  4341. C                                   READ NEXT FILE NAME
  4342. C
  4343.       DO 1050 JJ = 1,20
  4344. C
  4345.         RFNAM(JJ) = 999
  4346. C
  4347.  1050 CONTINUE
  4348. C
  4349.       CALL CMR4(RFNAM,IEOF,NCHARF)
  4350. C
  4351. C                                   EOF MEANS YOU'RE DONE
  4352. C
  4353.       IF(IEOF .EQ. 2)GO TO 8500
  4354. C
  4355. C                                   UNPACK THE NAME
  4356. C
  4357.       DO 1200 I = 1,20
  4358. C
  4359.         TEMP = ISHFT(IAND(RFNAM(I),MLEFT),-8)
  4360.         IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
  4361.         URFNAM(2*(I-1)+1) = TEMP
  4362.         IF(TEMP .EQ. LF)GO TO 1300
  4363. C
  4364.         TEMP = IAND(RFNAM(I),MRIGHT)
  4365.         IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
  4366.         URFNAM(2*I) = TEMP
  4367.         IF(TEMP .EQ. LF)GO TO 1300
  4368. C
  4369.  1200 CONTINUE
  4370. C
  4371.  1300 CONTINUE
  4372. C
  4373. C                                   FIX UP NAME TO MAXIV FORMAT
  4374. C
  4375.       CALL FXFILE(URFNAM,UFFNAM,NCHARF,NUMFIX)
  4376. C
  4377. C                                   PACK THE STRING
  4378. C
  4379.       CALL PACK(UFFNAM,FFNAM)
  4380. C
  4381.       NWRDF = (NCHARF + 1) / 2
  4382. C
  4383.       IF(AUTO .EQ. BIGY)GO TO 5000
  4384. C
  4385. C                                      WRITE OUT DEFAULTS
  4386. C
  4387.       WRITE(LOCALO,1400)RFNAM,FFNAM,(MYUSL(II),II=1,2)
  4388. C
  4389.  1400 FORMAT(' Received name...........',20A2,/
  4390.      >       ' Acceptable name.........',4A2,/
  4391.      >       ' Default USL.............',2A2,//)
  4392. C
  4393.  1450 CONTINUE
  4394. C
  4395.       WRITE(LOCALO,1500)
  4396.  1500 FORMAT(' Enter name and library - <CR> accepts defaults:')
  4397. C
  4398. C
  4399.       DO 1525 JJ = 1,40
  4400. C
  4401.         SCRTCH(JJ) = 4Z2020
  4402. C
  4403.  1525 CONTINUE
  4404. C
  4405.       CALL READ4(IUFT(1,2),SCRTCH,80,.TRUE.)
  4406. C
  4407.       NCHRC = IUFT(4,2)
  4408. C
  4409. C                                     NO INPUT MEANS ACCEPT DEFAULT
  4410. C
  4411.       IF(NCHRC .EQ. 0)GO TO 2100
  4412. C
  4413. C                                     UNPACK THE INPUT
  4414. C
  4415.       DO 1600 I = 1,40
  4416. C
  4417.         USCTCH(2*(I-1)+1) = ISHFT(IAND(SCRTCH(I),MLEFT),-8)
  4418.         USCTCH(2*I) = IAND(SCRTCH(I),MRIGHT)
  4419. C
  4420.  1600 CONTINUE
  4421. C
  4422. C                                NO INPUT ACCEPTS DEFAULTS
  4423. C
  4424.       IF(USCTCH(1) .EQ. 0)GO TO 2100
  4425. C
  4426. C                                SKIP BLANKS TO FIND START OF FILE NAME
  4427. C
  4428.       DO 1700 I = 1,80
  4429. C
  4430.         IF(USCTCH(I) .EQ. BLANK)GO TO 1700
  4431. C
  4432.         SFLNM = I
  4433.         GO TO 1750
  4434. C
  4435.  1700 CONTINUE
  4436. C
  4437.       GO TO 2100
  4438. C
  4439.  1750 CONTINUE
  4440. C
  4441. C                                 FIND END OF FILE NAME
  4442. C
  4443.       DO 1800 I = SFLNM,80
  4444. C
  4445.         IF(USCTCH(I) .NE. BLANK)GO TO 1800
  4446. C
  4447.         EFLNM = I - 1
  4448.         EFLNM1 = EFLNM + 1
  4449.         USCTCH(EFLNM1) = LF
  4450. C
  4451.         GO TO 1850
  4452. C
  4453.  1800 CONTINUE
  4454. C
  4455.  1850 CONTINUE
  4456. C
  4457. C                                  FIND START OF LIBRARY
  4458. C
  4459.       EFLNM2 = EFLNM1 + 1
  4460. C
  4461.       DO 1900 I = EFLNM2,80
  4462. C
  4463.         IF((USCTCH(I) .EQ. BLANK) .OR. (USCTCH(I) .EQ. 0) .OR.
  4464.      >     (USCTCH(I) .EQ. 2Z0A) .OR. (USCTCH(I) .EQ. LF))GO TO 1900
  4465. C
  4466.         SLIB = I
  4467.         USCTCH(SLIB+3) = LF
  4468. C
  4469.         GO TO 1950
  4470. C
  4471.  1900 CONTINUE
  4472. C
  4473.       SLIB = I
  4474. C
  4475.  1950 CONTINUE
  4476. C
  4477. C                                CHECK FILE NAME FOR LEGALITY
  4478. C
  4479.       NCHARF = EFLNM - SFLNM + 1
  4480. C
  4481.       CALL FXFILE(USCTCH(SFLNM),UFFNAM,NCHARF,NUMFIX)
  4482. C
  4483.       IF(NUMFIX .EQ. 0)GO TO 2000
  4484. C
  4485.       WRITE(LOCALO,1975)
  4486.  1975 FORMAT(' File name must be A-Z, 1-9, :, ., or $')
  4487.       GO TO 1450
  4488. C
  4489.  2000 CONTINUE
  4490. C
  4491. C                                PACK THE FILE NAME
  4492. C
  4493.       CALL PACK(UFFNAM,FFNAM)
  4494. C
  4495. C                                IF NO LIB INPUT, USE DEFAULT
  4496. C
  4497.       IF(SLIB .GE. 80)GO TO 2100
  4498. C
  4499. C
  4500. C                                CHECK IF WE CAN CAN-CODE THE LIBRARY
  4501. C
  4502.       CHRFND = 0
  4503. C
  4504.       DO 2025 I = 1,3
  4505. C
  4506. C
  4507.         IPT = SLIB + 3 - I
  4508. C
  4509. C                                TRAILING BLANKS ARE OK
  4510. C
  4511.         IF(((USCTCH(IPT) .EQ. BLANK) .OR. (USCTCH(IPT) .EQ. 0))
  4512.      >     .AND. (CHRFND .EQ. 0))GO TO 2025
  4513. C
  4514.         CHRFND = CHRFND + 1
  4515. C
  4516.         IF(((USCTCH(IPT) .GE. BIGA) .AND. (USCTCH(IPT) .LE. BIGZ)) .OR.
  4517.      >     ((USCTCH(IPT) .GE. DIG0) .AND. (USCTCH(IPT) .LE. DIG9)) .OR.
  4518.      >     (USCTCH(IPT) .EQ. COLON)                                .OR.
  4519.      >     (USCTCH(IPT) .EQ. PERIOD)                               .OR.
  4520.      >     (USCTCH(IPT) .EQ. DOLLAR))GO TO 2025
  4521. C
  4522.         GO TO 2030
  4523. C
  4524.  2025 CONTINUE
  4525. C
  4526.       GO TO 2075
  4527. C
  4528.  2030 CONTINUE
  4529. C
  4530. C
  4531.       WRITE(LOCALO,2050)
  4532.  2050 FORMAT(' Improper logical file name')
  4533. C
  4534.       GO TO 1450
  4535. C
  4536.  2075 CONTINUE
  4537. C
  4538.       CALL PACK(USCTCH(SLIB),MYUSL)
  4539. C
  4540.  2100 CONTINUE
  4541. C
  4542. C                          ASK CAT OR RECAT THE FILE
  4543. C
  4544.       WRITE(LOCALO,2200)
  4545.  2200 FORMAT(' CAT or RECAT this file? (C/R):')
  4546. C
  4547.       CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
  4548. C
  4549.       CAT = ISHFT(SCRTCH,-8)
  4550. C
  4551.       IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 2100
  4552. C
  4553.  5000 CONTINUE
  4554. C
  4555. C                        OUTPUT SED COMMANDS TO CAT OR RECAT
  4556. C                        THIS FILE
  4557. C
  4558.       ENCODE(80,5010,SCRTCH)MYUSL
  4559. 5010  FORMAT('ASS USL ',2A2)
  4560. C
  4561.       CALL CMW4(SCRTCH)
  4562. C
  4563.       IF(CAT .EQ. BIGC)ENCODE(80,5020,SCRTCH)FFNAM
  4564.       IF(CAT .EQ. BIGR)ENCODE(80,5030,SCRTCH)FFNAM
  4565. C
  4566.  5020 FORMAT('CAT ',4A2)
  4567.  5030 FORMAT('REC ',4A2)
  4568. C
  4569.       CALL CMW4(SCRTCH)
  4570. C
  4571. C                         LOOP BACK FOR MORE FILES
  4572. C
  4573.       GO TO 1000
  4574. C
  4575.  8500 CONTINUE
  4576. C
  4577.       ENCODE(80,8510,SCRTCH)
  4578.  8510 FORMAT('EXI')
  4579. C
  4580.       CALL CMW4(SCRTCH)
  4581. C
  4582. C
  4583.  9000 CONTINUE
  4584. C
  4585.       CALL RNOUT
  4586.       CALL WEOF(IUFT(1,9))
  4587. C
  4588. C
  4589. C
  4590.       RETURN
  4591.       END
  4592. <<< sbreak. >>>
  4593.       INTEGER FUNCTION SBREAK (X)
  4594. C
  4595. C     ****************************************************************
  4596. C
  4597. C              KERMIT for the MODCOMP MAXIV operating system
  4598. C
  4599. C        Compliments of:
  4600. C
  4601. C                         SETPOINT, Inc.
  4602. C                      10245 Brecksville Rd.
  4603. C                      Brecksville, Ohio 44141
  4604. C
  4605. C
  4606. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  4607. C      of this version hereby grant permission to copy this software
  4608. C      provided that it is not used for an explicitly commercial
  4609. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  4610. C      no warranty whatsoever regarding the accuracy of this package
  4611. C      and will assume no liability resulting from it's use.
  4612. C
  4613. C     ****************************************************************
  4614. C
  4615. C     Abstract:  Send a BREAK packet to signify the end of
  4616. C                transmissions
  4617. C
  4618. C     MODIFICATION HISTORY
  4619. C
  4620. C     BY            DATE     REASON            PROGRAMS AFFECTED
  4621. C
  4622. C     ****************************************************************
  4623. C
  4624. C     Author:  Rick Burke           Version:  A.0   Date: Sep-86
  4625. C
  4626. C     Calling Parameters:
  4627. C
  4628. C     R    X            - Dummy argument required by FORTRAN
  4629. C
  4630. C     ****************************************************************
  4631. C
  4632. C     Messages generated by this module :  None
  4633. C
  4634. C     ****************************************************************
  4635. C
  4636. C     Subroutines called directly : MOD, RPACK, SPACK
  4637. C
  4638. C     ****************************************************************
  4639. C
  4640. C     Files referenced :  None
  4641. C
  4642. C     ****************************************************************
  4643. C
  4644. C     Local variable definitions :
  4645. C
  4646. C     LEN          - Length of response packet
  4647. C     NUM          - Packet number of response
  4648. C     STATUS       - Status of response packet
  4649. C     TV1          - Temporary variable
  4650. C     TV2          - Temporary variable
  4651. C     TV3          - Temporary variable
  4652. C
  4653. C     ****************************************************************
  4654. C
  4655. C     Commons referenced :  None
  4656. C
  4657. C     ****************************************************************
  4658. C
  4659. C     (*$END.DOCUMENT*)
  4660. C
  4661. C     ****************************************************************
  4662. C     *                                                              *
  4663. C     *         D I M E N S I O N   S T A T E M E N T S              *
  4664. C     *                                                              *
  4665. C     ****************************************************************
  4666. C
  4667.       IMPLICIT INTEGER (A-Z)
  4668. C
  4669. C     ****************************************************************
  4670. C     *                                                              *
  4671. C     *         T Y P E   S T A T E M E N T S                        *
  4672. C     *                                                              *
  4673. C     ****************************************************************
  4674. C
  4675. C
  4676. C     ****************************************************************
  4677. C     *                                                              *
  4678. C     *         C O M M O N   S T A T E M E N T S                    *
  4679. C     *                                                              *
  4680. C     ****************************************************************
  4681. C
  4682.       INCLUDE USL/UFTTBC
  4683.       INCLUDE USL/KERCOM
  4684.       INCLUDE USL/KERPMC
  4685. C
  4686. C     ****************************************************************
  4687. C     *                                                              *
  4688. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  4689. C     *                                                              *
  4690. C     ****************************************************************
  4691. C
  4692. C
  4693. C     ****************************************************************
  4694. C     *                                                              *
  4695. C     *         D A T A   S T A T E M E N T S                        *
  4696. C     *                                                              *
  4697. C     ****************************************************************
  4698. C
  4699. C
  4700. C     ****************************************************************
  4701. C
  4702. C     Code starts here :
  4703. C
  4704. C----->  Assume some kind of error.
  4705. C
  4706.       SBREAK = BIGA
  4707. C
  4708. C----->  Check whether retry counter exceeded.
  4709. C
  4710.       IF (NUMTRY .GT. MAXTRY) RETURN
  4711.       NUMTRY = NUMTRY + 1
  4712. C
  4713. C----->  Send BREAK packet and get the response.
  4714. C
  4715.       TNUM = N
  4716.       TV1 = BIGB
  4717.       TV2 = 0
  4718.       TV3 = 0
  4719.       CALL SPACK (TV1,TNUM,TV2,TV3)
  4720.       STATUS = RPACK (LEN,NUM,RECPKT)
  4721. C
  4722. C----->  Branch if response was not a NAK.
  4723. C
  4724.       IF (STATUS .NE. BIGN) GO TO 10
  4725.       IF (N .NE. NUM-1) SBREAK = STATE
  4726.       RETURN
  4727.    10 CONTINUE
  4728. C
  4729. C----->  Branch if response was not an ACK.
  4730. C
  4731.       IF (STATUS .NE. BIGY) GO TO 30
  4732.       IF (N .EQ. NUM) GO TO 20
  4733.       SBREAK=STATE
  4734.       RETURN
  4735.    20 CONTINUE
  4736. C
  4737. C----->  Received good ACK to BREAK packet so reset retry counter,
  4738. C----->  bump packet counter, and set the state to "C" (complete).
  4739. C
  4740.       NUMTRY = 0
  4741.       N = MOD (N+1,64)
  4742.       SBREAK = BIGC
  4743. C
  4744. C---->  If we're in HOST mode, terminate the binary read outstanding
  4745. C
  4746.       IF(HOSTON .EQ. NO)GO TO 25
  4747. C
  4748.       CALL TERMIN(IUFT(1,4),.FALSE.)
  4749. C
  4750.    25 CONTINUE
  4751.       RETURN
  4752.    30 CONTINUE
  4753. C
  4754. C-----> Handle BAD status or unknown or ERROR packet types.
  4755. C
  4756.       IF (STATUS .EQ. BAD) SBREAK = STATE
  4757.       RETURN
  4758.       END
  4759. <<< sconne. >>>
  4760.       SUBROUTINE SCONNE
  4761. C
  4762. C     ****************************************************************
  4763. C
  4764. C              KERMIT for the MODCOMP MAXIV operating system
  4765. C
  4766. C        Compliments of:
  4767. C
  4768. C                         SETPOINT, Inc.
  4769. C                      10245 Brecksville Rd.
  4770. C                      Brecksville, Ohio 44141
  4771. C
  4772. C
  4773. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  4774. C      of this version hereby grant permission to copy this software
  4775. C      provided that it is not used for an explicitly commercial
  4776. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  4777. C      no warranty whatsoever regarding the accuracy of this package
  4778. C      and will assume no liability resulting from it's use.
  4779. C
  4780. C     ****************************************************************
  4781. C
  4782. C     Abstract:
  4783. C
  4784. C     MODIFICATION HISTORY
  4785. C
  4786. C     BY            DATE     REASON            PROGRAMS AFFECTED
  4787. C
  4788. C     ****************************************************************
  4789. C
  4790. C     Author:                       Version:        Date:
  4791. C
  4792. C     Calling Parameters:  None
  4793. C
  4794. C
  4795. C     ****************************************************************
  4796. C
  4797. C     Messages generated by this module :  None
  4798. C
  4799. C     ****************************************************************
  4800. C
  4801. C     Subroutines called directly :  None
  4802. C
  4803. C     ****************************************************************
  4804. C
  4805. C     Files referenced :  None
  4806. C
  4807. C     ****************************************************************
  4808. C
  4809. C     Local variable definitions :  None
  4810. C
  4811. C     ****************************************************************
  4812. C
  4813. C     Commons referenced :  None
  4814. C
  4815. C     ****************************************************************
  4816. C
  4817. C     (*$END.DOCUMENT*)
  4818. C
  4819. C     ****************************************************************
  4820. C     *                                                              *
  4821. C     *         D I M E N S I O N   S T A T E M E N T S              *
  4822. C     *                                                              *
  4823. C     ****************************************************************
  4824. C
  4825.       IMPLICIT INTEGER (A-Z)
  4826. C
  4827. C     ****************************************************************
  4828. C     *                                                              *
  4829. C     *         T Y P E   S T A T E M E N T S                        *
  4830. C     *                                                              *
  4831. C     ****************************************************************
  4832. C
  4833. C
  4834. C     ****************************************************************
  4835. C     *                                                              *
  4836. C     *         C O M M O N   S T A T E M E N T S                    *
  4837. C     *                                                              *
  4838. C     ****************************************************************
  4839. C
  4840. C
  4841. C     ****************************************************************
  4842. C     *                                                              *
  4843. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  4844. C     *                                                              *
  4845. C     ****************************************************************
  4846. C
  4847. C
  4848. C     ****************************************************************
  4849. C     *                                                              *
  4850. C     *         D A T A   S T A T E M E N T S                        *
  4851. C     *                                                              *
  4852. C     ****************************************************************
  4853. C
  4854. C
  4855. C     ****************************************************************
  4856. C
  4857. C     Code starts here :
  4858. C
  4859. C
  4860.       RETURN
  4861.       END
  4862. <<< sconnect. >>>
  4863.       SUBROUTINE SCONNECT
  4864. C
  4865. C
  4866. C     Applicable operating system :
  4867. C
  4868. C                YES     NO     MAYBE
  4869. C     GENERIC            X
  4870. C     MAXIV       X
  4871. C     VMS                X
  4872. C     RSX-11M            X
  4873. C
  4874. C     ****************************************************************
  4875. C
  4876. C     Abstract:
  4877. C
  4878. C     MODIFICATION HISTORY
  4879. C
  4880. C     BY            DATE     REASON            PROGRAMS AFFECTED
  4881. C
  4882. C     ****************************************************************
  4883. C
  4884. C     Author:                       Version:        Date:
  4885. C
  4886. C     Calling Parameters:
  4887. C
  4888. C     R/W  PARAM 1      - Definition of parameter 1
  4889. C     R/W  PARAM 2      - Definition of parameter 2
  4890. C     R/W  PARAM n      - Definition of parameter n
  4891. C
  4892. C     ****************************************************************
  4893. C
  4894. C     Messages generated by this module :  None
  4895. C
  4896. C     ****************************************************************
  4897. C
  4898. C     Subroutines called directly :
  4899. C
  4900. C     ****************************************************************
  4901. C
  4902. C     Files referenced :  None
  4903. C
  4904. C     R/W              File identifier
  4905. C
  4906. C     ****************************************************************
  4907. C
  4908. C     Local variable definitions :
  4909. C
  4910. C     ****************************************************************
  4911. C
  4912. C     Commons referenced :  KERCOM , KERPMC
  4913. C
  4914. C     ****************************************************************
  4915. C
  4916. C     (*$END.DOCUMENT*)
  4917. C**********************************************************************
  4918. C
  4919. C              KERMIT for the MODCOMP MAXIV operating system
  4920. C
  4921. C        Compliments of:
  4922. C
  4923. C                         SETPOINT, Inc.
  4924. C                      10245 Brecksville Rd.
  4925. C                      Brecksville, Ohio 44141
  4926. C
  4927. C
  4928. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  4929. C      of this version hereby grant permission to copy this software
  4930. C      provided that it is not used for an explicitly commercial
  4931. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  4932. C      no warranty whatsoever regarding the accuracy of this package
  4933. C      and will assume no liability resulting from it's use.
  4934. C
  4935. C
  4936. C**********************************************************************
  4937. C
  4938. C     ****************************************************************
  4939. C     *                                                              *
  4940. C     *         D I M E N S I O N   S T A T E M E N T S              *
  4941. C     *                                                              *
  4942. C     ****************************************************************
  4943. C
  4944. C
  4945. C     ****************************************************************
  4946. C     *                                                              *
  4947. C     *         T Y P E   S T A T E M E N T S                        *
  4948. C     *                                                              *
  4949. C     ****************************************************************
  4950. C
  4951. C
  4952.       IMPLICIT INTEGER (A-Z)
  4953. C
  4954. C
  4955.       INTEGER IBUF,ILEN,TV,IWRITE,IESCHAR,STATUS,IA,IB
  4956.       INTEGER IFUNC,ICLAS,LUTERM,TLEN,RMTRAW,LOCALRAW
  4957.       INTEGER TCODE
  4958. C
  4959. C     ****************************************************************
  4960. C     *                                                              *
  4961. C     *         C O M M O N   S T A T E M E N T S                    *
  4962. C     *                                                              *
  4963. C     ****************************************************************
  4964. C
  4965. C
  4966.       INCLUDE USL/KERCOM
  4967.       INCLUDE USL/KERPMC
  4968. C
  4969. C     ****************************************************************
  4970. C     *                                                              *
  4971. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  4972. C     *                                                              *
  4973. C     ****************************************************************
  4974. C
  4975. C
  4976. C     ****************************************************************
  4977. C     *                                                              *
  4978. C     *         D A T A   S T A T E M E N T S                        *
  4979. C     *                                                              *
  4980. C     ****************************************************************
  4981. C
  4982. C
  4983. C     ****************************************************************
  4984. C
  4985. C     Code starts here :
  4986. C
  4987. C
  4988.       RETURN
  4989.       END
  4990. <<< scopy. >>>
  4991.       SUBROUTINE SCOPY (XFROM,I,XTO,J)
  4992. C
  4993. C     ****************************************************************
  4994. C
  4995. C              KERMIT for the MODCOMP MAXIV operating system
  4996. C
  4997. C        Compliments of:
  4998. C
  4999. C                         SETPOINT, Inc.
  5000. C                      10245 Brecksville Rd.
  5001. C                      Brecksville, Ohio 44141
  5002. C
  5003. C
  5004. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5005. C      of this version hereby grant permission to copy this software
  5006. C      provided that it is not used for an explicitly commercial
  5007. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5008. C      no warranty whatsoever regarding the accuracy of this package
  5009. C      and will assume no liability resulting from it's use.
  5010. C
  5011. C     ****************************************************************
  5012. C
  5013. C     Abstract:
  5014. C
  5015. C     MODIFICATION HISTORY
  5016. C
  5017. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5018. C
  5019. C     ****************************************************************
  5020. C
  5021. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  5022. C
  5023. C     Calling Parameters:
  5024. C
  5025. C     R    XFROM        - Source array
  5026. C     R    I            - Initial index in source array
  5027. C     W    XTO          - Destination array
  5028. C     R    J            - Initial index in destination array
  5029. C
  5030. C     ****************************************************************
  5031. C
  5032. C     Messages generated by this module :  None
  5033. C
  5034. C     ****************************************************************
  5035. C
  5036. C     Subroutines called directly :  None
  5037. C
  5038. C     ****************************************************************
  5039. C
  5040. C     Files referenced :  None
  5041. C
  5042. C     ****************************************************************
  5043. C
  5044. C     Local variable definitions :
  5045. C
  5046. C     K1           - Index into FROM array
  5047. C     K2           - Index into TO array
  5048. C
  5049. C     ****************************************************************
  5050. C
  5051. C     Commons referenced :  KERPAR
  5052. C
  5053. C     ****************************************************************
  5054. C
  5055. C     (*$END.DOCUMENT*)
  5056. C
  5057. C     ****************************************************************
  5058. C     *                                                              *
  5059. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5060. C     *                                                              *
  5061. C     ****************************************************************
  5062. C
  5063.       IMPLICIT INTEGER (A-Z)
  5064. C
  5065.       INTEGER*2   XFROM(1),        XTO(1)
  5066. C
  5067. C     ****************************************************************
  5068. C     *                                                              *
  5069. C     *         T Y P E   S T A T E M E N T S                        *
  5070. C     *                                                              *
  5071. C     ****************************************************************
  5072. C
  5073. C
  5074. C     ****************************************************************
  5075. C     *                                                              *
  5076. C     *         C O M M O N   S T A T E M E N T S                    *
  5077. C     *                                                              *
  5078. C     ****************************************************************
  5079. C
  5080.       INCLUDE USL/KERPMC
  5081. C
  5082. C     ****************************************************************
  5083. C     *                                                              *
  5084. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  5085. C     *                                                              *
  5086. C     ****************************************************************
  5087. C
  5088. C
  5089. C     ****************************************************************
  5090. C     *                                                              *
  5091. C     *         D A T A   S T A T E M E N T S                        *
  5092. C     *                                                              *
  5093. C     ****************************************************************
  5094. C
  5095. C
  5096. C     ****************************************************************
  5097. C
  5098. C     Code starts here :
  5099. C
  5100.       K2 = J
  5101.       K1 = I
  5102. C
  5103.    10 CONTINUE
  5104.       XTO(K2) = XFROM(K1)
  5105.       K2 = K2 + 1
  5106.       K1 = K1 + 1
  5107.       IF (XFROM(K1-1) .NE. EOS) GO TO 10
  5108.       RETURN
  5109.       END
  5110. <<< sdata. >>>
  5111.       INTEGER FUNCTION SDATA (X)
  5112. C
  5113. C     ****************************************************************
  5114. C
  5115. C              KERMIT for the MODCOMP MAXIV operating system
  5116. C
  5117. C        Compliments of:
  5118. C
  5119. C                         SETPOINT, Inc.
  5120. C                      10245 Brecksville Rd.
  5121. C                      Brecksville, Ohio 44141
  5122. C
  5123. C
  5124. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5125. C      of this version hereby grant permission to copy this software
  5126. C      provided that it is not used for an explicitly commercial
  5127. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5128. C      no warranty whatsoever regarding the accuracy of this package
  5129. C      and will assume no liability resulting from it's use.
  5130. C
  5131. C     ****************************************************************
  5132. C
  5133. C     Abstract:  Send a data packet to the remote Kermit.
  5134. C
  5135. C     MODIFICATION HISTORY
  5136. C
  5137. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5138. C
  5139. C     ****************************************************************
  5140. C
  5141. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  5142. C
  5143. C     Calling Parameters:
  5144. C
  5145. C     R    X            - Dummy argument required by FORTRAN
  5146. C
  5147. C     ****************************************************************
  5148. C
  5149. C     Messages generated by this module :  None
  5150. C
  5151. C     ****************************************************************
  5152. C
  5153. C     Subroutines called directly : BUFILL, MOD, RPACK, SPACK
  5154. C
  5155. C     ****************************************************************
  5156. C
  5157. C     Files referenced :  None
  5158. C
  5159. C     ****************************************************************
  5160. C
  5161. C     Local variable definitions :
  5162. C
  5163. C     LEN          - Length of received packet
  5164. C     NUM          - Number of received packet
  5165. C     TNUM         - Expected packet number
  5166. C     TV1          - Temporary variable
  5167. C
  5168. C     ****************************************************************
  5169. C
  5170. C     Commons referenced :  KER and  KERPAR local commons
  5171. C
  5172. C     ****************************************************************
  5173. C
  5174. C     (*$END.DOCUMENT*)
  5175. C
  5176. C     ****************************************************************
  5177. C     *                                                              *
  5178. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5179. C     *                                                              *
  5180. C     ****************************************************************
  5181. C
  5182.       IMPLICIT INTEGER (A-Z)
  5183. C
  5184. C     ****************************************************************
  5185. C     *                                                              *
  5186. C     *         T Y P E   S T A T E M E N T S                        *
  5187. C     *                                                              *
  5188. C     ****************************************************************
  5189. C
  5190. C
  5191. C     ****************************************************************
  5192. C     *                                                              *
  5193. C     *         C O M M O N   S T A T E M E N T S                    *
  5194. C     *                                                              *
  5195. C     ****************************************************************
  5196. C
  5197.       INCLUDE USL/KERCOM
  5198.       INCLUDE USL/KERPMC
  5199. C
  5200. C     ****************************************************************
  5201. C     *                                                              *
  5202. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  5203. C     *                                                              *
  5204. C     ****************************************************************
  5205. C
  5206. C
  5207. C     ****************************************************************
  5208. C     *                                                              *
  5209. C     *         D A T A   S T A T E M E N T S                        *
  5210. C     *                                                              *
  5211. C     ****************************************************************
  5212. C
  5213. C
  5214. C     ****************************************************************
  5215. C
  5216. C     Code starts here :
  5217. C
  5218. C
  5219. C----->  Assume some kind of error.
  5220. C
  5221.       SDATA = BIGA
  5222. C
  5223. C----->  Retry counter exceeded?
  5224. C
  5225.       IF (NUMTRY .GT. MAXTRY) RETURN
  5226.       NUMTRY = NUMTRY + 1
  5227. C
  5228. C----->  Send the data packet.
  5229. C
  5230.       TNUM = N
  5231.       TV1 = BIGD
  5232.       CALL SPACK (TV1,TNUM,SIZE,PACKET)
  5233. C
  5234. C----->  If we are in local mode then display the packet
  5235. C----->  sequence number.
  5236. C
  5237.       IF (HOSTON .EQ. NO) WRITE (LOCALO,100) TNUM
  5238. C
  5239. C----->  Get the reply from the remote.
  5240. C
  5241.       STATUS = RPACK (LEN,NUM,RECPKT)
  5242. C
  5243. C----->  The next statements are to make sure that we are not one
  5244. C----->  packet ahead of the other Kermit. This will happen if the
  5245. C----->  other Kermit sends a NAK (due to a timeout detection)
  5246. C----->  before we send the first SINIT packet.
  5247. C
  5248.       IF (STATUS .EQ.  BIGY .AND.
  5249.      >    N      .EQ. NUM+1      ) STATUS = RPACK (LEN,NUM,RECPKT)
  5250.       IF (STATUS .NE. BIGN) GO TO 10
  5251. C
  5252. C----->  We got a NAK.
  5253. C
  5254.       IF (N .EQ. NUM-1) GO TO 50
  5255.       SDATA = STATE
  5256.       RETURN
  5257.    10 CONTINUE
  5258.       IF (STATUS .NE. BIGY) GO TO 40
  5259. C
  5260. C----->  We got an ACK.
  5261. C
  5262.       IF (N .EQ. NUM) GO TO 20
  5263. C
  5264. C----->  But, it was for the last packet.
  5265. C
  5266.       SDATA = STATE
  5267.       RETURN
  5268.    20 CONTINUE
  5269.       NUMTRY = 0
  5270.       N = MOD((N+1),64)
  5271.       SIZE = BUFILL (PACKET)
  5272.       IF (SIZE .NE. EOF) GO TO 30
  5273.       SDATA = BIGZ
  5274.       RETURN
  5275.    30 CONTINUE
  5276.       SDATA = BIGD
  5277.       RETURN
  5278.    40 CONTINUE
  5279.       IF (STATUS .NE. BAD) GO TO 50
  5280. C
  5281. C----->  We got a checksum error, try again.
  5282. C
  5283.       SDATA = STATE
  5284.       RETURN
  5285.    50 CONTINUE
  5286. C
  5287. C----->  Here we got an unknown packet type or an error occurred.
  5288. C
  5289.       RETURN
  5290. 100   FORMAT('+PACKET #',I3,'  ')
  5291.       END
  5292. <<< sendsw. >>>
  5293.       INTEGER FUNCTION SENDSW (X)
  5294. C
  5295. C     ****************************************************************
  5296. C
  5297. C              KERMIT for the MODCOMP MAXIV operating system
  5298. C
  5299. C        Compliments of:
  5300. C
  5301. C                         SETPOINT, Inc.
  5302. C                      10245 Brecksville Rd.
  5303. C                      Brecksville, Ohio 44141
  5304. C
  5305. C
  5306. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5307. C      of this version hereby grant permission to copy this software
  5308. C      provided that it is not used for an explicitly commercial
  5309. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5310. C      no warranty whatsoever regarding the accuracy of this package
  5311. C      and will assume no liability resulting from it's use.
  5312. C
  5313. C     ****************************************************************
  5314. C
  5315. C     Abstract: Send a file or group of files to a remote Kermit
  5316. C
  5317. C     MODIFICATION HISTORY
  5318. C
  5319. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5320. C
  5321. C     ****************************************************************
  5322. C
  5323. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  5324. C
  5325. C     Calling Parameters:
  5326. C
  5327. C     R    X            - Dummy argument requred by functions
  5328. C
  5329. C     ****************************************************************
  5330. C
  5331. C     Messages generated by this module :  None
  5332. C
  5333. C     ****************************************************************
  5334. C
  5335. C     Subroutines called directly :  SBREAK, SDATA, SEOF, SFILE,
  5336. C                                    SINIT, SPACK
  5337. C
  5338. C     ****************************************************************
  5339. C
  5340. C     Files referenced :  None
  5341. C
  5342. C     ****************************************************************
  5343. C
  5344. C     Local variable definitions :
  5345. C
  5346. C     STATUS       - Flag to indicate that all work is done
  5347. C     TV1          - Packet type for SPACK call
  5348. C     TV2          - Packet number for SPACK call
  5349. C     TV3          - Packet Length for SPACK call
  5350. C     TV4          - Data for packet to be sent to remote Kermit
  5351. C
  5352. C     ****************************************************************
  5353. C
  5354. C     Commons referenced :  KER, KERPAR, and XBYTE local commons
  5355. C
  5356. C     ****************************************************************
  5357. C
  5358. C     (*$END.DOCUMENT*)
  5359. C
  5360. C     ****************************************************************
  5361. C     *                                                              *
  5362. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5363. C     *                                                              *
  5364. C     ****************************************************************
  5365. C
  5366.       IMPLICIT INTEGER (A-Z)
  5367. C
  5368. C     ****************************************************************
  5369. C     *                                                              *
  5370. C     *         T Y P E   S T A T E M E N T S                        *
  5371. C     *                                                              *
  5372. C     ****************************************************************
  5373. C
  5374. C
  5375. C     ****************************************************************
  5376. C     *                                                              *
  5377. C     *         C O M M O N   S T A T E M E N T S                    *
  5378. C     *                                                              *
  5379. C     ****************************************************************
  5380. C
  5381.       INCLUDE USL/KERCOM
  5382. C
  5383.       INCLUDE USL/KERPMC
  5384. C
  5385.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  5386. C
  5387. C     ****************************************************************
  5388. C     *                                                              *
  5389. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  5390. C     *                                                              *
  5391. C     ****************************************************************
  5392. C
  5393. C
  5394. C     ****************************************************************
  5395. C     *                                                              *
  5396. C     *         D A T A   S T A T E M E N T S                        *
  5397. C     *                                                              *
  5398. C     ****************************************************************
  5399. C
  5400. C
  5401. C     ****************************************************************
  5402. C
  5403. C     Code starts here :
  5404. C
  5405.       STATE = BIGS
  5406.       XNEW = YES
  5407.       XCOUNT = 1
  5408.       XEOF = NO
  5409.       N = 0
  5410.       NUMTRY = 0
  5411.       STATUS = YES
  5412. C
  5413. C----->  Loop to send a packet, until STATUS <> YES.
  5414. C
  5415.    10 CONTINUE
  5416.       IF (STATUS .NE. YES) RETURN
  5417. C
  5418. C-----> Is this a data packet?
  5419. C
  5420.       IF (STATE .NE. BIGD) GO TO 20
  5421.       STATE = SDATA (X)
  5422.       GO TO 10
  5423. C
  5424. C----->  Is this a file header packet?
  5425. C
  5426.    20 CONTINUE
  5427.       IF (STATE .NE. BIGF) GO TO 30
  5428.       STATE = SFILE (X)
  5429.       GO TO 10
  5430.    30 CONTINUE
  5431. C
  5432. C----->  Is this an EOF header packet?
  5433. C
  5434.       IF (STATE .NE. BIGZ) GO TO 40
  5435.       STATE = SEOF (X)
  5436.       GO TO 10
  5437.    40 CONTINUE
  5438. C
  5439. C----->  Is this an initialization packet?
  5440. C
  5441.       IF (STATE .NE. BIGS) GO TO 50
  5442.       STATE = SINIT (X)
  5443.       GO TO 10
  5444.    50 CONTINUE
  5445. C
  5446. C----->  Is this a BREAK packet?
  5447. C
  5448.       IF (STATE .NE. BIGB) GO TO 60
  5449.       STATE = SBREAK (X)
  5450.       GO TO 10
  5451.    60 CONTINUE
  5452. C
  5453. C----->  Is the transfer complete?
  5454. C
  5455.       IF (STATE .NE. BIGC) GO TO 70
  5456.       SENDSW = YES
  5457.       RETURN
  5458.    70 CONTINUE
  5459. C
  5460. C----->  Did the file transfer fail?
  5461. C
  5462.       IF (STATE .NE. BIGA) GO TO 80
  5463.       SENDSW = NO
  5464.       TV1 = BIGE
  5465.       TV2 = N
  5466.       TV3 = 0
  5467.       TV4 = 0
  5468. C
  5469. C----->  Send an error packet.
  5470. C
  5471.       CALL SPACK (TV1,TV2,TV3,TV4)
  5472.       RETURN
  5473.    80 CONTINUE
  5474. C
  5475. C----->  Unknown STATE, signal file transfer failure.
  5476. C
  5477.       SENDSW = NO
  5478.       RETURN
  5479.       END
  5480. <<< seof. >>>
  5481.       INTEGER FUNCTION SEOF (X)
  5482. C
  5483. C     ****************************************************************
  5484. C
  5485. C              KERMIT for the MODCOMP MAXIV operating system
  5486. C
  5487. C        Compliments of:
  5488. C
  5489. C                         SETPOINT, Inc.
  5490. C                      10245 Brecksville Rd.
  5491. C                      Brecksville, Ohio 44141
  5492. C
  5493. C
  5494. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5495. C      of this version hereby grant permission to copy this software
  5496. C      provided that it is not used for an explicitly commercial
  5497. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5498. C      no warranty whatsoever regarding the accuracy of this package
  5499. C      and will assume no liability resulting from it's use.
  5500. C
  5501. C     ****************************************************************
  5502. C
  5503. C     Abstract:  Send an EOF packet to the other Kermit.
  5504. C
  5505. C     MODIFICATION HISTORY
  5506. C
  5507. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5508. C
  5509. C     ****************************************************************
  5510. C
  5511. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  5512. C
  5513. C     Calling Parameters:
  5514. C
  5515. C     R    X            - Dummy argument required by FORTRAN
  5516. C
  5517. C     ****************************************************************
  5518. C
  5519. C     Messages generated by this module :  None
  5520. C
  5521. C     ****************************************************************
  5522. C
  5523. C     Subroutines called directly :  DGETLI, MOD, PACK, POSUSL,
  5524. C                                    PUTLIN, RPACK, SCOPY, SPACK
  5525. C
  5526. C     ****************************************************************
  5527. C
  5528. C     Files referenced :  None
  5529. C
  5530. C     ****************************************************************
  5531. C
  5532. C     Local variable definitions :
  5533. C
  5534. C     AONE         - Index variable
  5535. C     BONE         - Index variable
  5536. C     FOUND        - Flag for existing file found
  5537. C     LEN          - Length of received packet
  5538. C     NUM          - Number of received packet
  5539. C     STATUS       - Status of received packet
  5540. C     TEMP         - Function code value from DGETLI
  5541. C     TNUM         - Packet number of transmitted packet
  5542. C     TV1          - Temporary variable
  5543. C     TV2          - Temporary variable
  5544. C     TV3          - Temporary variable
  5545. C     ALIN(132)    - Line buffer with file name read from
  5546. C                    scratch partition
  5547. C     FNAM(4)      - Packed file name array
  5548. C
  5549. C     ****************************************************************
  5550. C
  5551. C     Commons referenced :  KERCOM, KERPMC and UFTTBC local commons
  5552. C
  5553. C     ****************************************************************
  5554. C
  5555. C     (*$END.DOCUMENT*)
  5556. C
  5557. C     ****************************************************************
  5558. C     *                                                              *
  5559. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5560. C     *                                                              *
  5561. C     ****************************************************************
  5562. C
  5563.       IMPLICIT INTEGER (A-Z)
  5564. C
  5565.       INTEGER*2 ALIN(132),     FNAM(4)
  5566. C
  5567. C     ****************************************************************
  5568. C     *                                                              *
  5569. C     *         T Y P E   S T A T E M E N T S                        *
  5570. C     *                                                              *
  5571. C     ****************************************************************
  5572. C
  5573.       LOGICAL*2   FOUND
  5574. C
  5575. C     ****************************************************************
  5576. C     *                                                              *
  5577. C     *         C O M M O N   S T A T E M E N T S                    *
  5578. C     *                                                              *
  5579. C     ****************************************************************
  5580. C
  5581.       INCLUDE USL/KERCOM
  5582.       INCLUDE USL/KERPMC
  5583.       INCLUDE USL/UFTTBC
  5584. C
  5585. C     ****************************************************************
  5586. C     *                                                              *
  5587. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  5588. C     *                                                              *
  5589. C     ****************************************************************
  5590. C
  5591. C
  5592. C     ****************************************************************
  5593. C     *                                                              *
  5594. C     *         D A T A   S T A T E M E N T S                        *
  5595. C     *                                                              *
  5596. C     ****************************************************************
  5597. C
  5598. C
  5599. C     ****************************************************************
  5600. C
  5601. C     Code starts here :
  5602. C
  5603. C----->  Assume an error.
  5604. C
  5605.       SEOF = BIGA
  5606. C
  5607. C----->  Check if maximum number of retries exceeded.
  5608. C
  5609.       IF (NUMTRY .GT. MAXTRY) RETURN
  5610.       NUMTRY = NUMTRY+1
  5611. C
  5612. C----->  Send the EOF packet.
  5613. C
  5614.       AONE = 1
  5615.       BONE = 1
  5616.       TNUM = N
  5617.       TV1 = BIGZ
  5618.       TV2 = 0
  5619.       TV3 = 0
  5620.       CALL SPACK (TV1,TNUM,TV2,TV3)
  5621.       STATUS = RPACK (LEN,NUM,RECPKT)
  5622. C
  5623. C----->  Branch if response was not a NAK.
  5624. C
  5625.       IF (STATUS .NE. BIGN) GO TO 10
  5626.       IF (N .NE. NUM-1) SEOF = STATE
  5627.       RETURN
  5628.    10 CONTINUE
  5629. C
  5630. C----->  Branch if response was not an ACK.
  5631. C
  5632.       IF (STATUS .NE. BIGY) GO TO 80
  5633.       IF (N .EQ. NUM) GO TO 20
  5634.       SEOF = STATE
  5635.       RETURN
  5636.    20 CONTINUE
  5637. C
  5638. C----->  Reset the retry counter and bump the packet number.
  5639. C
  5640.       NUMTRY = 0
  5641.       N = MOD (N+1,64)
  5642.    30 CONTINUE
  5643. C
  5644. C----->  Check whether there is another file to send.
  5645. C
  5646.       SCRLUN = IUFT(2,9)
  5647.       READ (SCRLUN,1000,END=35) FNAM
  5648.  1000 FORMAT (4A2)
  5649.       GO TO 40
  5650.    35 CONTINUE
  5651.       SEOF = BIGB
  5652.       RETURN
  5653.    40 CONTINUE
  5654. C
  5655. C----->  There is another file to send, make sure that it exists.
  5656. C
  5657.       CALL POSUSL (IUFT(2,7),FNAM,FOUND)
  5658.       IF (FOUND) GO TO 50
  5659. C
  5660. C------>  Requested file not present.
  5661. C
  5662.       IF (HOSTON .NE. NO) GO TO 30
  5663.       WRITE (LOCALO,1010) FNAM
  5664.  1010 FORMAT (' FILE NOT FOUND--> ',4A2)
  5665.       GO TO 30
  5666.    50 CONTINUE
  5667. C
  5668. C----->  We have another valid file to send.
  5669. C
  5670.       DO 60 I=1,8
  5671.       IWORD = FNAM((I+1)/2)
  5672.       IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
  5673.       IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
  5674.       IF (FILNAM(I) .EQ.     0 .OR.
  5675.      >    FILNAM(I) .EQ. BLANK     ) GO TO 70
  5676.    60 CONTINUE
  5677.       I = 9
  5678.    70 CONTINUE
  5679.       FILNAM(I) = LF
  5680.       FILNAM(I+1) = EOS
  5681.       SEOF = BIGF
  5682.       RETURN
  5683.    80 CONTINUE
  5684. C
  5685. C----->  If there was a checksum error, try again.
  5686. C
  5687.       IF (STATUS .EQ. BAD) SEOF = STATE
  5688.       RETURN
  5689.       END
  5690. <<< setker. >>>
  5691. C**********************************************************************
  5692. C
  5693. C              KERMIT for the MODCOMP MAXIV operating system
  5694. C
  5695. C        Compliments of:
  5696. C
  5697. C                         SETPOINT, Inc.
  5698. C                      10245 Brecksville Rd.
  5699. C                      Brecksville, Ohio 44141
  5700. C
  5701. C
  5702. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5703. C      of this version hereby grant permission to copy this software
  5704. C      provided that it is not used for an explicitly commercial
  5705. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5706. C      no warranty whatsoever regarding the accuracy of this package
  5707. C      and will assume no liability resulting from it's use.
  5708. C
  5709. C
  5710. C**********************************************************************
  5711. <<< sfile. >>>
  5712.       INTEGER FUNCTION SFILE (X)
  5713. C
  5714. C     ****************************************************************
  5715. C
  5716. C              KERMIT for the MODCOMP MAXIV operating system
  5717. C
  5718. C        Compliments of:
  5719. C
  5720. C                         SETPOINT, Inc.
  5721. C                      10245 Brecksville Rd.
  5722. C                      Brecksville, Ohio 44141
  5723. C
  5724. C
  5725. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5726. C      of this version hereby grant permission to copy this software
  5727. C      provided that it is not used for an explicitly commercial
  5728. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5729. C      no warranty whatsoever regarding the accuracy of this package
  5730. C      and will assume no liability resulting from it's use.
  5731. C
  5732. C     ****************************************************************
  5733. C
  5734. C     Abstract:  Send the file name to the other Kermit
  5735. C
  5736. C     MODIFICATION HISTORY
  5737. C
  5738. C
  5739. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5740. C
  5741. C     ****************************************************************
  5742. C
  5743. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  5744. C
  5745. C     Calling Parameters:
  5746. C
  5747. C     R    X            - Dummy argument required by FORTRAN
  5748. C
  5749. C     ****************************************************************
  5750. C
  5751. C     Messages generated by this module :  None
  5752. C
  5753. C     ****************************************************************
  5754. C
  5755. C     Subroutines called directly :  BUFILL, MOD, PUTLIN, RPACK,
  5756. C                                    SCOPY, SPACK
  5757. C
  5758. C     ****************************************************************
  5759. C
  5760. C     Files referenced :  None
  5761. C
  5762. C     ****************************************************************
  5763. C
  5764. C     Local variable definitions :
  5765. C
  5766. C     AONE         - Index variable
  5767. C     BONE         - Index variable
  5768. C     LEN          - Length of file name
  5769. C     NUM          - Packet number of received data
  5770. C     STATUS       - Status of the recieved packet
  5771. C     TNUM         - Packet number of transmitted data
  5772. C     TV1          - Temporary variable
  5773. C     ALIN(132)    - Line buffer for file name
  5774. C
  5775. C     ****************************************************************
  5776. C
  5777. C     Commons referenced :  KER, KERPAR, and XBYTE local commons
  5778. C
  5779. C     ****************************************************************
  5780. C
  5781. C     (*$END.DOCUMENT*)
  5782. C
  5783. C     ****************************************************************
  5784. C     *                                                              *
  5785. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5786. C     *                                                              *
  5787. C     ****************************************************************
  5788. C
  5789.       IMPLICIT INTEGER (A-Z)
  5790. C
  5791.       INTEGER*2 ALIN(132)
  5792. C
  5793. C     ****************************************************************
  5794. C     *                                                              *
  5795. C     *         T Y P E   S T A T E M E N T S                        *
  5796. C     *                                                              *
  5797. C     ****************************************************************
  5798. C
  5799. C
  5800. C     ****************************************************************
  5801. C     *                                                              *
  5802. C     *         C O M M O N   S T A T E M E N T S                    *
  5803. C     *                                                              *
  5804. C     ****************************************************************
  5805. C
  5806.       INCLUDE USL/KERCOM
  5807.       INCLUDE USL/KERPMC
  5808.       INCLUDE USL/UFTTBC
  5809. C
  5810.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  5811. C
  5812. C     ****************************************************************
  5813. C     *                                                              *
  5814. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  5815. C     *                                                              *
  5816. C     ****************************************************************
  5817. C
  5818. C
  5819. C     ****************************************************************
  5820. C     *                                                              *
  5821. C     *         D A T A   S T A T E M E N T S                        *
  5822. C     *                                                              *
  5823. C     ****************************************************************
  5824. C
  5825. C
  5826. C     ****************************************************************
  5827. C
  5828. C     Code starts here :
  5829. C
  5830. C----->  Assume an error.
  5831. C
  5832.        SFILE = BIGA
  5833. C
  5834. C------>  Maximum no. of retries exceeded?
  5835. C
  5836.       IF (NUMTRY .GT. MAXTRY) RETURN
  5837.       NUMTRY = NUMTRY+1
  5838. C
  5839. C----->  Calculate the length of the file name.
  5840. C
  5841.       LEN = 1
  5842.    10 CONTINUE
  5843.       IF (FILNAM(LEN) .EQ. EOS) GO TO 20
  5844.       LEN = LEN + 1
  5845.       GO TO 10
  5846.    20 CONTINUE
  5847.       LEN = LEN - 2
  5848. C
  5849. C----->  If we are running locally then display the file name.
  5850. C
  5851.       IF (HOSTON .NE. NO .OR.
  5852.      >    NUMTRY .GT.  1     ) GO TO 30
  5853.       DO 25 I=1,LEN
  5854.       ALIN(I) = ISHFT (FILNAM(I),8)
  5855.    25 CONTINUE
  5856.       WRITE (LOCALO,1000) (ALIN(I),I=1,LEN)
  5857.  1000 FORMAT (' SENDING FILE--> ',8A1)
  5858.       WRITE (LOCALO,1010)
  5859.  1010 FORMAT (/)
  5860.    30 CONTINUE
  5861. C
  5862. C----->  Send the file name packet.
  5863. C
  5864.       TNUM = N
  5865.       TV1 = BIGF
  5866.       CALL SPACK (TV1,TNUM,LEN,FILNAME)
  5867.       STATUS = RPACK (LEN,NUM,RECPKT)
  5868. C
  5869. C----->  Branch if the packet was not NAKed.
  5870. C
  5871.       IF (STATUS .NE. BIGN) GO TO 40
  5872.       IF (N .EQ. NUM-1) RETURN
  5873.       SFILE = STATE
  5874.       RETURN
  5875.    40 CONTINUE
  5876. C
  5877. C----->  Branch if the packet was not ACKed.
  5878. C
  5879.       IF (STATUS .NE. BIGY) GO TO 60
  5880. C
  5881. C----->  Branch if packet number was OK.
  5882. C
  5883.       IF (N .EQ. NUM) GO TO 50
  5884.       SFILE = STATE
  5885.       RETURN
  5886.    50 CONTINUE
  5887. C
  5888. C----->  Reset retry counter and bump packet number.
  5889. C
  5890.       NUMTRY = 0
  5891.       N = MOD (N+1,64)
  5892. C
  5893. C----->  Get ready to begin sending the data.
  5894. C
  5895.       XNEW = YES
  5896.       XCOUNT = 1
  5897.       XEOF = NO
  5898.       CALL CMRI4 (IUFT(2,7),40)
  5899.       SIZE = BUFILL (PACKET)
  5900.       IF (SIZE .EQ. EOF) RETURN
  5901.       SFILE = BIGD
  5902.       RETURN
  5903.    60 CONTINUE
  5904. C
  5905. C----->  Handle a checksum error or unexpected packet type.
  5906. C
  5907.       IF (STATUS .EQ. BAD) SFILE = STATE
  5908.       RETURN
  5909.       END
  5910. <<< shelp. >>>
  5911.       SUBROUTINE SHELP
  5912. C
  5913. C     ****************************************************************
  5914. C
  5915. C              KERMIT for the MODCOMP MAXIV operating system
  5916. C
  5917. C        Compliments of:
  5918. C
  5919. C                         SETPOINT, Inc.
  5920. C                      10245 Brecksville Rd.
  5921. C                      Brecksville, Ohio 44141
  5922. C
  5923. C
  5924. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  5925. C      of this version hereby grant permission to copy this software
  5926. C      provided that it is not used for an explicitly commercial
  5927. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  5928. C      no warranty whatsoever regarding the accuracy of this package
  5929. C      and will assume no liability resulting from it's use.
  5930. C
  5931. C     ****************************************************************
  5932. C
  5933. C     Abstract:  Display the help file contents on the terminal.
  5934. C
  5935. C     MODIFICATION HISTORY
  5936. C
  5937. C     BY            DATE     REASON            PROGRAMS AFFECTED
  5938. C
  5939. C     ****************************************************************
  5940. C
  5941. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  5942. C
  5943. C     Calling Parameters:  None
  5944. C
  5945. C     ****************************************************************
  5946. C
  5947. C     Messages generated by this module :  None
  5948. C
  5949. C     ****************************************************************
  5950. C
  5951. C     Subroutines called directly :  ASSGN4, CMRI4, DGETLI, PACK,
  5952. C                                    POSUSL
  5953. C
  5954. C     ****************************************************************
  5955. C
  5956. C     Files referenced :  None
  5957. C
  5958. C     ****************************************************************
  5959. C
  5960. C     Local variable definitions :
  5961. C
  5962. C     FOUND        - Flag for requested file found and positioned
  5963. C     HLPUSL       - CAN code of logical file where help file resides
  5964. C     HLPFIL(4)    - Help file name in ASCII
  5965. C     LEN          - Length of output record
  5966. C
  5967. C     ****************************************************************
  5968. C
  5969. C     Commons referenced :  KER, KERPMC
  5970. C
  5971. C     ****************************************************************
  5972. C
  5973. C     (*$END.DOCUMENT*)
  5974. C
  5975. C     ****************************************************************
  5976. C     *                                                              *
  5977. C     *         D I M E N S I O N   S T A T E M E N T S              *
  5978. C     *                                                              *
  5979. C     ****************************************************************
  5980. C
  5981.       IMPLICIT INTEGER (A-Z)
  5982.       INTEGER*2   HLPFIL(4),   ALIN(132)
  5983. C
  5984. C     ****************************************************************
  5985. C     *                                                              *
  5986. C     *         T Y P E   S T A T E M E N T S                        *
  5987. C     *                                                              *
  5988. C     ****************************************************************
  5989. C
  5990.       LOGICAL*2   FOUND
  5991. C
  5992. C     ****************************************************************
  5993. C     *                                                              *
  5994. C     *         C O M M O N   S T A T E M E N T S                    *
  5995. C     *                                                              *
  5996. C     ****************************************************************
  5997. C
  5998.       INCLUDE USL/KERCOM
  5999.       INCLUDE USL/KERPMC
  6000.       INCLUDE USL/UFTTBC
  6001. C
  6002. C     ****************************************************************
  6003. C     *                                                              *
  6004. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6005. C     *                                                              *
  6006. C     ****************************************************************
  6007. C
  6008. C
  6009. C     ****************************************************************
  6010. C     *                                                              *
  6011. C     *         D A T A   S T A T E M E N T S                        *
  6012. C     *                                                              *
  6013. C     ****************************************************************
  6014. C
  6015.       DATA        HLPFIL /'HELPFILE'/
  6016.       DATA        HLPUSL /3@KEH/
  6017. C
  6018. C     ****************************************************************
  6019. C
  6020. C     Code starts here :
  6021. C
  6022. C----->  Assign KE7 (UFT #7) to the USL with the help file and
  6023. C----->  position to the help file.
  6024. C
  6025.       IUFT(3,7) = 4ZA000
  6026.       CALL ASSGN4 (IUFT(1,7),HLPUSL)
  6027.       CALL POSUSL (IUFT(2,7),HLPFIL,FOUND)
  6028.       IF (FOUND) GO TO 10
  6029.       WRITE (LOCALO,1000)
  6030.  1000 FORMAT (' FILE CONTAINING HELP INFORMATION IS NOT AVAILABLE')
  6031.       RETURN
  6032.    10 CONTINUE
  6033.       CALL CMRI4 (IUFT(2,7),40)
  6034.    20 CONTINUE
  6035.       IF (DGETLIN (ALIN,7) .EQ. EOF) GO TO 50
  6036.       DO 30 LEN=1,82
  6037.       IF (ALIN(LEN) .EQ. LF) GO TO 40
  6038.       ALIN(LEN) = ISHFT (ALIN(LEN),8)
  6039.    30 CONTINUE
  6040.    40 CONTINUE
  6041.       LEN = LEN - 1
  6042.       IF (LEN .GE. 80) LEN = 79
  6043.       WRITE (LOCALO,1010) (ALIN(I),I=1,LEN)
  6044.  1010 FORMAT (79A1)
  6045.       GO TO 20
  6046.    50 CONTINUE
  6047.       RETURN
  6048.       END
  6049. <<< sinit. >>>
  6050.       INTEGER FUNCTION SINIT (X)
  6051. C
  6052. C     ****************************************************************
  6053. C
  6054. C              KERMIT for the MODCOMP MAXIV operating system
  6055. C
  6056. C        Compliments of:
  6057. C
  6058. C                         SETPOINT, Inc.
  6059. C                      10245 Brecksville Rd.
  6060. C                      Brecksville, Ohio 44141
  6061. C
  6062. C
  6063. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6064. C      of this version hereby grant permission to copy this software
  6065. C      provided that it is not used for an explicitly commercial
  6066. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6067. C      no warranty whatsoever regarding the accuracy of this package
  6068. C      and will assume no liability resulting from it's use.
  6069. C
  6070. C     ****************************************************************
  6071. C
  6072. C     Abstract:  Send an initial packet for the first connection
  6073. C                Tell the other Kermit what my parameters are.
  6074. C
  6075. C     MODIFICATION HISTORY
  6076. C
  6077. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6078. C
  6079. C     ****************************************************************
  6080. C
  6081. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  6082. C
  6083. C     Calling Parameters:
  6084. C
  6085. C     R    X            - Dummy argument required by FORTRAN
  6086. C
  6087. C     ****************************************************************
  6088. C
  6089. C     Messages generated by this module :  None
  6090. C
  6091. C     ****************************************************************
  6092. C
  6093. C     Subroutines called directly : DGETLI, MOD, PACK, POSUSL,
  6094. C                                   RPACK, RPAR, SCOPY, SPACK,
  6095. C                                   SPAR
  6096. C
  6097. C     ****************************************************************
  6098. C
  6099. C     Files referenced :  None
  6100. C
  6101. C     ****************************************************************
  6102. C
  6103. C     Local variable definitions :
  6104. C
  6105. C     FOUND        - Flag indicating existing file name found
  6106. C     LEN          - Length of received apcket
  6107. C     NUM          - Number of received packet
  6108. C     SCRUFT       - UFT of assigned to scratch partition
  6109. C                    with list of files to be sent
  6110. C     STATUS       - Status of received packet
  6111. C     TNUM         - Number of transmitted packet
  6112. C     TEMP         - Function value returned by DGETLI
  6113. C     TV1          - Temporary variable
  6114. C     TV2          - Temporary variable
  6115. C     ALIN(132)    - File name buffer
  6116. C
  6117. C     ****************************************************************
  6118. C
  6119. C     Commons referenced :  KER and KERPAR local commons
  6120. C
  6121. C     ****************************************************************
  6122. C
  6123. C     (*$END.DOCUMENT*)
  6124. C
  6125. C     ****************************************************************
  6126. C     *                                                              *
  6127. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6128. C     *                                                              *
  6129. C     ****************************************************************
  6130. C
  6131.       IMPLICIT INTEGER (A-Z)
  6132. C
  6133.       INTEGER*2 ALIN(132),     FNAM(4)
  6134. C
  6135. C     ****************************************************************
  6136. C     *                                                              *
  6137. C     *         T Y P E   S T A T E M E N T S                        *
  6138. C     *                                                              *
  6139. C     ****************************************************************
  6140. C
  6141.       LOGICAL*2 FOUND
  6142. C
  6143. C     ****************************************************************
  6144. C     *                                                              *
  6145. C     *         C O M M O N   S T A T E M E N T S                    *
  6146. C     *                                                              *
  6147. C     ****************************************************************
  6148. C
  6149.       INCLUDE USL/KERCOM
  6150.       INCLUDE USL/KERPMC
  6151.       INCLUDE USL/UFTTBC
  6152. C
  6153. C     ****************************************************************
  6154. C     *                                                              *
  6155. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6156. C     *                                                              *
  6157. C     ****************************************************************
  6158. C
  6159. C
  6160. C     ****************************************************************
  6161. C     *                                                              *
  6162. C     *         D A T A   S T A T E M E N T S                        *
  6163. C     *                                                              *
  6164. C     ****************************************************************
  6165. C
  6166.       DATA        SCRUFT /9/
  6167. C
  6168. C     ****************************************************************
  6169. C
  6170. C     Code starts here :
  6171. C
  6172. C----->  Assume an error.
  6173. C
  6174.       SINIT = BIGA
  6175. C
  6176. C----->  Check if maximum number of retries exceeded.
  6177. C
  6178.       IF (NUMTRY .GT. MAXTRY) RETURN
  6179.       NUMTRY = NUMTRY+1
  6180. C
  6181. C----->  Get my required parameters.
  6182. C
  6183.       CALL SPAR (PACKET)
  6184. C
  6185. C----->  and send them to the remote.
  6186. C
  6187.       TNUM = N
  6188.       TV1 = BIGS
  6189.       TV2 = 6
  6190.       CALL SPACK (TV1,TNUM,TV2,PACKET)
  6191.       STATUS = RPACK (LEN,NUM,RECPKT)
  6192. C
  6193. C----->  Was the reply a NAK?  Branch if not.
  6194. C
  6195.       IF (STATUS .NE.BIGN) GO TO 10
  6196.       IF (N .NE. NUM-1) SINIT = STATE
  6197.       RETURN
  6198.    10 CONTINUE
  6199. C
  6200. C----->  Was the reply an ACK?  Branch if not.
  6201. C
  6202.       IF (STATUS .NE. BIGY) GO TO 60
  6203.       IF (N .EQ. NUM) GO TO 20
  6204.       SINIT = STATE
  6205.       RETURN
  6206.    20 CONTINUE
  6207.       CALL RPAR (RECPKT)
  6208. C
  6209. C----->  Reset the retry counter and bump the packet number.
  6210. C
  6211.       NUMTRY = 0
  6212.       N = MOD (N+1,64)
  6213. C
  6214. C----->  Get a valid file name from the file list.
  6215. C
  6216.    30 CONTINUE
  6217.       SCRLUN = IUFT(2,SCRUFT)
  6218.       READ (SCRLUN,1000,END=70) FNAM
  6219.  1000 FORMAT (4A2)
  6220.       CALL POSUSL (IUFT(2,7),FNAM,FOUND)
  6221.       IF (.NOT. FOUND) GO TO 30
  6222.       DO 40 I=1,8
  6223.       IWORD = FNAM((I+1)/2)
  6224.       IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
  6225.       IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
  6226.       IF (FILNAM(I) .EQ.     0 .OR.
  6227.      >    FILNAM(I) .EQ. BLANK     ) GO TO 50
  6228.    40 CONTINUE
  6229.       I = 9
  6230.    50 CONTINUE
  6231.       FILNAM(I) = LF
  6232.       FILNAM(I+1) = EOS
  6233.       SINIT = BIGF
  6234.       RETURN
  6235.    60 CONTINUE
  6236. C
  6237. C----->  Handle a checksum error or unexpected packet type.
  6238. C
  6239.       IF (STATUS .EQ. BAD) SINIT = STATE
  6240.       RETURN
  6241.    70 CONTINUE
  6242.       RETURN
  6243.       END
  6244. <<< skipbl. >>>
  6245.       SUBROUTINE SKIPBL(LIN, I)
  6246. C
  6247. C     ****************************************************************
  6248. C
  6249. C              KERMIT for the MODCOMP MAXIV operating system
  6250. C
  6251. C        Compliments of:
  6252. C
  6253. C                         SETPOINT, Inc.
  6254. C                      10245 Brecksville Rd.
  6255. C                      Brecksville, Ohio 44141
  6256. C
  6257. C
  6258. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6259. C      of this version hereby grant permission to copy this software
  6260. C      provided that it is not used for an explicitly commercial
  6261. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6262. C      no warranty whatsoever regarding the accuracy of this package
  6263. C      and will assume no liability resulting from it's use.
  6264. C
  6265. C     ****************************************************************
  6266. C
  6267. C     Abstract:  SEARCHES STRING FOR FIRST NON-BLANK CHARACTER
  6268. C
  6269. C     MODIFICATION HISTORY
  6270. C
  6271. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6272. C
  6273. C     ****************************************************************
  6274. C
  6275. C     Author:  BOB BORGESON         Version: A.0    Date: Oct-86
  6276. C
  6277. C     Calling Parameters:
  6278. C
  6279. C     R    LIN          - INPUT STRING TO BE SEARCHED
  6280. C     R/W  I            - ON INPUT, WHERE TO START LOOKING FOR
  6281. C                         CHARACTERS; ON OUTPUT, WHERE FOUND
  6282. C
  6283. C     ****************************************************************
  6284. C
  6285. C     Messages generated by this module :  None
  6286. C
  6287. C     ****************************************************************
  6288. C
  6289. C     Subroutines called directly :
  6290. C
  6291. C     ****************************************************************
  6292. C
  6293. C     Files referenced :  None
  6294. C
  6295. C     ****************************************************************
  6296. C
  6297. C     Local variable definitions :
  6298. C
  6299. C     ****************************************************************
  6300. C
  6301. C     Commons referenced :  None
  6302. C
  6303. C     ****************************************************************
  6304. C
  6305. C     (*$END.DOCUMENT*)
  6306. C
  6307. C     ****************************************************************
  6308. C     *                                                              *
  6309. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6310. C     *                                                              *
  6311. C     ****************************************************************
  6312. C
  6313.       IMPLICIT INTEGER (A-Z)
  6314. C
  6315.       INTEGER*2   LIN(1)
  6316. C
  6317. C     ****************************************************************
  6318. C     *                                                              *
  6319. C     *         T Y P E   S T A T E M E N T S                        *
  6320. C     *                                                              *
  6321. C     ****************************************************************
  6322. C
  6323. C
  6324. C     ****************************************************************
  6325. C     *                                                              *
  6326. C     *         C O M M O N   S T A T E M E N T S                    *
  6327. C     *                                                              *
  6328. C     ****************************************************************
  6329. C
  6330. C
  6331. C     ****************************************************************
  6332. C     *                                                              *
  6333. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6334. C     *                                                              *
  6335. C     ****************************************************************
  6336. C
  6337. C
  6338. C     ****************************************************************
  6339. C     *                                                              *
  6340. C     *         D A T A   S T A T E M E N T S                        *
  6341. C     *                                                              *
  6342. C     ****************************************************************
  6343. C
  6344. C
  6345. C     ****************************************************************
  6346. C
  6347. C     Code starts here :
  6348. C
  6349. 23000 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23001
  6350.       I = I + 1
  6351.       GOTO 23000
  6352. 23001 CONTINUE
  6353.       RETURN
  6354.       END
  6355. <<< spack. >>>
  6356.       SUBROUTINE SPACK (XTYPE,NUM,LEN,XDATA)
  6357. C
  6358. C     ****************************************************************
  6359. C
  6360. C              KERMIT for the MODCOMP MAXIV operating system
  6361. C
  6362. C        Compliments of:
  6363. C
  6364. C                         SETPOINT, Inc.
  6365. C                      10245 Brecksville Rd.
  6366. C                      Brecksville, Ohio 44141
  6367. C
  6368. C
  6369. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6370. C      of this version hereby grant permission to copy this software
  6371. C      provided that it is not used for an explicitly commercial
  6372. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6373. C      no warranty whatsoever regarding the accuracy of this package
  6374. C      and will assume no liability resulting from it's use.
  6375. C
  6376. C     ****************************************************************
  6377. C
  6378. C     Abstract:  SEND THIS PACKET TO THE REMOTE KERMIT
  6379. C
  6380. C
  6381. C     MODIFICATION HISTORY
  6382. C
  6383. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6384. C
  6385. C
  6386. C     ****************************************************************
  6387. C
  6388. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  6389. C
  6390. C     Calling Parameters:
  6391. C
  6392. C     R    XTYPE     - DATA PACKET TYPE
  6393. C     R    NUM       - PACKET SEQUENCE NUMBER (MODULO 64)
  6394. C     R    LEN       - LENGTH IN WORDS OF XDATA
  6395. C     R    XDATA     - DATA PORTION OF PACKET
  6396. C
  6397. C     ****************************************************************
  6398. C
  6399. C     Messages generated by this module :  None
  6400. C
  6401. C     ****************************************************************
  6402. C
  6403. C     Subroutines called directly :  TOCHAR, TPUTCH
  6404. C
  6405. C     ****************************************************************
  6406. C
  6407. C     Files referenced :  None
  6408. C
  6409. C     ****************************************************************
  6410. C
  6411. C     Local variable definitions :
  6412. C
  6413. C     BUFFER  - SCRATCH TO PIECE TOGETHER THE WHOLE PACKET
  6414. C     CH      - UFT # TO OUTPUT TO
  6415. C     CHKSUM  - BLOCK CHECKSUM
  6416. C     COUNT   - RUNNING COUNT OF HOW MANY CHARACTERS IN PACKET
  6417. C
  6418. C     ****************************************************************
  6419. C
  6420. C     Commons referenced :  KER and KERPAR
  6421. C
  6422. C     ****************************************************************
  6423. C
  6424. C     (*$END.DOCUMENT*)
  6425. C
  6426. C     ****************************************************************
  6427. C     *                                                              *
  6428. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6429. C     *                                                              *
  6430. C     ****************************************************************
  6431. C
  6432.       IMPLICIT INTEGER (A-Z)
  6433. C
  6434.       INTEGER*2   XDATA(1),    BUFFER(132)
  6435. C
  6436. C     ****************************************************************
  6437. C     *                                                              *
  6438. C     *         T Y P E   S T A T E M E N T S                        *
  6439. C     *                                                              *
  6440. C     ****************************************************************
  6441. C
  6442. C
  6443. C     ****************************************************************
  6444. C     *                                                              *
  6445. C     *         C O M M O N   S T A T E M E N T S                    *
  6446. C     *                                                              *
  6447. C     ****************************************************************
  6448. C
  6449.       INCLUDE USL/KERCOM
  6450.       INCLUDE USL/KERPMC
  6451. C
  6452. C     ****************************************************************
  6453. C     *                                                              *
  6454. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6455. C     *                                                              *
  6456. C     ****************************************************************
  6457. C
  6458. C
  6459. C     ****************************************************************
  6460. C     *                                                              *
  6461. C     *         D A T A   S T A T E M E N T S                        *
  6462. C     *                                                              *
  6463. C     ****************************************************************
  6464. C
  6465. C
  6466. C     ****************************************************************
  6467. C
  6468. C     Code starts here :
  6469. C
  6470. C
  6471. C
  6472. C                                   !THIS IS THE CHANNEL TO SEND PACKET
  6473. C                                   !OUT ON, START WITH THE FIRST BYTE
  6474.       CH=RMTOUT
  6475.       I=1
  6476. C
  6477.   100 CONTINUE
  6478. C                                     !SEND OUT PADCHAR IF NEEDED
  6479.       IF(I.GT.PAD)GO TO 200
  6480.          CALL TPUTCH(PADCHAR,CH)
  6481.          I=I+1
  6482.          GO TO 100
  6483.   200 CONTINUE
  6484. C                                     !BUILD UP THE PACKET
  6485.       COUNT=1
  6486.       BUFFER(COUNT)=SOH
  6487.       COUNT=COUNT+1
  6488.       CHKSUM=TOCHAR(LEN+3)
  6489.       BUFFER(COUNT)=TOCHAR(LEN+3)
  6490.       COUNT=COUNT+1
  6491.       CHKSUM=CHKSUM+TOCHAR(NUM)
  6492.       BUFFER(COUNT)=TOCHAR(NUM)
  6493.       COUNT=COUNT+1
  6494.       CHKSUM=CHKSUM+XTYPE
  6495.       BUFFER(COUNT)=XTYPE
  6496.       COUNT=COUNT+1
  6497. C
  6498. C                                    !COPY THE CONTENT OF PACKET INFORMA
  6499.       IF (LEN .LT. 1) GO TO 310
  6500.       DO 300 I=1,LEN
  6501. C                                    !CALCULATE THE CHECKSUM
  6502.          BUFFER(COUNT)=XDATA(I)
  6503.          COUNT=COUNT+1
  6504.          CHKSUM=CHKSUM+XDATA(I)
  6505.   300 CONTINUE
  6506.   310 CONTINUE
  6507. C
  6508.       TV1=IAND(CHKSUM,192)
  6509.       TV2=TV1/64
  6510.       TV3=TV2+CHKSUM
  6511.       CHKSUM=IAND(TV3,63)
  6512.       BUFFER(COUNT)=TOCHAR(CHKSUM)
  6513.       COUNT=COUNT+1
  6514.       BUFFER(COUNT)=EOL
  6515.       BUFFER(COUNT+1)=EOS
  6516.       COUNT=1
  6517.       CH=RMTOUT
  6518. C
  6519. C                                                !SEND OUT THE PACKET
  6520.   400 CONTINUE
  6521.       IF(BUFFER(COUNT).EQ.EOS)GO TO 500
  6522.          CALL TPUTCH(BUFFER(COUNT),CH)
  6523.          COUNT=COUNT+1
  6524.          GO TO 400
  6525.   500 CONTINUE
  6526.       RETURN
  6527.       END
  6528. <<< spar. >>>
  6529.       SUBROUTINE SPAR(XDATA)
  6530. C
  6531. C     ****************************************************************
  6532. C
  6533. C              KERMIT for the MODCOMP MAXIV operating system
  6534. C
  6535. C        Compliments of:
  6536. C
  6537. C                         SETPOINT, Inc.
  6538. C                      10245 Brecksville Rd.
  6539. C                      Brecksville, Ohio 44141
  6540. C
  6541. C
  6542. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6543. C      of this version hereby grant permission to copy this software
  6544. C      provided that it is not used for an explicitly commercial
  6545. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6546. C      no warranty whatsoever regarding the accuracy of this package
  6547. C      and will assume no liability resulting from it's use.
  6548. C
  6549. C     ****************************************************************
  6550. C
  6551. C     Abstract:  SET UP THE INIT PACKET (OUR REQUIREMENTS)
  6552. C
  6553. C     MODIFICATION HISTORY
  6554. C
  6555. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6556. C
  6557. C     ****************************************************************
  6558. C
  6559. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  6560. C
  6561. C     Calling Parameters:
  6562. C
  6563. C     R/W  XDATA     - THE DATA PACKET
  6564. C
  6565. C     ****************************************************************
  6566. C
  6567. C     Messages generated by this module :  None
  6568. C
  6569. C     ****************************************************************
  6570. C
  6571. C     Subroutines called directly : CTL, TOCHAR
  6572. C
  6573. C     ****************************************************************
  6574. C
  6575. C     Files referenced :  None
  6576. C
  6577. C     ****************************************************************
  6578. C
  6579. C     Local variable definitions :
  6580. C
  6581. C     XZERO   -  CONTAINS THE VALUE ZERO
  6582. C
  6583. C     ****************************************************************
  6584. C
  6585. C     Commons referenced :  KER and KERPAR
  6586. C
  6587. C     ****************************************************************
  6588. C
  6589. C     (*$END.DOCUMENT*)
  6590. C
  6591. C     ****************************************************************
  6592. C     *                                                              *
  6593. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6594. C     *                                                              *
  6595. C     ****************************************************************
  6596. C
  6597.       IMPLICIT INTEGER (A-Z)
  6598. C
  6599.       INTEGER*2   XDATA(1)
  6600. C
  6601. C     ****************************************************************
  6602. C     *                                                              *
  6603. C     *         T Y P E   S T A T E M E N T S                        *
  6604. C     *                                                              *
  6605. C     ****************************************************************
  6606. C
  6607. C
  6608. C     ****************************************************************
  6609. C     *                                                              *
  6610. C     *         C O M M O N   S T A T E M E N T S                    *
  6611. C     *                                                              *
  6612. C     ****************************************************************
  6613. C
  6614.       INCLUDE USL/KERCOM
  6615.       INCLUDE USL/KERPMC
  6616. C
  6617. C     ****************************************************************
  6618. C     *                                                              *
  6619. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6620. C     *                                                              *
  6621. C     ****************************************************************
  6622. C
  6623. C
  6624. C     ****************************************************************
  6625. C     *                                                              *
  6626. C     *         D A T A   S T A T E M E N T S                        *
  6627. C     *                                                              *
  6628. C     ****************************************************************
  6629. C
  6630. C
  6631. C     ****************************************************************
  6632. C
  6633. C     Code starts here :
  6634. C
  6635.       XDATA(1)=TOCHAR(PAKSIZ)
  6636.       XDATA(2)=TOCHAR(10)
  6637.       XDATA(3)=TOCHAR(MYPAD)
  6638.       XDATA(4)=CTL(MYPCHA)
  6639.       XDATA(5)=TOCHAR(MYEOL)
  6640.       XDATA(6)=MYQUOTE
  6641. C
  6642.       RETURN
  6643.       END
  6644. <<< squit. >>>
  6645.       SUBROUTINE SQUIT
  6646. C
  6647. C     ****************************************************************
  6648. C
  6649. C              KERMIT for the MODCOMP MAXIV operating system
  6650. C
  6651. C        Compliments of:
  6652. C
  6653. C                         SETPOINT, Inc.
  6654. C                      10245 Brecksville Rd.
  6655. C                      Brecksville, Ohio 44141
  6656. C
  6657. C
  6658. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6659. C      of this version hereby grant permission to copy this software
  6660. C      provided that it is not used for an explicitly commercial
  6661. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6662. C      no warranty whatsoever regarding the accuracy of this package
  6663. C      and will assume no liability resulting from it's use.
  6664. C
  6665. C     ****************************************************************
  6666. C
  6667. C     Abstract:  Final EXIT from Kermit program. If any files have been
  6668. C                received, let user change to MAXIV compatible names
  6669. C                and select their USL source library.
  6670. C
  6671. C     MODIFICATION HISTORY
  6672. C
  6673. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6674. C
  6675. C     ****************************************************************
  6676. C
  6677. C     Author:  Rick Burke           Version: A.0    Date:  Aug-86
  6678. C
  6679. C     Calling Parameters:  None
  6680. C
  6681. C     ****************************************************************
  6682. C
  6683. C     Messages generated by this module :  None
  6684. C
  6685. C     ****************************************************************
  6686. C
  6687. C     Subroutines called directly : EXIT, RSTORE, WEOF
  6688. C
  6689. C     ****************************************************************
  6690. C
  6691. C     Files referenced :  None
  6692. C
  6693. C     ****************************************************************
  6694. C
  6695. C     Local variable definitions :  None
  6696. C
  6697. C     ****************************************************************
  6698. C
  6699. C     Commons referenced :  UFTTBL
  6700. C
  6701. C     ****************************************************************
  6702. C
  6703. C     (*$END.DOCUMENT*)
  6704. C
  6705. C     ****************************************************************
  6706. C     *                                                              *
  6707. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6708. C     *                                                              *
  6709. C     ****************************************************************
  6710. C
  6711.       IMPLICIT INTEGER (A-Z)
  6712. C
  6713. C     ****************************************************************
  6714. C     *                                                              *
  6715. C     *         T Y P E   S T A T E M E N T S                        *
  6716. C     *                                                              *
  6717. C     ****************************************************************
  6718. C
  6719. C
  6720. C     ****************************************************************
  6721. C     *                                                              *
  6722. C     *         C O M M O N   S T A T E M E N T S                    *
  6723. C     *                                                              *
  6724. C     ****************************************************************
  6725. C
  6726.       INCLUDE USL/KERCOM
  6727.       INCLUDE USL/KERPMC
  6728.       INCLUDE USL/UFTTBC
  6729. C
  6730. C     ****************************************************************
  6731. C     *                                                              *
  6732. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6733. C     *                                                              *
  6734. C     ****************************************************************
  6735. C
  6736. C
  6737. C     ****************************************************************
  6738. C     *                                                              *
  6739. C     *         D A T A   S T A T E M E N T S                        *
  6740. C     *                                                              *
  6741. C     ****************************************************************
  6742. C
  6743. C
  6744. C     ****************************************************************
  6745. C
  6746. C     Code starts here :
  6747. C
  6748. C----->  First, write EOF at the end of the received file list.
  6749. C
  6750.       CALL WEOF(IUFT(1,5))
  6751. C
  6752. C----->  Next, terminate any read to the remote Kermit.
  6753. C
  6754.       CALL TERMIN (IUFT(1,4),.FALSE.)
  6755. C
  6756. C---->   CALL ROUTINE TO CATALOG FILES
  6757. C
  6758.       CALL RSTORE
  6759. C
  6760. C
  6761.       WRITE(LOCALO,1000)
  6762.  1000 FORMAT(' KERMIT-MAXIV EXITING...')
  6763.       CALL EXIT
  6764.       RETURN
  6765.       END
  6766. <<< srecei. >>>
  6767.       SUBROUTINE SRECEIVE
  6768. C
  6769. C     ****************************************************************
  6770. C
  6771. C              KERMIT for the MODCOMP MAXIV operating system
  6772. C
  6773. C        Compliments of:
  6774. C
  6775. C                         SETPOINT, Inc.
  6776. C                      10245 Brecksville Rd.
  6777. C                      Brecksville, Ohio 44141
  6778. C
  6779. C
  6780. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6781. C      of this version hereby grant permission to copy this software
  6782. C      provided that it is not used for an explicitly commercial
  6783. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6784. C      no warranty whatsoever regarding the accuracy of this package
  6785. C      and will assume no liability resulting from it's use.
  6786. C
  6787. C     ****************************************************************
  6788. C
  6789. C     Abstract:  MONITORS THE RECSW ROUTINE TO RECEIVE FILE
  6790. C
  6791. C     MODIFICATION HISTORY
  6792. C
  6793. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6794. C
  6795. C     ****************************************************************
  6796. C
  6797. C     Author:  BOB BORGESON         Version: A.0    Date: Oct-86
  6798. C
  6799. C     Calling Parameters:
  6800. C
  6801. C     ****************************************************************
  6802. C
  6803. C     Messages generated by this module :  None
  6804. C
  6805. C     ****************************************************************
  6806. C
  6807. C     Subroutines called directly :  RECSW
  6808. C
  6809. C     ****************************************************************
  6810. C
  6811. C     Files referenced :  None
  6812. C
  6813. C     ****************************************************************
  6814. C
  6815. C     Local variable definitions :
  6816. C
  6817. C      STATUS   - RECEIVES THE KERMIT STATE CODE
  6818. C
  6819. C     ****************************************************************
  6820. C
  6821. C     Commons referenced :  KER and KERPAR
  6822. C
  6823. C     ****************************************************************
  6824. C
  6825. C     (*$END.DOCUMENT*)
  6826. C
  6827. C     ****************************************************************
  6828. C     *                                                              *
  6829. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6830. C     *                                                              *
  6831. C     ****************************************************************
  6832. C
  6833.       IMPLICIT INTEGER (A-Z)
  6834. C
  6835. C     ****************************************************************
  6836. C     *                                                              *
  6837. C     *         T Y P E   S T A T E M E N T S                        *
  6838. C     *                                                              *
  6839. C     ****************************************************************
  6840. C
  6841. C
  6842. C     ****************************************************************
  6843. C     *                                                              *
  6844. C     *         C O M M O N   S T A T E M E N T S                    *
  6845. C     *                                                              *
  6846. C     ****************************************************************
  6847. C
  6848.       INCLUDE USL/UFTTBC
  6849.       INCLUDE USL/KERCOM
  6850.       INCLUDE USL/KERPMC
  6851. C
  6852. C     ****************************************************************
  6853. C     *                                                              *
  6854. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  6855. C     *                                                              *
  6856. C     ****************************************************************
  6857. C
  6858. C
  6859. C     ****************************************************************
  6860. C     *                                                              *
  6861. C     *         D A T A   S T A T E M E N T S                        *
  6862. C     *                                                              *
  6863. C     ****************************************************************
  6864. C
  6865. C
  6866. C     ****************************************************************
  6867. C
  6868. C     Code starts here :
  6869. C
  6870. C
  6871. C                             IF WE'RE IN HOST MODE, ISSUE BINARY READ
  6872. C
  6873.       IF(HOSTON .EQ. NO)GO TO 10
  6874. C
  6875.         CALL READ4(IUFT(1,4),BLIN(1,1),132,.FALSE.)
  6876.         CURCHN = 1
  6877. C
  6878.    10 CONTINUE
  6879. C
  6880. C                             CALL RECSW AND INDICATE SUCCESS OR FAILURE
  6881.          STATUS=RECSW(X)
  6882.           IF(STATUS.EQ.YES) WRITE(LOCALO,100)
  6883.           IF(STATUS.NE.YES) WRITE(LOCALO,101)
  6884.       RETURN
  6885. 100   FORMAT(' FILE TRANSFER COMPLETED')
  6886. 101   FORMAT(' FILE TRANSFER FAILED')
  6887.       END
  6888. <<< ssend. >>>
  6889.       SUBROUTINE SSEND (ALIN)
  6890. C
  6891. C     ****************************************************************
  6892. C
  6893. C              KERMIT for the MODCOMP MAXIV operating system
  6894. C
  6895. C        Compliments of:
  6896. C
  6897. C                         SETPOINT, Inc.
  6898. C                      10245 Brecksville Rd.
  6899. C                      Brecksville, Ohio 44141
  6900. C
  6901. C
  6902. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  6903. C      of this version hereby grant permission to copy this software
  6904. C      provided that it is not used for an explicitly commercial
  6905. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  6906. C      no warranty whatsoever regarding the accuracy of this package
  6907. C      and will assume no liability resulting from it's use.
  6908. C
  6909. C     ****************************************************************
  6910. C
  6911. C     Abstract:  Send a file or group of files to a remote Kermit.
  6912. C
  6913. C
  6914. C     MODIFICATION HISTORY
  6915. C
  6916. C     BY            DATE     REASON            PROGRAMS AFFECTED
  6917. C
  6918. C     ****************************************************************
  6919. C
  6920. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  6921. C
  6922. C     Calling Parameters:
  6923. C
  6924. C     R    ALIN         - Command line with name of file or group
  6925. C                         of files to be sent.
  6926. C
  6927. C     ****************************************************************
  6928. C
  6929. C     Messages generated by this module :  None
  6930. C
  6931. C     ****************************************************************
  6932. C
  6933. C     Subroutines called directly :  ASSGN4, CTA4, ISCAN, ISHFT
  6934. C                                    PACK, POSUSL, READ4, REW4,
  6935. C                                    SENDSW, SKIPBL, WAIT, WEOF4
  6936. C
  6937. C     ****************************************************************
  6938. C
  6939. C     Files referenced :  None
  6940. C
  6941. C     ****************************************************************
  6942. C
  6943. C     Local variable definitions :
  6944. C
  6945. C     A1           - Character pointer into ALIN
  6946. C     BEGENT       - Index to 1st entry in directory sector
  6947. C     BKPTR        - Pointer to previous sector
  6948. C     CH           - UFT number for directory reads
  6949. C     ERR          - Error indicator for CTA4
  6950. C     FILEOK       - Success flag from POSUSL, file was found
  6951. C     FRPTR        - Forward pointer to next directory sector
  6952. C     I            - Index variable
  6953. C     IDX          - Index variable
  6954. C     IND          - Error indicator from WAIT call
  6955. C     JUSL         - CAN code of directory name to be sent to
  6956. C                    the remote Kermit
  6957. C     MXENT        - Number of directory entries per sector
  6958. C     SCRLUN       - LUN of file for file name list
  6959. C     SCRUFT       - UFT number of file to be used for temporary
  6960. C                    storage of file names to be sent to remote
  6961. C     SECTOR       - Directory partition file position index to read
  6962. C     STATUS       - Function value returned by SENDSW
  6963. C     TCOUNT       - Index variable
  6964. C     X            - Dummy argument required by SENDSW function
  6965. C     DIRBUF(128)  - Buffer for directory sector
  6966. C     DIRNAM(132)  - Buffer for ASCII name of directory to send
  6967. C     ENTRY(9,14)  - Table of directory entries for a sector
  6968. C     FILNME(4)    - ASCII file name (packed 2 chars per word)
  6969. C     TLINE(12)    - File name buffer (unpacked ASCII)
  6970. C
  6971. C     ****************************************************************
  6972. C
  6973. C     Commons referenced :  KER, KERPAR, and UFTTBL local commons
  6974. C
  6975. C     ****************************************************************
  6976. C
  6977. C     (*$END.DOCUMENT*)
  6978. C
  6979. C     ****************************************************************
  6980. C     *                                                              *
  6981. C     *         D I M E N S I O N   S T A T E M E N T S              *
  6982. C     *                                                              *
  6983. C     ****************************************************************
  6984. C
  6985.       IMPLICIT INTEGER (A-Z)
  6986.       INTEGER*2   ALIN(1),     DIRNAM(132), ENTRY(9,14), DIRBUF(128)
  6987.       INTEGER*2   FILNME(4),   TLINE(12)
  6988. C
  6989. C     ****************************************************************
  6990. C     *                                                              *
  6991. C     *         T Y P E   S T A T E M E N T S                        *
  6992. C     *                                                              *
  6993. C     ****************************************************************
  6994. C
  6995.       LOGICAL*2   FILEOK
  6996. C
  6997. C     ****************************************************************
  6998. C     *                                                              *
  6999. C     *         C O M M O N   S T A T E M E N T S                    *
  7000. C     *                                                              *
  7001. C     ****************************************************************
  7002. C
  7003.       INCLUDE USL/KERCOM
  7004.       INCLUDE USL/KERPMC
  7005.       INCLUDE USL/UFTTBC
  7006. C
  7007. C     ****************************************************************
  7008. C     *                                                              *
  7009. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  7010. C     *                                                              *
  7011. C     ****************************************************************
  7012. C
  7013.       EQUIVALENCE (DIRBUF(1),BKPTR),        (DIRBUF(2),FRPTR)
  7014.       EQUIVALENCE (DIRBUF(3),ENTRY(1,1))
  7015. C
  7016. C     ****************************************************************
  7017. C     *                                                              *
  7018. C     *         D A T A   S T A T E M E N T S                        *
  7019. C     *                                                              *
  7020. C     ****************************************************************
  7021. C
  7022.       DATA        MXENT /14/,  SCRUFT / 9/
  7023. C
  7024. C     ****************************************************************
  7025. C
  7026. C     Code starts here :
  7027. C
  7028. C----->  If we're in HOST mode, issue binary READ.
  7029. C
  7030.       IF (HOSTON .NE. YES) GO TO 5
  7031.       CURCHN = 1
  7032.       CALL READ4 (IUFT(1,4),BLIN(1,CURCHN),132,.FALSE.)
  7033.     5 CONTINUE
  7034. C
  7035. C----->  Initialize the logical unit for the file name list.
  7036. C
  7037.       SCRLUN = IUFT(2,SCRUFT)
  7038. C
  7039. C----->  Position character pointer to start of file specification.
  7040. C
  7041.       A1 = 1
  7042.       CALL SKIPBL(ALIN,A1)
  7043.       IF (ALIN(A1) .NE. LF) GO TO 10
  7044.       WRITE (LOCALO,1000)
  7045.  1000 FORMAT (' PROPER FORMAT IS "SEND FILENAME" OR ',/
  7046.      >        ' "SEND @FILENAME"')
  7047.       RETURN
  7048.    10 CONTINUE
  7049. C
  7050. C----->  Check for "@" as next character.  If so then the request is
  7051. C----->  to send an entire directory of files.
  7052. C
  7053.       IF (ALIN(A1) .NE. ATSIGN) GO TO 90
  7054.       A1 = A1 + 1
  7055. C
  7056. C----->  Extract the directory name from the command line and
  7057. C----->  convert it to CAN code.
  7058. C
  7059.       DIRNAM(1) = 4Z2020
  7060.       DIRNAM(2) = 4Z2020
  7061.       DIRNAM(3) = 4Z2020
  7062.       CALL PACK (ALIN(A1),DIRNAM)
  7063.       JUSL = ISCAN (DIRNAM)
  7064. C
  7065. C----->  Set up the UFT for reading the directory.
  7066. C
  7067.       CH = 7
  7068.       IUFT(3,CH) = 4Z9400
  7069.       CALL ASSGN4 (IUFT(1,CH),JUSL)
  7070. C
  7071. C----->  Rewind the scratch file that will contain the names of the
  7072. C----->  files to be sent.
  7073. C
  7074.       CALL REW4 (IUFT(1,SCRUFT))
  7075. C
  7076. C----->  Read a directory and put the file names into the scratch file.
  7077. C
  7078.       FRPTR = 0
  7079.    20 CONTINUE
  7080.       IUFT(4,CH) = FRPTR
  7081.       SECTOR = FRPTR
  7082.       CALL READ4 (IUFT(1,CH),DIRBUF,256)
  7083.       IF (SECTOR .NE. 0) GO TO 30
  7084. C
  7085. C----->  Was the directory found?
  7086. C
  7087.       IF (BKPTR .EQ. -1) GO TO 30
  7088.       WRITE (1,1010) (DIRNAM(I),I=1,4)
  7089.  1010 FORMAT (' DIRECTORY NOT FOUND ON ',3A2)
  7090.       RETURN
  7091. C
  7092. C----->  Loop through this sector to find a file entry.
  7093. C
  7094.    30 CONTINUE
  7095.       BEGENT = 1
  7096.       IF (SECTOR .EQ. 0) BEGENT = 2
  7097.       DO 40 IDX=BEGENT,MXENT
  7098.       IF (ENTRY(1,IDX) .NE.      0 .AND.
  7099.      >    ENTRY(1,IDX) .NE. 4ZFEFE      ) GO TO 50
  7100.    40 CONTINUE
  7101. C
  7102. C----->  Entry not found, go read the next sector unless this
  7103. C----->  sector was the last (FRPTR = -1).
  7104. C
  7105.       IF (FRPTR .LT. 0) GO TO 80
  7106.       GO TO 20
  7107.    50 CONTINUE
  7108.       IF (ENTRY(1,IDX) .EQ. 4ZFFFF) GO TO 80
  7109.       IF (ENTRY(1,IDX) .EQ.      0 .OR.
  7110.      >    ENTRY(1,IDX) .EQ. 4ZFEFE     ) GO TO 75
  7111. C
  7112. C----->  Got a file entry, so convert the file
  7113. C----->  name into the unpacked ASCII string for
  7114. C----->  DPUTLIN.
  7115. C
  7116.       CALL CTA4 (ENTRY(1,IDX),TLINE(1),ERR)
  7117.       CALL CTA4 (ENTRY(2,IDX),TLINE(4),ERR)
  7118.       CALL CTA4 (ENTRY(3,IDX),TLINE(7),ERR)
  7119.       DO 55 I=1,9
  7120.       TLINE(I) = ISHFT (TLINE(I),-8)
  7121.    55 CONTINUE
  7122. C
  7123. C----->  Remove trailing blanks.
  7124. C
  7125.       DO 60 I=1,9
  7126.       TCOUNT = 10 - I
  7127.       IF (TLINE(TCOUNT) .NE.     0 .AND.
  7128.      >    TLINE(TCOUNT) .NE. BLANK      ) GO TO 70
  7129.    60 CONTINUE
  7130.       TCOUNT = 0
  7131.    70 CONTINUE
  7132. C
  7133. C----->  Add CR/EOS at the end.
  7134. C
  7135.       TLINE(TCOUNT+1) = LF
  7136.       TLINE(TCOUNT+2) = EOS
  7137. C
  7138. C----->  Write the file name out to the scratch file.
  7139. C
  7140.       FILNME(1) = '  '
  7141.       FILNME(2) = '  '
  7142.       FILNME(3) = '  '
  7143.       FILNME(4) = '  '
  7144.       CALL PACK (TLINE,FILNME)
  7145.       WRITE (SCRLUN,1050) FILNME
  7146.  1050 FORMAT (4A2)
  7147.    75 CONTINUE
  7148. C
  7149. C----->  Loop back to get another file name.
  7150. C
  7151.       IDX = IDX + 1
  7152.       IF (IDX .LE. MXENT) GO TO 50
  7153.       GO TO 20
  7154.    80 CONTINUE
  7155. C
  7156. C----->  Write an EOF after the last name in the scratch partition.
  7157. C
  7158.       CALL WEOF4 (IUFT(1,SCRUFT))
  7159.       GO TO 110
  7160.    90 CONTINUE
  7161. C
  7162. C----->  Write the file name in the command line to the scratch
  7163. C----->  partition.
  7164. C
  7165. C----->  First, try to position to the file.
  7166. C
  7167.       CH = 7
  7168.       CALL ASSGN4 (IUFT(1,CH),SUSL)
  7169.       FILNME(1) = '  '
  7170.       FILNME(2) = '  '
  7171.       FILNME(3) = '  '
  7172.       FILNME(4) = '  '
  7173.       CALL PACK (ALIN(A1),FILNME)
  7174.       CALL POSUSL (IUFT(2,CH),FILNME,FILEOK)
  7175.       IF (FILEOK) GO TO 100
  7176.       WRITE (LOCALO,1020)
  7177.  1020 FORMAT (' REQUESTED SOURCE FILE NOT FOUND.',//)
  7178.       RETURN
  7179.   100 CONTINUE
  7180. C
  7181. C----->  Put the file name at the beginning of the scratch.
  7182. C
  7183.       CALL REW4 (IUFT(1,SCRUFT))
  7184.       WRITE (SCRLUN,1050) FILNME
  7185.       CALL WEOF4 (IUFT(1,SCRUFT))
  7186.   110 CONTINUE
  7187. C
  7188. C----->  Send the file(s) to the remote Kermit.
  7189. C
  7190.       CALL REW4 (IUFT(1,SCRUFT))
  7191.       CALL WAIT (DELAY,2,IND)
  7192.       STATUS = SENDSW (X)
  7193.       IF (STATUS .EQ. YES) WRITE (LOCALO,1030)
  7194.  1030 FORMAT (' FILE TRANSFER COMPLETED.',//)
  7195.       IF (STATUS .NE. YES) WRITE (LOCALO,1040)
  7196.  1040 FORMAT (' FILE TRANSFER FAILED.',//)
  7197.       RETURN
  7198.       END
  7199. <<< sset. >>>
  7200.       SUBROUTINE SSET (ALIN)
  7201. C
  7202. C     ****************************************************************
  7203. C
  7204. C              KERMIT for the MODCOMP MAXIV operating system
  7205. C
  7206. C        Compliments of:
  7207. C
  7208. C                         SETPOINT, Inc.
  7209. C                      10245 Brecksville Rd.
  7210. C                      Brecksville, Ohio 44141
  7211. C
  7212. C
  7213. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  7214. C      of this version hereby grant permission to copy this software
  7215. C      provided that it is not used for an explicitly commercial
  7216. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  7217. C      no warranty whatsoever regarding the accuracy of this package
  7218. C      and will assume no liability resulting from it's use.
  7219. C
  7220. C     ****************************************************************
  7221. C
  7222. C     Abstract: PARSE AND SET VARIOUS SELECTABLE PARAMETERS
  7223. C
  7224. C     MODIFICATION HISTORY
  7225. C
  7226. C     BY            DATE     REASON            PROGRAMS AFFECTED
  7227. C
  7228. C     ****************************************************************
  7229. C
  7230. C     Author:  Bob Borgeson         Version: A.0    Date: Aug-86
  7231. C
  7232. C     Calling Parameters:
  7233. C
  7234. C     R    ALIN         - SET COMMAND STRING
  7235. C
  7236. C     ****************************************************************
  7237. C
  7238. C     Messages generated by this module :
  7239. C
  7240. C          SEE THE FORMAT STATEMENTS GROUPED AT THE END OF THE CODE
  7241. C
  7242. C     ****************************************************************
  7243. C
  7244. C     Subroutines called directly :  SKIPBL, CTOI
  7245. C
  7246. C     ****************************************************************
  7247. C
  7248. C     Files referenced :  None
  7249. C
  7250. C     ****************************************************************
  7251. C
  7252. C     Local variable definitions :
  7253. C
  7254. C           BLIN      SCRATCH FOR CHECKING COMMANDS
  7255. C           CHRFND    # OF CHARACTERS FOUND
  7256. C           CMDLEN    MAXIMUM LENGTH OF SET COMMANDS
  7257. C           CMDTBL    TABLE OF UNPACKED ASCII COMMANDS
  7258. C           FOUND     # OF COMMANDS FOUND
  7259. C           Fx        CHARACTER POSITIONS TO START SEARCH AT
  7260. C           GOODSP    IF = 1 THE SELECTED BAUD RATE IS OK
  7261. C           KUSL      UNPACKED USL NAME
  7262. C           NUMCMD    # OF COMMANDS SEARCHED FOR
  7263. C           NUMPAR    # OF PARITY KEYWORDS SEARCHED FOR
  7264. C           PARLEN    MAXIMUM LENGTH OF PARITY KEYWORD
  7265. C           TV        STARTING CHARACTER OF COMMAND
  7266. C           WCHCMD    WHICH COMMAND WAS FOUND
  7267. C           WCHPAR    WHICH PARITY WAS CHOSEN
  7268. C           Zx        CHARACTER POSITION TO START SEARCH AT
  7269. C
  7270. C     ****************************************************************
  7271. C
  7272. C     Commons referenced :  KER and KERPAR local commons
  7273. C
  7274. C     ****************************************************************
  7275. C
  7276. C     (*$END.DOCUMENT*)
  7277. C
  7278. C     ****************************************************************
  7279. C     *                                                              *
  7280. C     *         D I M E N S I O N   S T A T E M E N T S              *
  7281. C     *                                                              *
  7282. C     ****************************************************************
  7283. C
  7284.       IMPLICIT INTEGER (A-Z)
  7285. C
  7286.       INTEGER*2   ALIN(1) ,  BLIN(132) , KUSL(3), CMDTBL(8,9)
  7287.      >         ,  PARTBL(6,5)
  7288. C
  7289. C     ****************************************************************
  7290. C     *                                                              *
  7291. C     *         T Y P E   S T A T E M E N T S                        *
  7292. C     *                                                              *
  7293. C     ****************************************************************
  7294. C
  7295. C
  7296. C     ****************************************************************
  7297. C     *                                                              *
  7298. C     *         C O M M O N   S T A T E M E N T S                    *
  7299. C     *                                                              *
  7300. C     ****************************************************************
  7301. C
  7302.       INCLUDE USL/KERCOM
  7303.       INCLUDE USL/KERPMC
  7304. C
  7305. C     ****************************************************************
  7306. C     *                                                              *
  7307. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  7308. C     *                                                              *
  7309. C     ****************************************************************
  7310. C
  7311. C
  7312. C     ****************************************************************
  7313. C     *                                                              *
  7314. C     *         D A T A   S T A T E M E N T S                        *
  7315. C     *                                                              *
  7316. C     ****************************************************************
  7317. C
  7318.       DATA        CMDTBL       /66,65,85,68,10002,0,0,0,
  7319.      >                          68,69,76,65,89,10002,0,0,
  7320.      >                          80,65,82,73,84,89,10002,0,
  7321.      >                          69,83,67,65,80,69,10002,0,
  7322.      >                          80,65,67,75,69,84,10002,0,
  7323.      >                          83,79,72,10002,0,0,0,0,
  7324.      >                          69,79,76,10002,0,0,0,0,
  7325.      >                          77,89,81,85,79,84,69,10002,
  7326.      >                          85,83,76,10002,0,0,0,0/
  7327. C
  7328.       DATA        PARTBL       /79,68,68,10002,0,0,
  7329.      >                          69,86,69,78,10002,0,
  7330.      >                          77,65,82,75,10002,0,
  7331.      >                          83,80,65,67,69,10002,
  7332.      >                          78,79,78,69,10002,0/
  7333. C
  7334.       DATA   NUMPAR   / 5 /
  7335.      >      ,NUMCMD   / 9 /
  7336.      >      ,PARLEN   / 6 /
  7337.      >      ,CMDLEN   / 8 /
  7338. C
  7339. C     ****************************************************************
  7340. C
  7341. C     Code starts here :
  7342. C
  7343. C----->  Skip past SET to start of first parameter.
  7344. C
  7345.       A1 = 1
  7346.       CALL SKIPBL (ALIN,A1)
  7347.       TV = A1
  7348. C
  7349. C----->  Find the SET function - first strip this word
  7350. C
  7351.       FOUND = -1
  7352.       IEND = 81 - TV
  7353. C
  7354.       DO 10 I = 1,IEND
  7355. C
  7356.         BLIN(I) = ALIN(TV+I-1)
  7357. C
  7358.         IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 20
  7359. C
  7360.    10 CONTINUE
  7361. C
  7362.    20 CONTINUE
  7363. C
  7364.       BLIN(I) = LF
  7365.       BLIN(I+1) = EOS
  7366. C
  7367.       TV = I + 2
  7368. C
  7369.       DO 50 J = 1,NUMCMD
  7370. C
  7371.         DO 30 I = 1,CMDLEN
  7372. C
  7373. C-----> If you get LF, then we got a legal command
  7374. C
  7375.           IF(BLIN(I) .EQ. LF)GO TO 40
  7376. C
  7377. C-----> If end of command, then no match
  7378. C
  7379.           IF(CMDTBL(I,J) .EQ. EOS)GO TO 50
  7380. C
  7381. C-----> Check for matching character
  7382. C
  7383.           IF(BLIN(I) .NE. CMDTBL(I,J))GO TO 50
  7384. C
  7385.    30   CONTINUE
  7386. C
  7387.        GO TO 50
  7388. C
  7389.    40   CONTINUE
  7390. C
  7391. C------> Found your keyword
  7392. C
  7393.         WCHCMD = J
  7394.         FOUND = FOUND + 1
  7395. C
  7396.    50 CONTINUE
  7397. C
  7398.       IF (FOUND) 70 , 90 , 80
  7399. C
  7400.    70 CONTINUE
  7401. C
  7402. C----->   No command was recognized
  7403. C
  7404.       WRITE(LOCALO,75)
  7405.    75 FORMAT(' UNRECOGNIZED COMMAND - TYPE "HELP"')
  7406.       RETURN
  7407. C
  7408.    80 CONTINUE
  7409. C
  7410. C----->   The command was not unique
  7411. C
  7412.       WRITE(LOCALO,85)
  7413.    85 FORMAT(' AMBIGUOUS COMMAND - TYPE "HELP"')
  7414.       RETURN
  7415. C
  7416.    90 CONTINUE
  7417. C
  7418. C----->  Service the requested command
  7419. C
  7420.       GO TO(100,200,300,500,800,900,1000,1100,1200) , WCHCMD
  7421. C
  7422.   100 CONTINUE
  7423. C
  7424. C----->  Set BAUD rate.
  7425. C
  7426. C
  7427. C----->  If baud rate setting not supported, or in HOST mode,
  7428. C----->  do not allow baud rate to be set.
  7429. C
  7430. C+++++++
  7431.       HOSTON = NO
  7432.       SBAUD = YES
  7433. C+++++++++
  7434.       IF (SBAUD .NE. YES) GO TO 190
  7435.       IF (HOSTON .NE. YES) GO TO 120
  7436.       WRITE (LOCALO,9100)
  7437.       WRITE (LOCALO,9101)
  7438.       RETURN
  7439.   120 CONTINUE
  7440. C
  7441. C----->  Get the desired baud rate from the command line and
  7442. C----->  convert it to an integer.
  7443. C
  7444.       F1 = TV
  7445.       CALL SKIPBL (ALIN,F1)
  7446.       X = CTOI (ALIN,F1)
  7447. C
  7448. C----->  Validate the speed against the allowable values.
  7449. C
  7450.       IF (X .EQ.   300 .OR.
  7451.      >    X .EQ.  1200 .OR.
  7452.      >    X .EQ.  2400 .OR.
  7453.      >    X .EQ.  4800 .OR.
  7454.      >    X .EQ.  9600 .OR.
  7455.      >    X .EQ. 19200     ) GO TO 130
  7456.       WRITE (LOCALO,9102)
  7457.       RETURN
  7458.   130 CONTINUE
  7459.       SPEED = X
  7460.       RETURN
  7461.   190 CONTINUE
  7462.       WRITE (LOCALO,9103)
  7463.       RETURN
  7464. C
  7465.   200 CONTINUE
  7466. C
  7467. C----->  Set the initial packet delay period if not
  7468. C----->  in remote host mode.
  7469. C
  7470.       IF (HOSTON .NE. NO) GO TO 210
  7471.       WRITE (LOCALO,9104)
  7472.       RETURN
  7473.   210 CONTINUE
  7474. C
  7475. C----->  Get the delay value.
  7476. C
  7477.       F2 = TV
  7478.       CALL SKIPBL (ALIN,F2)
  7479.       X = CTOI (ALIN,F2)
  7480.       IF (X .GT. 0) GO TO 220
  7481.       WRITE (LOCALO,9105)
  7482.       RETURN
  7483.   220 CONTINUE
  7484. C
  7485. C----->  Only allow values in range of 0..60.
  7486. C
  7487.       IF (X .LE. 60) GO TO 230
  7488.       DELAY  =  60
  7489.       WRITE (LOCALO,9106)
  7490.       WRITE (LOCALO,9107)
  7491.       RETURN
  7492.   230 CONTINUE
  7493.       DELAY = X
  7494.       RETURN
  7495.   300 CONTINUE
  7496. C
  7497. C----->  Set data parity.
  7498. C
  7499. C+++++++++
  7500.       HOSTON = NO
  7501.       SPARITY = YES
  7502. C+++++++++++++
  7503.       IF (SPARITY  .NE.  YES) GO TO 390
  7504.       IF (HOSTON  .NE.  YES) GO TO 310
  7505.       WRITE (LOCALO,9108)
  7506.       WRITE (LOCALO,9109)
  7507.       RETURN
  7508.   310 CONTINUE
  7509. C
  7510.       F3 = TV
  7511.       CALL SKIPBL(ALIN,F3)
  7512.       TV = F3
  7513. C
  7514. C----->  Pull out the parity keyword
  7515. C
  7516.       DO 315 I = 1,6
  7517. C
  7518.         BLIN(I) = ALIN(TV+I-1)
  7519.         IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 320
  7520. C
  7521.   315 CONTINUE
  7522. C
  7523.   320 CONTINUE
  7524. C
  7525.       BLIN(I) = LF
  7526.       BLIN(I+1) = EOS
  7527. C
  7528.       FOUND = -1
  7529. C
  7530.       DO 345 J = 1,NUMPAR
  7531. C
  7532.         DO 325 I = 1,PARLEN
  7533. C
  7534. C------>   If end of keyword, then this is a good answer
  7535. C
  7536.           IF(BLIN(I) .EQ. LF)GO TO 335
  7537. C
  7538. C------>   If end of search pattern, no good
  7539. C
  7540.           IF(PARTBL(I,J) .EQ. EOS)GO TO 345
  7541. C
  7542. C------>   Check next character
  7543. C
  7544.           IF(BLIN(I) .NE. PARTBL(I,J))GO TO 345
  7545. C
  7546.   325   CONTINUE
  7547. C
  7548.         GO TO 345
  7549. C
  7550.   335   CONTINUE
  7551. C
  7552. C------>  Remember which keyword was found
  7553. C
  7554.         WCHPAR = J
  7555.         FOUND = FOUND + 1
  7556. C
  7557.   345 CONTINUE
  7558. C
  7559.       IF (FOUND) 385 , 350 , 80
  7560. C
  7561.   350 CONTINUE
  7562. C
  7563.       GO TO (360 , 360 , 380 , 370 , 360 ), WCHPAR
  7564. C
  7565.   360 CONTINUE
  7566. C
  7567. C----->  Set the selected parity flag
  7568. C
  7569.       PARITY = WCHPAR
  7570.       RETURN
  7571. C
  7572.   370 CONTINUE
  7573. C
  7574. C----->  This parity is not supported on MODCOMP
  7575. C
  7576.       WRITE(LOCALO,9110)
  7577.       RETURN
  7578. C
  7579.   380 CONTINUE
  7580. C
  7581. C----->  This parity is not supported on MODCOMP
  7582. C
  7583.       WRITE(LOCALO,9111)
  7584.       RETURN
  7585. C
  7586.   385 CONTINUE
  7587. C
  7588.       WRITE(LOCALO,9112)
  7589.       RETURN
  7590. C
  7591.   390 CONTINUE
  7592. C
  7593. C----->  Parity not selectable.
  7594. C
  7595.       WRITE (LOCALO,9113)
  7596.       RETURN
  7597.   500 CONTINUE
  7598. C
  7599. C----->  Set HOST mode escape character.
  7600. C
  7601.       IF (HOSTON .NE. YES) GO TO 510
  7602.       WRITE (LOCALO,9117)
  7603.       WRITE (LOCALO,9118)
  7604.       RETURN
  7605.   510 CONTINUE
  7606.       F5 = TV
  7607.       CALL SKIPBL (ALIN,F5)
  7608.       X = CTOI (ALIN,F5)
  7609.       IF (X .LE.  0 .OR.
  7610.      >    X .GE. 32      ) GO TO 520
  7611.       ESCHAR = X
  7612.       RETURN
  7613.   520 CONTINUE
  7614.       WRITE (LOCALO,9119)
  7615.       RETURN
  7616.   800 CONTINUE
  7617. C
  7618. C----->  Set the packet size.
  7619. C
  7620.       F8 = TV
  7621.       CALL SKIPBL(ALIN,F8)
  7622.       X = CTOI(ALIN,F8)
  7623.       IF (X .LE. 30 .OR.
  7624.      >    X .GE. 95     ) GO TO 810
  7625.       PAKSIZ = X
  7626.       RETURN
  7627.   810 CONTINUE
  7628.       WRITE (LOCALO,9126)
  7629.       RETURN
  7630.   900 CONTINUE
  7631. C
  7632. C----->  Set the start of header character.
  7633. C
  7634.       F9 = TV
  7635.       CALL SKIPBL (ALIN,F9)
  7636.       X = CTOI (ALIN,F9)
  7637.       IF (HOSTON .NE. YES) GO TO 930
  7638.       IF (X .NE. EOL) GO TO 910
  7639.       WRITE (LOCALO,9127)
  7640.       RETURN
  7641.   910 CONTINUE
  7642.       IF (X .LE.  0 .OR.
  7643.      >    X .GE. 32     ) GO TO 920
  7644.       SOH = X
  7645.       RETURN
  7646.   920 CONTINUE
  7647.       WRITE (LOCALO,9128)
  7648.       RETURN
  7649.   930 CONTINUE
  7650.       IF (X .NE.    EOL .AND.
  7651.      >    X .NE. PROMPT      ) GO TO 940
  7652.       WRITE (LOCALO,9129)
  7653.       WRITE (LOCALO,9130)
  7654.       RETURN
  7655.   940 CONTINUE
  7656.       IF (X .LE.  0 .OR.
  7657.      >    X .GE. 32     ) GO TO 950
  7658.       SOH = X
  7659.       RETURN
  7660.   950 CONTINUE
  7661.       WRITE (LOCALO,9131)
  7662.       WRITE (LOCALO,9132)
  7663.       RETURN
  7664.  1000 CONTINUE
  7665. C
  7666. C----->  Set the end-of-line character.
  7667. C
  7668.       F10 = TV
  7669.       CALL SKIPBL (ALIN,F10)
  7670.       X = CTOI (ALIN,F10)
  7671.       IF (HOSTON .NE. YES) GO TO 1030
  7672.       IF (X .NE. SOH) GO TO 1010
  7673.       WRITE (LOCALO,9133)
  7674.       RETURN
  7675.  1010 CONTINUE
  7676.       IF (X .LE.  0 .OR.
  7677.      >    X .GE. 32     ) GO TO 1020
  7678.       MYEOL = X
  7679.       RETURN
  7680.  1020 CONTINUE
  7681.       WRITE (LOCALO,9134)
  7682.       WRITE (LOCALO,9135)
  7683.       RETURN
  7684.  1030 CONTINUE
  7685.       IF (X .NE.    SOH .AND.
  7686.      >    X .NE. PROMPT      ) GO TO 1040
  7687.       WRITE (LOCALO,9136)
  7688.       WRITE (LOCALO,9137)
  7689.       RETURN
  7690.  1040 CONTINUE
  7691.       IF (X .LE.  0 .OR.
  7692.      >    X .GE. 32     )GO TO 1050
  7693.       MYEOL = X
  7694.       RETURN
  7695.  1050 CONTINUE
  7696.       WRITE (LOCALO,9138)
  7697.       WRITE (LOCALO,9139)
  7698.       RETURN
  7699.  1100 CONTINUE
  7700. C
  7701. C----->  Set the quoting character.
  7702. C
  7703.       F11 = TV
  7704.       CALL SKIPBL (ALIN,F11)
  7705.       X = CTOI (ALIN,F11)
  7706.       IF (X .LE.  32 .OR.
  7707.      >    X .GE. 127     ) GO TO 1110
  7708.       MYQUOTE = X
  7709.       RETURN
  7710.  1110 CONTINUE
  7711.       WRITE (LOCALO,9140)
  7712.       WRITE (LOCALO,9141)
  7713.       RETURN
  7714.  1200 CONTINUE
  7715. C
  7716. C----->  Set the USL directory for files to send.
  7717. C
  7718.         F12 = TV
  7719.         CALL SKIPBL (ALIN,F12)
  7720. C
  7721. C----->  Make the USL name is CAN codeable.
  7722. C
  7723.       CHRFND = 0
  7724. C
  7725.       DO 1210 I=1,3
  7726.       ICHAR = ALIN(F12+3-I)
  7727. C
  7728.       IF((ICHAR .EQ. LF) .OR. (ICHAR .EQ. EOS))ALIN(F12+3-I) = BLANK
  7729.       IF(((ICHAR .EQ. BLANK) .OR. (ICHAR .EQ. LF) .OR.
  7730.      >    (ICHAR .EQ. EOS)) .AND. (CHRFND .EQ. 0))GO TO 1210
  7731.       CHRFND = CHRFND + 1
  7732. C
  7733.       IF ((ICHAR .GE. BIGA .AND. ICHAR .LE. BIGZ) .OR.
  7734.      >    (ICHAR .GE. DIG0 .AND. ICHAR .LE. DIG9) .OR.
  7735.      >    (ICHAR .EQ. COLON)                      .OR.
  7736.      >    (ICHAR .EQ. PERIOD)                     .OR.
  7737.      >    (ICHAR .EQ. DOLLAR)                         ) GO TO 1210
  7738.       GO TO 1220
  7739.  1210 CONTINUE
  7740. C
  7741.       IF(CHRFND .EQ. 0)GO TO 1220
  7742.       GO TO 1230
  7743. C
  7744.  1220 CONTINUE
  7745. C
  7746. C-----> USL not can codeable.
  7747. C
  7748.       WRITE (LOCALO,9143)
  7749.       RETURN
  7750.  1230 CONTINUE
  7751.       KUSL(1) = ISHFT (ALIN(F12),8)
  7752.       KUSL(2) = ISHFT (ALIN(F12+1),8)
  7753.       KUSL(3) = ISHFT (ALIN(F12+2),8)
  7754.       SUSL = IACAN4 (KUSL)
  7755.       RETURN
  7756.  9100 FORMAT(' BAUD RATE SETTING NOT SUPPORTED')
  7757.  9101 FORMAT(' IN REMOTE HOST MODE')
  7758.  9102 FORMAT(' INVALID OR UNSUPPORTED BAUD RATE SELECTED')
  7759.  9103 FORMAT(' THIS SYSTEM DOES NOT SUPPORT BAUD SELECTION')
  7760.  9104 FORMAT(' DELAY SETTING NOT VALID IN LOCAL HOST MODE')
  7761.  9105 FORMAT(' INVALID DELAY SETTING')
  7762.  9106 FORMAT(' DELAY SETTING TOO LONG')
  7763.  9107 FORMAT(' DEFAULTED TO 60 SECONDS')
  7764.  9108 FORMAT(' PARITY SETTING NOT SUPPORTED')
  7765.  9109 FORMAT(' IN REMOTE HOST MODE')
  7766.  9110 FORMAT(' SPACE PARITY NOT SUPPORTED IN MAXIV')
  7767.  9111 FORMAT(' MARK PARITY NOT SUPPORTED IN MAXIV')
  7768.  9112 FORMAT(' PARITY SELECTED NOT VALID')
  7769.  9113 FORMAT(' PARITY SETTING NOT SUPPORTED IN THIS SYSTEM')
  7770.  9117 FORMAT(' ESCAPE SETTING NOT VALID IN')
  7771.  9118 FORMAT(' REMOTE HOST MODE')
  7772.  9119 FORMAT(' ESCAPE CHARACTER MUST BE BETWEEN 0 & 32')
  7773.  9126 FORMAT(' INVALID PACKET SIZE SPECIFIED')
  7774.  9127 FORMAT(' INVALID; IN CONFLICT WITH EOL')
  7775.  9128 FORMAT(' INVALID; SOH MUST BE BETWEEN 0 & 32')
  7776.  9129 FORMAT(' INVALID; IN CONFLICT WITH EOL')
  7777.  9130 FORMAT(' OR IBM PROMPT')
  7778.  9131 FORMAT(' INVALID; SOH MUST BE BETWEEN')
  7779.  9132 FORMAT(' 0 & 32')
  7780.  9133 FORMAT(' INVALID; IN CONFLICT WITH SOH')
  7781.  9134 FORMAT(' INVALID; EOL MUST BE BETWEEN')
  7782.  9135 FORMAT(' 0 & 32')
  7783.  9136 FORMAT(' INVALID; EOL IN CONFLICT WITH')
  7784.  9137 FORMAT(' SOH OR IBM PROMPT')
  7785.  9138 FORMAT(' INVALID; EOL MUST BE BETWEEN')
  7786.  9139 FORMAT(' 0 & 32')
  7787.  9140 FORMAT(' QUOTE CHARACTER MUST BE BETWEEN')
  7788.  9141 FORMAT(' 32 & 127')
  7789.  9142 FORMAT(' INVALID SET PARAMETER(S) DETECTED')
  7790.  9143 FORMAT(' USL NAME NOT CANCODEABLE')
  7791.  9144 FORMAT(' INVALID SET HOST MODE SELECTED')
  7792.       END
  7793. <<< sstatu. >>>
  7794.       SUBROUTINE SSTATUS
  7795. C
  7796. C     ****************************************************************
  7797. C
  7798. C              KERMIT for the MODCOMP MAXIV operating system
  7799. C
  7800. C        Compliments of:
  7801. C
  7802. C                         SETPOINT, Inc.
  7803. C                      10245 Brecksville Rd.
  7804. C                      Brecksville, Ohio 44141
  7805. C
  7806. C
  7807. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  7808. C      of this version hereby grant permission to copy this software
  7809. C      provided that it is not used for an explicitly commercial
  7810. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  7811. C      no warranty whatsoever regarding the accuracy of this package
  7812. C      and will assume no liability resulting from it's use.
  7813. C
  7814. C     ****************************************************************
  7815. C
  7816. C     Abstract:  OUTPUT THE STATUS AND VALUES OF VARIABLES
  7817. C
  7818. C     MODIFICATION HISTORY
  7819. C
  7820. C     BY            DATE     REASON            PROGRAMS AFFECTED
  7821. C
  7822. C     ****************************************************************
  7823. C
  7824. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  7825. C
  7826. C     Calling Parameters:  None
  7827. C
  7828. C     ****************************************************************
  7829. C
  7830. C     Messages generated by this module :  None
  7831. C
  7832. C     ****************************************************************
  7833. C
  7834. C     Subroutines called directly :  CTA4
  7835. C
  7836. C     ****************************************************************
  7837. C
  7838. C     Files referenced :  None
  7839. C
  7840. C     ****************************************************************
  7841. C
  7842. C     Local variable definitions :
  7843. C
  7844. C     KUSL   -  UNPACKED VERSION OF USL NAME  (IN HIGH ORDER BYTES)
  7845. C
  7846. C     ****************************************************************
  7847. C
  7848. C     Commons referenced :  KER, and KERPAR local commons
  7849. C
  7850. C     ****************************************************************
  7851. C
  7852. C     (*$END.DOCUMENT*)
  7853. C
  7854. C     ****************************************************************
  7855. C     *                                                              *
  7856. C     *         D I M E N S I O N   S T A T E M E N T S              *
  7857. C     *                                                              *
  7858. C     ****************************************************************
  7859. C
  7860.       IMPLICIT INTEGER (A-Z)
  7861. C
  7862.       INTEGER*2   KUSL(3)
  7863. C
  7864. C     ****************************************************************
  7865. C     *                                                              *
  7866. C     *         T Y P E   S T A T E M E N T S                        *
  7867. C     *                                                              *
  7868. C     ****************************************************************
  7869. C
  7870. C
  7871. C     ****************************************************************
  7872. C     *                                                              *
  7873. C     *         C O M M O N   S T A T E M E N T S                    *
  7874. C     *                                                              *
  7875. C     ****************************************************************
  7876. C
  7877.       INCLUDE USL/KERCOM
  7878.       INCLUDE USL/KERPMC
  7879. C
  7880. C     ****************************************************************
  7881. C     *                                                              *
  7882. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  7883. C     *                                                              *
  7884. C     ****************************************************************
  7885. C
  7886. C
  7887. C     ****************************************************************
  7888. C     *                                                              *
  7889. C     *         D A T A   S T A T E M E N T S                        *
  7890. C     *                                                              *
  7891. C     ****************************************************************
  7892. C
  7893. C
  7894. C     ****************************************************************
  7895. C
  7896. C     Code starts here :
  7897. C
  7898. C----->  Convert the USL name to ASCII.
  7899. C
  7900.       CALL CTA4 (SUSL,KUSL,IND)
  7901.       IF (IND .EQ. 1) GO TO 10
  7902.       KUSL(1) = '?'
  7903.       KUSL(2) = '?'
  7904.       KUSL(3) = '?'
  7905.    10 CONTINUE
  7906. C                                    !WE ARE RUNNING IN REMOTE HOST MODE
  7907.       IF(HOSTON.NE.YES)GO TO 1000
  7908.          WRITE (LOCALO,107)
  7909.          WRITE (LOCALO,104)DELAY
  7910.          WRITE (LOCALO,103)MYEOL
  7911.          WRITE (LOCALO,100)PAKSIZ
  7912.          WRITE (LOCALO,102)MYQUOTE
  7913.          WRITE (LOCALO,101)SOH
  7914.          WRITE (LOCALO,120)KUSL
  7915.          IF(STATE.EQ.BIGC) WRITE (LOCALO,108)
  7916.          IF(STATE .NE. BIGC)WRITE (LOCALO,109)
  7917.          RETURN
  7918.  1000 CONTINUE
  7919.            WRITE (LOCALO,110)
  7920.            WRITE (LOCALO,106)SPEED
  7921.            WRITE (LOCALO,103)MYEOL
  7922.            WRITE (LOCALO,105)ESCHAR
  7923.            IF(IBMON.NE.YES)GO TO 1100
  7924.               WRITE (LOCALO,117)
  7925.               WRITE (LOCALO,119)PROMPT
  7926.               GO TO 1200
  7927.  1100      CONTINUE
  7928.            WRITE (LOCALO,118)
  7929.  1200      CONTINUE
  7930.            WRITE (LOCALO,100)PAKSIZ
  7931.            IF(PARITY.EQ.1) WRITE (LOCALO,111)
  7932.            IF(PARITY.EQ.2) WRITE (LOCALO,112)
  7933.            IF(PARITY.EQ.3) WRITE (LOCALO,113)
  7934.            IF(PARITY.EQ.4) WRITE (LOCALO,114)
  7935.            IF((PARITY .LT. 1) .OR. (PARITY .GT. 4))WRITE (LOCALO,115)
  7936.            WRITE (LOCALO,102)MYQUOTE
  7937.            WRITE (LOCALO,101)SOH
  7938.            WRITE (LOCALO,120)KUSL
  7939.            WRITE (LOCALO,116)
  7940.            IF(STATE.EQ.BIGC) WRITE (LOCALO,108)
  7941.            IF(STATE .NE. BIGC)WRITE (LOCALO,109)
  7942. 100   FORMAT(' PACKET SIZE = ',I4)
  7943. 101   FORMAT(' SOH         = ',I4)
  7944. 102   FORMAT(' MYQUOTE     = ',I4)
  7945. 103   FORMAT(' MYEOL       = ',I4)
  7946. 104   FORMAT(' DELAY (SEC) = ',I4)
  7947. 105   FORMAT(' ESCAPE CHAR = ',I4)
  7948. 106   FORMAT(' BAUD RATE   = ',I5)
  7949. 107   FORMAT(' REMOTE HOST KERMIT MODE IN EFFECT')
  7950. 108   FORMAT(' FILE TRANSFER STATE = C')
  7951. 109   FORMAT(' FILE TRANSFER STATE = A')
  7952. 110   FORMAT(' LOCAL KERMIT MODE IN EFFECT')
  7953. 111   FORMAT(' PARITY      = EVEN')
  7954. 112   FORMAT(' PARITY      = ODD')
  7955. 113   FORMAT(' PARITY      = SPACE')
  7956. 114   FORMAT(' PARITY      = MARK')
  7957. 115   FORMAT(' PARITY      = NONE')
  7958. 116   FORMAT(' REMOTE TTY LINE USED IS ??')
  7959. 117   FORMAT(' IBM FLAG    =   ON')
  7960. 118   FORMAT(' IBM FLAG    =  OFF')
  7961. 119   FORMAT(' IBM PROMPT  = ',I4)
  7962. 120   FORMAT(' USL DIRECTORY = ',3A1)
  7963.       RETURN
  7964.       END
  7965. <<< tochar. >>>
  7966.       INTEGER FUNCTION TOCHAR(CH)
  7967. C
  7968. C     ****************************************************************
  7969. C
  7970. C              KERMIT for the MODCOMP MAXIV operating system
  7971. C
  7972. C        Compliments of:
  7973. C
  7974. C                         SETPOINT, Inc.
  7975. C                      10245 Brecksville Rd.
  7976. C                      Brecksville, Ohio 44141
  7977. C
  7978. C
  7979. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  7980. C      of this version hereby grant permission to copy this software
  7981. C      provided that it is not used for an explicitly commercial
  7982. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  7983. C      no warranty whatsoever regarding the accuracy of this package
  7984. C      and will assume no liability resulting from it's use.
  7985. C
  7986. C     ****************************************************************
  7987. C
  7988. C     Abstract:  CONVERT INTEGER TO ASCII (ADD 32)
  7989. C
  7990. C     MODIFICATION HISTORY
  7991. C
  7992. C     BY            DATE     REASON            PROGRAMS AFFECTED
  7993. C
  7994. C     ****************************************************************
  7995. C
  7996. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  7997. C
  7998. C     Calling Parameters:
  7999. C
  8000. C     R    CH          - NUMBER TO TRANSFORM
  8001. C
  8002. C     ****************************************************************
  8003. C
  8004. C     Messages generated by this module :  None
  8005. C
  8006. C     ****************************************************************
  8007. C
  8008. C     Subroutines called directly :  None
  8009. C
  8010. C     ****************************************************************
  8011. C
  8012. C     Files referenced :  None
  8013. C
  8014. C     ****************************************************************
  8015. C
  8016. C     Local variable definitions :  None
  8017. C
  8018. C     ****************************************************************
  8019. C
  8020. C     Commons referenced :  KERPAR local common
  8021. C
  8022. C     ****************************************************************
  8023. C
  8024. C     (*$END.DOCUMENT*)
  8025. C
  8026. C     ****************************************************************
  8027. C     *                                                              *
  8028. C     *         D I M E N S I O N   S T A T E M E N T S              *
  8029. C     *                                                              *
  8030. C     ****************************************************************
  8031. C
  8032.       IMPLICIT INTEGER (A-Z)
  8033. C
  8034. C     ****************************************************************
  8035. C     *                                                              *
  8036. C     *         T Y P E   S T A T E M E N T S                        *
  8037. C     *                                                              *
  8038. C     ****************************************************************
  8039. C
  8040. C
  8041. C     ****************************************************************
  8042. C     *                                                              *
  8043. C     *         C O M M O N   S T A T E M E N T S                    *
  8044. C     *                                                              *
  8045. C     ****************************************************************
  8046. C
  8047.       INCLUDE USL/KERPMC
  8048. C
  8049. C     ****************************************************************
  8050. C     *                                                              *
  8051. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  8052. C     *                                                              *
  8053. C     ****************************************************************
  8054. C
  8055. C
  8056. C     ****************************************************************
  8057. C     *                                                              *
  8058. C     *         D A T A   S T A T E M E N T S                        *
  8059. C     *                                                              *
  8060. C     ****************************************************************
  8061. C
  8062. C
  8063. C     ****************************************************************
  8064. C
  8065. C     Code starts here :
  8066. C
  8067.       TOCHAR = CH + BLANK
  8068.       RETURN
  8069.       END
  8070. <<< tputch. >>>
  8071.       SUBROUTINE TPUTCH (XCHAR,CH)
  8072. C
  8073. C     ****************************************************************
  8074. C
  8075. C              KERMIT for the MODCOMP MAXIV operating system
  8076. C
  8077. C        Compliments of:
  8078. C
  8079. C                         SETPOINT, Inc.
  8080. C                      10245 Brecksville Rd.
  8081. C                      Brecksville, Ohio 44141
  8082. C
  8083. C
  8084. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  8085. C      of this version hereby grant permission to copy this software
  8086. C      provided that it is not used for an explicitly commercial
  8087. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  8088. C      no warranty whatsoever regarding the accuracy of this package
  8089. C      and will assume no liability resulting from it's use.
  8090. C
  8091. C     ****************************************************************
  8092. C
  8093. C     Abstract:  OUTPUT A CHAR.
  8094. C
  8095. C     MODIFICATION HISTORY
  8096. C
  8097. C     BY            DATE     REASON            PROGRAMS AFFECTED
  8098. C
  8099. C
  8100. C     ****************************************************************
  8101. C
  8102. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  8103. C
  8104. C     Calling Parameters:
  8105. C
  8106. C     R    XCHAR   - CHARACTER TO OUTPUT (UNPACKED IN 1 WORD)
  8107. C     R    CH      - UFT # TO OUTPUT IT ON
  8108. C
  8109. C     ****************************************************************
  8110. C
  8111. C     Messages generated by this module :  None
  8112. C
  8113. C     ****************************************************************
  8114. C
  8115. C     Subroutines called directly :  WRITE4
  8116. C
  8117. C     ****************************************************************
  8118. C
  8119. C     Files referenced :  None
  8120. C
  8121. C     ****************************************************************
  8122. C
  8123. C     Local variable definitions :
  8124. C
  8125. C      IBUF  - SCRATCH TO OUTPUT CHARACTER WITH
  8126. C
  8127. C     ****************************************************************
  8128. C
  8129. C     Commons referenced :  KERPAR, UFTTBL
  8130. C
  8131. C     ****************************************************************
  8132. C
  8133. C     (*$END.DOCUMENT*)
  8134. C
  8135. C     ****************************************************************
  8136. C     *                                                              *
  8137. C     *         D I M E N S I O N   S T A T E M E N T S              *
  8138. C     *                                                              *
  8139. C     ****************************************************************
  8140. C
  8141.       IMPLICIT INTEGER (A-Z)
  8142. C
  8143. C     ****************************************************************
  8144. C     *                                                              *
  8145. C     *         T Y P E   S T A T E M E N T S                        *
  8146. C     *                                                              *
  8147. C     ****************************************************************
  8148. C
  8149. C
  8150. C     ****************************************************************
  8151. C     *                                                              *
  8152. C     *         C O M M O N   S T A T E M E N T S                    *
  8153. C     *                                                              *
  8154. C     ****************************************************************
  8155. C
  8156.       INCLUDE USL/KERPMC
  8157.       INCLUDE USL/UFTTBC
  8158. C
  8159. C     ****************************************************************
  8160. C     *                                                              *
  8161. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  8162. C     *                                                              *
  8163. C     ****************************************************************
  8164. C
  8165. C
  8166. C     ****************************************************************
  8167. C     *                                                              *
  8168. C     *         D A T A   S T A T E M E N T S                        *
  8169. C     *                                                              *
  8170. C     ****************************************************************
  8171. C
  8172. C
  8173. C     ****************************************************************
  8174. C
  8175. C     Code starts here :
  8176. C
  8177. C                                   !SHIFT BYTE LEFT BY 8 BITS
  8178.       IBUF=ISHFT(XCHAR,8)
  8179. C                                   !OUTPUT A SINGLE BYTE IN WAIT MODE
  8180.       CALL WRITE4(IUFT(1,CH),IBUF,1,.TRUE.)
  8181.       RETURN
  8182.       END
  8183. <<< uftini. >>>
  8184.       SUBROUTINE UFTINI
  8185. C
  8186. C     ****************************************************************
  8187. C
  8188. C              KERMIT for the MODCOMP MAXIV operating system
  8189. C
  8190. C        Compliments of:
  8191. C
  8192. C                         SETPOINT, Inc.
  8193. C                      10245 Brecksville Rd.
  8194. C                      Brecksville, Ohio 44141
  8195. C
  8196. C
  8197. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  8198. C      of this version hereby grant permission to copy this software
  8199. C      provided that it is not used for an explicitly commercial
  8200. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  8201. C      no warranty whatsoever regarding the accuracy of this package
  8202. C      and will assume no liability resulting from it's use.
  8203. C
  8204. C     ****************************************************************
  8205. C
  8206. C     Abstract:  Initialize the UFTs required for the MAX IV Kermit
  8207. C                package.
  8208. C
  8209. C     MODIFICATION HISTORY
  8210. C
  8211. C     BY            DATE     REASON            PROGRAMS AFFECTED
  8212. C
  8213. C     ****************************************************************
  8214. C
  8215. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  8216. C
  8217. C     Calling Parameters:  None
  8218. C
  8219. C     ****************************************************************
  8220. C
  8221. C     Messages generated by this module :  None
  8222. C
  8223. C     ****************************************************************
  8224. C
  8225. C     Subroutines called directly :  BLDUFT, REWIND
  8226. C
  8227. C     ****************************************************************
  8228. C
  8229. C     Files referenced :  None
  8230. C
  8231. C     ****************************************************************
  8232. C
  8233. C     Local variable definitions :
  8234. C
  8235. C     DEV1         - Logical device to which KE2 is assigned
  8236. C     DEV2         - Logical device to which KE4 is assigned
  8237. C     HANOPT       - Handler options word from TASS4
  8238. C     LDEVST       - Logical device status returned from TASS4
  8239. C     LFNAM        - CAN code of base value of LFN for Kermit I/O
  8240. C     RECSIZ       - Record size returned by TASS4
  8241. C     SUCCES       - Success indicator of TASS4 calls
  8242. C
  8243. C     ****************************************************************
  8244. C
  8245. C     Commons referenced :  KER, KERPAR, and UFTTBL local commons
  8246. C
  8247. C     ****************************************************************
  8248. C
  8249. C     (*$END.DOCUMENT*)
  8250. C
  8251. C     ****************************************************************
  8252. C     *                                                              *
  8253. C     *         D I M E N S I O N   S T A T E M E N T S              *
  8254. C     *                                                              *
  8255. C     ****************************************************************
  8256. C
  8257.       IMPLICIT INTEGER (A-Z)
  8258. C
  8259. C     ****************************************************************
  8260. C     *                                                              *
  8261. C     *         T Y P E   S T A T E M E N T S                        *
  8262. C     *                                                              *
  8263. C     ****************************************************************
  8264. C
  8265. C
  8266. C     ****************************************************************
  8267. C     *                                                              *
  8268. C     *         C O M M O N   S T A T E M E N T S                    *
  8269. C     *                                                              *
  8270. C     ****************************************************************
  8271. C
  8272.       INCLUDE USL/KERCOM
  8273.       INCLUDE USL/KERPMC
  8274.       INCLUDE USL/UFTTBC
  8275. C
  8276. C     ****************************************************************
  8277. C     *                                                              *
  8278. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  8279. C     *                                                              *
  8280. C     ****************************************************************
  8281. C
  8282. C
  8283. C     ****************************************************************
  8284. C     *                                                              *
  8285. C     *         D A T A   S T A T E M E N T S                        *
  8286. C     *                                                              *
  8287. C     ****************************************************************
  8288. C
  8289.       DATA LFNAM /3@KE0/
  8290. C
  8291. C     ****************************************************************
  8292. C
  8293. C     Code starts here :
  8294. C
  8295.       CALL BLDUFT (IUFT(1,1),0,LFNAM+1,4ZA000)
  8296.       CALL BLDUFT (IUFT(1,2),0,LFNAM+2,4ZE000)
  8297.       CALL BLDUFT (IUFT(1,3),0,LFNAM+3,4ZC280)
  8298.       CALL BLDUFT (IUFT(1,4),0,LFNAM+4,4ZD380,0,0,0,4Z8000,0,BLIN(1,1),
  8299.      >             132)
  8300.       CALL BLDUFT (IUFT(1,5),0,LFNAM+5,4ZA000)
  8301.       CALL BLDUFT (IUFT(1,7),0,LFNAM+7,4ZA000)
  8302.       CALL BLDUFT (IUFT(1,8),0,LFNAM+8,4ZA000)
  8303.       CALL BLDUFT (IUFT(1,9),0,LFNAM+9,4ZA000)
  8304.       CALL BLDUFT (IUFT(1,10),0,LFNAM+4,4ZD380,0,0,0,4Z8000,0,BLIN(1,2),
  8305.      >             132)
  8306. C
  8307. C                 NOW REWIND THE DISK FILES WE WILL ACCESS
  8308. C
  8309.       CALL REW4 (IUFT(1,5))
  8310.       CALL REW4 (IUFT(1,8))
  8311. C
  8312.       CALL WEOF4 (IUFT(1,8))
  8313. C
  8314. C----->  If the terminal I/O and Kermit I/O ports are pointing
  8315. C----->  at the I/O channel then set HOSTON = YES and defer
  8316. C----->  issuing a read to KE4 until either a SEND or
  8317. C----->  RECEIVE are issued.
  8318. C
  8319.       CALL TASS4 (IUFT(1,2),SUCCES,LDEVST,RECSIZ,DEV1,HANOPT)
  8320.       IF (SUCCES .NE. 1) CALL EXIT
  8321.       CALL TASS4 (IUFT(1,4),SUCCES,LDEVST,RECSIZ,DEV2,HANOPT)
  8322.       IF (SUCCES .NE. 1) CALL EXIT
  8323. C
  8324. C----->  Zero out the buffers we will use for Kermit data.
  8325. C
  8326.       DO 10 I = 1,132
  8327.       BLIN(I,1) = 0
  8328.       BLIN(I,2) = 0
  8329.    10 CONTINUE
  8330.       IF (DEV1 .NE. DEV2) GO TO 20
  8331. C
  8332. C----->  Kermit has been activated from a remote device, so set
  8333. C----->  the HOSTON flag and don't queue an initial read.
  8334. C
  8335.       HOSTON = YES
  8336.       CHRCHN = 0
  8337.       RETURN
  8338.    20 CONTINUE
  8339. C
  8340. C----->  Kermit has been activated by a local terminal, so issue
  8341. C----->  the initial read, in anticipation of incoming data.
  8342. C
  8343.       HOSTON = NO
  8344.       CURCHN = 1
  8345.       CALL READ4 (IUFT(1,4),BLIN(1,CURCHN),132,.FALSE.)
  8346.       RETURN
  8347.       END
  8348. <<< ufttbc. >>>
  8349.       COMMON /UFTTBL/ IUFT(10,10) , BLIN(132,2)  , CURCHN
  8350. <<< unchar. >>>
  8351.       INTEGER FUNCTION UNCHAR (CH)
  8352. C
  8353. C     ****************************************************************
  8354. C
  8355. C              KERMIT for the MODCOMP MAXIV operating system
  8356. C
  8357. C        Compliments of:
  8358. C
  8359. C                         SETPOINT, Inc.
  8360. C                      10245 Brecksville Rd.
  8361. C                      Brecksville, Ohio 44141
  8362. C
  8363. C
  8364. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  8365. C      of this version hereby grant permission to copy this software
  8366. C      provided that it is not used for an explicitly commercial
  8367. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  8368. C      no warranty whatsoever regarding the accuracy of this package
  8369. C      and will assume no liability resulting from it's use.
  8370. C
  8371. C     ****************************************************************
  8372. C
  8373. C     Abstract: TRANSFORMS ASCII PRINTABLE CHARACTER BACK TO A
  8374. C               BINARY INTEGER (0 - 94)
  8375. C
  8376. C
  8377. C     MODIFICATION HISTORY
  8378. C
  8379. C     BY            DATE     REASON            PROGRAMS AFFECTED
  8380. C
  8381. C
  8382. C     ****************************************************************
  8383. C
  8384. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  8385. C
  8386. C     Calling Parameters:
  8387. C
  8388. C     R    CH    - THE CHARACTER THAT GETS CONVERTED
  8389. C
  8390. C     ****************************************************************
  8391. C
  8392. C     Messages generated by this module :  None
  8393. C
  8394. C     ****************************************************************
  8395. C
  8396. C     Subroutines called directly :  None
  8397. C
  8398. C     ****************************************************************
  8399. C
  8400. C     Files referenced :  None
  8401. C
  8402. C
  8403. C     ****************************************************************
  8404. C
  8405. C     Local variable definitions :  None
  8406. C
  8407. C     ****************************************************************
  8408. C
  8409. C     Commons referenced :  KERPAR local common
  8410. C
  8411. C     ****************************************************************
  8412. C
  8413. C     (*$END.DOCUMENT*)
  8414. C
  8415. C     ****************************************************************
  8416. C     *                                                              *
  8417. C     *         D I M E N S I O N   S T A T E M E N T S              *
  8418. C     *                                                              *
  8419. C     ****************************************************************
  8420. C
  8421.       IMPLICIT INTEGER (A-Z)
  8422. C
  8423. C     ****************************************************************
  8424. C     *                                                              *
  8425. C     *         T Y P E   S T A T E M E N T S                        *
  8426. C     *                                                              *
  8427. C     ****************************************************************
  8428. C
  8429. C
  8430. C     ****************************************************************
  8431. C     *                                                              *
  8432. C     *         C O M M O N   S T A T E M E N T S                    *
  8433. C     *                                                              *
  8434. C     ****************************************************************
  8435. C
  8436.       INCLUDE USL/KERPMC
  8437. C
  8438. C     ****************************************************************
  8439. C     *                                                              *
  8440. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  8441. C     *                                                              *
  8442. C     ****************************************************************
  8443. C
  8444. C
  8445. C     ****************************************************************
  8446. C     *                                                              *
  8447. C     *         D A T A   S T A T E M E N T S                        *
  8448. C     *                                                              *
  8449. C     ****************************************************************
  8450. C
  8451. C
  8452. C     ****************************************************************
  8453. C
  8454. C     Code starts here :
  8455. C
  8456.       UNCHAR = CH - BLANK
  8457.       RETURN
  8458.       END
  8459. <<< upper. >>>
  8460.       SUBROUTINE UPPER (ALIN,BLIN)
  8461. C
  8462. C     ****************************************************************
  8463. C
  8464. C              KERMIT for the MODCOMP MAXIV operating system
  8465. C
  8466. C        Compliments of:
  8467. C
  8468. C                         SETPOINT, Inc.
  8469. C                      10245 Brecksville Rd.
  8470. C                      Brecksville, Ohio 44141
  8471. C
  8472. C
  8473. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  8474. C      of this version hereby grant permission to copy this software
  8475. C      provided that it is not used for an explicitly commercial
  8476. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  8477. C      no warranty whatsoever regarding the accuracy of this package
  8478. C      and will assume no liability resulting from it's use.
  8479. C
  8480. C     ****************************************************************
  8481. C
  8482. C     Abstract:  CONVERT LOWER (ALIN) TO UPPER CASE (BLIN)
  8483. C
  8484. C     MODIFICATION HISTORY
  8485. C
  8486. C     BY            DATE     REASON            PROGRAMS AFFECTED
  8487. C
  8488. C
  8489. C     ****************************************************************
  8490. C
  8491. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  8492. C
  8493. C     Calling Parameters:
  8494. C
  8495. C     R    ALIN          LOWER CASE CHARACTER
  8496. C     W    BLIN          UPPER CASE CHARACTER
  8497. C
  8498. C     ****************************************************************
  8499. C
  8500. C     Messages generated by this module :  None
  8501. C
  8502. C     ****************************************************************
  8503. C
  8504. C     Subroutines called directly :  None
  8505. C
  8506. C     ****************************************************************
  8507. C
  8508. C     Files referenced :  None
  8509. C
  8510. C     ****************************************************************
  8511. C
  8512. C     Local variable definitions :
  8513. C
  8514. C       A1   INDEX TO CHARACTER BEING CONVERTED
  8515. C
  8516. C     ****************************************************************
  8517. C
  8518. C     Commons referenced :  KERPAR local common
  8519. C
  8520. C     ****************************************************************
  8521. C
  8522. C     (*$END.DOCUMENT*)
  8523. C
  8524. C     ****************************************************************
  8525. C     *                                                              *
  8526. C     *         D I M E N S I O N   S T A T E M E N T S              *
  8527. C     *                                                              *
  8528. C     ****************************************************************
  8529. C
  8530.       IMPLICIT INTEGER (A-Z)
  8531. C
  8532.       INTEGER*2   ALIN(1),     BLIN(1)
  8533. C
  8534. C     ****************************************************************
  8535. C     *                                                              *
  8536. C     *         T Y P E   S T A T E M E N T S                        *
  8537. C     *                                                              *
  8538. C     ****************************************************************
  8539. C
  8540. C
  8541. C     ****************************************************************
  8542. C     *                                                              *
  8543. C     *         C O M M O N   S T A T E M E N T S                    *
  8544. C     *                                                              *
  8545. C     ****************************************************************
  8546. C
  8547.       INCLUDE USL/KERPMC
  8548. C
  8549. C     ****************************************************************
  8550. C     *                                                              *
  8551. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  8552. C     *                                                              *
  8553. C     ****************************************************************
  8554. C
  8555. C
  8556. C     ****************************************************************
  8557. C     *                                                              *
  8558. C     *         D A T A   S T A T E M E N T S                        *
  8559. C     *                                                              *
  8560. C     ****************************************************************
  8561. C
  8562. C
  8563. C     ****************************************************************
  8564. C
  8565. C     Code starts here :
  8566. C
  8567.       A1 = 1
  8568.   100 CONTINUE
  8569.       BLIN(A1) = ALIN(A1)
  8570.       IF (BLIN(A1) .EQ. EOS) GO TO 200
  8571.       IF (BLIN(A1) .GT.  96 .AND.
  8572.      >    BLIN(A1) .LT. 123      ) BLIN(A1) = BLIN(A1) - 32
  8573.       A1 = A1 + 1
  8574.       GO TO 100
  8575.   200 CONTINUE
  8576.       RETURN
  8577.       END
  8578.