home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / sset. < prev    next >
Text File  |  2020-01-01  |  15KB  |  594 lines

  1.       SUBROUTINE SSET (ALIN)
  2. C
  3. C     ****************************************************************
  4. C
  5. C              KERMIT for the MODCOMP MAXIV operating system
  6. C
  7. C        Compliments of:
  8. C
  9. C                         SETPOINT, Inc.
  10. C                      10245 Brecksville Rd.
  11. C                      Brecksville, Ohio 44141
  12. C
  13. C
  14. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  15. C      of this version hereby grant permission to copy this software
  16. C      provided that it is not used for an explicitly commercial
  17. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  18. C      no warranty whatsoever regarding the accuracy of this package
  19. C      and will assume no liability resulting from it's use.
  20. C
  21. C     ****************************************************************
  22. C
  23. C     Abstract: PARSE AND SET VARIOUS SELECTABLE PARAMETERS
  24. C
  25. C     MODIFICATION HISTORY
  26. C
  27. C     BY            DATE     REASON            PROGRAMS AFFECTED
  28. C
  29. C     ****************************************************************
  30. C
  31. C     Author:  Bob Borgeson         Version: A.0    Date: Aug-86
  32. C
  33. C     Calling Parameters:
  34. C
  35. C     R    ALIN         - SET COMMAND STRING
  36. C
  37. C     ****************************************************************
  38. C
  39. C     Messages generated by this module :
  40. C
  41. C          SEE THE FORMAT STATEMENTS GROUPED AT THE END OF THE CODE
  42. C
  43. C     ****************************************************************
  44. C
  45. C     Subroutines called directly :  SKIPBL, CTOI
  46. C
  47. C     ****************************************************************
  48. C
  49. C     Files referenced :  None
  50. C
  51. C     ****************************************************************
  52. C
  53. C     Local variable definitions :
  54. C
  55. C           BLIN      SCRATCH FOR CHECKING COMMANDS
  56. C           CHRFND    # OF CHARACTERS FOUND
  57. C           CMDLEN    MAXIMUM LENGTH OF SET COMMANDS
  58. C           CMDTBL    TABLE OF UNPACKED ASCII COMMANDS
  59. C           FOUND     # OF COMMANDS FOUND
  60. C           Fx        CHARACTER POSITIONS TO START SEARCH AT
  61. C           GOODSP    IF = 1 THE SELECTED BAUD RATE IS OK
  62. C           KUSL      UNPACKED USL NAME
  63. C           NUMCMD    # OF COMMANDS SEARCHED FOR
  64. C           NUMPAR    # OF PARITY KEYWORDS SEARCHED FOR
  65. C           PARLEN    MAXIMUM LENGTH OF PARITY KEYWORD
  66. C           TV        STARTING CHARACTER OF COMMAND
  67. C           WCHCMD    WHICH COMMAND WAS FOUND
  68. C           WCHPAR    WHICH PARITY WAS CHOSEN
  69. C           Zx        CHARACTER POSITION TO START SEARCH AT
  70. C
  71. C     ****************************************************************
  72. C
  73. C     Commons referenced :  KER and KERPAR local commons
  74. C
  75. C     ****************************************************************
  76. C
  77. C     (*$END.DOCUMENT*)
  78. C
  79. C     ****************************************************************
  80. C     *                                                              *
  81. C     *         D I M E N S I O N   S T A T E M E N T S              *
  82. C     *                                                              *
  83. C     ****************************************************************
  84. C
  85.       IMPLICIT INTEGER (A-Z)
  86. C
  87.       INTEGER*2   ALIN(1) ,  BLIN(132) , KUSL(3), CMDTBL(8,9)
  88.      >         ,  PARTBL(6,5)
  89. C
  90. C     ****************************************************************
  91. C     *                                                              *
  92. C     *         T Y P E   S T A T E M E N T S                        *
  93. C     *                                                              *
  94. C     ****************************************************************
  95. C
  96. C
  97. C     ****************************************************************
  98. C     *                                                              *
  99. C     *         C O M M O N   S T A T E M E N T S                    *
  100. C     *                                                              *
  101. C     ****************************************************************
  102. C
  103.       INCLUDE USL/KERCOM
  104.       INCLUDE USL/KERPMC
  105. C
  106. C     ****************************************************************
  107. C     *                                                              *
  108. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  109. C     *                                                              *
  110. C     ****************************************************************
  111. C
  112. C
  113. C     ****************************************************************
  114. C     *                                                              *
  115. C     *         D A T A   S T A T E M E N T S                        *
  116. C     *                                                              *
  117. C     ****************************************************************
  118. C
  119.       DATA        CMDTBL       /66,65,85,68,10002,0,0,0,
  120.      >                          68,69,76,65,89,10002,0,0,
  121.      >                          80,65,82,73,84,89,10002,0,
  122.      >                          69,83,67,65,80,69,10002,0,
  123.      >                          80,65,67,75,69,84,10002,0,
  124.      >                          83,79,72,10002,0,0,0,0,
  125.      >                          69,79,76,10002,0,0,0,0,
  126.      >                          77,89,81,85,79,84,69,10002,
  127.      >                          85,83,76,10002,0,0,0,0/
  128. C
  129.       DATA        PARTBL       /79,68,68,10002,0,0,
  130.      >                          69,86,69,78,10002,0,
  131.      >                          77,65,82,75,10002,0,
  132.      >                          83,80,65,67,69,10002,
  133.      >                          78,79,78,69,10002,0/
  134. C
  135.       DATA   NUMPAR   / 5 /
  136.      >      ,NUMCMD   / 9 /
  137.      >      ,PARLEN   / 6 /
  138.      >      ,CMDLEN   / 8 /
  139. C
  140. C     ****************************************************************
  141. C
  142. C     Code starts here :
  143. C
  144. C----->  Skip past SET to start of first parameter.
  145. C
  146.       A1 = 1
  147.       CALL SKIPBL (ALIN,A1)
  148.       TV = A1
  149. C
  150. C----->  Find the SET function - first strip this word
  151. C
  152.       FOUND = -1
  153.       IEND = 81 - TV
  154. C
  155.       DO 10 I = 1,IEND
  156. C
  157.         BLIN(I) = ALIN(TV+I-1)
  158. C
  159.         IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 20
  160. C
  161.    10 CONTINUE
  162. C
  163.    20 CONTINUE
  164. C
  165.       BLIN(I) = LF
  166.       BLIN(I+1) = EOS
  167. C
  168.       TV = I + 2
  169. C
  170.       DO 50 J = 1,NUMCMD
  171. C
  172.         DO 30 I = 1,CMDLEN
  173. C
  174. C-----> If you get LF, then we got a legal command
  175. C
  176.           IF(BLIN(I) .EQ. LF)GO TO 40
  177. C
  178. C-----> If end of command, then no match
  179. C
  180.           IF(CMDTBL(I,J) .EQ. EOS)GO TO 50
  181. C
  182. C-----> Check for matching character
  183. C
  184.           IF(BLIN(I) .NE. CMDTBL(I,J))GO TO 50
  185. C
  186.    30   CONTINUE
  187. C
  188.        GO TO 50
  189. C
  190.    40   CONTINUE
  191. C
  192. C------> Found your keyword
  193. C
  194.         WCHCMD = J
  195.         FOUND = FOUND + 1
  196. C
  197.    50 CONTINUE
  198. C
  199.       IF (FOUND) 70 , 90 , 80
  200. C
  201.    70 CONTINUE
  202. C
  203. C----->   No command was recognized
  204. C
  205.       WRITE(LOCALO,75)
  206.    75 FORMAT(' UNRECOGNIZED COMMAND - TYPE "HELP"')
  207.       RETURN
  208. C
  209.    80 CONTINUE
  210. C
  211. C----->   The command was not unique
  212. C
  213.       WRITE(LOCALO,85)
  214.    85 FORMAT(' AMBIGUOUS COMMAND - TYPE "HELP"')
  215.       RETURN
  216. C
  217.    90 CONTINUE
  218. C
  219. C----->  Service the requested command
  220. C
  221.       GO TO(100,200,300,500,800,900,1000,1100,1200) , WCHCMD
  222. C
  223.   100 CONTINUE
  224. C
  225. C----->  Set BAUD rate.
  226. C
  227. C
  228. C----->  If baud rate setting not supported, or in HOST mode,
  229. C----->  do not allow baud rate to be set.
  230. C
  231. C+++++++
  232.       HOSTON = NO
  233.       SBAUD = YES
  234. C+++++++++
  235.       IF (SBAUD .NE. YES) GO TO 190
  236.       IF (HOSTON .NE. YES) GO TO 120
  237.       WRITE (LOCALO,9100)
  238.       WRITE (LOCALO,9101)
  239.       RETURN
  240.   120 CONTINUE
  241. C
  242. C----->  Get the desired baud rate from the command line and
  243. C----->  convert it to an integer.
  244. C
  245.       F1 = TV
  246.       CALL SKIPBL (ALIN,F1)
  247.       X = CTOI (ALIN,F1)
  248. C
  249. C----->  Validate the speed against the allowable values.
  250. C
  251.       IF (X .EQ.   300 .OR.
  252.      >    X .EQ.  1200 .OR.
  253.      >    X .EQ.  2400 .OR.
  254.      >    X .EQ.  4800 .OR.
  255.      >    X .EQ.  9600 .OR.
  256.      >    X .EQ. 19200     ) GO TO 130
  257.       WRITE (LOCALO,9102)
  258.       RETURN
  259.   130 CONTINUE
  260.       SPEED = X
  261.       RETURN
  262.   190 CONTINUE
  263.       WRITE (LOCALO,9103)
  264.       RETURN
  265. C
  266.   200 CONTINUE
  267. C
  268. C----->  Set the initial packet delay period if not
  269. C----->  in remote host mode.
  270. C
  271.       IF (HOSTON .NE. NO) GO TO 210
  272.       WRITE (LOCALO,9104)
  273.       RETURN
  274.   210 CONTINUE
  275. C
  276. C----->  Get the delay value.
  277. C
  278.       F2 = TV
  279.       CALL SKIPBL (ALIN,F2)
  280.       X = CTOI (ALIN,F2)
  281.       IF (X .GT. 0) GO TO 220
  282.       WRITE (LOCALO,9105)
  283.       RETURN
  284.   220 CONTINUE
  285. C
  286. C----->  Only allow values in range of 0..60.
  287. C
  288.       IF (X .LE. 60) GO TO 230
  289.       DELAY  =  60
  290.       WRITE (LOCALO,9106)
  291.       WRITE (LOCALO,9107)
  292.       RETURN
  293.   230 CONTINUE
  294.       DELAY = X
  295.       RETURN
  296.   300 CONTINUE
  297. C
  298. C----->  Set data parity.
  299. C
  300. C+++++++++
  301.       HOSTON = NO
  302.       SPARITY = YES
  303. C+++++++++++++
  304.       IF (SPARITY  .NE.  YES) GO TO 390
  305.       IF (HOSTON  .NE.  YES) GO TO 310
  306.       WRITE (LOCALO,9108)
  307.       WRITE (LOCALO,9109)
  308.       RETURN
  309.   310 CONTINUE
  310. C
  311.       F3 = TV
  312.       CALL SKIPBL(ALIN,F3)
  313.       TV = F3
  314. C
  315. C----->  Pull out the parity keyword
  316. C
  317.       DO 315 I = 1,6
  318. C
  319.         BLIN(I) = ALIN(TV+I-1)
  320.         IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 320
  321. C
  322.   315 CONTINUE
  323. C
  324.   320 CONTINUE
  325. C
  326.       BLIN(I) = LF
  327.       BLIN(I+1) = EOS
  328. C
  329.       FOUND = -1
  330. C
  331.       DO 345 J = 1,NUMPAR
  332. C
  333.         DO 325 I = 1,PARLEN
  334. C
  335. C------>   If end of keyword, then this is a good answer
  336. C
  337.           IF(BLIN(I) .EQ. LF)GO TO 335
  338. C
  339. C------>   If end of search pattern, no good
  340. C
  341.           IF(PARTBL(I,J) .EQ. EOS)GO TO 345
  342. C
  343. C------>   Check next character
  344. C
  345.           IF(BLIN(I) .NE. PARTBL(I,J))GO TO 345
  346. C
  347.   325   CONTINUE
  348. C
  349.         GO TO 345
  350. C
  351.   335   CONTINUE
  352. C
  353. C------>  Remember which keyword was found
  354. C
  355.         WCHPAR = J
  356.         FOUND = FOUND + 1
  357. C
  358.   345 CONTINUE
  359. C
  360.       IF (FOUND) 385 , 350 , 80
  361. C
  362.   350 CONTINUE
  363. C
  364.       GO TO (360 , 360 , 380 , 370 , 360 ), WCHPAR
  365. C
  366.   360 CONTINUE
  367. C
  368. C----->  Set the selected parity flag
  369. C
  370.       PARITY = WCHPAR
  371.       RETURN
  372. C
  373.   370 CONTINUE
  374. C
  375. C----->  This parity is not supported on MODCOMP
  376. C
  377.       WRITE(LOCALO,9110)
  378.       RETURN
  379. C
  380.   380 CONTINUE
  381. C
  382. C----->  This parity is not supported on MODCOMP
  383. C
  384.       WRITE(LOCALO,9111)
  385.       RETURN
  386. C
  387.   385 CONTINUE
  388. C
  389.       WRITE(LOCALO,9112)
  390.       RETURN
  391. C
  392.   390 CONTINUE
  393. C
  394. C----->  Parity not selectable.
  395. C
  396.       WRITE (LOCALO,9113)
  397.       RETURN
  398.   500 CONTINUE
  399. C
  400. C----->  Set HOST mode escape character.
  401. C
  402.       IF (HOSTON .NE. YES) GO TO 510
  403.       WRITE (LOCALO,9117)
  404.       WRITE (LOCALO,9118)
  405.       RETURN
  406.   510 CONTINUE
  407.       F5 = TV
  408.       CALL SKIPBL (ALIN,F5)
  409.       X = CTOI (ALIN,F5)
  410.       IF (X .LE.  0 .OR.
  411.      >    X .GE. 32      ) GO TO 520
  412.       ESCHAR = X
  413.       RETURN
  414.   520 CONTINUE
  415.       WRITE (LOCALO,9119)
  416.       RETURN
  417.   800 CONTINUE
  418. C
  419. C----->  Set the packet size.
  420. C
  421.       F8 = TV
  422.       CALL SKIPBL(ALIN,F8)
  423.       X = CTOI(ALIN,F8)
  424.       IF (X .LE. 30 .OR.
  425.      >    X .GE. 95     ) GO TO 810
  426.       PAKSIZ = X
  427.       RETURN
  428.   810 CONTINUE
  429.       WRITE (LOCALO,9126)
  430.       RETURN
  431.   900 CONTINUE
  432. C
  433. C----->  Set the start of header character.
  434. C
  435.       F9 = TV
  436.       CALL SKIPBL (ALIN,F9)
  437.       X = CTOI (ALIN,F9)
  438.       IF (HOSTON .NE. YES) GO TO 930
  439.       IF (X .NE. EOL) GO TO 910
  440.       WRITE (LOCALO,9127)
  441.       RETURN
  442.   910 CONTINUE
  443.       IF (X .LE.  0 .OR.
  444.      >    X .GE. 32     ) GO TO 920
  445.       SOH = X
  446.       RETURN
  447.   920 CONTINUE
  448.       WRITE (LOCALO,9128)
  449.       RETURN
  450.   930 CONTINUE
  451.       IF (X .NE.    EOL .AND.
  452.      >    X .NE. PROMPT      ) GO TO 940
  453.       WRITE (LOCALO,9129)
  454.       WRITE (LOCALO,9130)
  455.       RETURN
  456.   940 CONTINUE
  457.       IF (X .LE.  0 .OR.
  458.      >    X .GE. 32     ) GO TO 950
  459.       SOH = X
  460.       RETURN
  461.   950 CONTINUE
  462.       WRITE (LOCALO,9131)
  463.       WRITE (LOCALO,9132)
  464.       RETURN
  465.  1000 CONTINUE
  466. C
  467. C----->  Set the end-of-line character.
  468. C
  469.       F10 = TV
  470.       CALL SKIPBL (ALIN,F10)
  471.       X = CTOI (ALIN,F10)
  472.       IF (HOSTON .NE. YES) GO TO 1030
  473.       IF (X .NE. SOH) GO TO 1010
  474.       WRITE (LOCALO,9133)
  475.       RETURN
  476.  1010 CONTINUE
  477.       IF (X .LE.  0 .OR.
  478.      >    X .GE. 32     ) GO TO 1020
  479.       MYEOL = X
  480.       RETURN
  481.  1020 CONTINUE
  482.       WRITE (LOCALO,9134)
  483.       WRITE (LOCALO,9135)
  484.       RETURN
  485.  1030 CONTINUE
  486.       IF (X .NE.    SOH .AND.
  487.      >    X .NE. PROMPT      ) GO TO 1040
  488.       WRITE (LOCALO,9136)
  489.       WRITE (LOCALO,9137)
  490.       RETURN
  491.  1040 CONTINUE
  492.       IF (X .LE.  0 .OR.
  493.      >    X .GE. 32     )GO TO 1050
  494.       MYEOL = X
  495.       RETURN
  496.  1050 CONTINUE
  497.       WRITE (LOCALO,9138)
  498.       WRITE (LOCALO,9139)
  499.       RETURN
  500.  1100 CONTINUE
  501. C
  502. C----->  Set the quoting character.
  503. C
  504.       F11 = TV
  505.       CALL SKIPBL (ALIN,F11)
  506.       X = CTOI (ALIN,F11)
  507.       IF (X .LE.  32 .OR.
  508.      >    X .GE. 127     ) GO TO 1110
  509.       MYQUOTE = X
  510.       RETURN
  511.  1110 CONTINUE
  512.       WRITE (LOCALO,9140)
  513.       WRITE (LOCALO,9141)
  514.       RETURN
  515.  1200 CONTINUE
  516. C
  517. C----->  Set the USL directory for files to send.
  518. C
  519.         F12 = TV
  520.         CALL SKIPBL (ALIN,F12)
  521. C
  522. C----->  Make the USL name is CAN codeable.
  523. C
  524.       CHRFND = 0
  525. C
  526.       DO 1210 I=1,3
  527.       ICHAR = ALIN(F12+3-I)
  528. C
  529.       IF((ICHAR .EQ. LF) .OR. (ICHAR .EQ. EOS))ALIN(F12+3-I) = BLANK
  530.       IF(((ICHAR .EQ. BLANK) .OR. (ICHAR .EQ. LF) .OR.
  531.      >    (ICHAR .EQ. EOS)) .AND. (CHRFND .EQ. 0))GO TO 1210
  532.       CHRFND = CHRFND + 1
  533. C
  534.       IF ((ICHAR .GE. BIGA .AND. ICHAR .LE. BIGZ) .OR.
  535.      >    (ICHAR .GE. DIG0 .AND. ICHAR .LE. DIG9) .OR.
  536.      >    (ICHAR .EQ. COLON)                      .OR.
  537.      >    (ICHAR .EQ. PERIOD)                     .OR.
  538.      >    (ICHAR .EQ. DOLLAR)                         ) GO TO 1210
  539.       GO TO 1220
  540.  1210 CONTINUE
  541. C
  542.       IF(CHRFND .EQ. 0)GO TO 1220
  543.       GO TO 1230
  544. C
  545.  1220 CONTINUE
  546. C
  547. C-----> USL not can codeable.
  548. C
  549.       WRITE (LOCALO,9143)
  550.       RETURN
  551.  1230 CONTINUE
  552.       KUSL(1) = ISHFT (ALIN(F12),8)
  553.       KUSL(2) = ISHFT (ALIN(F12+1),8)
  554.       KUSL(3) = ISHFT (ALIN(F12+2),8)
  555.       SUSL = IACAN4 (KUSL)
  556.       RETURN
  557.  9100 FORMAT(' BAUD RATE SETTING NOT SUPPORTED')
  558.  9101 FORMAT(' IN REMOTE HOST MODE')
  559.  9102 FORMAT(' INVALID OR UNSUPPORTED BAUD RATE SELECTED')
  560.  9103 FORMAT(' THIS SYSTEM DOES NOT SUPPORT BAUD SELECTION')
  561.  9104 FORMAT(' DELAY SETTING NOT VALID IN LOCAL HOST MODE')
  562.  9105 FORMAT(' INVALID DELAY SETTING')
  563.  9106 FORMAT(' DELAY SETTING TOO LONG')
  564.  9107 FORMAT(' DEFAULTED TO 60 SECONDS')
  565.  9108 FORMAT(' PARITY SETTING NOT SUPPORTED')
  566.  9109 FORMAT(' IN REMOTE HOST MODE')
  567.  9110 FORMAT(' SPACE PARITY NOT SUPPORTED IN MAXIV')
  568.  9111 FORMAT(' MARK PARITY NOT SUPPORTED IN MAXIV')
  569.  9112 FORMAT(' PARITY SELECTED NOT VALID')
  570.  9113 FORMAT(' PARITY SETTING NOT SUPPORTED IN THIS SYSTEM')
  571.  9117 FORMAT(' ESCAPE SETTING NOT VALID IN')
  572.  9118 FORMAT(' REMOTE HOST MODE')
  573.  9119 FORMAT(' ESCAPE CHARACTER MUST BE BETWEEN 0 & 32')
  574.  9126 FORMAT(' INVALID PACKET SIZE SPECIFIED')
  575.  9127 FORMAT(' INVALID; IN CONFLICT WITH EOL')
  576.  9128 FORMAT(' INVALID; SOH MUST BE BETWEEN 0 & 32')
  577.  9129 FORMAT(' INVALID; IN CONFLICT WITH EOL')
  578.  9130 FORMAT(' OR IBM PROMPT')
  579.  9131 FORMAT(' INVALID; SOH MUST BE BETWEEN')
  580.  9132 FORMAT(' 0 & 32')
  581.  9133 FORMAT(' INVALID; IN CONFLICT WITH SOH')
  582.  9134 FORMAT(' INVALID; EOL MUST BE BETWEEN')
  583.  9135 FORMAT(' 0 & 32')
  584.  9136 FORMAT(' INVALID; EOL IN CONFLICT WITH')
  585.  9137 FORMAT(' SOH OR IBM PROMPT')
  586.  9138 FORMAT(' INVALID; EOL MUST BE BETWEEN')
  587.  9139 FORMAT(' 0 & 32')
  588.  9140 FORMAT(' QUOTE CHARACTER MUST BE BETWEEN')
  589.  9141 FORMAT(' 32 & 127')
  590.  9142 FORMAT(' INVALID SET PARAMETER(S) DETECTED')
  591.  9143 FORMAT(' USL NAME NOT CANCODEABLE')
  592.  9144 FORMAT(' INVALID SET HOST MODE SELECTED')
  593.       END
  594.