home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / vmskermit32 / vmsmit.bli < prev    next >
Text File  |  2018-01-01  |  118KB  |  5,179 lines

  1. MODULE KERMIT (IDENT = '3.3.128', MAIN = MAIN_ROUTINE,
  2.     ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)
  3.         ) =
  4.  
  5. BEGIN
  6.  
  7. BIND
  8.     IDENT_STRING = %ASCID'VMS Kermit-32 version 3.3.128';    ! Ident message
  9.  
  10. !++
  11. ! FACILITY:
  12. !   KERMIT-32
  13. !
  14. ! ABSTRACT:
  15. !   KERMIT-32 is an implementation of the KERMIT protocal to allow the
  16. !   transfer of files from micro computers to the DECsystem-10, DECSYSTEM-20
  17. !   and now the VAX/VMS systems.
  18. !
  19. ! ENVIRONMENT:
  20. !   User mode
  21. !
  22. ! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983
  23. !
  24. ! MODIFIED BY:
  25. !
  26. !--
  27.  
  28. %SBTTL 'Table of Contents'
  29. %SBTTL 'Revision History'
  30.  
  31. !++
  32. ! Start of version 1.
  33. !
  34. ! 1.0.000    By: Robert C. McQueen        On: 4-Jan-1983
  35. !        Create this program.
  36. !
  37. ! 1.0.001    By: Robert C. McQueen        On: 4-May-1983
  38. !        Allow RECEIVE without a file specification to mean
  39. !        use what ever the remote says.
  40. !
  41. ! 1.1.002    By: W. Hom            On: 6-July-1983
  42. !        Implement CONNECT command.
  43. !
  44. ! 1.2.003    By: Robert C. McQueen        On: 15-Aug-1983
  45. !        Add SET PARITY command and SHOW PARITY to support
  46. !        eight bit quoting.
  47. !
  48. ! 1.2.004    By: Robert C. McQueen        On: 23-August-1983
  49. !        Add dummy routine SY_TIME.
  50. !
  51. ! 1.2.005    By: Robert C. McQueen        On: 23-August-1983
  52. !        Add SET [SEND | RECEIVE] EIGHT-BIT-QUOTE <octal>
  53. !        command.  Add message for SHOW RECEIVE and SHOW SEND parameters
  54. !
  55. ! 1.2.006    By: Robert C. McQueen        On: 26-August-1983
  56. !        Add BYE, FINISH and LOGOUT commands.  These commands call
  57. !        DO_GENERIC to send generic functions to remote servers.
  58. !
  59. ! 1.2.007    By: Robert C. McQueen        On: 16-September-1983
  60. !        Implement SY_TIME, and XFR_STATUS routines.
  61. !        Add more stat type out.
  62. !
  63. ! 1.2.008    By: Robert C. McQueen        On: 19-September-1983
  64. !        Add the SET RETRY command and the SHOW RETRY command.
  65. !
  66. ! 1.2.009    By: Robert C. McQueen        On: 20-September-1983
  67. !        Add CRCCLC routine for calculating CRC-CCITT.
  68. !        Set SET BLOCK_CHECK_TYPE and SHOW BLOCK_CHECK_TYPE commands.
  69. !
  70. ! 1.2.010    By: Nick Bush            On: 3-October-1983
  71. !        SERVER (in KERMSG) actually returns a value.  If it
  72. !        is "ABORTED", then we should prompt again.  This allows
  73. !        a ^Y typed to the server to put it back into command
  74. !        level.  (If you want to type out statistics or whatever).
  75. !
  76. ! 2.0.011    Release VAX/VMS Kermit-32 version 2.0
  77. !
  78. ! 2.0.012    By: Nick Bush            On: 10-Nov-1983
  79. !        Add type out of version number.  Also fix some
  80. !        problems with IBM mode and local echo.
  81. !
  82. ! 2.0.013    By: Nick Bush            On: 11-Nov-1983
  83. !        Change how debugging output is done so that it
  84. !        can be redirected to the logical device KER$DEBUG.
  85. !        If the logical name is defined to be something other
  86. !        that SYS$OUTPUT, KERMIT will send any debugging output
  87. !        there.
  88. !
  89. ! 2.0.014    By: Robert C. McQueen        On: 16-Nov-1983
  90. !        Make sure all message number checks are mod 64.  There
  91. !        were four that weren't.
  92. !
  93. ! 2.0.015    By: Nick Bush            On: 17-Nov-1983
  94. !        Always clear purge typeahead when posting receive QIO.
  95. !        Also, clear any typeahead just before sending a packet.
  96. !
  97. ! 2.0.016    By: Nick Bush            On: 4-Dec-1983
  98. !        Change how binary files are written to (hopefully) improve
  99. !        the performance.  We will now use 510 records and only
  100. !        write out the record when it is filled (instead of writing
  101. !        one record per packet).  This should cut down on the overhead
  102. !        substantially.
  103. !
  104. ! 2.0.017    By: Nick Bush            On: 9-Dec-1983
  105. !        Fix processing for VFC format files.  Also fix GET_ASCII
  106. !        for PRN and FTN record types.  Change GET_ASCII so that
  107. !        'normal' CR records get sent with trailing CRLF's instead
  108. !        of <LF>record<CR>.  That was confusing too many people.
  109. !
  110. ! 2.0.020    By: Nick Bush            On: 9-Dec-1983
  111. !        Only abort (when remote) if we seen two control-Y's in
  112. !        succession.  This way a single glitch does not kill us.
  113. !
  114. ! 2.0.021    By: Nick Bush            On: 12-Dec-1983
  115. !        Add status type-out character (^A), debug toggle
  116. !        character (^D), and force timeout character (^M)
  117. !        to those accepted during a transfer when we are remote.
  118. !
  119. ! 2.0.022    By: Nick Bush            On: 15-Dec-1983
  120. !        Add Fixed record size (512 byte) format for writing files.
  121. !        This can be used for .EXE files.  Also clean up writing
  122. !        ASCII files so that we don't lose any characters.
  123. !
  124. ! 2.0.023    By: Nick Bush            On: 16-Dec-1983
  125. !        Add a default terminal name for the communications line.
  126. !        If KER$COMM is defined, that will be the default.
  127. !
  128. ! 2.0.025    By: Robert C. McQueen        On: 22-Dec-1983
  129. !        Use RMSG_COUNT and SMSG_COUNT now.
  130. !
  131. ! 2.0.026    By: Nick Bush            On: 3-Jan-1984
  132. !        Add options for format of file specification to be
  133. !        sent in file header packets.  Also type out full file
  134. !        specification being sent/received instead of just
  135. !        the name we are telling the other end to use.
  136. !
  137. ! 2.0.027    By: Nick Bush            On: 20-Jan-1984
  138. !        Fix reset of parity to use the correct field in the
  139. !        IO status block from the IO$_SENSEMODE.  It was using
  140. !        the LF fill count instead.
  141. !
  142. ! 2.0.030    By: Nick Bush            On: 3-Feb-1984
  143. !        Add the capability of receiving a file with a different
  144. !        name than given by KERMSG.  The RECEIVE and GET commands
  145. !        now really are different.
  146. !
  147. ! 2.0.031    By: Nick Bush            On: 4-Feb-1984
  148. !        Change connect code to improve response (hopefully
  149. !        without worsening throughput or runtime requirements).
  150. !        When either terminal is idle we will be waiting for
  151. !        a single character with a larger buffered read queued
  152. !        up immediately after it.
  153. !
  154. ! 2.0.032    By: Nick Bush            On: 25-Feb-1984
  155. !        Add code for LOCAL and REMOTE commands.  These depend
  156. !        upon support in KERMSG and KERSYS.
  157. !
  158. ! 2.0.033    By: Nick Bush            On: 6-March-1984
  159. !        Change command input and terminal processing so that
  160. !        we will always have SYS$OUTPUT and SYS$COMMAND open
  161. !        when they are terminals, and will also always have
  162. !        the transfer terminal line open.  This makes it
  163. !        unnecessary for the user to allocate a dialup line
  164. !        in order to go between CONNECT and a transfer command,
  165. !        and keep anyone else from grabbing the line between
  166. !        commands.
  167. !        Also add the command parsing for the rest of the LOCAL/REMOTE
  168. !        commands.  This makes use of the fact that we have
  169. !        SYS$COMMAND open to allow us to read passwords without echo.
  170. !        Commands which should only be done when Kermit is local
  171. !        (GET, BYE, etc.) will now give an error if the transfer
  172. !        line is the same as the controlling terminal.
  173. !        SEND will now check for the files existance before calling
  174. !        KERMSG to send it.
  175. !
  176. ! 2.0.034    By: Nick Bush                On: 7-March-1984
  177. !        Default the parity type to be that of the default transfer
  178. !        line.  This should make things simpler for systems which use
  179. !        parity by default.
  180. !
  181. ! 2.0.035    By: Nick Bush                On: 8-March-1984
  182. !        Add LOG SESSION command to set a log file for CONNECT.
  183. !        While we are doing so, clean up the command parsing a little
  184. !        so that we don't have as many COPY_xxx routines.
  185. !
  186. ! 2.0.036    By: Nick Bush                On: 15-March-1984
  187. !        Fix PUT_FILE to correctly handle carriage returns which are
  188. !        not followed by line feeds.  Count was being decremented
  189. !        Instead of incremented.
  190. !
  191. ! 2.0.037    By: Robert C. McQueen            On: 20-March-1984
  192. !        Fix call to LOG_OPEN for debug log file.
  193. !        Module: KERTRM.
  194. !
  195. ! 2.0.040    By: Nick Bush                On: 22-March-1984
  196. !        Fix processing of FORTRAN carriage control to handle lines
  197. !        which do not contain the carriage control character (i.e., zero
  198. !        length records).  Previously, this type of record was sending
  199. !        infinite nulls.
  200. !
  201. ! 2.0.041    By: Nick Bush                On: 26-March-1984
  202. !        Add SET PROMPT command.
  203. !
  204. ! 2.0.042    By: Nick Bush                On: 26-March-1984
  205. !        Fix connect processing to make it easy to type messages
  206. !        on the user's terminal while connected.  Use this
  207. !        to type messages when log file stopped and started.
  208. !        Include the node name in the messages to keep
  209. !        users who are running through multiple Kermit's from
  210. !        getting confused.
  211. !
  212. ! 2.0.043    By: Nick Bush                On: 28-March-1984
  213. !        Fix SET PARITY ODD to work.  Somehow, the table entry
  214. !        had PR_NONE instead of PR_ODD.  Also add status type
  215. !        out and help message to connect command.
  216. !
  217. ! 2.0.044    By: Nick Bush                On: 28-March-1984
  218. !        Fix SET SEND START_OF_PACKET to store in SND_SOH instead
  219. !        of RCV_SOH.  Also, set TY_FIL false before calling FILE_OPEN
  220. !        to check for existence of send files.
  221. !
  222. ! 3.0.045    Start of version 3.
  223. !
  224. ! 3.0.046    By: Nick Bush                On: 29-March-1984
  225. !        Fix debugging log file to correctly set/clear file open
  226. !        flag.  Also make log files default to .LOG.
  227. !
  228. ! 3.0.047    By: Nick Bush                On: 30-March-1984
  229. !        Fix SEND command processing to save and restore the file
  230. !        specification over the call to FILE_OPEN, since FILE_OPEN
  231. !        rewrites it with the resulting file name, losing any
  232. !        wild-cards.
  233. !
  234. ! 3.0.050    By: Nick Bush                On: 2-April-1984
  235. !        Add SET SERVER_TIMER to determine period between idle naks.
  236. !        Also allow for a routine to process file specs before
  237. !        FILE_OPEN uses them.  This allows individual sites to
  238. !        restrict the format of file specifications used by Kermit.
  239. !
  240. ! 3.0.051    By: Nick Bush                On: 2-April-1984
  241. !        Fix command scanning to correctly exit after performing
  242. !        a single command when entered with a command present.
  243. !
  244. ! 3.1.052    By: Nick Bush                On: 3-July-1984
  245. !        Fix KERCOM's definition of MAX_MSG to allow for all characters
  246. !        of packet to fit into buffers, not just the counted ones.
  247. !
  248. ! 3.1.053    By: Robert C. McQueen            On: 9-July-1984
  249. !        Fix FORTRAN carriage control processing to pass along
  250. !        any character from the carriage control column that is
  251. !        not really carriage control.
  252. !
  253. ! 3.1.054    By: Nick Bush                On: 13-July-1984
  254. !        Change TERM_OPEN to take an argument which determines
  255. !        whether it should post any QIO's.  This makes it unnecessary
  256. !        for TERM_CONNECT to cancel the QIO's, and avoids problems
  257. !        with DECnet remote terminals.
  258. !
  259. ! 3.1.055    By: Nick Bush                On: 27-August-1984
  260. !        Clear out FILE_SIZE before processing a RECEIVE command to
  261. !        ensure that KERMSG doesn't perform a GET.
  262. !
  263. ! 3.1.056    By: Nick Bush                On: 28-August-1984
  264. !        Add a TAKE (or @) command.  Also perform an initialization
  265. !        file on startup.  This file is either VMSKERMIT.INI or
  266. !        whatever file is pointed to by the logical name VMSKERMIT.
  267. !
  268. ! 3.1.057    By: Nick Bush                On: 21-Feb-1985
  269. !        Determine VMS version on startup and remember for later
  270. !        use.  Use it in KERSYS to determine whether we will need
  271. !        to force an end-of-file on the mailbox when the subprocess
  272. !        on the other end goes away.
  273. !
  274. ! 3.1.060    By: Nick Bush                On: 16-March-1985
  275. !        Increase size of terminal name buffers to account for large
  276. !        unit numbers (most likely seen with VTA's).
  277. !
  278. ! 3.1.061    By: Nick Bush                On: 16-March-1985
  279. !        Only attempt to set parity back when closing terminal.
  280. !
  281. ! 3.1.062    By: Nick Bush                On: 16-March-1985
  282. !        Previous edit broke remote commands - must post QIO's
  283. !        when opening terminals for these.
  284. !
  285. ! 3.1.063    By: Nick Bush                On: 16-March-1985
  286. !        Fix status command to output right headers over data.
  287. !
  288. ! 3.1.064    By: Nick Bush                On: 30-March-1985
  289. !        Fix LIB$SPAWN call to set SYS$INPUT for the subprocess
  290. !        to be NLA0: so that it doesn't try to input from the
  291. !        terminal.
  292. !
  293. ! 3.1.065    By: Nick Bush                On: 10-April-1985
  294. !        Split IBM handshaking from parity and local echo.  Allow
  295. !        link time setting of IBM_MODE defaults by defining symbols:
  296. !
  297. !        IBM_MODE_CHARACTER = character value of handshake character
  298. !        IBM_MODE_ECHO = 1 for local echo, 2 for no local echo
  299. !        IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even),
  300. !            (3 = odd), (4 = space).
  301. !
  302. !        If not specified, Kermit will continue to use DC1, local echo
  303. !        and odd parity for IBM_MODE.
  304. !
  305. ! 3.1.066    By: Nick Bush                On: 22-April-1985
  306. !        Don't use NLA0: as SYS$INPUT when spawning things under VMS 3.
  307. !
  308. !
  309. ! Start version 3.2 on 8-May-1985
  310. !
  311. ! 3.2.067    By: Robert McQueen            On: 8-May-1985
  312. !        Use $GETJPIW and $GETDVIW instead of $GETJPI and $GETDVI.
  313. !        Module: KERTRM, KERFIL
  314. !
  315. ! 3.2.070    By: Robert McQueen            On: 17-Dec-1985
  316. !        Fix a problem with CRC calculations when 8 bit data and not
  317. !        8 bit quoting.
  318. !
  319. ! 3.2.071    By: Robert McQueen            On: 11-March-1986
  320. !        Fix a problem were KERMSG didn't allow for a line termination
  321. !        character in the buffer.
  322. !
  323. ! 3.2.072    By: Robert McQueen            On: 11-March-1986
  324. !        Allow 0 as a valid value for SET SEND PADDING command.
  325. !
  326. ! 3.2.073    By: Robert McQueen            On: 11-March-1986
  327. !        Fix a problem restoring the terminal characteristics under
  328. !        VMS 4.x
  329. !
  330. ! 3.2.074    By: Robert McQueen            On: 11-March-1986
  331. !        Put MAX_MSG back the way it was and fix the problem correctly
  332. !        in KERMSG.
  333. !
  334. ! 3.2.075    By: Robert McQueen            On: 8-April-1986
  335. !        Change how the FINISH command works.  Cause it to go back to
  336. !        the Kermit-32 prompt, not exit.
  337. !
  338. ! 3.2.076    By: Robert McQueen            On: 17-April-1986
  339. !        Set PASSTHRU in addition to everything else we change in VMSTRM.
  340. !
  341. ! 3.2.077    By: Robert McQueen            On: 8-May-1986
  342. !        FIX FORTRAN CC!! (Once and for all I hope)
  343. !
  344. ! 3.2.100    By: Gregory P. Welsh            On: 1-June-1986
  345. !        Add TRANSMIT command along with set SET/SHOW TRANSMIT ECHO
  346. !               and DELAY commands.
  347. !
  348. ! Start of version 3.3
  349. !
  350. ! 3.3.101    By: Robert C. McQueen            On: 2-July-1986
  351. !        Change $TRNLOG system service calls to LIB$SYS_TRNLOG library
  352. !        routine.  Handle no translation properly in VMSTRM.BLI.
  353. !
  354. ! 3.3.102    By: Robert McQueen            On: 5-July-1986
  355. !        Add changes/fixes suggested by Art Guion and David Deley for
  356. !        VMSTRM.BLI
  357. !        - Turn off FALLBACK terminal characteristics for eightbit
  358. !          operations.
  359. !        - Decrease IBM timeouts when waiting for a handshake.
  360. !
  361. ! 3.3.103    By: Robert McQueen            On: 5-July-1986
  362. !        Add changes/fixes suggested by David Deley for VMSMIT.BLI
  363. !        - Problem with an infinite loop getting a command.
  364. !
  365. ! 3.3.104    By: Robert McQueen            On: 5-July-1986
  366. !        Add changes/fixes suggested by Art Guion and David Deley for
  367. !        KERMSG.BLI.
  368. !        - Always attempt a handshake in IBM mode.  Failing to handshake
  369. !          may cause 3704/5 style controller to hang a VM system.
  370. !        - Don't lose the last character in a buffer.   BFR_FILL logic
  371. !          forgets to send the last cahracters of a file when it doesn't
  372. !          fit into the current packet.
  373. !
  374. ! 3.3.105    By: Robert McQueen            On: 8-July-1986
  375. !        Attempt to fix the truncation errors that we now get from
  376. !        LINK with BLISS-32 v4.2.  Also do code clean up in VMSTRM and
  377. !        VMSFIL.
  378. !
  379. ! 3.3.106    By: Robert McQueen            On: 8-July-1986
  380. !        Fix problem of closing a fixed file and losing data.
  381. !
  382. ! 3.3.107    By: Antonino N. Mione            On: 8-Sep-1986
  383. !        Do not abort on ERROR packet while in SERVER mode. Instead,
  384. !        return to SERVER IDLE mode.
  385. !
  386. ! 3.3.110    By: Antonino N. Mione            On: 8-Sep-1986
  387. !        Make KERMIT-32 close the terminal (so the terminal
  388. !        parameters are appropriately reset) upon reciept of 
  389. !        a GENERIC LOGOUT packet.
  390. !
  391. ! 3.3.111    By: Robert McQueen            On: 2-Oct-1986
  392. !        Make Kermit-32 not eat the parity from a CR if a LF doesn't
  393. !        follow it when writing an ASCII file.
  394. !
  395. ! 3.3.112    JHW0001        Jonathan H. Welch,     28-Apr-1988 12:11
  396. !        Fix the message generated in NEXT_FILE so that the
  397. !        filenames displayed (i.e. Sending: foo.bar;1 as foo.bar)
  398. !        are always terminated by a null (ASCIZ).
  399. !
  400. ! 3.3.113    JHW0002        Jonathan H. Welch,    5-May-1988 11:48
  401. !        Modified SY_TIME to use $GETTIM as opposed to the LIB$timer
  402. !        routines (which broke when their method of calculating
  403. !        time differences changed in V4.4?).
  404. !
  405. !        Removed the call to LIB$INIT_TIMER in SY_INIT.
  406. !
  407. ! 3.3.114    JHW003        Jonathan H. Welch,    6-May-1988 9:41
  408. !        Modified MAIN_ROUTINE to return the status code from
  409. !        COMND when exiting.
  410. !
  411. !        Note: The error message codes returned are internal
  412. !        Kermit-32 error codes.
  413. !
  414. ! 3.3.115    JHW004        Jonathan H. Welch,    9-May-1988
  415. !        Added the ability to send a break character to
  416. !        the outgoing terminal session using the sequence
  417. !        esc-chr B.  The break will be sent after the next 
  418. !        character arrives.  This is because there must be
  419. !        no outstanding I/O on a channel in order to modify
  420. !        terminal characteristics (necessary to send a break).
  421. !
  422. ! 3.3.116    JHW005        Jonathan H. Welch,    12-May-1988 8:35
  423. !        Modified COMND_HELP to look for the kermit help
  424. !        file called KERMIT_HELP or pointed to by the logical
  425. !        name KERMIT_HELP.  Thus if a user wants to have the
  426. !        kermit help file in a directory other than SYS$HELP
  427. !        it is not necessary to define the logical name KERMIT
  428. !        (which causes problems: i.e. RUN KERMIT will fail).
  429. !
  430. ! 3.3.117    JHW006        Jonathan H. Welch,    12-May-1988
  431. !        Calls to LIB$SIGNAL with multiple arguments were
  432. !        not coded correctly.  For calls with multiple arguments
  433. !        an argument count was added.
  434. !        Minor changes to KERM_HANDLER to make use of the changed
  435. !        argument passing method.
  436. !        
  437. ! 3.3.118    By: Burt Johnson            On: 1-Feb-1990
  438. !        Added support for Extended Length packets;
  439. !
  440. ! 3.3.119    JHW007        Jonathan H. Welch,    4-Apr-1990 7:47
  441. !        Modified Final_Status to have an initial value of SS$_NORMAL.
  442. !        Previously, if all kermit operations were successful a
  443. !        return status of 0 was generated.
  444. !
  445. !        Added a compile-time test for BLISS32 systems in the three
  446. !        generic bliss files (GLB, MSG, TT) which didn't have this
  447. !        declaration so that references to data use longword offsets.
  448. !        Burt Johnson's solution (PSECT PLIT = $CODE$) was generating
  449. !        many link-time errors.
  450. !
  451. ! 3.3.120    JHW008        Jonathan H. Welch,    5-Apr-1990 10:57
  452. !        Modified the call to NORMALIZE_FILE in routine REC_FILE
  453. !        to adjust file name and type lengths downwards to 39
  454. !        characters each as opposed to the pre-VMS 4 format of
  455. !        9 for the name and 3 for the type.
  456. !
  457. ! 3.3.121    JHW009        Jonathan H. Welch,    12-Apr-1990 12:20
  458. !        Added and modified routines in vmstrm.bli to notify the
  459. !        user if SS$_HANGUP occurs on the outgoing terminal line.
  460. !        If the outgoing line is serviced by a decserver (LTA type
  461. !        terminal) the user must issue a CONNECT LTAnnn command
  462. !        to reestablish a LAT link to the decserver.
  463. !
  464. ! 3.3.122    JHW010        Jonathan H. Welch,    23-Apr-1990 09:42
  465. !        Added SET FILE BLOCKSIZE nnn (where nnn is the record size
  466. !        in bytes) command for incoming BINARY and FIXED file transfers.
  467. !        If no blocksize has been specified the old behavior (510 byte
  468. !        records plus 2 bytes (for CR/LF) for BINARY files and 512
  469. !        byte records for FIXED files will be used.
  470. !        Also modified SHOW FILE to display record size when appropriate.
  471. !
  472. ! 3.3.123    JHW011        Jonathan H. Welch,     17-May-1990 9:06
  473. !        Modified a miscoded call to send_packet in routine
  474. !        send_gencmd to correctly specify the length of the
  475. !        response packet to transmit.  This miscoding only
  476. !        affected long packet support, in particular, when
  477. !        GETting files standard length packets were being used
  478. !        when long packet support was available in both kermit
  479. !        programs.
  480. !
  481. ! 3.3.124    JHW012        Jonathan H. Welch,     18-May-1990 7:56
  482. !        Modified asn_wth_mbx to obtain the master PID in the
  483. !        process tree before asking for JPI$_TERMINAL.  $GETJPI
  484. !        was returning a null string for this item when called
  485. !        from a subprocess resulting in a "No default terminal 
  486. !        line for transfers" message.
  487. !
  488. ! 3.3.125    JHW013        Jonathan H. Welch,    18-May-1990 13:00
  489. !        Extended the buffer size for terminal names from 20 
  490. !        characters to 255 to make sure any terminal name can
  491. !        be accomodated.
  492. !
  493. ! 3.3.126    JHW014        Jonathan H. Welch,    5-Jun-1990 12:38
  494. !        Modified asn_wth_mbx to add a ':' to the end of the
  495. !               terminal name is one is not returned by VMS.
  496. !               This will keep LIB$GETDVI from failing with an
  497. !               "invalid device name" which results in the kermit
  498. !               error "no default terminal line for transfers."
  499. !
  500. ! 3.3.127    JHW015        Jonathan H. Welch,    16-Jul-1990 15:30
  501. !        Fixed the logic in GET_ASCII which was causing an infinite
  502. !        loop for files with print file carriage control.
  503. !
  504. ! 3.3.128    JHW016        Jonathan H. Welch,    17-Oct-1990 9:42
  505. !        Modified asn_wth_mbx to work properly in non-interactive mode.
  506. !--
  507.  
  508. %SBTTL 'Routine definitions -- Forwards'
  509. !<BLF/NOFORMAT>
  510. !
  511. ! Forward definitions
  512. !
  513.  
  514. ! Command processing routines
  515.  
  516. FORWARD ROUTINE
  517.     COMND,            ! Process a command
  518.     COMND_ERROR : NOVALUE,    ! Give error for command
  519.     COMND_FILE,            ! Process command file
  520.     DO_COMND,            ! Parse and dispatch one command
  521.     COMND_HELP    : NOVALUE,    ! Process the HELP command
  522.     COMND_SHOW    : NOVALUE,    ! Process the SHOW command
  523.     COMND_STATUS : NOVALUE,    ! Process the STATUS command
  524.     COMND_REMOTE : NOVALUE,    ! Process the REMOTE command
  525.     COMND_LOCAL : NOVALUE,    ! Process the LOCAL commands
  526.     GET_REM_ARGS,        ! Get arguments for REMOTE/LOCAL commands
  527.     STORE_TEXT,            ! Routine to store a file name
  528.     COPY_TERM_NAME,        ! Copy device name (TERM_xxxx)
  529.     COPY_DESC,            ! Copy file name (FILE_xxx)
  530.     COPY_ALT_FILE,        ! Copy to alternate file name (ALT_FILE_xxx)
  531.     COPY_GEN_1DATA,        ! Copy to GEN_1DATA (generic command argument)
  532.     STORE_BLOCKSIZE,         ! Store the blocksize value
  533.     STORE_DEBUG,        ! Store the debuging flag
  534.     STORE_TR_ECHO,        ! Store the transmit echo flag  [078]
  535.     STORE_TR_DELAY,        ! Store the transmit delay  [078]
  536.     STORE_FTP,            ! Store the file type
  537.     STORE_FNM,            ! Store the file name form
  538.     STORE_ECHO,            ! Store the local echo flag
  539.     STORE_PARITY,        ! Store the parity type
  540.     STORE_CHK,            ! This routine will store the checksum type.
  541.     STORE_ABT,            ! This routine will store the aborted file disposition
  542.     STORE_IBM,            ! Store IBM flag
  543.     STORE_MSG_FIL,        ! Store TY_FIL
  544.     STORE_MSG_PKT,        ! Store TY_PKT
  545.     CHECK_PACKET_LEN,        ! Validate PACKET length given
  546.     CHECK_NPAD,            ! Validate the number of pad characters
  547.     CHECK_PAD_CHAR,        ! Validate the padding character being set
  548.     CHECK_EOL,            ! Validate EOL character given.
  549.     CHECK_QUOTE,        ! Validate quoting character
  550.     CHECK_SOH,            ! Validate the start of packet character given
  551.     KEY_ERROR;            ! Return correct keyword error value
  552.  
  553. !
  554. ! Error handling routines
  555. !
  556.  
  557. FORWARD ROUTINE
  558.     KERM_HANDLER;            ! Condition handler
  559.     %SBTTL    'Include files'
  560.  
  561. !
  562. ! INCLUDE FILES:
  563. !
  564.  
  565. LIBRARY 'SYS$LIBRARY:STARLET';
  566.  
  567. LIBRARY 'SYS$LIBRARY:TPAMAC';
  568.  
  569. REQUIRE 'KERCOM';                ! Common definitions
  570.  
  571. REQUIRE 'KERERR';                ! Error message symbol definitions
  572.  
  573. %SBTTL 'Macro definitions'
  574.  
  575. !
  576. ! MACROS:
  577. !
  578.  
  579. MACRO
  580.     TPARSE_ARGS =
  581.         BUILTIN AP;
  582.         MAP AP : REF BLOCK [,BYTE];
  583.     %;
  584.  
  585. !
  586. ! Macro to initialize a string descriptor
  587. !
  588. MACRO
  589.     INIT_STR_DESC (DESC, BUFFER, SIZE) =
  590.     BEGIN
  591. !    MAP
  592. !    DESC : BLOCK [8, BYTE];
  593.     DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
  594.     DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  595.     DESC [DSC$W_LENGTH] = SIZE;
  596.     DESC [DSC$A_POINTER] = BUFFER;
  597.     END
  598.     %;
  599.     %SBTTL    'Equated symbols -- Command types'
  600.  
  601. !
  602. ! EQUATED SYMBOLS:
  603. !
  604. ! Command offsets
  605.  
  606. LITERAL
  607.     CMD_MIN = 1,                ! Minimum value
  608.     CMD_CONN = 1,                ! Connect command
  609.     CMD_EXIT = 2,                ! Exit command
  610.     CMD_HELP = 3,                ! Help command
  611.     CMD_RECEIVE = 4,                ! Receive command
  612.     CMD_SET = 5,                ! Set command
  613.     CMD_SEND = 6,                ! Send command
  614.     CMD_SHOW = 7,                ! Show command
  615.     CMD_SERVER = 8,                ! SERVER command
  616.     CMD_STATUS = 9,                ! STATUS command
  617.     CMD_LOGOUT = 10,                ! Generic LOGOUT command
  618.     CMD_BYE = 11,                ! Generic LOGOUT command and EXIT
  619.     CMD_FINISH = 12,                ! Generic EXIT command
  620.     CMD_GET = 13,                ! Get command
  621.     CMD_REMOTE = 14,                ! Remote command
  622.     CMD_LOCAL = 15,                ! Local command
  623.     CMD_PUSH = 16,                ! PUSH command (spawn new DCL)
  624.     CMD_NULL = 17,                ! Any command which is done
  625.                             ! totally by the LIB$TPARSE call
  626.     CMD_TAKE = 18,                ! Take command
  627.     CMD_TRANSMIT = 19,                          ! Transmit command [078]
  628.     CMD_MAX = 19;                               ! Maximum command value [078]
  629.  
  630. ! Items to show
  631.  
  632. LITERAL
  633.     SHOW_ALL = 1,                ! Show everything
  634.     SHOW_DEB = 2,                ! Show debugging flag
  635.     SHOW_DEL = 3,                ! Show delay
  636.     SHOW_ESC = 4,                ! Show ESCAPE character
  637.     SHOW_TIM = 5,                ! Show random timing
  638.     SHOW_LIN = 6,                ! Show the line we are using
  639.     SHOW_ECH = 7,                ! Show the echo flag
  640.     SHOW_SEN = 8,                ! Show send parameters
  641.     SHOW_REC = 9,                ! Show the receive parameters
  642.     SHOW_PAR = 10,                ! Show the parity setting
  643.     SHOW_RTY = 11,                ! Show retry counters
  644.     SHOW_CHK = 12,                ! Show block-check-type
  645.     SHOW_ABT = 13,                ! Show aborted file disposition
  646.     SHOW_FIL = 14,                ! Show file parameters
  647.     SHOW_PAC = 15,                ! Show packet parameters
  648.     SHOW_COM = 16,                ! Show communications parameters
  649.     SHOW_VER = 17,                ! Show version
  650.     SHOW_TRN = 18;                              ! Show transmit delay and echo 
  651.     %SBTTL    'Equated symbols -- Constants'
  652.  
  653. ! Constants
  654.  
  655. LITERAL
  656.     CMD_BFR_LENGTH = 132,            ! Command buffer length
  657.     OUT_BFR_LENGTH = 80,            ! Output buffer length (SHOW cmd)
  658.     HELP_LENGTH = 132,                ! Length of the help buffer
  659.     TEMP_LENGTH = 132;                ! Length of the temporary area
  660. !
  661. ! The default prompt
  662. !
  663. BIND
  664.     DEFAULT_PROMPT = %ASCID'Kermit-32>';
  665.  
  666. MAP
  667.     DEFAULT_PROMPT : BLOCK [8, BYTE];    ! This is a descriptor
  668.     %SBTTL    'Storage -- Global'
  669.  
  670. !<BLF/NOFORMAT>
  671. !
  672. ! GLOBAL STORAGE:
  673. !
  674.  
  675.     GLOBAL
  676.     TRANSACTION_DESC : BLOCK [8, BYTE],    ! Descriptor for transaction log file
  677.     TRANSACTION_OPEN,            ! File open flag
  678.     TRANSACTION_FAB : $FAB_DECL,        ! Transaction file FAB
  679.     TRANSACTION_RAB : $RAB_DECL,        ! Transaction file RAB
  680.     ESCAPE_CHR,                ! Escape character for CONNECT
  681.     ALT_FILE_SIZE,                ! Number of characters in FILE_NAME
  682.     ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; ! Storage
  683.     %SBTTL    'Storage -- Local'
  684.  
  685. !
  686. ! OWN STORAGE:
  687. !
  688.  
  689.     OWN
  690.  
  691. ! Command scanning information
  692.  
  693.     TPARSE_BLOCK    : BLOCK [TPA$K_LENGTH0, BYTE]
  694.         INITIAL (TPA$K_COUNT0,        ! Longword count
  695.             TPA$M_ABBREV),        ! Allow abbreviations
  696.     BAD_CMD_DESC : BLOCK [8, BYTE],        ! Descriptor for bad command field
  697.     COMMAND,                ! Type of command we are doing
  698.     SHOW_TYPE,                ! Type of show command
  699.     REM_TYPE,                ! Type of REMOTE command
  700.     TAKE_DISPLAY,                ! Display commands being TAKEn
  701. !
  702. ! Output data area
  703. !
  704.     OUTPUT_LINE : VECTOR [OUT_BFR_LENGTH, BYTE, UNSIGNED],
  705.     OUTPUT_DESC : BLOCK [8, BYTE],
  706.     OUTPUT_SIZE : WORD UNSIGNED,
  707.  
  708. ! Misc constants.
  709.  
  710.     Final_Status : LONG UNSIGNED INITIAL(SS$_NORMAL), ! Status from within condition handler routine.
  711.     TRANSACTION_NAME : VECTOR [CH$ALLOCATION(MAX_FILE_NAME)],
  712.     PROMPT_DESC : BLOCK [8, BYTE],        ! Descriptor for prompt
  713.     PROMPT_TEXT : VECTOR [CH$ALLOCATION(TEMP_LENGTH)], ! Storage for prompt
  714.     CRC_TABLE : BLOCK [16, LONG],        ! CRC-CCITT table
  715.     TAK_FIL_DESC    : BLOCK [8, BYTE],    ! Take file descriptor
  716.     TAK_FIL_NAME    : BLOCK [CH$ALLOCATION(MAX_FILE_NAME)],
  717.     TEMP_DESC    : BLOCK [8, BYTE],    ! Temporary descriptor
  718.     TEMP_NAME    : VECTOR [CH$ALLOCATION(TEMP_LENGTH)];
  719.  
  720.  
  721. !<BLF/FORMAT>
  722. %SBTTL 'External routines'
  723. !
  724. ! EXTERNAL REFERENCES:
  725. !
  726.  
  727. EXTERNAL ROUTINE
  728. !
  729. ! Library routines
  730. !
  731.     LIB$GET_INPUT : ADDRESSING_MODE (GENERAL),
  732.     LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL),
  733.     LIB$TPARSE : ADDRESSING_MODE (GENERAL),
  734.     LIB$CRC_TABLE : ADDRESSING_MODE (GENERAL),
  735.     LIB$CRC : ADDRESSING_MODE (GENERAL),
  736.     LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE,
  737.     LIB$ESTABLISH : ADDRESSING_MODE (GENERAL),
  738.     LIB$ATTACH : ADDRESSING_MODE (GENERAL),
  739.     LIB$SPAWN : ADDRESSING_MODE (GENERAL),
  740. !
  741. ! KERMSG - KERMIT Message processing routines
  742. !
  743.     SEND_SWITCH,                ! Send a file
  744.     REC_SWITCH,                    ! Receive a file
  745.     DO_GENERIC,                    ! Send generic functions
  746.     SERVER,                    ! Server mode processing
  747.     SND_ERROR : NOVALUE,            ! Send E packet to remote
  748.     MSG_INIT : NOVALUE,                ! Initialization routine
  749. !
  750. ! KERFIL - File processing.
  751. !
  752.     FILE_INIT : NOVALUE,            ! Initialization routine
  753. !
  754. ! KERSYS - System subroutines for KERMSG
  755. !
  756.     SY_INIT : NOVALUE,                ! Initialization routine
  757. !
  758. ! KERTRM - Terminal processing.
  759. !
  760.     TERM_INIT : NOVALUE,            ! Initialize the terminal processing
  761.     TERM_OPEN,                    ! Open the terminal line
  762.     TERM_CLOSE,                    ! Close the terminal line
  763.     TERM_CONNECT,                ! Impliments CONNECT command
  764.     SET_TRANS_TERM,                ! Set new transfer terminal
  765.     COMND_TRANSMIT,                             ! Transmit command code   in module KERTRM
  766. !
  767. ! KERTT - Text processing
  768. !
  769.     TT_INIT : NOVALUE,                ! Initialization routine
  770.     TT_TEXT : NOVALUE,                ! Output a text string
  771.     TT_NUMBER : NOVALUE,            ! Output a number
  772.     TT_CHAR : NOVALUE,                ! Output a single character
  773.     TT_OUTPUT : NOVALUE,            ! Routine to dump the current
  774.                             !  text line.
  775.     TT_CRLF : NOVALUE;                ! Output the line
  776.  
  777. %SBTTL 'External storage'
  778. !
  779. ! EXTERNAL Storage:
  780. !
  781.  
  782. EXTERNAL
  783. !
  784. ! KERMSG storage
  785. !
  786. ! Receive parameters
  787.     RCV_PKT_SIZE,                ! Receive packet size
  788.     RCV_NPAD,                    ! Padding length
  789.     RCV_PADCHAR,                ! Padding character
  790.     RCV_TIMEOUT,                ! Time out
  791.     RCV_EOL,                    ! EOL character
  792.     RCV_QUOTE_CHR,                ! Quote character
  793.     RCV_8QUOTE_CHR,                ! 8-bit quoting character
  794.     RCV_SOH,                    ! Start of packet header
  795. !
  796. ! Send parameters
  797. !
  798.     SND_PKT_SIZE,                ! Send packet size
  799.     SND_NPAD,                    ! Padding length
  800.     SND_PADCHAR,                ! Padding character
  801.     SND_TIMEOUT,                ! Time out
  802.     SND_EOL,                    ! EOL character
  803.     SND_QUOTE_CHR,                ! Quote character
  804.     SND_SOH,                    ! Packet start of header
  805. !
  806. ! Server parameters
  807. !
  808.     SRV_TIMEOUT,                ! Time between idle naks in server
  809. !
  810. ! Misc. packet parameters
  811. !
  812.     SET_REPT_CHR,                ! Desired repeat character
  813. !
  814. ! Statistics
  815. !
  816.     SND_TOTAL_CHARS,                ! Total characters sent
  817.     RCV_TOTAL_CHARS,                ! Total characters received
  818.     SND_DATA_CHARS,                ! Total number of data characters sent
  819.     RCV_DATA_CHARS,                ! Total number of data characters received
  820.     SMSG_TOTAL_CHARS,                ! Total chars sent this file xfer
  821.     RMSG_TOTAL_CHARS,                ! Total chars rcvd this file xfer
  822.     SMSG_DATA_CHARS,                ! Total data chars this file xfer
  823.     RMSG_DATA_CHARS,                ! Total data chars this file xfer
  824.     RCV_NAKS,                    ! Total number of NAKs received
  825.     SND_NAKS,                    ! Total number of NAKs sent
  826.     RMSG_NAKS,                    ! Number of NAKs received
  827.     SMSG_NAKS,                    ! Number of NAKs sent
  828.     RCV_COUNT,                    ! Total number of packets received
  829.     SND_COUNT,                    ! Total number of packets sent
  830.     RMSG_COUNT,                    ! Number of packets received
  831.     SMSG_COUNT,                    ! Number of packets sent
  832.     XFR_TIME,                    ! Amount of time the last transfer took
  833.     TOTAL_TIME,                    ! Total time the transfers have taken
  834.     LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)],    ! Last error message
  835.     TY_PKT,                    ! Flag that packet numbers should be typed
  836.     TY_FIL,                    ! Flag that file names should be typed
  837.     GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Data for generic command
  838.     GEN_1SIZE,                    ! Size of data in GEN_1DATA
  839.     GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Second argument for generic command
  840.     GEN_2SIZE,                    ! Size of data in GEN_2DATA
  841.     GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Third arg for generic command
  842.     GEN_3SIZE,                    ! Size of data in GEN_3DATA
  843. !
  844. ! Misc constants.
  845. !
  846.     FILE_SIZE,                    ! Number of characters in FILE_NAME
  847.     FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
  848.     SI_RETRIES,                    ! Initial connection max retries
  849.     PKT_RETRIES,                ! Packet max retries
  850.     DELAY,                    ! Amount of time to delay
  851.     DEBUG_FLAG,                    ! Debugging mode on/off
  852.     CHKTYPE,                    ! Type of block-check-type wanted
  853.     ABT_FLAG,                    ! Aborted file disposition
  854. !    IBM_FLAG,                    ! IBM mode flag
  855.     IBM_CHAR,                    ! Handshaking character
  856.     WARN_FLAG,                    ! File warning flag
  857.     FIL_NORMAL_FORM,                ! File name type to send
  858.     PARITY_TYPE,                ! Type of parity we are using
  859.     ECHO_FLAG,                    ! Local echo flag
  860.     CONNECT_FLAG;                ! True if SYS$OUTPUT and line
  861.  
  862.                         ! xfering over are the same.
  863. !
  864. ! KERFIL storage
  865. !
  866.  
  867. EXTERNAL
  868.  
  869.     file_blocksize,                             ! Blocksize for FIXED files
  870.     file_blocksize_set,                ! Flag indicating a blocksize has been specified by the user.
  871.     FILE_TYPE,                    ! Type of file being processed
  872.     FILE_DESC : BLOCK [8, BYTE];        ! Descriptor for the file name
  873.  
  874. !
  875. ! KERTRM storage
  876. !
  877.  
  878. EXTERNAL
  879.     SESSION_DESC : BLOCK [8, BYTE],        ! Session log file name
  880.     DEBUG_DESC : BLOCK [8, BYTE],        ! Debugging log file name
  881.     TERM_DESC : BLOCK [8, BYTE],        ! Terminal name descriptor
  882.     TRANS_ECHO_FLAG,                            ! Transmit echo on/off   
  883.     TRANS_DELAY,                                ! Transmit delay   
  884.     TERM_FLAG;                    ! Terminal open flag
  885.  
  886. %SBTTL 'Command parsing tables'
  887. !<BLF/NOFORMAT>
  888. !++
  889. !
  890. !The following are the command state tables for the KERMIT-32
  891. !command processing.
  892. !
  893. !--
  894.  
  895. $INIT_STATE    (KERMIT_STATE,    KERMIT_KEY);
  896.  
  897. $STATE    (START,
  898.     ('BYE',        DONE_STATE,    ,    CMD_BYE,    COMMAND),
  899.     ('CONNECT',    CONN_STATE,    ,    CMD_CONN,    COMMAND),
  900.     ('EXIT',    DONE_STATE,    ,    CMD_EXIT,    COMMAND),
  901.     ('FINISH',    DONE_STATE,    ,    CMD_FINISH,    COMMAND),
  902.     ('GET',        GET_STATE,    ,    CMD_GET,    COMMAND),
  903.     ('HELP',    HELP_STATE,    ,    CMD_HELP,    COMMAND),
  904.     ('LOCAL',    REM_STATE,    ,    CMD_LOCAL,    COMMAND),
  905.     ('LOG',        LOG_STATE,    ,    CMD_NULL,    COMMAND),
  906.     ('LOGOUT',    DONE_STATE,    ,    CMD_LOGOUT,    COMMAND),
  907.     ('PUSH',    DONE_STATE,    ,    CMD_PUSH,    COMMAND),
  908.     ('QUIT',    DONE_STATE,    ,    CMD_EXIT,    COMMAND),
  909.     ('RECEIVE',    REC_STATE,    ,    CMD_RECEIVE,    COMMAND),
  910.     ('REMOTE',    REM_STATE,    ,    CMD_REMOTE,    COMMAND),
  911.     ('SET',        SET_STATE,    ,    CMD_SET,    COMMAND),
  912.     ('SEND',    SEND_STATE,    ,    CMD_SEND,    COMMAND),
  913.     ('SERVER',    DONE_STATE,    ,    CMD_SERVER,    COMMAND),
  914.     ('SHOW',    SHOW_STATE,    ,    CMD_SHOW,    COMMAND),
  915.     ('STATUS',    DONE_STATE,    ,    CMD_STATUS,    COMMAND),
  916.     ('TAKE',    TAKE_STATE,    ,    CMD_TAKE,    COMMAND),
  917.     ('@',        TAKE_STATE,    ,    CMD_TAKE,    COMMAND),
  918.         ('TRANSMIT',    TRANSMIT_STATE, ,       CMD_TRANSMIT,   COMMAND),  !
  919.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  920.     )
  921.  
  922. !++
  923. ! CONNECT command.  Format is:
  924. !
  925. !    Kermit-32>CONNECT device
  926. !
  927. ! Where:
  928. !    Device - Terminal line to connect to
  929. !
  930. !--
  931.  
  932. $STATE    (CONN_STATE,
  933.     (TPA$_EOS, DONE_STATE),
  934.     (TPA$_LAMBDA, SET_LIN_STATE)
  935.     )
  936.  
  937. !++
  938. ! EXIT command.  Format is:
  939. !
  940. !    Kermit-32>EXIT
  941. !
  942. ! Just exit back to VMS.
  943. !
  944. !--
  945.  
  946. !++
  947. ! HELP command.  Format is:
  948. !
  949. !    Kermit-32>HELP
  950. !
  951. ! Do HELP processing for KERMIT-32.
  952. !
  953. !--
  954.  
  955. $STATE    (HELP_STATE,
  956.     (TPA$_ANY,    HELP_STATE,    STORE_TEXT),
  957.     (TPA$_LAMBDA,    DONE_STATE)
  958. )
  959.  
  960.     %SBTTL    'QUIT command table'
  961.  
  962. !++
  963. ! QUIT command.  Format is:
  964. !
  965. !    Kermit-32>QUIT
  966. !
  967. ! This command will just exit back to VMS.
  968. !
  969. !--
  970.     %SBTTL    'GET command table'
  971.  
  972. !++
  973. ! GET command.  Format is:
  974. !
  975. !    Kermit-32>GET file-specification
  976. !
  977. ! This command will cause KERMIT to get a file from the micro.
  978. ! It will assume that it is to used what ever line it currently is
  979. ! associated with (CONNECT or SET LINE).
  980. !
  981. !--
  982.  
  983. $STATE    (GET_STATE,
  984.     (TPA$_ANY,    GET_STATE,    STORE_TEXT),
  985.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,FILE_DESC)
  986.     )
  987.     %SBTTL    'RECEIVE command table'
  988.  
  989. !++
  990. ! RECEIVE command.  Format is:
  991. !
  992. !    Kermit-32>RECEIVE file-specification
  993. !
  994. ! This command will cause KERMIT to receive a file from the micro.
  995. ! It will assume that it is to used what ever line it currently is
  996. ! associated with (CONNECT or SET LINE).
  997. !
  998. !--
  999.  
  1000. $STATE    (REC_STATE,
  1001.     (TPA$_ANY,    REC1_STATE,    STORE_TEXT),
  1002.     (TPA$_LAMBDA,    DONE_STATE)
  1003.     )
  1004.  
  1005.  
  1006. $STATE    (REC1_STATE,
  1007.     (TPA$_ANY,    REC1_STATE,    STORE_TEXT),
  1008.     (TPA$_LAMBDA,    DONE_STATE,    COPY_ALT_FILE)
  1009.     )
  1010.     %SBTTL    'REMOTE command tables'
  1011.  
  1012. !++
  1013. ! REMOTE command.  This command will allow the local Kermit user to
  1014. ! request the server Kermit to perform some action.
  1015. !
  1016. !    Kermit-32>REMOTE keyword arguments
  1017. !
  1018. ! Where:
  1019. !
  1020. !    Keyword is one of:
  1021. !        DELETE
  1022. !        DIRECTORY
  1023. !        DISK_USAGE
  1024. !        HELP
  1025. !        SPACE
  1026. !        TYPE
  1027. !--
  1028. $STATE    (REM_STATE,
  1029.     ('COPY',    REM2_STATE,    ,GC_COPY,    REM_TYPE),
  1030.     ('CWD',        REM1_STATE,    ,GC_CONNECT,    REM_TYPE),
  1031.     ('DELETE',    REM2_STATE,    ,GC_DELETE,    REM_TYPE),
  1032.     ('DIRECTORY',    REM1_STATE,    ,GC_DIRECTORY,    REM_TYPE),
  1033.     ('DISK_USAGE',    REM1_STATE,    ,GC_DISK_USAGE,    REM_TYPE),
  1034.     ('EXIT',    DONE_STATE,    ,GC_EXIT,    REM_TYPE),
  1035.     ('HELP',    REM1_STATE,    ,GC_HELP,    REM_TYPE),
  1036.     ('HOST',    REM2_STATE,    ,GC_COMMAND,    REM_TYPE),
  1037.     ('LOGIN',    REM2_STATE,    ,GC_LGN,    REM_TYPE),
  1038.     ('LOGOUT',    DONE_STATE,    ,GC_LOGOUT,    REM_TYPE),
  1039.     ('RENAME',    REM2_STATE,    ,GC_RENAME,    REM_TYPE),
  1040.     ('SEND_MESSAGE',REM2_STATE,    ,GC_SEND_MSG,    REM_TYPE),
  1041.     ('SPACE',    REM1_STATE,    ,GC_DISK_USAGE,    REM_TYPE),
  1042.     ('STATUS',    DONE_STATE,    ,GC_STATUS,    REM_TYPE),
  1043.     ('TYPE',    REM2_STATE,    ,GC_TYPE,    REM_TYPE),
  1044.     ('WHO',        REM1_STATE,    ,GC_WHO,    REM_TYPE),
  1045.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1046.     )
  1047.  
  1048. ! State to allow for either no arguments or a text string
  1049.  
  1050. $STATE    (REM1_STATE,
  1051.     (TPA$_ANY,    REM2_STATE,    STORE_TEXT),
  1052.     (TPA$_LAMBDA,    DONE_STATE)
  1053.     )
  1054.  
  1055. ! State to require a text string argument
  1056.  
  1057. $STATE    (REM2_STATE,
  1058.     (TPA$_ANY,    REM2_STATE,    STORE_TEXT),
  1059.     (TPA$_LAMBDA,    DONE_STATE,    COPY_GEN_1DATA)
  1060.     )
  1061.     %SBTTL    'SET command tables'
  1062.  
  1063. !++
  1064. ! SET command.  Format is:
  1065. !
  1066. !    Kermit-32>SET parameter
  1067. !
  1068. ! Where:
  1069. !    Parameter - One of many keywords
  1070. !
  1071. !--
  1072.  
  1073. $STATE    (SET_STATE,
  1074.     ('BLOCK_CHECK_TYPE', SET_CHK_STATE),
  1075.     ('DEBUGGING',    SET_DEB_STATE),
  1076.     ('DELAY',    SET_DEL_STATE),
  1077.     ('ESCAPE',    SET_ESC_STATE),
  1078.     ('FILE',    SET_FIL_STATE),
  1079.     ('HANDSHAKE',    SET_HAN_STATE),
  1080.     ('IBM_MODE',    SET_IBM_STATE),
  1081.     ('INCOMPLETE_FILE_DISPOSITION', SET_ABT_STATE),
  1082.     ('LINE',    SET_LIN_STATE),
  1083.     ('LOCAL_ECHO',    SET_ECH_STATE),
  1084.     ('MESSAGE',    SET_MSG_STATE),
  1085.     ('PARITY',    SET_PAR_STATE),
  1086.     ('PROMPT',    SET_PMT_STATE),
  1087.     ('RECEIVE',    SET_REC_STATE),
  1088.     ('REPEAT_QUOTE',SET_RPT_STATE),
  1089.     ('RETRY',    SET_RTY_STATE),
  1090.     ('SEND',    SET_SND_STATE),
  1091.     ('SERVER_TIMER',SET_SRV_STATE),
  1092.     ('TRANSMIT',    SET_TRN_STATE),  !
  1093.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1094.     )
  1095.  
  1096. !++
  1097. !
  1098. ! SET INCOMPLETE_FILE [disposition] command.  The possible arguments are
  1099. !    KEEP or DISCARD.
  1100. !
  1101. !--
  1102.  
  1103. $STATE    (SET_ABT_STATE,
  1104.     ('DISCARD', DONE_STATE,    STORE_ABT,,    ,TRUE),
  1105.     ('KEEP',    DONE_STATE,    STORE_ABT,,    ,FALSE),
  1106.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1107.     )
  1108.  
  1109. !++
  1110. !
  1111. ! SET BLOCK_CHECK_TYPE [type] command.  The format is:
  1112. !
  1113. !    Kermit-32>SET BLOCK_CHECK_TYPE [1_CHARACTER_CHECKSUM | ....]
  1114. !
  1115. !--
  1116.  
  1117. $STATE    (SET_CHK_STATE,
  1118.     ('1_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_1CHAR),
  1119.     ('2_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_2CHAR),
  1120.     ('3_CHARACTER_CRC_CCITT', DONE_STATE,    STORE_CHK,,    ,CHK_CRC),
  1121.     ('ONE_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_1CHAR),
  1122.     ('THREE_CHARACTER_CRC_CCITT', DONE_STATE, STORE_CHK,,    ,CHK_CRC),
  1123.     ('TWO_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_2CHAR),
  1124.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1125.     )
  1126.  
  1127. !++
  1128. !
  1129. ! SET DEBUGGING command.  The format is:
  1130. !
  1131. !    Kermit-32>SET DEBUGGING (on/off)
  1132. !
  1133. ! Where:
  1134. !    on/off is either the ON or OFF keyword.
  1135. !
  1136. !--
  1137.  
  1138. $STATE    (SET_DEB_STATE,
  1139.     ('OFF',        DONE_STATE,    STORE_DEBUG,    ,    ,FALSE),
  1140.     ('ON',        DONE_STATE,    STORE_DEBUG,    ,    ,TRUE),
  1141.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1142.     )
  1143.  
  1144. !++
  1145. !
  1146. ! SET IBM_MODE command.  The format is:
  1147. !
  1148. !    Kermit-32>SET IBM_MODE (on/off)
  1149. !
  1150. ! Where:
  1151. !    on/off is either the ON or OFF keyword.
  1152. !
  1153. !--
  1154.  
  1155. $STATE    (SET_IBM_STATE,
  1156.     ('OFF',        DONE_STATE,    STORE_IBM,    ,    ,FALSE),
  1157.     ('ON',        DONE_STATE,    STORE_IBM,    ,    ,TRUE),
  1158.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1159.     )
  1160. !++
  1161. !
  1162. ! SET HANDSHAKE command.  The format is:
  1163. !
  1164. !    Kermit-32>SET HANDSHAKE <octal>
  1165. !
  1166. ! Where:
  1167. !    <octal> is the octal number representing the handshake character
  1168. !    for file transfers.
  1169. !
  1170. ! Negative values indicate no handshaking.
  1171. !--
  1172.  
  1173. $STATE    (SET_HAN_STATE,
  1174.     ('NONE',    DONE_STATE,    ,   -1    ,IBM_CHAR),
  1175.     (TPA$_OCTAL,    DONE_STATE,    ,    ,IBM_CHAR)
  1176.     )
  1177.  
  1178. !++
  1179. !
  1180. ! SET DELAY command.  The format is:
  1181. !
  1182. !    Kermit-32>SET DELAY <dec>
  1183. !
  1184. ! Where:
  1185. !    <dec> is the number of seconds to delay before sending the
  1186. !    SEND-INIT packet.
  1187. !--
  1188.  
  1189. $STATE    (SET_DEL_STATE,
  1190.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,DELAY)
  1191.     )
  1192.  
  1193. !++
  1194. !
  1195. ! SET FILE BLOCKSIZE command.  The format is:
  1196. !
  1197. !    Kermit-32>SET FILE BLOCKSIZE <size>
  1198. !
  1199. ! Where:
  1200. !    <size> is the number of bytes per fixed-length record for BINARY
  1201. !    and FIXED files.
  1202. !--
  1203.  
  1204. $STATE    (SET_BLK_STATE,
  1205.     (TPA$_DECIMAL, DONE_STATE, store_blocksize, , file_blocksize)
  1206.         )
  1207.  
  1208. !++
  1209. !
  1210. ! SET ESCAPE command.  The format is:
  1211. !
  1212. !    Kermit-32>SET ESCAPE <octal>
  1213. !
  1214. ! Where:
  1215. !    <octal> is the octal number representing the escape character
  1216. !    for the CONNECT command processing.  The default escape character
  1217. !    is Control-].
  1218. !--
  1219.  
  1220. $STATE    (SET_ESC_STATE,
  1221.     (TPA$_OCTAL,    DONE_STATE,    ,    ,ESCAPE_CHR)
  1222.     )
  1223. !++
  1224. !
  1225. ! SET FILE xxx command.  The format is:
  1226. !
  1227. !    Kermit-32>SET FILE <item> <args>
  1228. !
  1229. ! Where:
  1230. !    <item> is one of:
  1231. !        NAMING - Type of file name to send
  1232. !        TYPE - Type of file to create on receive (or send in certain cases)
  1233. !               BLOCKSIZE - Size of blocks (in bytes) for (FIXED and BINARY 
  1234. !                           type) output files.
  1235. !
  1236. !--
  1237. $STATE    (SET_FIL_STATE,
  1238.     ('NAMING',    SET_FNM_STATE),
  1239.     ('TYPE',    SET_FTP_STATE),
  1240.     ('BLOCKSIZE',    SET_BLK_STATE),
  1241.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1242.     ) 
  1243. !++
  1244. !
  1245. ! SET FILE NAMING command.  The format is:
  1246. !
  1247. !    Kermit-32>SET FILE NAMING <type>
  1248. !
  1249. ! Where:
  1250. !    <type> is one of:
  1251. !        FULL   - Send complete file specification, including device and
  1252. !            directory
  1253. !        NORMAL_FORM - Send only name.type
  1254. !        UNTRANSLATED - Send name.type, but don't do any fixups on it
  1255. !--
  1256.  
  1257. $STATE (SET_FNM_STATE,
  1258.     ('FULL',    DONE_STATE,    STORE_FNM,    ,    ,FNM_FULL),
  1259.     ('NORMAL_FORM',    DONE_STATE,    STORE_FNM,    ,    ,FNM_NORMAL),
  1260.     ('UNTRANSLATED',DONE_STATE,    STORE_FNM,    ,    ,FNM_UNTRAN),
  1261.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1262.     )
  1263. !++
  1264. !
  1265. ! SET FILE TYPE command.  The format is:
  1266. !
  1267. !    Kermit-32>SET FILE TYPE <type>
  1268. !
  1269. ! Where:
  1270. !    <Type> is one of the following:
  1271. !        ASCII - Normal ASCII file (stream ascii)
  1272. !        BINARY - Micro binary file.
  1273. !--
  1274.  
  1275. $STATE    (SET_FTP_STATE,
  1276.     ('ASCII',    DONE_STATE,    STORE_FTP,    ,    ,FILE_ASC),
  1277.     ('BINARY',    DONE_STATE,    STORE_FTP,    ,    ,FILE_BIN),
  1278.     ('BLOCK',    DONE_STATE,    STORE_FTP,    ,    ,FILE_BLK),
  1279.     ('FIXED',    DONE_STATE,    STORE_FTP,    ,    ,FILE_FIX),
  1280.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1281.     )
  1282.  
  1283. !++
  1284. ! SET LINE command.  Format is:
  1285. !
  1286. !    Kermit-32>SET LINE terminal-device:
  1287. !
  1288. ! Where:
  1289. !    Terminal-device: is the terminal line to use to the transfer of
  1290. !    the data and to use in the CONNECT command.
  1291. !
  1292. !--
  1293.  
  1294. $STATE    (SET_LIN_STATE,
  1295.     (TPA$_ANY,    SET_LIN_STATE,    STORE_TEXT),
  1296.     (TPA$_LAMBDA,    DONE_STATE,    COPY_TERM_NAME)
  1297.     )
  1298.  
  1299. !++
  1300. ! SET LOCAL-ECHO command.  Format is:
  1301. !
  1302. !    Kermit-32>SET LOCAL-ECHO state
  1303. !
  1304. ! Where:
  1305. !    STATE is either the keyword ON or OFF.
  1306. !
  1307. !-
  1308.  
  1309. $STATE    (SET_ECH_STATE,
  1310.     ('OFF',        DONE_STATE,    STORE_ECHO,    ,    ,FALSE),
  1311.     ('ON',        DONE_STATE,    STORE_ECHO,    ,    ,TRUE),
  1312.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1313.     )
  1314.  
  1315.  
  1316. !++
  1317. ! SET MESSAGE command. Format is:
  1318. !
  1319. !    Kermit-32>SET MESSAGE <keyword>
  1320. !
  1321. ! Where the keyword is:
  1322. !
  1323. !    FILE_NAMES - Type out file names being transferred
  1324. !    PACKET_NUMBERS - Type out packet counts
  1325. !--
  1326.  
  1327. $STATE    (SET_MSG_STATE,
  1328.     ('FILE_NAMES',        SET_MSG_FIL_STATE),
  1329.     ('PACKET_NUMBERS',    SET_MSG_PKT_STATE),
  1330.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1331.     )
  1332.  
  1333. $STATE    (SET_MSG_FIL_STATE,
  1334.     ('OFF',        DONE_STATE,    STORE_MSG_FIL,    ,    ,FALSE),
  1335.     ('ON',        DONE_STATE,    STORE_MSG_FIL,    ,    ,TRUE),
  1336.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1337.     )
  1338.  
  1339. $STATE    (SET_MSG_PKT_STATE,
  1340.     ('OFF',        DONE_STATE,    STORE_MSG_PKT,    ,    ,FALSE),
  1341.     ('ON',        DONE_STATE,    STORE_MSG_PKT,    ,    ,TRUE),
  1342.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1343.     )
  1344.  
  1345. !++
  1346. ! SET PROMPT command.
  1347. !
  1348. !    Kermit-32>SET PROMPT new-prompt-text
  1349. !
  1350. !--
  1351.  
  1352. $STATE    (SET_PMT_STATE,
  1353.     (TPA$_ANY,    SET_PMT_STATE,    STORE_TEXT),
  1354.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,PROMPT_DESC)
  1355.     )
  1356.  
  1357. !++
  1358. ! SET REPEAT_QUOTE command.  Format is:
  1359. !
  1360. !    Kermit-32>SET REPEAT_QUOTE <character value>
  1361. !
  1362. !--
  1363.  
  1364. $STATE    (SET_RPT_STATE,
  1365.     (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,SET_REPT_CHR)
  1366.     )
  1367.  
  1368. !++
  1369. ! SET RETRY command.  Format is:
  1370. !
  1371. !    Kermit-32>SET RETRY <keyword>
  1372. !
  1373. ! Where the keyword is:
  1374. !
  1375. !    INITIAL_CONNECTION - set number of initial connection retries.
  1376. !    PACKET - set the number of packet retries.
  1377. !--
  1378.  
  1379. $STATE    (SET_RTY_STATE,
  1380.     ('INITIAL_CONNECTION',    SET_RTY_INI_STATE),
  1381.     ('PACKET',        SET_RTY_PKT_STATE),
  1382.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1383.     )
  1384.  
  1385.  
  1386. $STATE    (SET_RTY_INI_STATE,
  1387.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,SI_RETRIES)
  1388.     )
  1389.  
  1390. $STATE    (SET_RTY_PKT_STATE,
  1391.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,PKT_RETRIES)
  1392.     )
  1393.     %SBTTL    'SET PARITY type'
  1394.  
  1395. !++
  1396. ! SET PARITY command.  Format is:
  1397. !
  1398. !    Kermit-32>SET PARITY type
  1399. !
  1400. ! The type can be:
  1401. !
  1402. !    NONE - No parity processing
  1403. !    MARK - Mark parity
  1404. !    SPACE - Space parity
  1405. !    EVEN - Even parity
  1406. !    ODD - Odd parity
  1407. !
  1408. !--
  1409.  
  1410. $STATE    (SET_PAR_STATE,
  1411.     ('EVEN',    DONE_STATE,    STORE_PARITY,    ,    ,PR_EVEN),
  1412.     ('MARK',    DONE_STATE,    STORE_PARITY,    ,    ,PR_MARK),
  1413.     ('NONE',    DONE_STATE,    STORE_PARITY,    ,    ,PR_NONE),
  1414.     ('ODD',        DONE_STATE,    STORE_PARITY,    ,    ,PR_ODD),
  1415.     ('SPACE',    DONE_STATE,    STORE_PARITY,    ,    ,PR_SPACE),
  1416.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1417.     )
  1418.     %SBTTL    'SET RECEIVE table'
  1419.  
  1420. !++
  1421. ! SET RECEIVE command.  Format is:
  1422. !
  1423. !    Kermit-32>SET RECEIVE item
  1424. !
  1425. ! Where:
  1426. !    Item - One of the following:
  1427. !        PACKET-LENGTH <dec>
  1428. !        PADDING <dec>
  1429. !        PADCHAR <chr>
  1430. !        TIMEOUT <dec>
  1431. !        END-OF-LINE <oct>
  1432. !        QUOTE <chr>
  1433. !
  1434. !--
  1435.  
  1436. $STATE    (SET_REC_STATE,
  1437.     ('EIGHT-BIT-QUOTE',    SR_8QU_STATE),
  1438.     ('END_OF_LINE',        SR_EOL_STATE),
  1439.     ('PACKET_LENGTH',    SR_PKT_STATE),
  1440.     ('PADCHAR',        SR_PDC_STATE),
  1441.     ('PADDING',        SR_PAD_STATE),
  1442.     ('QUOTE',        SR_QUO_STATE),
  1443.     ('START_OF_PACKET',    SR_SOH_STATE),
  1444.     ('TIMEOUT',        SR_TIM_STATE),
  1445.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1446.     )
  1447.  
  1448. !++
  1449. !
  1450. ! SET RECEIVE PACKET-LENGTH command.  Format is:
  1451. !
  1452. !    Kermit-32>SET RECEIVE PACKET-LENGTH <dec>
  1453. !
  1454. ! Where:
  1455. !    <Dec> is a decimal number that specifies the length of a
  1456. !    receive packet.
  1457. !
  1458. !--
  1459.  
  1460. $STATE    (SR_PKT_STATE,
  1461.     (TPA$_DECIMAL,    DONE_STATE,    CHECK_PACKET_LEN,    ,RCV_PKT_SIZE)
  1462.     )
  1463.  
  1464.  
  1465. !++
  1466. !
  1467. ! SET RECEIVE PADDING command.  The format of this command is:
  1468. !
  1469. !    Kermit-32>SET RECEIVE PADDING <dec>
  1470. !
  1471. ! Where:
  1472. !    <dec> is the decimal number of padding characters to output.
  1473. !
  1474. !--
  1475.  
  1476. $STATE    (SR_PAD_STATE,
  1477.     (TPA$_DECIMAL,    DONE_STATE,    CHECK_NPAD,    ,RCV_NPAD)
  1478.     )
  1479.  
  1480. !++
  1481. !
  1482. ! SET RECEIVE PADCHAR command.  Format is:
  1483. !
  1484. !    Kermit-32>SET RECEIVE PADCHAR <oct>
  1485. !
  1486. ! Where:
  1487. !    <oct> is the octal representation of the padding character
  1488. !    that is to be used.
  1489. !
  1490. !--
  1491.  
  1492. $STATE    (SR_PDC_STATE,
  1493.     (TPA$_OCTAL,    DONE_STATE,    CHECK_PAD_CHAR,    ,RCV_PADCHAR)
  1494.     )
  1495. !++
  1496. !
  1497. ! SET RECEIVE START_OF_PACKET command.  Format is:
  1498. !
  1499. !    Kermit-32>SET RECEIVE START_OF_PACKET <oct>
  1500. !
  1501. ! Where:
  1502. !    <oct> is the octal representation of the padding character
  1503. !    that is to be used.
  1504. !
  1505. !--
  1506.  
  1507. $STATE    (SR_SOH_STATE,
  1508.     (TPA$_OCTAL,    DONE_STATE,    CHECK_SOH,    ,RCV_SOH)
  1509.     )
  1510.  
  1511. !++
  1512. !
  1513. ! SET RECEIVE TIMEOUT command.  The format is:
  1514. !
  1515. !    Kermit-32>SET RECEIVE TIMEOUT <dec>
  1516. !
  1517. ! Where:
  1518. !    <dec> is the number of seconds before KERMIT-32 should time out
  1519. !    attempting to receive a correct message.
  1520. !
  1521. !--
  1522.  
  1523. $STATE    (SR_TIM_STATE,
  1524.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,RCV_TIMEOUT)
  1525.     )
  1526.  
  1527. !++
  1528. ! SET END-OF-LINE command.  Format is:
  1529. !
  1530. !    Kermit-32>SET RECEIVE END-OF-LINE <octal>
  1531. !
  1532. ! Where:
  1533. !    <octal> is the octal number representation of the character
  1534. !    that is the end of line character.
  1535. !
  1536. !--
  1537.  
  1538. $STATE    (SR_EOL_STATE,
  1539.     (TPA$_OCTAL,    DONE_STATE,    CHECK_EOL,    ,RCV_EOL)
  1540.     )
  1541.  
  1542. !++
  1543. ! SET RECEIVE QUOTE command.  The format is:
  1544. !
  1545. !    Kermit-32>SET RECEIVE QUOTE <octal>
  1546. !
  1547. ! Where:
  1548. !    <octal> is the octal number representing the quoting character.
  1549. !
  1550. !--
  1551.  
  1552. $STATE    (SR_QUO_STATE,
  1553.     (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,RCV_QUOTE_CHR)
  1554.     )
  1555.     %SBTTL    'SET RECEIVE EIGHT-BIT-QUOTE'
  1556.  
  1557. !++
  1558. ! This routine will handle the setting of the eight bit quoting character.
  1559. !
  1560. !    Kermit-32>SET RECEIVE EIGHT-BIT-QUOTE <octal>
  1561. !
  1562. ! Where:
  1563. !    <octal> is the octal number representing the quoting character.
  1564. !
  1565. !--
  1566.  
  1567. $STATE    (SR_8QU_STATE,
  1568.     (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,RCV_8QUOTE_CHR)
  1569.     )
  1570.     %SBTTL    'SET SEND tables'
  1571.  
  1572. !++
  1573. ! SET SEND command.  Format is:
  1574. !
  1575. !    Kermit-32>SET SEND item
  1576. !
  1577. ! Where:
  1578. !    Item - One of the following:
  1579. !        PACKET-LENGTH <dec>
  1580. !        PADDING <dec>
  1581. !        PADCHAR <chr>
  1582. !        TIMEOUT <dec>
  1583. !        END-OF-LINE <oct>
  1584. !        QUOTE <chr>
  1585. !
  1586. !--
  1587.  
  1588. $STATE    (SET_SND_STATE,
  1589.     ('END_OF_LINE',        SS_EOL_STATE),
  1590.     ('PACKET_LENGTH',    SS_PKT_STATE),
  1591.     ('PADCHAR',        SS_PDC_STATE),
  1592.     ('PADDING',        SS_PAD_STATE),
  1593.     ('QUOTE',        SS_QUO_STATE),
  1594.     ('START_OF_PACKET',    SS_SOH_STATE),
  1595.     ('TIMEOUT',        SS_TIM_STATE),
  1596.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1597.     )
  1598.  
  1599.  
  1600.  
  1601. !++
  1602. !
  1603. ! SET SEND PACKET-LENGTH command.  Format is:
  1604. !
  1605. !    Kermit-32>SET SEND PACKET-LENGTH <dec>
  1606. !
  1607. ! Where:
  1608. !    <Dec> is a decimal number that specifies the length of a
  1609. !    receive packet.
  1610. !
  1611. !--
  1612.  
  1613. $STATE    (SS_PKT_STATE,
  1614.     (TPA$_DECIMAL,    DONE_STATE,    CHECK_PACKET_LEN,    ,SND_PKT_SIZE)
  1615.     )
  1616.  
  1617.  
  1618. !++
  1619. !
  1620. ! SET SEND PADDING command.  The format of this command is:
  1621. !
  1622. !    Kermit-32>SET SEND PADDING <dec>
  1623. !
  1624. ! Where:
  1625. !    <dec> is the decimal number of padding characters to output.
  1626. !
  1627. !--
  1628.  
  1629. $STATE    (SS_PAD_STATE,
  1630.     (TPA$_DECIMAL,    DONE_STATE,    CHECK_NPAD,    ,SND_NPAD)
  1631.     )
  1632.  
  1633. !++
  1634. !
  1635. ! SET SEND PADCHAR command.  Format is:
  1636. !
  1637. !    Kermit-32>SET SEND PADCHAR <oct>
  1638. !
  1639. ! Where:
  1640. !    <oct> is the octal representation of the padding character
  1641. !    that is to be used.
  1642. !
  1643. !--
  1644.  
  1645. $STATE    (SS_PDC_STATE,
  1646.     (TPA$_OCTAL,    DONE_STATE,    CHECK_PAD_CHAR,    ,SND_PADCHAR)
  1647.     )
  1648. !++
  1649. !
  1650. ! SET RECEIVE START_OF_PACKET command.  Format is:
  1651. !
  1652. !    Kermit-32>SET RECEIVE START_OF_PACKET <oct>
  1653. !
  1654. ! Where:
  1655. !    <oct> is the octal representation of the padding character
  1656. !    that is to be used.
  1657. !
  1658. !--
  1659.  
  1660. $STATE    (SS_SOH_STATE,
  1661.     (TPA$_OCTAL,    DONE_STATE,    CHECK_SOH,    ,SND_SOH)
  1662.     )
  1663.  
  1664. !++
  1665. !
  1666. ! SET SEND TIMEOUT command.  The format is:
  1667. !
  1668. !    Kermit-32>SET SEND TIMEOUT <dec>
  1669. !
  1670. ! Where:
  1671. !    <dec> is the number of seconds before KERMIT-32 should time out
  1672. !    attempting to receive a correct message.
  1673. !
  1674. !--
  1675.  
  1676. $STATE    (SS_TIM_STATE,
  1677.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,SND_TIMEOUT)
  1678.     )
  1679.  
  1680. !++
  1681. ! SET SEND END-OF-LINE command.  Format is:
  1682. !
  1683. !    Kermit-32>SET SEND END-OF-LINE <octal>
  1684. !
  1685. ! Where:
  1686. !    <octal> is the octal number representation of the character
  1687. !    that is the end of line character.
  1688. !
  1689. !--
  1690.  
  1691. $STATE    (SS_EOL_STATE,
  1692.     (TPA$_OCTAL,    DONE_STATE,    CHECK_EOL,    ,SND_EOL)
  1693.     )
  1694.  
  1695. !++
  1696. ! SET SEND QUOTA command.  The format is:
  1697. !
  1698. !    Kermit-32>SET SEND QUOTA <octal>
  1699. !
  1700. ! Where:
  1701. !    <octal> is the octal number representing the quoting character.
  1702. !
  1703. !--
  1704.  
  1705. $STATE    (SS_QUO_STATE,
  1706.     (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,SND_QUOTE_CHR)
  1707.     )
  1708.  
  1709. !++
  1710. ! SET SERVER_TIMER command.
  1711. !
  1712. ! This sets the time between naks send when server is idle.
  1713. !--
  1714.  
  1715. $STATE    (SET_SRV_STATE,
  1716.     (TPA$_DECIMAL,    DONE_STATE,    ,    ,SRV_TIMEOUT)
  1717.     )
  1718.  
  1719. !++
  1720. !
  1721. ! SET TRANSMIT xxx command.  The format is:     !  and below
  1722. !
  1723. !    Kermit-32>SET TRANSMIT <item> <args>
  1724. !
  1725. ! Where:
  1726. !    <item> is one of:
  1727. !        DELAY - Time to delay after each carriage return
  1728. !            ECHO - Echo from terminal line or just print line numbers
  1729. !
  1730. !--
  1731. $STATE    (SET_TRN_STATE,                                                !
  1732.     ('DELAY',    SET_TRD_STATE),                                !
  1733.     ('ECHO',    SET_TRE_STATE),                                !
  1734.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)                     !
  1735.     )                                                              !
  1736.  
  1737. !++
  1738. !
  1739. ! SET TRANSMIT DELAY command.  Format is:          ! and below
  1740. !
  1741. !    Kermit-32>SET TRANSMIT DELAY <digit>
  1742. !
  1743. ! Where:
  1744. !    <digit> is a decimal digit that specifies the length of time in
  1745. !    tenths of a second to delay after transmitting a carriage return.
  1746. !
  1747. !--
  1748.  
  1749. $STATE    (SET_TRD_STATE,                                                       !
  1750.     (TPA$_DIGIT,    DONE_STATE,    STORE_TR_DELAY,     ,TRANS_DELAY) !
  1751.     )                                                                     !
  1752.  
  1753. !++
  1754. !
  1755. ! SET TRANSMIT ECHO command.  The format is:         !  and below
  1756. !
  1757. !    Kermit-32>SET TRANSMIT ECHO (on/off)
  1758. !
  1759. ! Where:
  1760. !    on/off is either the ON or OFF keyword.
  1761. !
  1762. !--
  1763.  
  1764. $STATE    (SET_TRE_STATE,                                                 !
  1765.     ('ON',        DONE_STATE,    STORE_TR_ECHO,    ,    ,TRUE), !
  1766.     ('OFF',        DONE_STATE,    STORE_TR_ECHO,    ,    ,FALSE),!
  1767.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)                      !
  1768.     )                                                               !
  1769.     %SBTTL    'SEND command'
  1770.  
  1771. !++
  1772. ! SEND command.  The format is:
  1773. !
  1774. !    Kermit-32>SEND file-specification
  1775. !
  1776. ! Where:
  1777. !    FILE-SPECIFICATION is any valid VAX/VMS file specification.
  1778. !
  1779. !--
  1780.  
  1781. $STATE    (SEND_STATE,
  1782.     (TPA$_ANY,    SEND_STATE,    STORE_TEXT),
  1783.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,FILE_DESC)
  1784.     )
  1785.     %SBTTL    'SHOW command'
  1786.  
  1787. !++
  1788. ! SHOW command.  The format is:
  1789. !
  1790. !    Kermit-32>SHOW <parameter>
  1791. !
  1792. ! Where:
  1793. !    <Parameter> is one of the following:
  1794. !        SEND - Send parameters
  1795. !        RECEIVE - Receive parameters
  1796. !        DEBUGGING - State of the debugging flag
  1797. !        FILE-TYPE - Type of the file
  1798. !        LOCAL-ECHO - Local echo flag
  1799. !        LINE - Current line associated
  1800. !        ESCAPE - Current escape character
  1801. !        DELAY  - Delay parameter.
  1802. !
  1803. !--
  1804.  
  1805. $STATE    (SHOW_STATE,
  1806.     ('ALL',            DONE_STATE,    ,SHOW_ALL,    SHOW_TYPE),
  1807.     ('BLOCK_CHECK_TYPE',    DONE_STATE,    ,SHOW_CHK,    SHOW_TYPE),
  1808.     ('COMMUNICATIONS',    DONE_STATE,    ,SHOW_COM,    SHOW_TYPE),
  1809.     ('DEBUGGING',        DONE_STATE,    ,SHOW_DEB,    SHOW_TYPE),
  1810.     ('DELAY',        DONE_STATE,    ,SHOW_DEL,    SHOW_TYPE),
  1811.     ('ESCAPE',        DONE_STATE,    ,SHOW_ESC,    SHOW_TYPE),
  1812.     ('FILE_PARAMETERS',    DONE_STATE,    ,SHOW_FIL,    SHOW_TYPE),
  1813.     ('INCOMPLETE_FILE_DISPOSITION',DONE_STATE,    ,SHOW_ABT,    SHOW_TYPE),
  1814.     ('LINE',        DONE_STATE,    ,SHOW_LIN,    SHOW_TYPE),
  1815.     ('LOCAL_ECHO',        DONE_STATE,    ,SHOW_ECH,    SHOW_TYPE),
  1816.     ('PACKET',        DONE_STATE,    ,SHOW_PAC,    SHOW_TYPE),
  1817.     ('PARITY',        DONE_STATE,    ,SHOW_PAR,    SHOW_TYPE),
  1818.     ('SEND',        DONE_STATE,    ,SHOW_SEN,    SHOW_TYPE),
  1819.     ('TIMING',        DONE_STATE,    ,SHOW_TIM,    SHOW_TYPE),
  1820.     ('RECEIVE',        DONE_STATE,    ,SHOW_REC,    SHOW_TYPE),
  1821.     ('RETRY',        DONE_STATE,    ,SHOW_RTY,    SHOW_TYPE),
  1822.     ('VERSION',        DONE_STATE,    ,SHOW_VER,    SHOW_TYPE),
  1823.     ('TRANSMIT',        DONE_STATE,    ,SHOW_TRN,    SHOW_TYPE),   !
  1824.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1825.     )
  1826.     %SBTTL    'LOG command'
  1827.  
  1828. !++
  1829. ! The LOG command allows the specification of a session or transaction
  1830. !log file.
  1831. !--
  1832.  
  1833. $STATE    (LOG_STATE,
  1834.     ('DEBUGGING',    DBG_STATE),
  1835.     ('SESSION',    SES_STATE),
  1836.     ('TRANSACTIONS',TRN_STATE),
  1837.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1838.     )
  1839.  
  1840. $STATE    (DBG_STATE,
  1841.     (TPA$_ANY,    DBG_STATE,    STORE_TEXT),
  1842.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,DEBUG_DESC)
  1843.     )
  1844.  
  1845. $STATE    (SES_STATE,
  1846.     (TPA$_ANY,    SES_STATE,    STORE_TEXT),
  1847.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,SESSION_DESC)
  1848.     )
  1849.  
  1850. $STATE    (TRN_STATE,
  1851.     (TPA$_ANY,    TRN_STATE,    STORE_TEXT),
  1852.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,TRANSACTION_DESC)
  1853.     )
  1854.  
  1855.  
  1856.     %SBTTL    'Take command tables'
  1857.  
  1858. !++
  1859. ! The following describes the TAKE (or @) command.
  1860. !--
  1861.  
  1862. $STATE    (TAKE_STATE,
  1863.     ('/',        TAK_SWT_STATE,    COPY_DESC,    ,    ,TAK_FIL_DESC),
  1864.     (TPA$_ANY,    TAKE_STATE,    STORE_TEXT),
  1865.     (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,TAK_FIL_DESC)
  1866.     )
  1867.  
  1868. $STATE    (TAK_SWT_STATE,
  1869.     ('DISPLAY',        DONE_STATE,    ,TRUE,        TAKE_DISPLAY),
  1870.     (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
  1871.     )
  1872.  
  1873.       %SBTTL  'TRANSMIT command'                                         !
  1874.                                                                          !
  1875. !++                                                                      !
  1876. ! TRANSMIT command.  The format is:                                      !
  1877. !                                                                        !
  1878. !     Kermit-32>TRANSMIT file-specification                              !
  1879. !                                                                        !
  1880. ! Where:                                                                 !
  1881. !     FILE-SPECIFICATION is any valid VAX/VMS file specification.        !
  1882. !                                                                        !
  1883. !--                                                                      !
  1884.                                                                          ! 
  1885. $STATE  (TRANSMIT_STATE,                                                 !
  1886.       (TPA$_ANY,  TRANSMIT_STATE,          STORE_TEXT),                  !
  1887.       (TPA$_LAMBDA, DONE_STATE,        COPY_DESC,                       , ,FILE_DESC)  !
  1888.       )                                                                  !
  1889.  
  1890.     %SBTTL    'Done state'
  1891.  
  1892. !++
  1893. ! This is the single state that is the required CONFIRM for the end
  1894. ! of the commands.
  1895. !--
  1896.  
  1897. $STATE    (DONE_STATE,
  1898.     (TPA$_EOS,    TPA$_EXIT)
  1899.     )
  1900.  
  1901. !++
  1902. !
  1903. ! End of the KERMIT-32 command definitions
  1904. !
  1905. !--
  1906.  
  1907. PSECT    OWN = $OWN$;
  1908. PSECT    GLOBAL = $GLOBAL$;
  1909.  
  1910. !<BLF/FORMAT>
  1911. ROUTINE MAIN_ROUTINE =
  1912.  
  1913. !++
  1914. ! FUNCTIONAL DESCRIPTION:
  1915. !
  1916. !    This is the main routine for KERMIT-32.  This routine will
  1917. !    initialize the various parameters and then call the command
  1918. !    scanner to process commands.
  1919. !
  1920. ! FORMAL PARAMETERS:
  1921. !
  1922. !    None.
  1923. !
  1924. ! IMPLICIT INPUTS:
  1925. !
  1926. !    None.
  1927. !
  1928. ! IMPLICIT OUTPUTS:
  1929. !
  1930. !    None.
  1931. !
  1932. ! ROUTINE VALUE and
  1933. ! COMPLETION CODES:
  1934. !
  1935. !    Return status from last command.
  1936. !
  1937. ! SIDE EFFECTS:
  1938. !
  1939. !    None.
  1940. !
  1941. !--
  1942.  
  1943.     BEGIN
  1944.  
  1945.     LOCAL
  1946.     STATUS,                    ! Returned status
  1947.     CRC_BIT_MASK,                ! Bit mask for CRC initialization
  1948.     LOOP_FLAG;
  1949.  
  1950. !
  1951. ! Initialize some variables
  1952. !
  1953.     STATUS = LIB$PUT_OUTPUT (IDENT_STRING);    ! Say who we are
  1954.     MSG_INIT ();                ! Initialize message processing
  1955.     TERM_INIT ();                ! Init terminal processing
  1956.     TT_INIT ();                    ! Init text processing
  1957.     FILE_INIT ();                ! Init file processing
  1958.     SY_INIT ();                    ! Init system routines
  1959.     ESCAPE_CHR = CHR_ESCAPE;
  1960. !
  1961. ! Initialize some VAX/VMS interface items
  1962. !
  1963.     CRC_BIT_MASK = %O'102010';            ! CRC bit mask
  1964.     LIB$CRC_TABLE (CRC_BIT_MASK, CRC_TABLE);
  1965.     LIB$ESTABLISH (KERM_HANDLER);
  1966. !
  1967. ! Initialize transaction log file descriptor
  1968. !
  1969.     INIT_STR_DESC (TRANSACTION_DESC, TRANSACTION_NAME, 0);
  1970. !
  1971. ! Initialize take file descriptor
  1972. !
  1973.     INIT_STR_DESC (TAK_FIL_DESC, TAK_FIL_NAME, 0);
  1974. !
  1975. ! Initialize prompt descriptor
  1976. !
  1977.     INIT_STR_DESC (PROMPT_DESC, PROMPT_TEXT, 0);
  1978. !
  1979. ! Take initialization file
  1980. !
  1981.     COMND_FILE (%ASCID'VMSKERMIT', %ASCID'.INI;0', TRUE, FALSE);
  1982. !
  1983. ! Main command loop
  1984. !
  1985.     Status = COMND ();
  1986.     RETURN .Final_Status OR STS$M_INHIB_MSG;
  1987.     END;                    ! end of routine MAIN_ROUTINE
  1988. %SBTTL 'COMND'
  1989. ROUTINE COMND =
  1990.  
  1991. !++
  1992. ! FUNCTIONAL DESCRIPTION:
  1993. !    This routine will do the command scanning for KERMIT-32.  It
  1994. !    will call the correct routines to process the commands.
  1995. !
  1996. ! CALLING SEQUENCE:
  1997. !
  1998. !    COMND();
  1999. !
  2000. ! INPUT PARAMETERS:
  2001. !
  2002. !    None.
  2003. !
  2004. ! IMPLICIT INPUTS:
  2005. !
  2006. !    None.
  2007. !
  2008. ! OUTPUT PARAMETERS:
  2009. !
  2010. !    None.
  2011. !
  2012. ! IMPLICIT OUTPUTS:
  2013. !
  2014. !    None.
  2015. !
  2016. ! COMPLETION CODES:
  2017. !
  2018. !    Return status from last command.
  2019. !
  2020. ! SIDE EFFECTS:
  2021. !
  2022. !    None.
  2023. !
  2024. !--
  2025.  
  2026.     BEGIN
  2027.  
  2028.     EXTERNAL ROUTINE
  2029.     GET_COMMAND,                ! Get line from SYS$COMMAND
  2030.     LIB$GET_FOREIGN : ADDRESSING_MODE (GENERAL);    ! Get command which started program
  2031.  
  2032.     LOCAL
  2033.     DESC : BLOCK [8, BYTE],
  2034.     CMD_BUF : VECTOR [80, BYTE, UNSIGNED],
  2035.     CMD_SIZE : UNSIGNED WORD,
  2036.     ONE_COMMAND,                ! Only do one command
  2037.     STATUS : UNSIGNED LONG;
  2038.  
  2039.     ONE_COMMAND = FALSE;            ! And many commands
  2040. !
  2041. ! Initialize the command string descriptor
  2042. !
  2043.     INIT_STR_DESC (DESC, CMD_BUF, 80);
  2044. !
  2045. ! Get the first command string.  If we get something, then we will only
  2046. ! want to perform one command, then exit.  Otherwise, we will do commands
  2047. ! until something one tells us to exit.
  2048. !
  2049.     STATUS = LIB$GET_FOREIGN (DESC, 0, CMD_SIZE, 0);
  2050.  
  2051.     IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL;
  2052.  
  2053.     IF NOT .STATUS
  2054.     THEN
  2055.     BEGIN
  2056.     LIB$SIGNAL (.STATUS);
  2057.     RETURN .STATUS;
  2058.     END;
  2059.  
  2060.     IF .CMD_SIZE GTR 0 THEN ONE_COMMAND = TRUE;
  2061.  
  2062.     WHILE TRUE DO
  2063.     BEGIN
  2064.  
  2065.     IF .CMD_SIZE GTR 0
  2066.     THEN
  2067.         BEGIN
  2068.         DESC [DSC$W_LENGTH] = .CMD_SIZE;
  2069.  
  2070.         IF .STATUS THEN STATUS = DO_COMND (DESC);
  2071.  
  2072.         IF .STATUS EQL KER_EXIT THEN RETURN SS$_NORMAL;
  2073.  
  2074.         IF NOT .STATUS AND .STATUS NEQ KER_TAKE_ERROR THEN COMND_ERROR (.STATUS);
  2075.  
  2076.         END;
  2077.  
  2078. !
  2079. ! If we were given command when run, just exit after doing it
  2080. !
  2081.  
  2082.     IF .ONE_COMMAND THEN RETURN SS$_NORMAL;
  2083.  
  2084. !
  2085. ! Initialize prompt if null
  2086. !
  2087.  
  2088.     IF .PROMPT_DESC [DSC$W_LENGTH] LEQ 0
  2089.     THEN
  2090.         BEGIN
  2091.         CH$COPY (.DEFAULT_PROMPT [DSC$W_LENGTH], CH$PTR (.DEFAULT_PROMPT [DSC$A_POINTER]), 0,
  2092.         TEMP_LENGTH, CH$PTR (PROMPT_TEXT));
  2093.         PROMPT_DESC = .DEFAULT_PROMPT [DSC$W_LENGTH];
  2094.         END;
  2095.  
  2096.     DESC [DSC$W_LENGTH] = 80;        ! Reset length
  2097.     STATUS = GET_COMMAND (DESC, PROMPT_DESC, CMD_SIZE, TRUE);
  2098.  
  2099.     IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL;
  2100. !
  2101. ! If there was an error then return the error code to the upper level
  2102. !
  2103.     IF NOT .STATUS                ! Failing status?
  2104.     THEN
  2105.         RETURN .STATUS;            ! Yes, return it
  2106.  
  2107.     END;                    ! End of WHILE TRUE DO BEGIN
  2108.  
  2109.     RETURN SS$_NORMAL;
  2110.     END;                    ! End of COMND
  2111. %SBTTL 'COMND_FILE - Perform take (indirect) file'
  2112. ROUTINE COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG) =
  2113.  
  2114. !++
  2115. ! FUNCTIONAL DESCRIPTION:
  2116. !
  2117. ! This routine will read a file of commands and perform them.  If any
  2118. ! error occurs, it will abort the command processing.
  2119. !
  2120. ! CALLING SEQUENCE:
  2121. !
  2122. !    STATUS = COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG)
  2123. !
  2124. ! INPUT PARAMETERS:
  2125. !
  2126. !    TAKE_DESC - String descriptor of file specification
  2127. !    DEFAULT_DESC - Default file specification
  2128. !    OK_NONE - If true, return EOF if file does not exist, otherwise
  2129. !        return error if file does not exist.
  2130. !    DISPLAY_FLAG - If true display commands being executed
  2131. !
  2132. ! IMPLICIT INPUTS:
  2133. !
  2134. !    None.
  2135. !
  2136. ! OUPTUT PARAMETERS:
  2137. !
  2138. !    None.
  2139. !
  2140. ! IMPLICIT OUTPUTS:
  2141. !
  2142. !    None.
  2143. !
  2144. ! COMPLETION CODES:
  2145. !
  2146. !    Standard status values
  2147. !
  2148. ! SIDE EFFECTS:
  2149. !
  2150. !    None.
  2151. !
  2152. !--
  2153.  
  2154.     BEGIN
  2155.  
  2156.     EXTERNAL ROUTINE
  2157.     STR$UPCASE : ADDRESSING_MODE (GENERAL),    ! Upcase a string
  2158.     LIB$GET_VM : ADDRESSING_MODE (GENERAL) NOVALUE,
  2159.     LIB$FREE_VM : ADDRESSING_MODE (GENERAL) NOVALUE;
  2160.  
  2161.     MAP
  2162.     TAKE_DESC : REF BLOCK [8, BYTE],
  2163.     DEFAULT_DESC : REF BLOCK [8, BYTE];    ! The args are descriptors
  2164.  
  2165.     LOCAL
  2166.     TAKE_FILE_DESC : BLOCK [8, BYTE],    ! Descriptor for take file
  2167.     TAKE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],    ! Name of take file
  2168.     TAKE_FILE_FAB : $FAB_DECL,        ! FAB for take file
  2169.     TAKE_FILE_RAB : $RAB_DECL,        ! RAB for take file
  2170.     TAKE_FILE_XABFHC : $XABFHC_DECL,    ! XAB for file header items
  2171.     TAKE_FILE_BADR,                ! Address of take file buffer
  2172.     TAKE_FILE_BSIZ,                ! Size of take file buffer
  2173.     TAKE_FILE_FADR,                ! Address of fixed header buffer
  2174.     TAKE_FILE_FSIZ,                ! size of fixed header buffer
  2175.     STATUS,                    ! Random status values
  2176.     CMD_DESC : BLOCK [8, BYTE];        ! Descriptor for command
  2177.  
  2178.     CH$COPY (.TAKE_DESC [DSC$W_LENGTH], CH$PTR (.TAKE_DESC [DSC$A_POINTER]), 0, MAX_FILE_NAME,
  2179.     CH$PTR (TAKE_FILE_NAME));
  2180.     INIT_STR_DESC (TAKE_FILE_DESC, TAKE_FILE_NAME, .TAKE_DESC [DSC$W_LENGTH]);
  2181.     $FAB_INIT (FAB = TAKE_FILE_FAB, FNA = TAKE_FILE_NAME, FNS = .TAKE_FILE_DESC [DSC$W_LENGTH], FAC = GET,
  2182.     XAB = TAKE_FILE_XABFHC, DNA = .DEFAULT_DESC [DSC$A_POINTER], DNS = .DEFAULT_DESC [DSC$W_LENGTH]);
  2183.     $XABFHC_INIT (XAB = TAKE_FILE_XABFHC);
  2184.     STATUS = $OPEN (FAB = TAKE_FILE_FAB);
  2185.  
  2186.     IF NOT .STATUS
  2187.     THEN
  2188.     BEGIN
  2189.  
  2190.     IF .STATUS EQL RMS$_FNF AND .OK_NONE THEN RETURN KER_TAKE_EOF;
  2191.  
  2192.     LIB$SIGNAL (.STATUS);
  2193.     RETURN KER_TAKE_ERROR;
  2194.     END;
  2195.  
  2196. !
  2197. ! Allocate a buffer
  2198. !
  2199.     TAKE_FILE_BSIZ = .TAKE_FILE_XABFHC [XAB$W_LRL];
  2200.  
  2201.     IF .TAKE_FILE_BSIZ EQL 0 THEN TAKE_FILE_BSIZ = MAX_REC_LENGTH;
  2202.  
  2203.     LIB$GET_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);
  2204.     INIT_STR_DESC (CMD_DESC, .TAKE_FILE_BADR, .TAKE_FILE_BSIZ);
  2205. !
  2206. ! Determine if we need a buffer for the fixed control area
  2207. !
  2208.     TAKE_FILE_FSIZ = .TAKE_FILE_FAB [FAB$B_FSZ];
  2209.  
  2210.     IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$GET_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);
  2211.  
  2212. !
  2213. ! Initialize the RAB for the $CONNECT RMS call
  2214. !
  2215.     $RAB_INIT (RAB = TAKE_FILE_RAB, FAB = TAKE_FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .TAKE_FILE_BADR,
  2216.     USZ = .TAKE_FILE_BSIZ);
  2217.  
  2218.     IF .TAKE_FILE_FSIZ NEQ 0 THEN TAKE_FILE_RAB [RAB$L_RHB] = .TAKE_FILE_FADR;
  2219.  
  2220.     STATUS = $CONNECT (RAB = TAKE_FILE_RAB);
  2221.  
  2222.     IF NOT .STATUS
  2223.     THEN
  2224.     BEGIN
  2225.     LIB$SIGNAL (.STATUS);
  2226.     LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);
  2227.  
  2228.     IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);
  2229.  
  2230.     RETURN KER_TAKE_ERROR;
  2231.     END;
  2232.  
  2233.     WHILE (STATUS = $GET (RAB = TAKE_FILE_RAB)) DO
  2234.     BEGIN
  2235.  
  2236.     IF .TAKE_FILE_RAB [RAB$W_RSZ] GTR 0
  2237.     THEN
  2238.         BEGIN
  2239.         CMD_DESC [DSC$W_LENGTH] = .TAKE_FILE_RAB [RAB$W_RSZ];
  2240.         STATUS = STR$UPCASE (CMD_DESC, CMD_DESC);
  2241.  
  2242.         IF .DISPLAY_FLAG THEN LIB$PUT_OUTPUT (CMD_DESC);
  2243.  
  2244.         STATUS = DO_COMND (CMD_DESC);
  2245.  
  2246.         IF NOT .STATUS
  2247.         THEN
  2248.         BEGIN
  2249.  
  2250.         IF .STATUS NEQ KER_TAKE_ERROR
  2251.         THEN
  2252.             BEGIN
  2253.             COMND_ERROR (.STATUS);
  2254.             LIB$PUT_OUTPUT (CMD_DESC);
  2255.             STATUS = KER_TAKE_ERROR;    ! Indicate we should abort back
  2256.             END;
  2257.  
  2258.         EXITLOOP;
  2259.         END;
  2260.  
  2261.         END;
  2262.  
  2263.     END;                    ! End of WHILE TRUE DO BEGIN
  2264.  
  2265. !
  2266. ! When the loop exits, we got some kind of error.  Complain unless end of file.
  2267. !
  2268.  
  2269.     IF .STATUS EQL RMS$_EOF THEN STATUS = KER_TAKE_EOF;
  2270.  
  2271.     IF .STATUS NEQ KER_EXIT AND .STATUS NEQ KER_TAKE_EOF AND .STATUS NEQ KER_TAKE_ERROR
  2272.     THEN
  2273.     LIB$SIGNAL (.STATUS);
  2274.  
  2275. !
  2276. ! Close the file
  2277. !
  2278.     $DISCONNECT (RAB = TAKE_FILE_RAB);
  2279.     $CLOSE (FAB = TAKE_FILE_FAB);
  2280. !
  2281. ! Return any buffers
  2282. !
  2283.     LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);
  2284.  
  2285.     IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);
  2286.  
  2287.     RETURN .STATUS;
  2288.     END;                    ! End of COMND_FILE
  2289. %SBTTL 'COMND_ERROR - Give error message for command'
  2290. ROUTINE COMND_ERROR (STATUS) : NOVALUE =
  2291.  
  2292. !++
  2293. ! FUNCTIONAL DESCRIPTION:
  2294. !
  2295. ! This routine will issue an error message for a command parsing error.
  2296. !
  2297. ! CALLING SEQUENCE:
  2298. !
  2299. !    COMND_ERROR (.STATUS);
  2300. !
  2301. ! INPUT PARAMETERS:
  2302. !
  2303. !    STATUS - The status value returned from DO_COMND
  2304. !
  2305. ! IMPLICIT INPUTS:
  2306. !
  2307. !    None.
  2308. !
  2309. ! OUPTUT PARAMETERS:
  2310. !
  2311. !    None.
  2312. !
  2313. ! IMPLICIT OUTPUTS:
  2314. !
  2315. !    None.
  2316. !
  2317. ! COMPLETION CODES:
  2318. !
  2319. !    None.
  2320. !
  2321. ! SIDE EFFECTS:
  2322. !
  2323. !    None.
  2324. !
  2325. !--
  2326.  
  2327.     BEGIN
  2328.  
  2329.     IF .STATUS EQL KER_AMBIGKEY OR .STATUS EQL KER_UNKNOWKEY
  2330.     THEN
  2331.     LIB$SIGNAL (.STATUS, 1,
  2332.         TPARSE_BLOCK [TPA$L_TOKENCNT])
  2333.     ELSE
  2334.     BEGIN
  2335.  
  2336.     EXTERNAL LITERAL
  2337.         LIB$_SYNTAXERR;
  2338.  
  2339.     IF .STATUS EQL LIB$_SYNTAXERR
  2340.     THEN
  2341.         LIB$SIGNAL (KER_CMDERR, 1, TPARSE_BLOCK [TPA$L_STRINGCNT])
  2342.     ELSE
  2343.         LIB$SIGNAL (.STATUS);
  2344.  
  2345.     END;
  2346.  
  2347.     END;                    ! End of COMND_ERROR
  2348. %SBTTL 'DO_COMND'
  2349. ROUTINE DO_COMND (CMD_DESC) =
  2350.  
  2351. !++
  2352. ! FUNCTIONAL DESCRIPTION:
  2353. ! This routine will parse and process one Kermit command.
  2354. !
  2355. ! CALLING SEQUENCE:
  2356. !
  2357. !    STATUS = DO_COMND(CMD_DESC);
  2358. !
  2359. ! INPUT PARAMETERS:
  2360. !
  2361. !    CMD_DESC - Descriptor of command string
  2362. !
  2363. ! IMPLICIT INPUTS:
  2364. !
  2365. !    None.
  2366. !
  2367. ! OUTPUT PARAMETERS:
  2368. !
  2369. !    None.
  2370. !
  2371. ! IMPLICIT OUTPUTS:
  2372. !
  2373. !    None.
  2374. !
  2375. ! COMPLETION CODES:
  2376. !
  2377. !    None.
  2378. !
  2379. ! SIDE EFFECTS:
  2380. !
  2381. !    None.
  2382. !
  2383. !--
  2384.  
  2385.     BEGIN
  2386.  
  2387.     BIND
  2388.     SERVER_TEXT = %ASCID'Kermit Server running on VAX/VMS host.  Please type your escape sequence to',
  2389.     SERVER_TEXT_1 = %ASCID' return to your local machine.  Shut down the server by typing the Kermit BYE',
  2390.     SERVER_TEXT_2 = %ASCID' command on your local machine.',
  2391.     PUSH_TEXT = %ASCID' Type LOGOUT to return to VMS Kermit';
  2392.  
  2393.     MAP
  2394.     CMD_DESC : REF BLOCK [8, BYTE];        ! Descriptor for command
  2395.  
  2396.     LOCAL
  2397.     STATUS : UNSIGNED LONG;
  2398.  
  2399. ! Initialize some per-command data areas.
  2400.     INIT_STR_DESC (TEMP_DESC, TEMP_NAME, 0);
  2401.     COMMAND = 0;
  2402.     SHOW_TYPE = 0;
  2403.     REM_TYPE = 0;
  2404.     FILE_SIZE = 0;
  2405.     ALT_FILE_SIZE = 0;
  2406.     GEN_1SIZE = 0;
  2407.     GEN_2SIZE = 0;
  2408.     GEN_3SIZE = 0;
  2409.     CONNECT_FLAG = FALSE;            ! Assume not connected
  2410.     TAKE_DISPLAY = 0;
  2411.     TPARSE_BLOCK [TPA$L_STRINGCNT] = .CMD_DESC [DSC$W_LENGTH];
  2412.     TPARSE_BLOCK [TPA$L_STRINGPTR] = .CMD_DESC [DSC$A_POINTER];
  2413.     TPARSE_BLOCK [TPA$V_BLANKS] = 0;        ! Ignore blanks
  2414.     STATUS = LIB$TPARSE (TPARSE_BLOCK, KERMIT_STATE, KERMIT_KEY);
  2415.  
  2416.     IF .STATUS
  2417.     THEN
  2418.     BEGIN
  2419.     FILE_SIZE = .FILE_DESC [DSC$W_LENGTH];    ! Copy length in case needed
  2420.  
  2421.     CASE .COMMAND FROM CMD_MIN TO CMD_MAX OF
  2422.         SET
  2423.  
  2424.         [CMD_BYE] :
  2425.         BEGIN
  2426.  
  2427.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2428.         THEN
  2429.             BEGIN
  2430.  
  2431.             IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY;
  2432.  
  2433.             TERM_CLOSE ()
  2434.             END;
  2435.  
  2436.         IF NOT .STATUS THEN RETURN .STATUS ELSE RETURN KER_EXIT;
  2437.  
  2438.         END;
  2439.  
  2440.         [CMD_CONN] :
  2441.         TERM_CONNECT ();
  2442.  
  2443.         [CMD_EXIT] :
  2444.         RETURN KER_EXIT;
  2445.  
  2446.         [CMD_FINISH] :
  2447.  
  2448.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2449.         THEN
  2450.             BEGIN
  2451.  
  2452.             IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_EXIT) ELSE STATUS = KER_LOCONLY;
  2453.  
  2454.             TERM_CLOSE ()
  2455.             END;
  2456.  
  2457.         [CMD_GET] :
  2458.  
  2459.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2460.         THEN
  2461.             BEGIN
  2462.  
  2463.             IF NOT .CONNECT_FLAG THEN REC_SWITCH () ELSE STATUS = KER_LOCONLY;
  2464.  
  2465.             TERM_CLOSE ();
  2466.             END;
  2467.  
  2468.         [CMD_HELP] :
  2469.         COMND_HELP ();
  2470.  
  2471.         [CMD_LOGOUT] :
  2472.  
  2473.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2474.         THEN
  2475.             BEGIN
  2476.  
  2477.             IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY;
  2478.  
  2479.             TERM_CLOSE ()
  2480.             END;
  2481.  
  2482.         [CMD_RECEIVE] :
  2483.  
  2484.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2485.         THEN
  2486.             BEGIN
  2487.             FILE_SIZE = 0;        ! No file to request
  2488.             REC_SWITCH ();
  2489.             TERM_CLOSE ();
  2490.             END;
  2491.  
  2492.         [CMD_REMOTE] :
  2493.         COMND_REMOTE ();
  2494.  
  2495.         [CMD_LOCAL] :
  2496.         COMND_LOCAL ();
  2497.  
  2498.         [CMD_PUSH] :
  2499.         BEGIN
  2500.  
  2501.         OWN
  2502.             PID : INITIAL (0);
  2503.  
  2504.         LIB$PUT_OUTPUT (PUSH_TEXT);
  2505.  
  2506.         IF .PID NEQ 0
  2507.         THEN
  2508.             BEGIN
  2509.             STATUS = LIB$ATTACH (PID);
  2510.  
  2511.             IF NOT .STATUS THEN PID = 0;
  2512.  
  2513.             END;
  2514.  
  2515.         IF .PID EQL 0
  2516.                 THEN STATUS = LIB$SPAWN (0, 0, 0, 0, 0, PID);    ! Just spawn a DCL
  2517.  
  2518.         END;
  2519.  
  2520.         [CMD_SEND] :
  2521.         BEGIN
  2522.  
  2523.         EXTERNAL ROUTINE
  2524.             FILE_OPEN,            ! Open file routine
  2525.             FILE_CLOSE;            ! Close file routine
  2526.  
  2527.         LOCAL
  2528.             SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
  2529.             SAVE_FILE_SIZE,
  2530.             SAVE_TY_FIL;
  2531.  
  2532.         SAVE_TY_FIL = .TY_FIL;        ! Save current type out flag
  2533.         TY_FIL = FALSE;            ! Suppress type out of names
  2534.         SAVE_FILE_SIZE = .FILE_SIZE;    ! Save the file name size
  2535.  
  2536.         CH$MOVE((.FILE_SIZE),CH$PTR(FILE_NAME),
  2537.             CH$PTR(SAVE_FILE_NAME));
  2538.  
  2539.         IF FILE_OPEN (FNC_READ)
  2540.         THEN
  2541.             BEGIN
  2542.             FILE_SIZE = .SAVE_FILE_SIZE;    ! Reset the file name size
  2543.             CH$MOVE(.FILE_SIZE,CH$PTR(SAVE_FILE_NAME),
  2544.             CH$PTR(FILE_NAME));
  2545.  
  2546.             FILE_CLOSE (FALSE);
  2547.             TY_FIL = .SAVE_TY_FIL;    ! Reset type out flag
  2548.  
  2549.             IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2550.             THEN
  2551.             BEGIN
  2552.             SEND_SWITCH ();
  2553.             TERM_CLOSE ();
  2554.             END;
  2555.  
  2556.             END
  2557.         ELSE
  2558.             TY_FIL = .SAVE_TY_FIL;    ! Reset type out flag
  2559.  
  2560.         END;
  2561.  
  2562.         [CMD_SERVER] :
  2563.         BEGIN
  2564.         LIB$PUT_OUTPUT (SERVER_TEXT);
  2565.         LIB$PUT_OUTPUT (SERVER_TEXT_1);
  2566.         LIB$PUT_OUTPUT (SERVER_TEXT_2);
  2567.  
  2568.         IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
  2569.         THEN
  2570.             BEGIN
  2571.             STATUS = SERVER ();
  2572.             TERM_CLOSE ();
  2573.             RETURN KER_NORMAL;
  2574.  
  2575.             END;
  2576.  
  2577.         END;
  2578.  
  2579.         [CMD_SHOW] :
  2580.         COMND_SHOW ();
  2581.  
  2582.         [CMD_STATUS] :
  2583.         COMND_STATUS ();
  2584.  
  2585.         [CMD_TAKE] :
  2586.         STATUS = COMND_FILE (TAK_FIL_DESC, %ASCID'.COM;0', FALSE, .TAKE_DISPLAY);
  2587.  
  2588.             [CMD_TRANSMIT]:                                               !
  2589.                 COMND_TRANSMIT ();                                        !
  2590.  
  2591.         [INRANGE] :
  2592.         TES;
  2593.  
  2594.     END;
  2595.  
  2596.     RETURN .STATUS;
  2597.     END;                    ! End of DO_COMND
  2598. %SBTTL 'Command execution -- COMND_HELP'
  2599. ROUTINE COMND_HELP : NOVALUE =
  2600.  
  2601. !++
  2602. ! FUNCTIONAL DESCRIPTION:
  2603. !
  2604. !    This routine will do the HELP command processing for KERMIT.  It
  2605. !    will call the library routines.
  2606. !
  2607. ! CALLING SEQUENCE:
  2608. !
  2609. !    COMND_HELP();
  2610. !
  2611. ! INPUT PARAMETERS:
  2612. !
  2613. !    None.
  2614. !
  2615. ! IMPLICIT INPUTS:
  2616. !
  2617. !    None.
  2618. !
  2619. ! OUTPUT PARAMETERS:
  2620. !
  2621. !    None.
  2622. !
  2623. ! IMPLICIT OUTPUTS:
  2624. !
  2625. !    None.
  2626. !
  2627. ! COMPLETION CODES:
  2628. !
  2629. !    None.
  2630. !
  2631. ! SIDE EFFECTS:
  2632. !
  2633. !    None.
  2634. !
  2635. !--
  2636.  
  2637.     BEGIN
  2638.  
  2639.     LOCAL
  2640.         Help_File : VECTOR [2],
  2641.     STATUS : UNSIGNED LONG;
  2642.  
  2643.     EXTERNAL ROUTINE
  2644.     LBR$OUTPUT_HELP : ADDRESSING_MODE (GENERAL);
  2645.  
  2646. !
  2647. ! Do the help processing.
  2648. !
  2649.     Status = $TRNLNM(TABNAM = %ASCID 'LNM$FILE_DEV',
  2650.                      LOGNAM = %ASCID 'KERMIT_HELP');
  2651.     IF .Status
  2652.     THEN
  2653.         BEGIN
  2654.         Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP');
  2655.         Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP');
  2656.         STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,
  2657.                                   0,
  2658.                                   TEMP_DESC,
  2659.                                   %ASCID'KERMIT_HELP',
  2660.                               UPLIT (HLP$M_PROMPT +
  2661.                                          HLP$M_PROCESS +
  2662.                                          HLP$M_GROUP +
  2663.                                          HLP$M_SYSTEM),
  2664.                                   LIB$GET_INPUT);
  2665.         END
  2666.     ELSE
  2667.         BEGIN
  2668.         Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP');
  2669.         Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP');
  2670.         STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,
  2671.                                   0,
  2672.                                   TEMP_DESC,
  2673.                                   %ASCID'KERMIT',
  2674.                                   UPLIT (HLP$M_PROMPT +
  2675.                                          HLP$M_PROCESS +
  2676.                                          HLP$M_GROUP +
  2677.                                          HLP$M_SYSTEM),
  2678.                                   LIB$GET_INPUT);
  2679.         END;
  2680.  
  2681.     IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
  2682.  
  2683.     END;
  2684. %SBTTL 'Command execution -- Support routines -- OUTPUT_LONG_WORD'
  2685. ROUTINE OUTPUT_LONG_WORD (MSG_ADDR, LONG_VALUE) : NOVALUE =
  2686.  
  2687. !++
  2688. ! FUNCTIONAL DESCRIPTION:
  2689. !    This routine is used to output the various long word parameters
  2690. !    that are shown by the SHOW command.  All text is defined in the level
  2691. !    0 of this program.
  2692. !
  2693. ! CALLING SEQUENCE:
  2694. !
  2695. !    OUTPUT_LONG_WORD( MSG_ASCID, LONG_WORD_VALUE_TO_OUTPUT);
  2696. !
  2697. ! INPUT PARAMETERS:
  2698. !
  2699. !    MSG_ASCID - %ASCID of the text to use for the $FAO call.
  2700. !
  2701. !    LONG_WORD_VALUE_TO_OUTPUT - Value of the long word to pass to the $FAO.
  2702. !
  2703. ! IMPLICIT INPUTS:
  2704. !
  2705. !    None.
  2706. !
  2707. ! OUTPUT PARAMETERS:
  2708. !
  2709. !    None.
  2710. !
  2711. ! IMPLICIT OUTPUTS:
  2712. !
  2713. !    None.
  2714. !
  2715. ! COMPLETION CODES:
  2716. !
  2717. !    None.
  2718. !
  2719. ! SIDE EFFECTS:
  2720. !
  2721. !    None.
  2722. !
  2723. !--
  2724.  
  2725.     BEGIN
  2726.  
  2727.     MAP
  2728.     LONG_VALUE : LONG UNSIGNED,
  2729.     MSG_ADDR : LONG UNSIGNED;
  2730.  
  2731.     LOCAL
  2732.     STATUS : UNSIGNED;            ! Status return by LIB$xxx
  2733.  
  2734.     INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  2735.     $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, .LONG_VALUE);
  2736.     OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  2737.     STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  2738.     END;
  2739. %SBTTL 'Command Execution -- COMND_REMOTE'
  2740. ROUTINE COMND_REMOTE : NOVALUE =
  2741.  
  2742. !++
  2743. ! FUNCTIONAL DESCRIPTION:
  2744. !
  2745. ! This routine will handle the REMOTE commands.  It will call KERMSG
  2746. !to perform the command.
  2747. !
  2748. ! CALLING SEQUENCE:
  2749. !
  2750. !    COMND_REMOTE ();
  2751. !
  2752. ! INPUT PARAMETERS:
  2753. !
  2754. !    None.
  2755. !
  2756. ! IMPLICIT INPUTS:
  2757. !
  2758. !    REM_TYPE - type of command to be executed
  2759. !    GEN_xDATA/GEN_xSIZE - arguments for the commands
  2760. !
  2761. ! OUPTUT PARAMETERS:
  2762. !
  2763. !    None.
  2764. !
  2765. ! IMPLICIT OUTPUTS:
  2766. !
  2767. !    None.
  2768. !
  2769. ! COMPLETION CODES:
  2770. !
  2771. !    None.
  2772. !
  2773. ! SIDE EFFECTS:
  2774. !
  2775. !    None.
  2776. !
  2777. !--
  2778.  
  2779.     BEGIN
  2780.  
  2781.     IF GET_REM_ARGS (FALSE)
  2782.     THEN
  2783.  
  2784.     IF TERM_OPEN (TRUE)            ! Open the terminal to determine if local
  2785.     THEN
  2786.         BEGIN
  2787.  
  2788.         IF NOT .CONNECT_FLAG
  2789.             THEN DO_GENERIC (.REM_TYPE)
  2790.             ELSE LIB$SIGNAL (KER_LOCONLY);
  2791.  
  2792.         TERM_CLOSE ();
  2793.         END;
  2794.  
  2795.     END;                    ! End of COMND_REMOTE
  2796. %SBTTL 'Command Execution -- COMND_LOCAL'
  2797. ROUTINE COMND_LOCAL : NOVALUE =
  2798.  
  2799. !++
  2800. ! FUNCTIONAL DESCRIPTION:
  2801. !
  2802. ! This routine will handle the LOCAL commands.  It will call the generic
  2803. !command processor to perform the command, and type the result.
  2804. !
  2805. ! CALLING SEQUENCE:
  2806. !
  2807. !    COMND_LOCAL ();
  2808. !
  2809. ! INPUT PARAMETERS:
  2810. !
  2811. !    None.
  2812. !
  2813. ! IMPLICIT INPUTS:
  2814. !
  2815. !    REM_TYPE - type of command to be executed
  2816. !    GEN_xDATA/GEN_xSIZE - arguments for the commands
  2817. !
  2818. ! OUPTUT PARAMETERS:
  2819. !
  2820. !    None.
  2821. !
  2822. ! IMPLICIT OUTPUTS:
  2823. !
  2824. !    None.
  2825. !
  2826. ! COMPLETION CODES:
  2827. !
  2828. !    None.
  2829. !
  2830. ! SIDE EFFECTS:
  2831. !
  2832. !    None.
  2833. !
  2834. !--
  2835.  
  2836.     BEGIN
  2837.  
  2838.     LOCAL
  2839.     SAVED_TY_FIL,                ! Saved value from TY_FIL
  2840.     STATUS,                    ! Status values
  2841.     FILE_FLAG,                ! Flag whether file is open
  2842.     CHARACTER,                ! Character from get-a-char routine
  2843.     STR_LENGTH,                ! Length of string
  2844.     STR_ADDRESS,                ! Address of string
  2845.     GET_CHR_RTN;                ! Address of routine to get a character
  2846.  
  2847.     EXTERNAL ROUTINE
  2848.     SY_GENERIC,                ! Do a generic command
  2849.     GET_FILE,                ! Get a character from a file
  2850.     FILE_OPEN,                ! Open a file
  2851.     FILE_CLOSE;                ! Close a file
  2852.  
  2853. !
  2854. ! First get any extra arguments needed
  2855. !
  2856.     STATUS = GET_REM_ARGS (TRUE);
  2857.  
  2858.     IF NOT .STATUS THEN RETURN;
  2859.  
  2860. !
  2861. ! Initialize arguments for SY_GENERIC
  2862. !
  2863.     GET_CHR_RTN = 0;                ! No routine
  2864.     STR_LENGTH = 0;                ! No length
  2865.     STR_ADDRESS = 0;                ! No address
  2866. !
  2867. ! Have generic routine do the command
  2868. !
  2869.     STATUS = SY_GENERIC (.REM_TYPE, STR_ADDRESS, STR_LENGTH, GET_CHR_RTN);
  2870.  
  2871.     IF NOT .STATUS
  2872.     THEN
  2873.     LIB$SIGNAL (.STATUS)
  2874.     ELSE
  2875.     BEGIN
  2876. !
  2877. ! If we got a string, type it out
  2878. !
  2879.  
  2880.     IF .STR_LENGTH NEQ 0
  2881.     THEN
  2882.         BEGIN
  2883.  
  2884.         LOCAL
  2885.         POINTER;
  2886.  
  2887.         POINTER = CH$PTR (.STR_ADDRESS);
  2888.  
  2889.         DECR I FROM .STR_LENGTH TO 1 DO
  2890.         TT_CHAR (CH$RCHAR_A (POINTER));
  2891.  
  2892.         TT_CRLF ();                ! Make sure it gets dumped
  2893.         END
  2894.     ELSE
  2895. !
  2896. ! Here if we didn't get a string.  Either we need to call the supplied routine
  2897. ! or open a file and call GET_FILE for each character.
  2898. !
  2899.         BEGIN
  2900.  
  2901.         IF .GET_CHR_RTN NEQ 0
  2902.         THEN
  2903.         FILE_FLAG = FALSE        ! No file open
  2904.         ELSE
  2905.         BEGIN
  2906.         FILE_FLAG = TRUE;        ! Have a file
  2907.         GET_CHR_RTN = GET_FILE;        ! This is our get-a-char routine
  2908.         SAVED_TY_FIL = .TY_FIL;        ! Save current type out flag
  2909.         TY_FIL = FALSE;            ! Make sure we don't have name typed
  2910.         STATUS = FILE_OPEN (FNC_READ);    ! Open the file
  2911.         TY_FIL = .SAVED_TY_FIL;        ! Restore type out value
  2912.  
  2913.         IF NOT .STATUS            ! If we couldn't open the file
  2914.         THEN
  2915.             RETURN;            ! Just return, (FILE_OPEN reported it)
  2916.  
  2917.         END;
  2918.  
  2919.         DO
  2920.         BEGIN
  2921.         STATUS = (.GET_CHR_RTN) (CHARACTER);    ! Get a character
  2922.  
  2923.         IF .STATUS AND NOT .STATUS EQL KER_EOF    ! Did we get one?
  2924.         THEN
  2925.             TT_CHAR (.CHARACTER)    ! Yes, type it
  2926.         ELSE
  2927. !
  2928. ! If no character returned, check for EOF and close file if we opened it
  2929. !
  2930.  
  2931.             IF .STATUS EQL KER_EOF AND .FILE_FLAG THEN FILE_CLOSE ();
  2932.  
  2933.         END
  2934.         UNTIL NOT .STATUS OR .STATUS EQL KER_EOF;    ! Loop until we are done
  2935.  
  2936.         TT_OUTPUT ();            ! Force out last buffer
  2937.         END;
  2938.  
  2939.     END;
  2940.  
  2941.     END;                    ! End of COMND_LOCAL
  2942. %SBTTL 'Command execution -- COMND_SHOW'
  2943. ROUTINE COMND_SHOW : NOVALUE =
  2944.  
  2945. !++
  2946. ! FUNCTIONAL DESCRIPTION:
  2947. !
  2948. !    This routine will process the SHOW command.  This routine
  2949. !    expects that the command has already been processed and that
  2950. !    the type of SHOW command is stored in SHOW_TYPE.
  2951. !
  2952. ! CALLING SEQUENCE:
  2953. !
  2954. !    COMND_SHOW();
  2955. !
  2956. ! INPUT PARAMETERS:
  2957. !
  2958. !    None.
  2959. !
  2960. ! IMPLICIT INPUTS:
  2961. !
  2962. !    None.
  2963. !
  2964. ! OUTPUT PARAMETERS:
  2965. !
  2966. !    None.
  2967. !
  2968. ! IMPLICIT OUTPUTS:
  2969. !
  2970. !    None.
  2971. !
  2972. ! COMPLETION CODES:
  2973. !
  2974. !    None.
  2975. !
  2976. ! SIDE EFFECTS:
  2977. !
  2978. !    None.
  2979. !
  2980. !--
  2981.  
  2982.     BEGIN
  2983.  
  2984.     LOCAL
  2985.     STATUS : WORD;                ! Status returned
  2986.  
  2987. ! Bind some addresses to text
  2988.  
  2989.     BIND
  2990.     OFF_TEXT = %ASCID'OFF',            ! Item is off
  2991.     ON_TEXT = %ASCID'ON',            ! Item is on
  2992.     SHOW_ABT_MSG = %ASCID' Incomplete file disposition    !AS',
  2993.     ABT_DISCARD = %ASCID'Discard',
  2994.     ABT_KEEP = %ASCID'Keep',
  2995.     SHOW_CHK_MSG = %ASCID' Block check type        !AS',
  2996.     CHK_1CHAR_MSG = %ASCID'One character checksum',
  2997.     CHK_2CHAR_MSG = %ASCID'Two character checksum',
  2998.     CHK_CRC_MSG = %ASCID'Three character CRC-CCITT',
  2999.     SHOW_DEB_MSG = %ASCID' Debugging            !AS',
  3000.     SHOW_DEL_MSG = %ASCID' Delay                !ZL (sec)',
  3001.     SHOW_SRV_MSG = %ASCID' Server sends NAKs every !ZL seconds while waiting for a command',
  3002.     SHOW_ESC_MSG = %ASCID' Escape character        !3OL (octal)',
  3003.     SHOW_FTP_MSG = %ASCID' File type            !AS',
  3004.     SHOW_BLK_MSG = %ASCID' BINARY and FIXED record size   !UL (bytes)',
  3005.     FTP_ASCII =    %ASCID'ASCII',
  3006.     FTP_BINARY = %ASCID'BINARY',
  3007.     FTP_BLOCK = %ASCID'BLOCK',
  3008.     FTP_FIXED = %ASCID'FIXED',
  3009.     SHOW_FNM_MSG = %ASCID' File naming            !AS',
  3010.     FNM_MSG_FULL = %ASCID'Full file specifcation',
  3011.     FNM_MSG_NORMAL = %ASCID'Normal form',
  3012.     FNM_MSG_UNTRAN = %ASCID'Untranslated',
  3013. !    SHOW_IBM_MSG = %ASCID' IBM mode            !AS',
  3014.     SHOW_HAN_MSG = %ASCID' Handshaking character        !3OL (octal)',
  3015.     SHOW_HAN_MSG_NONE = %ASCID' Handshaking character        None',
  3016.     SHOW_LIN_MSG = %ASCID' Line used            !AS',
  3017.     SHOW_ECH_MSG = %ASCID' Local echo            !AS',
  3018.     SHOW_PAR_MSG = %ASCID' Parity type            !AS',
  3019.     PAR_EVEN = %ASCID'Even',
  3020.     PAR_ODD = %ASCID'Odd',
  3021.     PAR_MARK = %ASCID'Mark',
  3022.     PAR_SPACE = %ASCID'Space',
  3023.     PAR_NONE = %ASCID'None',
  3024.     SHOW_RTY_HDR = %ASCID' Retry maximums',
  3025.     SHOW_RTY_INI_MSG = %ASCID'  Initial connection        !ZL (dec)',
  3026.     SHOW_RTY_PKT_MSG = %ASCID'  Sending a packet        !ZL (dec)',
  3027.     SHOW_REC_HDR = %ASCID' Receive parameters',
  3028.     SHOW_SND_HDR = %ASCID' Send parameters',
  3029.     SHOW_PKT_MSG = %ASCID'  Packet length            !ZL (dec)',
  3030.     SHOW_PAD_MSG = %ASCID'  Padding length        !ZL (dec)',
  3031.     SHOW_PDC_MSG = %ASCID'  Padding character        !3OL (octal)',
  3032.     SHOW_TIM_MSG = %ASCID'  Time out            !ZL (sec)',
  3033.     SHOW_EOL_MSG = %ASCID'  End of line character        !3OL (octal)',
  3034.     SHOW_QUO_MSG = %ASCID'  Quoting character        !3OL (octal)',
  3035.     SHOW_SOH_MSG = %ASCID'  Start of packet        !3OL (octal)',
  3036.     SHOW_8QU_MSG = %ASCID'  8-bit quoting character    !3OL (octal)',
  3037.     SHOW_TRN_HDR = %ASCID' Transmit parameters',                            !   
  3038.     SHOW_TRD_MSG = %ASCID'  Delay                         0.!AD (sec)',     ! 
  3039.     SHOW_TRE_MSG = %ASCID'  Echo                    !AS',           ! 
  3040.     SHOW_RPT_MSG = %ASCID' Repeat quoting character    !3OL (octal)';
  3041.  
  3042. !++
  3043. ! FUNCTIONAL DESCRIPTION:
  3044. !
  3045. !    This routine is used to output the keywords TRUE or FALSE.
  3046. !    All text that this routine uses is defined in the level 0 BEGIN/END
  3047. !    of the program.
  3048. !
  3049. ! CALLING SEQUENCE:
  3050. !
  3051. !    OUTPUT_TRUE_FALSE( MSG_ASCID, FLAG_WORD);
  3052. !
  3053. ! INPUT PARAMETERS:
  3054. !
  3055. !    MSG_ASCID - %ASCID of the text to use for the $FAO call.
  3056. !
  3057. !    FLAG_WORD - Long word containing the value of either TRUE or FALSE.
  3058. !
  3059. ! IMPLICIT INPUTS:
  3060. !
  3061. !    None.
  3062. !
  3063. ! OUTPUT PARAMETERS:
  3064. !
  3065. !    None.
  3066. !
  3067. ! IMPLICIT OUTPUTS:
  3068. !
  3069. !    None.
  3070. !
  3071. ! COMPLETION CODES:
  3072. !
  3073. !    None.
  3074. !
  3075. ! SIDE EFFECTS:
  3076. !
  3077. !    None.
  3078. !
  3079. !--
  3080.  
  3081.     ROUTINE OUTPUT_TRUE_FALSE (MSG_ADDR, FLAG_ADDR) : NOVALUE =
  3082.     BEGIN
  3083.  
  3084.     MAP
  3085.         FLAG_ADDR : LONG UNSIGNED,
  3086.         MSG_ADDR : LONG UNSIGNED;
  3087.  
  3088.     LOCAL
  3089.         STATUS : UNSIGNED;            ! Status return by LIB$xxx
  3090.  
  3091.     INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3092.     $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC,
  3093.         (SELECTONE ..FLAG_ADDR OF
  3094.         SET
  3095.         [TRUE] : ON_TEXT;
  3096.         [FALSE] : OFF_TEXT;
  3097.         TES));
  3098.     OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3099.     STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3100.     END;
  3101.  
  3102.     SELECT .SHOW_TYPE OF
  3103.     SET
  3104. !
  3105. ! Show version
  3106. !
  3107.  
  3108.     [SHOW_ALL, SHOW_VER] :
  3109.         STATUS = LIB$PUT_OUTPUT (IDENT_STRING);    ! Type our name and version
  3110.  
  3111.     [SHOW_ALL, SHOW_CHK, SHOW_PAC] :
  3112.         BEGIN
  3113.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3114.         $FAO (SHOW_CHK_MSG, OUTPUT_SIZE, OUTPUT_DESC,
  3115.         (SELECTONE .CHKTYPE OF
  3116.             SET
  3117.             [CHK_1CHAR] : CHK_1CHAR_MSG;
  3118.             [CHK_2CHAR] : CHK_2CHAR_MSG;
  3119.             [CHK_CRC] : CHK_CRC_MSG;
  3120.             TES));
  3121.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3122.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3123.         END;
  3124.  
  3125.     [SHOW_ALL, SHOW_DEB] :
  3126.         OUTPUT_TRUE_FALSE (SHOW_DEB_MSG, DEBUG_FLAG);
  3127.  
  3128.     [SHOW_ALL, SHOW_DEL, SHOW_COM, SHOW_TIM] :
  3129.         OUTPUT_LONG_WORD (SHOW_DEL_MSG, .DELAY);
  3130.  
  3131.     [SHOW_ALL, SHOW_TIM] :
  3132.         OUTPUT_LONG_WORD (SHOW_SRV_MSG, .SRV_TIMEOUT);
  3133.  
  3134.     [SHOW_ALL, SHOW_ESC, SHOW_COM] :
  3135.         OUTPUT_LONG_WORD (SHOW_ESC_MSG, .ESCAPE_CHR);
  3136.  
  3137.     [SHOW_ALL, SHOW_FIL] :             !
  3138.         BEGIN
  3139.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3140.         $FAO (SHOW_FTP_MSG,
  3141.                   OUTPUT_SIZE,
  3142.                   OUTPUT_DESC,
  3143.                  (SELECTONE .FILE_TYPE OF
  3144.                     SET
  3145.                     [FILE_ASC] : FTP_ASCII;
  3146.                     [FILE_BIN] : FTP_BINARY;
  3147.                     [FILE_FIX] : FTP_FIXED;
  3148.                     [FILE_BLK] : FTP_BLOCK;
  3149.                     TES));
  3150.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3151.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3152. !
  3153. ! Display the file name format
  3154. !
  3155.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3156.         $FAO (SHOW_FNM_MSG, OUTPUT_SIZE, OUTPUT_DESC,
  3157.         (SELECTONE .FIL_NORMAL_FORM OF
  3158.             SET
  3159.             [FNM_FULL] : FNM_MSG_FULL;
  3160.             [FNM_NORMAL] : FNM_MSG_NORMAL;
  3161.             [FNM_UNTRAN] : FNM_MSG_UNTRAN;
  3162.             TES));
  3163.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3164.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3165.  
  3166. ! Display file block size
  3167.             INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3168.             $FAO(SHOW_BLK_MSG, OUTPUT_SIZE, OUTPUT_DESC, .file_blocksize);
  3169.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3170.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3171.  
  3172.         END;
  3173.  
  3174.     [SHOW_ALL, SHOW_COM] :
  3175.         IF .IBM_CHAR GEQ 0
  3176.         THEN
  3177.         OUTPUT_LONG_WORD (SHOW_HAN_MSG, .IBM_CHAR)
  3178.         ELSE
  3179.         STATUS = LIB$PUT_OUTPUT (SHOW_HAN_MSG_NONE);
  3180.  
  3181.     [SHOW_ALL, SHOW_ABT, SHOW_FIL] :
  3182.         BEGIN
  3183.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3184.         $FAO (SHOW_ABT_MSG, OUTPUT_SIZE, OUTPUT_DESC, (IF .ABT_FLAG THEN ABT_DISCARD ELSE ABT_KEEP));
  3185.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3186.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3187.         END;
  3188.  
  3189.     [SHOW_ALL, SHOW_LIN, SHOW_COM] :
  3190.         BEGIN
  3191.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3192.  
  3193.         IF .TERM_DESC [DSC$W_LENGTH] GTR 0
  3194.         THEN
  3195.         $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, TERM_DESC)
  3196.         ELSE
  3197.         $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, %ASCID'none');
  3198.  
  3199.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3200.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3201.         END;
  3202.  
  3203.     [SHOW_ALL, SHOW_ECH, SHOW_COM] :
  3204.         OUTPUT_TRUE_FALSE (SHOW_ECH_MSG, ECHO_FLAG);
  3205.  
  3206.     [SHOW_ALL, SHOW_PAR, SHOW_COM] :
  3207.         BEGIN
  3208.         INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3209.         $FAO (SHOW_PAR_MSG, OUTPUT_SIZE, OUTPUT_DESC,
  3210.         (SELECTONE .PARITY_TYPE OF
  3211.             SET
  3212.             [PR_EVEN] : PAR_EVEN;
  3213.             [PR_ODD] : PAR_ODD;
  3214.             [PR_NONE] : PAR_NONE;
  3215.             [PR_MARK] : PAR_MARK;
  3216.             [PR_SPACE] : PAR_SPACE;
  3217.             TES));
  3218.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3219.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3220.         END;
  3221.  
  3222.     [SHOW_ALL, SHOW_RTY, SHOW_PAC] :
  3223.         BEGIN
  3224.         STATUS = LIB$PUT_OUTPUT (SHOW_RTY_HDR);
  3225.         OUTPUT_LONG_WORD (SHOW_RTY_INI_MSG, .SI_RETRIES);
  3226.         OUTPUT_LONG_WORD (SHOW_RTY_PKT_MSG, .PKT_RETRIES);
  3227.         END;
  3228.  
  3229.     [SHOW_ALL, SHOW_SEN, SHOW_PAC] :
  3230.         BEGIN
  3231.         STATUS = LIB$PUT_OUTPUT (SHOW_SND_HDR);
  3232.         OUTPUT_LONG_WORD (SHOW_PKT_MSG, ABS (.SND_PKT_SIZE));
  3233.         OUTPUT_LONG_WORD (SHOW_PAD_MSG, ABS (.SND_NPAD));
  3234.         OUTPUT_LONG_WORD (SHOW_PDC_MSG, ABS (.SND_PADCHAR));
  3235.         OUTPUT_LONG_WORD (SHOW_TIM_MSG, ABS (.SND_TIMEOUT));
  3236.         OUTPUT_LONG_WORD (SHOW_EOL_MSG, ABS (.SND_EOL));
  3237.         OUTPUT_LONG_WORD (SHOW_QUO_MSG, ABS (.SND_QUOTE_CHR));
  3238.         OUTPUT_LONG_WORD (SHOW_SOH_MSG, ABS (.SND_SOH));
  3239.         END;
  3240.  
  3241.     [SHOW_ALL, SHOW_REC, SHOW_PAC] :
  3242.         BEGIN
  3243.         STATUS = LIB$PUT_OUTPUT (SHOW_REC_HDR);
  3244.         OUTPUT_LONG_WORD (SHOW_PKT_MSG, .RCV_PKT_SIZE);
  3245.         OUTPUT_LONG_WORD (SHOW_PAD_MSG, .RCV_NPAD);
  3246.         OUTPUT_LONG_WORD (SHOW_PDC_MSG, .RCV_PADCHAR);
  3247.         OUTPUT_LONG_WORD (SHOW_TIM_MSG, .RCV_TIMEOUT);
  3248.         OUTPUT_LONG_WORD (SHOW_EOL_MSG, .RCV_EOL);
  3249.         OUTPUT_LONG_WORD (SHOW_QUO_MSG, .RCV_QUOTE_CHR);
  3250.         OUTPUT_LONG_WORD (SHOW_8QU_MSG, .RCV_8QUOTE_CHR);
  3251.         OUTPUT_LONG_WORD (SHOW_SOH_MSG, .RCV_SOH);
  3252.         END;
  3253.  
  3254.     [SHOW_ALL, SHOW_TRN] :                                              !   
  3255.         BEGIN                                                           !
  3256.         STATUS = LIB$PUT_OUTPUT (SHOW_TRN_HDR);                         !
  3257.             INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);       !
  3258.             $FAO (SHOW_TRD_MSG, OUTPUT_SIZE, OUTPUT_DESC, 1, TRANS_DELAY);  !
  3259.             OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;                      !
  3260.             STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);                          !
  3261.         OUTPUT_TRUE_FALSE (SHOW_TRE_MSG, TRANS_ECHO_FLAG);              !
  3262.         END;                                                            !
  3263.  
  3264.     [SHOW_ALL, SHOW_PAC] :
  3265.         BEGIN
  3266.         OUTPUT_LONG_WORD (SHOW_RPT_MSG, .SET_REPT_CHR);
  3267.         END;
  3268.  
  3269.     TES;
  3270.  
  3271.     END;                    ! End of COMND_SHOW
  3272. %SBTTL 'Command execution -- COMND_STATUS'
  3273. ROUTINE COMND_STATUS : NOVALUE =
  3274.  
  3275. !++
  3276. ! FUNCTIONAL DESCRIPTION:
  3277. !
  3278. !    This routine will display the status of Kermit-32.
  3279. !
  3280. ! CALLING SEQUENCE:
  3281. !
  3282. !    COMND_STATUS ();
  3283. !
  3284. ! INPUT PARAMETERS:
  3285. !
  3286. !    None.
  3287. !
  3288. ! IMPLICIT INPUTS:
  3289. !
  3290. !    None.
  3291. !
  3292. ! OUTPUT PARAMETERS:
  3293. !
  3294. !    None.
  3295. !
  3296. ! IMPLICIT OUTPUTS:
  3297. !
  3298. !    None.
  3299. !
  3300. ! COMPLETION CODES:
  3301. !
  3302. !    None.
  3303. !
  3304. ! SIDE EFFECTS:
  3305. !
  3306. !    None.
  3307. !
  3308. !--
  3309.  
  3310.     BEGIN
  3311.  
  3312.     LOCAL
  3313.     STATUS,                    ! Status returned by system call
  3314.     POINTER,                ! Pointer to the LAST_ERROR text
  3315.     CHAR_COUNT;                ! Character count
  3316.  
  3317.     BIND
  3318.     TEXT_CR = %ASCID'',
  3319.     TEXT_BAUD = %ASCID' Effective data rate    !ZL baud',
  3320.     TEXT_NAKS_SENT = %ASCID' NAKs received        !ZL',
  3321.     TEXT_NAKS_RCV = %ASCID' NAKs sent        !ZL',
  3322.     TEXT_PKTS_SENT = %ASCID' Packets sent        !ZL',
  3323.     TEXT_PKTS_RCV = %ASCID' Packets received    !ZL',
  3324.     TEXT_CHR_SENT = %ASCID' Characters sent    !ZL',
  3325.     TEXT_DATA_CHAR_SENT = %ASCID' Data characters sent    !ZL',
  3326.     TEXT_DATA_CHAR_RCV = %ASCID' Data characters received !ZL',
  3327.     TEXT_CHR_RCV = %ASCID' Characters received    !ZL',
  3328.     TEXT_TOTAL_HDR = %ASCID'Totals since Kermit was started',
  3329.     TEXT_XFR_HDR = %ASCID'Totals for the last transfer';
  3330.  
  3331.     STATUS = LIB$PUT_OUTPUT (TEXT_CR);
  3332.     STATUS = LIB$PUT_OUTPUT (TEXT_XFR_HDR);
  3333.     OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SMSG_TOTAL_CHARS);
  3334.     OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SMSG_DATA_CHARS);
  3335.     OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SMSG_NAKS);
  3336.     OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SMSG_COUNT);
  3337.     OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RMSG_TOTAL_CHARS);
  3338.     OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RMSG_DATA_CHARS);
  3339.     OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RMSG_NAKS);
  3340.     OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RMSG_COUNT);
  3341.  
  3342.     IF .XFR_TIME NEQ 0
  3343.     THEN
  3344.         BEGIN
  3345.             LOCAL
  3346.                 Data_Chars,
  3347.                 Baud_Rate;
  3348.  
  3349.         IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS
  3350.             THEN Data_Chars = .SMSG_DATA_CHARS
  3351.             ELSE Data_Chars = .RMSG_DATA_CHARS;
  3352.  
  3353.             Baud_Rate = .Data_Chars * 10 / ((.Xfr_Time + 500) / 1000);
  3354.         OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate);
  3355.             END;
  3356. !    OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate);
  3357. !        (((IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS THEN .SMSG_DATA_CHARS ELSE .RMSG_DATA_CHARS)*10)/((
  3358. !        .XFR_TIME + 500)/1000)));
  3359.  
  3360.     STATUS = LIB$PUT_OUTPUT (TEXT_CR);
  3361.     STATUS = LIB$PUT_OUTPUT (TEXT_TOTAL_HDR);
  3362.     OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SND_TOTAL_CHARS);
  3363.     OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SND_DATA_CHARS);
  3364.     OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SND_NAKS);
  3365.     OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SND_COUNT);
  3366.     OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RCV_TOTAL_CHARS);
  3367.     OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RCV_DATA_CHARS);
  3368.     OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RCV_NAKS);
  3369.     OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RCV_COUNT);
  3370.  
  3371.     IF .TOTAL_TIME NEQ 0
  3372.     THEN
  3373.     OUTPUT_LONG_WORD (TEXT_BAUD,
  3374.         (((.RCV_DATA_CHARS + .SND_DATA_CHARS)*10)/((.TOTAL_TIME + 500)/1000)));
  3375.  
  3376. !
  3377. ! Output the error text if there is any
  3378. !
  3379.     POINTER = CH$PTR (LAST_ERROR);
  3380.     CHAR_COUNT = 0;
  3381.  
  3382.     WHILE CH$RCHAR_A (POINTER) NEQ CHR_NUL DO
  3383.     CHAR_COUNT = .CHAR_COUNT + 1;
  3384.  
  3385.     IF .CHAR_COUNT NEQ 0
  3386.     THEN
  3387.     BEGIN
  3388.     INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
  3389.     STATUS = $FAO (%ASCID'Last error: !AD', OUTPUT_SIZE, OUTPUT_DESC, .CHAR_COUNT, LAST_ERROR);
  3390.  
  3391.     IF NOT .STATUS
  3392.     THEN
  3393.         LIB$SIGNAL (.STATUS)
  3394.     ELSE
  3395.         BEGIN
  3396.         OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
  3397.         STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
  3398.  
  3399.         IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
  3400.  
  3401.         END;
  3402.  
  3403.     END;
  3404.  
  3405.     END;                    ! End of SHOW_STATUS
  3406. %SBTTL 'GET_REM_ARGS - Get extra arguments for remote commands'
  3407. ROUTINE GET_REM_ARGS (LOCAL_FLAG) =
  3408.  
  3409. !++
  3410. ! FUNCTIONAL DESCRIPTION:
  3411. !
  3412. ! This routine will get any extra arguments required for remote commands.
  3413. !It will prompt the user and get the input from SYS$COMMAND:.
  3414. !
  3415. ! CALLING SEQUENCE:
  3416. !
  3417. !    STATUS = GET_REM_ARGS (LOCAL_FLAG);
  3418. !
  3419. ! INPUT PARAMETERS:
  3420. !
  3421. !    LOCAL_FLAG - If true, this is for a LOCAL xxx command.  Only get the
  3422. !            arguments we know we need for local commands. Otherwise
  3423. !            get all possible arguments.
  3424. !
  3425. ! IMPLICIT INPUTS:
  3426. !
  3427. !    REM_TYPE - Type of remote command to get arguments for.
  3428. !
  3429. ! OUPTUT PARAMETERS:
  3430. !
  3431. !    None.
  3432. !
  3433. ! IMPLICIT OUTPUTS:
  3434. !
  3435. !    GEN_xDATA, GEN_xSIZE - Text and sizes of arguments
  3436. !
  3437. ! COMPLETION CODES:
  3438. !
  3439. !    Status values from subroutines called if in error.
  3440. !
  3441. ! SIDE EFFECTS:
  3442. !
  3443. !    None.
  3444. !
  3445. !--
  3446.  
  3447.     BEGIN
  3448.  
  3449.     EXTERNAL ROUTINE
  3450.     GET_COMMAND;                ! Get line from SYS$COMMAND:
  3451.  
  3452.     LOCAL
  3453.     GEN_2DESC : BLOCK [8, BYTE],        ! Descriptor for second argument
  3454.     GEN_3DESC : BLOCK [8, BYTE],        ! Descriptor for third argument
  3455.     STATUS;                    ! Random status values
  3456.  
  3457. !
  3458. ! Set up descriptors for second and third arguments
  3459. !
  3460.     INIT_STR_DESC (GEN_2DESC, GEN_2DATA, MAX_MSG);
  3461.     INIT_STR_DESC (GEN_3DESC, GEN_3DATA, MAX_MSG);
  3462.  
  3463.     SELECTONE .REM_TYPE OF
  3464.     SET
  3465.  
  3466.     [GC_CONNECT] :
  3467.  
  3468.         IF NOT .LOCAL_FLAG AND .GEN_1SIZE GTR 0
  3469.         THEN
  3470.         RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ',
  3471.             GEN_2SIZE, FALSE);
  3472.  
  3473.     [GC_COPY, GC_RENAME] :
  3474.  
  3475.         WHILE TRUE DO
  3476.         BEGIN
  3477.         STATUS = GET_COMMAND (GEN_2DESC, %ASCID'New file: ', GEN_2SIZE, TRUE);
  3478.  
  3479.         IF NOT .STATUS OR .GEN_2SIZE NEQ 0 THEN RETURN .STATUS;
  3480.  
  3481.         END;
  3482.  
  3483.     [GC_LGN] :
  3484.         BEGIN
  3485.         STATUS = GET_COMMAND (GEN_3DESC, %ASCID'Account: ', GEN_3SIZE, TRUE);
  3486.  
  3487.         IF NOT .STATUS THEN RETURN .STATUS;
  3488.  
  3489.         RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ', GEN_2SIZE, FALSE);
  3490.         END;
  3491.  
  3492.     [GC_SEND_MSG] :
  3493.         RETURN GET_COMMAND (GEN_2DESC, %ASCID'Message: ', GEN_2SIZE, TRUE);
  3494.  
  3495.     [GC_WHO] :
  3496.  
  3497.         IF NOT .LOCAL_FLAG THEN RETURN GET_COMMAND (GEN_2DESC, %ASCID'Options: ', GEN_2SIZE, TRUE);
  3498.  
  3499.     TES;
  3500.  
  3501. !
  3502. ! If we fall out of the SELECT, we don't need any arguments
  3503. !
  3504.     RETURN TRUE;
  3505.     END;                    ! End of GET_REM_ARGS
  3506. %SBTTL 'TPARSE support -- STORE_BLOCKSIZE'
  3507. ROUTINE STORE_BLOCKSIZE =
  3508.  
  3509. !++
  3510. ! FUNCTIONAL DESCRIPTION:
  3511. !
  3512. !    This routine will store the blocksize to be used when creating
  3513. !    BINARY and FIXED files.
  3514. !
  3515. ! CALLING SEQUENCE:
  3516. !
  3517. !    Standard LIB$TPARSE routine call.
  3518. !
  3519. ! INPUT PARAMETERS:
  3520. !
  3521. !    None.
  3522. !
  3523. ! IMPLICIT INPUTS:
  3524. !
  3525. !    None.
  3526. !
  3527. ! OUTPUT PARAMETERS:
  3528. !
  3529. !    None.
  3530. !
  3531. ! IMPLICIT OUTPUTS:
  3532. !
  3533. !    None.
  3534. !
  3535. ! COMPLETION CODES:
  3536. !
  3537. !    None.
  3538. !
  3539. ! SIDE EFFECTS:
  3540. !
  3541. !    None.
  3542. !
  3543. !--
  3544.  
  3545.     BEGIN
  3546.     TPARSE_ARGS;
  3547. !    file_blocksize = .AP [TPA$L_PARAM];
  3548.     file_blocksize_set = 1;
  3549.     RETURN SS$_NORMAL;
  3550.     END;                    ! End of STORE_BLOCKSIZE
  3551. %SBTTL 'TPARSE support -- STORE_DEBUG'
  3552. ROUTINE STORE_DEBUG =
  3553.  
  3554. !++
  3555. ! FUNCTIONAL DESCRIPTION:
  3556. !
  3557. !    This routine will store the debug flag into the DEBUG_FLAG
  3558. !    location.
  3559. !
  3560. ! CALLING SEQUENCE:
  3561. !
  3562. !    Standard LIB$TPARSE routine call.
  3563. !
  3564. ! INPUT PARAMETERS:
  3565. !
  3566. !    None.
  3567. !
  3568. ! IMPLICIT INPUTS:
  3569. !
  3570. !    None.
  3571. !
  3572. ! OUTPUT PARAMETERS:
  3573. !
  3574. !    None.
  3575. !
  3576. ! IMPLICIT OUTPUTS:
  3577. !
  3578. !    None.
  3579. !
  3580. ! COMPLETION CODES:
  3581. !
  3582. !    None.
  3583. !
  3584. ! SIDE EFFECTS:
  3585. !
  3586. !    None.
  3587. !
  3588. !--
  3589.  
  3590.     BEGIN
  3591.     TPARSE_ARGS;
  3592.     DEBUG_FLAG = .AP [TPA$L_PARAM];
  3593.     RETURN SS$_NORMAL;
  3594.     END;                    ! End of STORE_DEBUG
  3595. %SBTTL 'TPARSE support -- STORE_TR_DELAY'
  3596. ROUTINE STORE_TR_DELAY =                         !  and below             
  3597.  
  3598. !++
  3599. ! FUNCTIONAL DESCRIPTION:
  3600. !
  3601. !    This routine will store the transmit delay into the
  3602. !    TRANS_DELAY location.
  3603. !
  3604. ! CALLING SEQUENCE:
  3605. !
  3606. !    Standard LIB$TPARSE routine call.
  3607. !
  3608. ! INPUT PARAMETERS:
  3609. !
  3610. !    None.
  3611. !
  3612. ! IMPLICIT INPUTS:
  3613. !
  3614. !    None.
  3615. !
  3616. ! OUTPUT PARAMETERS:
  3617. !
  3618. !    None.
  3619. !
  3620. ! IMPLICIT OUTPUTS:
  3621. !
  3622. !    None.
  3623. !
  3624. ! COMPLETION CODES:
  3625. !
  3626. !    None.
  3627. !
  3628. ! SIDE EFFECTS:
  3629. !
  3630. !    None.
  3631. !
  3632. !--
  3633.  
  3634.     BEGIN                                       ! 
  3635.     TPARSE_ARGS;                                ! 
  3636.     TRANS_DELAY = .AP [TPA$L_PARAM];            ! 
  3637.     RETURN SS$_NORMAL;                          ! 
  3638.     END;                    ! End of STORE_TR_DELAY 
  3639. %SBTTL 'TPARSE support -- STORE_TR_ECHO'
  3640. ROUTINE STORE_TR_ECHO =                         !  and below   
  3641.  
  3642. !++
  3643. ! FUNCTIONAL DESCRIPTION:
  3644. !
  3645. !    This routine will store the transmit echo flag into the
  3646. !    TRANS_ECHO_FLAG location.
  3647. !
  3648. ! CALLING SEQUENCE:
  3649. !
  3650. !    Standard LIB$TPARSE routine call.
  3651. !
  3652. ! INPUT PARAMETERS:
  3653. !
  3654. !    None.
  3655. !
  3656. ! IMPLICIT INPUTS:
  3657. !
  3658. !    None.
  3659. !
  3660. ! OUTPUT PARAMETERS:
  3661. !
  3662. !    None.
  3663. !
  3664. ! IMPLICIT OUTPUTS:
  3665. !
  3666. !    None.
  3667. !
  3668. ! COMPLETION CODES:
  3669. !
  3670. !    None.
  3671. !
  3672. ! SIDE EFFECTS:
  3673. !
  3674. !    None.
  3675. !
  3676. !--
  3677.  
  3678.     BEGIN                                       ! 
  3679.     TPARSE_ARGS;                                ! 
  3680.     TRANS_ECHO_FLAG = .AP [TPA$L_PARAM];        ! 
  3681.     RETURN SS$_NORMAL;                          ! 
  3682.     END;                    ! End of STORE_TR_ECHO
  3683.  
  3684. %SBTTL 'TPARSE support -- STORE_IBM'
  3685. ROUTINE STORE_IBM =
  3686.  
  3687. !++
  3688. ! FUNCTIONAL DESCRIPTION:
  3689. !
  3690. !    This routine will store the IBM flag into the IBM_FLAG
  3691. !    location.
  3692. !
  3693. ! CALLING SEQUENCE:
  3694. !
  3695. !    Standard LIB$TPARSE routine call.
  3696. !
  3697. ! INPUT PARAMETERS:
  3698. !
  3699. !    None.
  3700. !
  3701. ! IMPLICIT INPUTS:
  3702. !
  3703. !    None.
  3704. !
  3705. ! OUTPUT PARAMETERS:
  3706. !
  3707. !    None.
  3708. !
  3709. ! IMPLICIT OUTPUTS:
  3710. !
  3711. !    None.
  3712. !
  3713. ! COMPLETION CODES:
  3714. !
  3715. !    None.
  3716. !
  3717. ! SIDE EFFECTS:
  3718. !
  3719. !    None.
  3720. !
  3721. !--
  3722.  
  3723.     BEGIN
  3724.  
  3725.     EXTERNAL LITERAL
  3726.     IBM_MODE_ECHO : WEAK,            ! IBM mode echo value
  3727.     IBM_MODE_PARITY : WEAK,            ! Default parity
  3728.     IBM_MODE_CHARACTER : WEAK;        ! And handshake character for
  3729.  
  3730.                             ! IBM mode
  3731.     TPARSE_ARGS;
  3732.  
  3733.     IF .AP [TPA$L_PARAM]
  3734.     THEN
  3735.     BEGIN
  3736.     IBM_CHAR = (IF IBM_MODE_CHARACTER NEQ 0 THEN IBM_MODE_CHARACTER ELSE CHR_DC1);
  3737.     PARITY_TYPE = (IF IBM_MODE_PARITY NEQ 0 THEN IBM_MODE_PARITY ELSE PR_MARK);
  3738.     ECHO_FLAG = (IF IBM_MODE_ECHO NEQ 0 THEN IBM_MODE_ECHO ELSE TRUE);
  3739.     END
  3740.     ELSE
  3741.     BEGIN
  3742.     IBM_CHAR = -1;                ! Turn IBM mode off
  3743.     ECHO_FLAG = FALSE;            ! No local echo
  3744.     PARITY_TYPE = PR_NONE;            ! and no parity
  3745.     END;
  3746.  
  3747.     RETURN SS$_NORMAL;
  3748.     END;                    ! End of STORE_IBM
  3749. %SBTTL 'TPARSE support -- STORE_ABT'
  3750. ROUTINE STORE_ABT =
  3751.  
  3752. !++
  3753. ! FUNCTIONAL DESCRIPTION:
  3754. !
  3755. !    This routine will store the aborted file disposition into ABT_FLAG
  3756. !
  3757. ! CALLING SEQUENCE:
  3758. !
  3759. !    Standard LIB$TPARSE routine call.
  3760. !
  3761. ! INPUT PARAMETERS:
  3762. !
  3763. !    None.
  3764. !
  3765. ! IMPLICIT INPUTS:
  3766. !
  3767. !    None.
  3768. !
  3769. ! OUTPUT PARAMETERS:
  3770. !
  3771. !    None.
  3772. !
  3773. ! IMPLICIT OUTPUTS:
  3774. !
  3775. !    None.
  3776. !
  3777. ! COMPLETION CODES:
  3778. !
  3779. !    None.
  3780. !
  3781. ! SIDE EFFECTS:
  3782. !
  3783. !    None.
  3784. !
  3785. !--
  3786.  
  3787.     BEGIN
  3788.     TPARSE_ARGS;
  3789.     ABT_FLAG = .AP [TPA$L_PARAM];
  3790.     RETURN SS$_NORMAL;
  3791.     END;                    ! End of STORE_ABT
  3792. %SBTTL 'TPARSE support -- STORE_CHK'
  3793. ROUTINE STORE_CHK =
  3794.  
  3795. !++
  3796. ! FUNCTIONAL DESCRIPTION:
  3797. !
  3798. !    This routine will store the block check type into XXXX
  3799. !    location.
  3800. !
  3801. ! CALLING SEQUENCE:
  3802. !
  3803. !    Standard LIB$TPARSE routine call.
  3804. !
  3805. ! INPUT PARAMETERS:
  3806. !
  3807. !    None.
  3808. !
  3809. ! IMPLICIT INPUTS:
  3810. !
  3811. !    None.
  3812. !
  3813. ! OUTPUT PARAMETERS:
  3814. !
  3815. !    None.
  3816. !
  3817. ! IMPLICIT OUTPUTS:
  3818. !
  3819. !    None.
  3820. !
  3821. ! COMPLETION CODES:
  3822. !
  3823. !    None.
  3824. !
  3825. ! SIDE EFFECTS:
  3826. !
  3827. !    None.
  3828. !
  3829. !--
  3830.  
  3831.     BEGIN
  3832.     TPARSE_ARGS;
  3833.     CHKTYPE = .AP [TPA$L_PARAM];
  3834.     RETURN SS$_NORMAL;
  3835.     END;                    ! End of STORE_CHK
  3836. %SBTTL 'TPARSE support -- STORE_FTP - Store file type'
  3837. ROUTINE STORE_FTP =
  3838.  
  3839. !++
  3840. ! FUNCTIONAL DESCRIPTION:
  3841. !
  3842. !    This routine will store the file type that was specified by the
  3843. !    user for the KERFIL processing.
  3844. !
  3845. ! CALLING SEQUENCE:
  3846. !
  3847. !    Standard call from LIB$TPARSE.
  3848. !
  3849. ! INPUT PARAMETERS:
  3850. !
  3851. !    None.
  3852. !
  3853. ! IMPLICIT INPUTS:
  3854. !
  3855. !    None.
  3856. !
  3857. ! OUTPUT PARAMETERS:
  3858. !
  3859. !    None.
  3860. !
  3861. ! IMPLICIT OUTPUTS:
  3862. !
  3863. !    None.
  3864. !
  3865. ! COMPLETION CODES:
  3866. !
  3867. !    None.
  3868. !
  3869. ! SIDE EFFECTS:
  3870. !
  3871. !    None.
  3872. !
  3873. !--
  3874.  
  3875.     BEGIN
  3876.     TPARSE_ARGS;
  3877.     FILE_TYPE = .AP [TPA$L_PARAM];
  3878.  
  3879.     IF (.FILE_TYPE EQL FILE_FIX) OR
  3880.        (.FILE_TYPE EQL FILE_BIN)
  3881.     THEN 
  3882.         BEGIN
  3883.         TT_TEXT(UPLIT('Current block size for file transfer is ', 0));
  3884.         TT_NUMBER(.file_blocksize);
  3885.         TT_CRLF();
  3886.         END;
  3887.  
  3888.     RETURN SS$_NORMAL;
  3889.     END;                    ! End of STORE_FTP
  3890. %SBTTL 'TPARSE support -- STORE_FNM - Store file type'
  3891. ROUTINE STORE_FNM =
  3892.  
  3893. !++
  3894. ! FUNCTIONAL DESCRIPTION:
  3895. !
  3896. !    This routine will store the file type that was specified by the
  3897. !    user for the KERFIL processing.
  3898. !
  3899. ! CALLING SEQUENCE:
  3900. !
  3901. !    Standard call from LIB$TPARSE.
  3902. !
  3903. ! INPUT PARAMETERS:
  3904. !
  3905. !    None.
  3906. !
  3907. ! IMPLICIT INPUTS:
  3908. !
  3909. !    None.
  3910. !
  3911. ! OUTPUT PARAMETERS:
  3912. !
  3913. !    None.
  3914. !
  3915. ! IMPLICIT OUTPUTS:
  3916. !
  3917. !    None.
  3918. !
  3919. ! COMPLETION CODES:
  3920. !
  3921. !    None.
  3922. !
  3923. ! SIDE EFFECTS:
  3924. !
  3925. !    None.
  3926. !
  3927. !--
  3928.  
  3929.     BEGIN
  3930.     TPARSE_ARGS;
  3931.     FIL_NORMAL_FORM = .AP [TPA$L_PARAM];
  3932.     RETURN SS$_NORMAL;
  3933.     END;                    ! End of STORE_FNM
  3934. %SBTTL 'TPARSE support -- STORE_PARITY - Store file type'
  3935. ROUTINE STORE_PARITY =
  3936.  
  3937. !++
  3938. ! FUNCTIONAL DESCRIPTION:
  3939. !
  3940. !    This routine will store the type of parity to use for the transfer.
  3941. !    If a parity type of other than NONE is specified then we will use
  3942. !    eight-bit quoting to support the transfer.
  3943. !
  3944. ! CALLING SEQUENCE:
  3945. !
  3946. !    Standard call from LIB$TPARSE.
  3947. !
  3948. ! INPUT PARAMETERS:
  3949. !
  3950. !    None.
  3951. !
  3952. ! IMPLICIT INPUTS:
  3953. !
  3954. !    None.
  3955. !
  3956. ! OUTPUT PARAMETERS:
  3957. !
  3958. !    None.
  3959. !
  3960. ! IMPLICIT OUTPUTS:
  3961. !
  3962. !    None.
  3963. !
  3964. ! COMPLETION CODES:
  3965. !
  3966. !    None.
  3967. !
  3968. ! SIDE EFFECTS:
  3969. !
  3970. !    None.
  3971. !
  3972. !--
  3973.  
  3974.     BEGIN
  3975.     TPARSE_ARGS;
  3976.     PARITY_TYPE = .AP [TPA$L_PARAM];
  3977.     RETURN SS$_NORMAL;
  3978.     END;                    ! End of STORE_PARITY
  3979. %SBTTL 'TPARSE support -- STORE_ECHO - Store local echo flag'
  3980. ROUTINE STORE_ECHO =
  3981.  
  3982. !++
  3983. ! FUNCTIONAL DESCRIPTION:
  3984. !
  3985. !    This routine will store the state of the local echo flag as the
  3986. !    user set it.
  3987. !
  3988. ! CALLING SEQUENCE:
  3989. !
  3990. !    Standard TPARSE argument call.
  3991. !
  3992. ! INPUT PARAMETERS:
  3993. !
  3994. !    None.
  3995. !
  3996. ! IMPLICIT INPUTS:
  3997. !
  3998. !    None.
  3999. !
  4000. ! OUTPUT PARAMETERS:
  4001. !
  4002. !    None.
  4003. !
  4004. ! IMPLICIT OUTPUTS:
  4005. !
  4006. !    None.
  4007. !
  4008. ! COMPLETION CODES:
  4009. !
  4010. !    None.
  4011. !
  4012. ! SIDE EFFECTS:
  4013. !
  4014. !    None.
  4015. !
  4016. !--
  4017.  
  4018.     BEGIN
  4019.     TPARSE_ARGS;
  4020.     ECHO_FLAG = .AP [TPA$L_PARAM];
  4021.     RETURN SS$_NORMAL;
  4022.     END;                    ! End of STORE_ECHO
  4023. %SBTTL 'TPARSE support -- STORE_MSG_FIL - Store file name typeout flag'
  4024. ROUTINE STORE_MSG_FIL =
  4025.  
  4026. !++
  4027. ! FUNCTIONAL DESCRIPTION:
  4028. !
  4029. !    This routine will store the state of the file name typeout flag as the
  4030. !    user set it.
  4031. !
  4032. ! CALLING SEQUENCE:
  4033. !
  4034. !    Standard TPARSE argument call.
  4035. !
  4036. ! INPUT PARAMETERS:
  4037. !
  4038. !    None.
  4039. !
  4040. ! IMPLICIT INPUTS:
  4041. !
  4042. !    None.
  4043. !
  4044. ! OUTPUT PARAMETERS:
  4045. !
  4046. !    None.
  4047. !
  4048. ! IMPLICIT OUTPUTS:
  4049. !
  4050. !    None.
  4051. !
  4052. ! COMPLETION CODES:
  4053. !
  4054. !    None.
  4055. !
  4056. ! SIDE EFFECTS:
  4057. !
  4058. !    None.
  4059. !
  4060. !--
  4061.  
  4062.     BEGIN
  4063.     TPARSE_ARGS;
  4064.     TY_FIL = .AP [TPA$L_PARAM];
  4065.     RETURN SS$_NORMAL;
  4066.     END;                    ! End of STORE_MSG_FIL
  4067. %SBTTL 'TPARSE support -- STORE_MSG_PKT - Store packet number typeout flag'
  4068. ROUTINE STORE_MSG_PKT =
  4069.  
  4070. !++
  4071. ! FUNCTIONAL DESCRIPTION:
  4072. !
  4073. !    This routine will store the state of the packet number flag as the
  4074. !    user set it.
  4075. !
  4076. ! CALLING SEQUENCE:
  4077. !
  4078. !    Standard TPARSE argument call.
  4079. !
  4080. ! INPUT PARAMETERS:
  4081. !
  4082. !    None.
  4083. !
  4084. ! IMPLICIT INPUTS:
  4085. !
  4086. !    None.
  4087. !
  4088. ! OUTPUT PARAMETERS:
  4089. !
  4090. !    None.
  4091. !
  4092. ! IMPLICIT OUTPUTS:
  4093. !
  4094. !    None.
  4095. !
  4096. ! COMPLETION CODES:
  4097. !
  4098. !    None.
  4099. !
  4100. ! SIDE EFFECTS:
  4101. !
  4102. !    None.
  4103. !
  4104. !--
  4105.  
  4106.     BEGIN
  4107.     TPARSE_ARGS;
  4108.     TY_PKT = .AP [TPA$L_PARAM];
  4109.     RETURN SS$_NORMAL;
  4110.     END;                    ! End of STORE_MSG_PKT
  4111. %SBTTL 'TPARSE support -- CHECK_EOL'
  4112. ROUTINE CHECK_EOL =
  4113.  
  4114. !++
  4115. ! FUNCTIONAL DESCRIPTION:
  4116. !
  4117. !    This routine will valid the SEND and RECEIVE eol character that
  4118. !    is being set by the user.
  4119. !
  4120. ! CALLING SEQUENCE:
  4121. !
  4122. !    Standard TPARSE routine calling sequence.
  4123. !
  4124. ! INPUT PARAMETERS:
  4125. !
  4126. !    None.
  4127. !
  4128. ! IMPLICIT INPUTS:
  4129. !
  4130. !    None.
  4131. !
  4132. ! OUTPUT PARAMETERS:
  4133. !
  4134. !    None.
  4135. !
  4136. ! IMPLICIT OUTPUTS:
  4137. !
  4138. !    None.
  4139. !
  4140. ! COMPLETION CODES:
  4141. !
  4142. !    None.
  4143. !
  4144. ! SIDE EFFECTS:
  4145. !
  4146. !    None.
  4147. !
  4148. !--
  4149.  
  4150.     BEGIN
  4151.     TPARSE_ARGS;
  4152.  
  4153.     IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0)
  4154.     THEN
  4155.     RETURN SS$_NORMAL
  4156.     ELSE
  4157.     RETURN KER_ILLEOL;
  4158.  
  4159.     END;                    ! End of CHECK_EOL
  4160. %SBTTL 'TPARSE support -- CHECK_QUOTE'
  4161. ROUTINE CHECK_QUOTE =
  4162.  
  4163. !++
  4164. ! FUNCTIONAL DESCRIPTION:
  4165. !
  4166. !    This routine will validate the SEND and RECEIVE quoting character that
  4167. !    is being set by the user.
  4168. !
  4169. ! CALLING SEQUENCE:
  4170. !
  4171. !    Standard TPARSE routine calling sequence.
  4172. !
  4173. ! INPUT PARAMETERS:
  4174. !
  4175. !    None.
  4176. !
  4177. ! IMPLICIT INPUTS:
  4178. !
  4179. !    None.
  4180. !
  4181. ! OUTPUT PARAMETERS:
  4182. !
  4183. !    None.
  4184. !
  4185. ! IMPLICIT OUTPUTS:
  4186. !
  4187. !    None.
  4188. !
  4189. ! COMPLETION CODES:
  4190. !
  4191. !    Error code or true value
  4192. !
  4193. ! SIDE EFFECTS:
  4194. !
  4195. !    None.
  4196. !
  4197. !--
  4198.  
  4199.     BEGIN
  4200.     TPARSE_ARGS;
  4201.  
  4202.     IF (.AP [TPA$L_NUMBER] GEQ %C' ' AND .AP [TPA$L_NUMBER] LSS %C'?') OR (.AP [TPA$L_NUMBER] GEQ %C'`' AND
  4203.     .AP [TPA$L_NUMBER] LSS CHR_DEL)
  4204.     THEN
  4205.     RETURN SS$_NORMAL
  4206.     ELSE
  4207.     RETURN KER_ILLQUO;
  4208.  
  4209.     END;                    ! End of CHECK_QUO
  4210. %SBTTL 'TPARSE support -- CHECK_SOH'
  4211. ROUTINE CHECK_SOH =
  4212.  
  4213. !++
  4214. ! FUNCTIONAL DESCRIPTION:
  4215. !
  4216. !    This routine will valid the SEND and RECEIVE START_OF_PACKET
  4217. !    character that is being set by the user.
  4218. !
  4219. ! CALLING SEQUENCE:
  4220. !
  4221. !    Standard TPARSE routine calling sequence.
  4222. !
  4223. ! INPUT PARAMETERS:
  4224. !
  4225. !    None.
  4226. !
  4227. ! IMPLICIT INPUTS:
  4228. !
  4229. !    None.
  4230. !
  4231. ! OUTPUT PARAMETERS:
  4232. !
  4233. !    None.
  4234. !
  4235. ! IMPLICIT OUTPUTS:
  4236. !
  4237. !    None.
  4238. !
  4239. ! COMPLETION CODES:
  4240. !
  4241. !    None.
  4242. !
  4243. ! SIDE EFFECTS:
  4244. !
  4245. !    None.
  4246. !
  4247. !--
  4248.  
  4249.     BEGIN
  4250.     TPARSE_ARGS;
  4251.  
  4252.     IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0)
  4253.     THEN
  4254.     RETURN SS$_NORMAL
  4255.     ELSE
  4256.     RETURN KER_ILLSOH;
  4257.  
  4258.     END;                    ! End of CHECK_SOH
  4259. %SBTTL 'TPARSE support -- CHECK_PAD_CHAR'
  4260. ROUTINE CHECK_PAD_CHAR =
  4261.  
  4262. !++
  4263. ! FUNCTIONAL DESCRIPTION:
  4264. !
  4265. !    This routine will valid the SEND and RECEIVE eol character that
  4266. !    is being set by the user.
  4267. !
  4268. ! CALLING SEQUENCE:
  4269. !
  4270. !    Standard TPARSE routine calling sequence.
  4271. !
  4272. ! INPUT PARAMETERS:
  4273. !
  4274. !    None.
  4275. !
  4276. ! IMPLICIT INPUTS:
  4277. !
  4278. !    None.
  4279. !
  4280. ! OUTPUT PARAMETERS:
  4281. !
  4282. !    None.
  4283. !
  4284. ! IMPLICIT OUTPUTS:
  4285. !
  4286. !    None.
  4287. !
  4288. ! COMPLETION CODES:
  4289. !
  4290. !    None.
  4291. !
  4292. ! SIDE EFFECTS:
  4293. !
  4294. !    None.
  4295. !
  4296. !--
  4297.  
  4298.     BEGIN
  4299.     TPARSE_ARGS;
  4300.  
  4301.     IF .AP [TPA$L_NUMBER] LSS %C' ' OR .AP [TPA$L_NUMBER] EQL CHR_DEL
  4302.     THEN
  4303.     RETURN SS$_NORMAL
  4304.     ELSE
  4305.     RETURN KER_ILLPADCHR;
  4306.  
  4307.     END;                    ! End of CHECK_PAD_CHAR
  4308. %SBTTL 'TPARSE support -- CHECK_NPAD'
  4309. ROUTINE CHECK_NPAD =
  4310.  
  4311. !++
  4312. ! FUNCTIONAL DESCRIPTION:
  4313. !
  4314. !    This routine will determine if the padding character specified by the
  4315. !    user is valid.
  4316. !
  4317. ! CALLING SEQUENCE:
  4318. !
  4319. !    Standard TPARSE calling sequence.
  4320. !
  4321. ! INPUT PARAMETERS:
  4322. !
  4323. !    None.
  4324. !
  4325. ! IMPLICIT INPUTS:
  4326. !
  4327. !    None.
  4328. !
  4329. ! OUTPUT PARAMETERS:
  4330. !
  4331. !    None.
  4332. !
  4333. ! IMPLICIT OUTPUTS:
  4334. !
  4335. !    None.
  4336. !
  4337. ! COMPLETION CODES:
  4338. !
  4339. !    None.
  4340. !
  4341. ! SIDE EFFECTS:
  4342. !
  4343. !    None.
  4344. !
  4345. !--
  4346.  
  4347.     BEGIN
  4348.     TPARSE_ARGS;
  4349.  
  4350.     IF .AP [TPA$L_NUMBER] LSS 0 THEN RETURN KER_ILLNPAD ELSE RETURN SS$_NORMAL;
  4351.  
  4352.     END;                    ! End of CHECK_NPAD
  4353. %SBTTL 'TPARSE support -- CHECK_PACKET_LEN'
  4354. ROUTINE CHECK_PACKET_LEN =
  4355.  
  4356. !++
  4357. ! FUNCTIONAL DESCRIPTION:
  4358. !
  4359. !    This routine will determine if the packet length specified by the
  4360. !    user is valid.
  4361. !
  4362. ! CALLING SEQUENCE:
  4363. !
  4364. !    Standard TPARSE calling sequence.
  4365. !
  4366. ! INPUT PARAMETERS:
  4367. !
  4368. !    None.
  4369. !
  4370. ! IMPLICIT INPUTS:
  4371. !
  4372. !    None.
  4373. !
  4374. ! OUTPUT PARAMETERS:
  4375. !
  4376. !    None.
  4377. !
  4378. ! IMPLICIT OUTPUTS:
  4379. !
  4380. !    None.
  4381. !
  4382. ! COMPLETION CODES:
  4383. !
  4384. !    None.
  4385. !
  4386. ! SIDE EFFECTS:
  4387. !
  4388. !    None.
  4389. !
  4390. !--
  4391.  
  4392.     BEGIN
  4393.     TPARSE_ARGS;
  4394.  
  4395.     IF .AP [TPA$L_NUMBER] LSS 10 OR .AP [TPA$L_NUMBER] GTR (MAX_MSG - 2)
  4396.     THEN
  4397.     RETURN KER_ILLPKTLEN
  4398.     ELSE
  4399.     RETURN SS$_NORMAL;
  4400.  
  4401.     END;                    ! End of CHECK_PACKET_LEN
  4402. %SBTTL 'STORE_TEXT'
  4403. ROUTINE STORE_TEXT =
  4404.  
  4405. !++
  4406. ! FUNCTIONAL DESCRIPTION:
  4407. !
  4408. !    This routine will store a single character of the file specification
  4409. !    that the user gives to the SEND and RECEIVE commands.
  4410. !
  4411. ! FORMAL PARAMETERS:
  4412. !
  4413. !    Character that was parsed.
  4414. !
  4415. ! IMPLICIT INPUTS:
  4416. !
  4417. !    None.
  4418. !
  4419. ! IMPLICIT OUTPUTS:
  4420. !
  4421. !    Character stored into the file specification vector.
  4422. !
  4423. ! ROUTINE VALUE and
  4424. ! COMPLETION CODES:
  4425. !
  4426. !    None.
  4427. !
  4428. ! SIDE EFFECTS:
  4429. !
  4430. !    None.
  4431. !
  4432. !--
  4433.  
  4434.     BEGIN
  4435.     TPARSE_ARGS;
  4436.  
  4437.     IF (TEMP_DESC [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH] + 1) LSS TEMP_LENGTH
  4438.     THEN
  4439.     BEGIN
  4440.     CH$WCHAR (.AP [TPA$B_CHAR], CH$PTR (TEMP_NAME, .TEMP_DESC [DSC$W_LENGTH] - 1));
  4441.     AP [TPA$V_BLANKS] = 1;            ! Blanks are significant
  4442.     RETURN SS$_NORMAL;
  4443.     END
  4444.     ELSE
  4445.     RETURN KER_LINTOOLNG;
  4446.  
  4447.     END;                    ! End of STORE_TEXT
  4448. %SBTTL 'TPARSE support -- COPY_DESC - Copy string to a descriptor'
  4449. ROUTINE COPY_DESC =
  4450.  
  4451. !++
  4452. ! FUNCTIONAL DESCRIPTION:
  4453. !
  4454. ! This routine will copy a string to the descriptor passed in the TPARSE
  4455. ! argument.
  4456. !
  4457. ! CALLING SEQUENCE:
  4458. !
  4459. !    COPY_FILE();
  4460. !
  4461. ! INPUT PARAMETERS:
  4462. !
  4463. !    None.
  4464. !
  4465. ! IMPLICIT INPUTS:
  4466. !
  4467. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4468. !    in the descriptor.
  4469. !
  4470. ! OUTPUT PARAMETERS:
  4471. !
  4472. !    None.
  4473. !
  4474. ! IMPLICIT OUTPUTS:
  4475. !
  4476. !    Descriptor fields set up.
  4477. !    TEMP_DESC.
  4478. !
  4479. ! COMPLETION CODES:
  4480. !
  4481. !    0 - Failure.
  4482. !    1 - Success.
  4483. !
  4484. ! SIDE EFFECTS:
  4485. !
  4486. !    None.
  4487. !
  4488. !--
  4489.  
  4490.     BEGIN
  4491.     TPARSE_ARGS;
  4492.  
  4493.     LOCAL
  4494.     DESC_ADDR;
  4495.  
  4496.     DESC_ADDR = .AP [TPA$L_PARAM];
  4497.     BEGIN
  4498.  
  4499.     MAP
  4500.     DESC_ADDR : REF BLOCK [8, BYTE];
  4501.  
  4502.     DESC_ADDR [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH];
  4503.     CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
  4504.     CH$PTR (.DESC_ADDR [DSC$A_POINTER]));
  4505.     END;
  4506.     RETURN SS$_NORMAL;
  4507.     END;                    ! End of COPY_FILE
  4508. %SBTTL 'TPARSE support -- COPY_ALT_FILE - Copy file specification'
  4509. ROUTINE COPY_ALT_FILE =
  4510.  
  4511. !++
  4512. ! FUNCTIONAL DESCRIPTION:
  4513. !
  4514. !    This routine will copy the file name from the temporary
  4515. !    descriptor to the descriptor that is used for the file name.
  4516. !    (ALT_FILE_NAME).
  4517. !    This is for use by the RECEIVE command so that the user may
  4518. !    specify an alternate file name for the received file.
  4519. !
  4520. ! CALLING SEQUENCE:
  4521. !
  4522. !    COPY_ALT_FILE();
  4523. !
  4524. ! INPUT PARAMETERS:
  4525. !
  4526. !    None.
  4527. !
  4528. ! IMPLICIT INPUTS:
  4529. !
  4530. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4531. !    in the descriptor.
  4532. !
  4533. ! OUTPUT PARAMETERS:
  4534. !
  4535. !    None.
  4536. !
  4537. ! IMPLICIT OUTPUTS:
  4538. !
  4539. !    ALT_FILE_NAME set up with what was in TEMP_NAME and
  4540. !    TEMP_DESC.
  4541. !
  4542. ! COMPLETION CODES:
  4543. !
  4544. !    0 - Failure.
  4545. !    1 - Success.
  4546. !
  4547. ! SIDE EFFECTS:
  4548. !
  4549. !    None.
  4550. !
  4551. !--
  4552.  
  4553.     BEGIN
  4554.     ALT_FILE_SIZE = .TEMP_DESC [DSC$W_LENGTH];
  4555.     CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
  4556.     CH$PTR (ALT_FILE_NAME));
  4557.     RETURN SS$_NORMAL;
  4558.     END;                    ! End of COPY_ALT_FILE
  4559. %SBTTL 'TPARSE support -- COPY_GEN_1DATA - Copy generic command argument'
  4560. ROUTINE COPY_GEN_1DATA =
  4561.  
  4562. !++
  4563. ! FUNCTIONAL DESCRIPTION:
  4564. !
  4565. !    This routine will copy the generic command argument from the
  4566. !    temporary descriptor to the global storage for the argument
  4567. !    (GEN_1DATA).
  4568. !
  4569. ! CALLING SEQUENCE:
  4570. !
  4571. !    COPY_GEN_1DATA();
  4572. !
  4573. ! INPUT PARAMETERS:
  4574. !
  4575. !    None.
  4576. !
  4577. ! IMPLICIT INPUTS:
  4578. !
  4579. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4580. !    in the descriptor.
  4581. !
  4582. ! OUTPUT PARAMETERS:
  4583. !
  4584. !    None.
  4585. !
  4586. ! IMPLICIT OUTPUTS:
  4587. !
  4588. !    GEN_1DATA and GEN_1SIZE set up with what was in TEMP_NAME and
  4589. !    TEMP_DESC.
  4590. !
  4591. ! COMPLETION CODES:
  4592. !
  4593. !    0 - Failure.
  4594. !    1 - Success.
  4595. !
  4596. ! SIDE EFFECTS:
  4597. !
  4598. !    None.
  4599. !
  4600. !--
  4601.  
  4602.     BEGIN
  4603.     GEN_1SIZE = .TEMP_DESC [DSC$W_LENGTH];
  4604.     CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
  4605.     CH$PTR (GEN_1DATA));
  4606.     RETURN SS$_NORMAL;
  4607.     END;                    ! End of COPY_GEN_1DATA
  4608. %SBTTL 'TPARSE support -- COPY_GEN_2DATA - Copy generic command argument'
  4609. ROUTINE COPY_GEN_2DATA =
  4610.  
  4611. !++
  4612. ! FUNCTIONAL DESCRIPTION:
  4613. !
  4614. !    This routine will copy the generic command argument from the
  4615. !    temporary descriptor to the global storage for the argument
  4616. !    (GEN_2DATA).
  4617. !
  4618. ! CALLING SEQUENCE:
  4619. !
  4620. !    COPY_GEN_2DATA();
  4621. !
  4622. ! INPUT PARAMETERS:
  4623. !
  4624. !    None.
  4625. !
  4626. ! IMPLICIT INPUTS:
  4627. !
  4628. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4629. !    in the descriptor.
  4630. !
  4631. ! OUTPUT PARAMETERS:
  4632. !
  4633. !    None.
  4634. !
  4635. ! IMPLICIT OUTPUTS:
  4636. !
  4637. !    GEN_2DATA and GEN_2SIZE set up with what was in TEMP_NAME and
  4638. !    TEMP_DESC.
  4639. !
  4640. ! COMPLETION CODES:
  4641. !
  4642. !    0 - Failure.
  4643. !    1 - Success.
  4644. !
  4645. ! SIDE EFFECTS:
  4646. !
  4647. !    None.
  4648. !
  4649. !--
  4650.  
  4651.     BEGIN
  4652.     GEN_2SIZE = .TEMP_DESC [DSC$W_LENGTH];
  4653.     CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
  4654.     CH$PTR (GEN_2DATA));
  4655.     RETURN SS$_NORMAL;
  4656.     END;                    ! End of COPY_GEN_2DATA
  4657. %SBTTL 'TPARSE support -- COPY_GEN_3DATA - Copy generic command argument'
  4658. ROUTINE COPY_GEN_3DATA =
  4659.  
  4660. !++
  4661. ! FUNCTIONAL DESCRIPTION:
  4662. !
  4663. !    This routine will copy the generic command argument from the
  4664. !    temporary descriptor to the global storage for the argument
  4665. !    (GEN_3DATA).
  4666. !
  4667. ! CALLING SEQUENCE:
  4668. !
  4669. !    COPY_GEN_3DATA();
  4670. !
  4671. ! INPUT PARAMETERS:
  4672. !
  4673. !    None.
  4674. !
  4675. ! IMPLICIT INPUTS:
  4676. !
  4677. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4678. !    in the descriptor.
  4679. !
  4680. ! OUTPUT PARAMETERS:
  4681. !
  4682. !    None.
  4683. !
  4684. ! IMPLICIT OUTPUTS:
  4685. !
  4686. !    GEN_3DATA and GEN_3SIZE set up with what was in TEMP_NAME and
  4687. !    TEMP_DESC.
  4688. !
  4689. ! COMPLETION CODES:
  4690. !
  4691. !    0 - Failure.
  4692. !    1 - Success.
  4693. !
  4694. ! SIDE EFFECTS:
  4695. !
  4696. !    None.
  4697. !
  4698. !--
  4699.  
  4700.     BEGIN
  4701.     GEN_3SIZE = .TEMP_DESC [DSC$W_LENGTH];
  4702.     CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
  4703.     CH$PTR (GEN_3DATA));
  4704.     RETURN SS$_NORMAL;
  4705.     END;                    ! End of COPY_GEN_3DATA
  4706. %SBTTL 'COPY_TERM_NAME'
  4707. ROUTINE COPY_TERM_NAME =
  4708.  
  4709. !++
  4710. ! FUNCTIONAL DESCRIPTION:
  4711. !
  4712. !    This routine will copy the device name from the temporary
  4713. !    descriptor to the descriptor that is used for the terminal name.
  4714. !    (TERM_NAME and TERM_DESC).
  4715. !    It will call KERTRM to validate the name as a usuable terminal.
  4716. !
  4717. ! CALLING SEQUENCE:
  4718. !
  4719. !    COPY_TERM_NAME();
  4720. !
  4721. ! INPUT PARAMETERS:
  4722. !
  4723. !    None.
  4724. !
  4725. ! IMPLICIT INPUTS:
  4726. !
  4727. !    TEMP_DESC and TEMP_NAME set up with the device name and length
  4728. !    in the descriptor.
  4729. !
  4730. ! OUTPUT PARAMETERS:
  4731. !
  4732. !    None.
  4733. !
  4734. ! IMPLICIT OUTPUTS:
  4735. !
  4736. !    TERM_NAME and TERM_DESC set up with what was in TEMP_NAME and
  4737. !    TEMP_DESC.
  4738. !
  4739. ! COMPLETION CODES:
  4740. !
  4741. !    0 - Failure.
  4742. !    1 - Success.
  4743. !
  4744. ! SIDE EFFECTS:
  4745. !
  4746. !    None.
  4747. !
  4748. !--
  4749.  
  4750.     BEGIN
  4751.  
  4752.     EXTERNAL
  4753.     JOB_TERM_DESC : BLOCK [8, BYTE];    ! Descriptor for jobs contolling terminal
  4754.  
  4755.     IF NOT CH$FAIL (CH$FIND_NOT_CH (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (.TEMP_DESC [DSC$A_POINTER]), %C' '))
  4756.     THEN
  4757.     RETURN SET_TRANS_TERM (TEMP_DESC)
  4758.     ELSE
  4759.  
  4760.     IF NOT SET_TRANS_TERM (%ASCID'KER$COMM')
  4761.     THEN
  4762.  
  4763.         IF NOT SET_TRANS_TERM (%ASCID'SYS$INPUT')
  4764.         THEN
  4765.  
  4766.         IF NOT SET_TRANS_TERM (%ASCID'SYS$OUTPUT')
  4767.         THEN
  4768.  
  4769.             IF NOT SET_TRANS_TERM (%ASCID'SYS$COMMAND') THEN RETURN SET_TRANS_TERM (JOB_TERM_DESC);
  4770.  
  4771.     RETURN SS$_NORMAL;
  4772.     END;                    ! End of COPY_TERM_NAME
  4773. %SBTTL 'KEY_ERROR - Handle keyword errors'
  4774. ROUTINE KEY_ERROR =
  4775.  
  4776. !++
  4777. ! FUNCTIONAL DESCRIPTION:
  4778. !
  4779. ! This routine is called from the command parser (LIB$TPARSE) when a keyword
  4780. ! does not match.  It will just return the correct error code.
  4781. !
  4782. ! CALLING SEQUENCE:
  4783. !
  4784. !    STATUS = KEY_ERROR ();
  4785. !
  4786. ! INPUT PARAMETERS:
  4787. !
  4788. !    None.
  4789. !
  4790. ! IMPLICIT INPUTS:
  4791. !
  4792. !    None.
  4793. !
  4794. ! OUPTUT PARAMETERS:
  4795. !
  4796. !    None.
  4797. !
  4798. ! IMPLICIT OUTPUTS:
  4799. !
  4800. !    None.
  4801. !
  4802. ! COMPLETION CODES:
  4803. !
  4804. !    None.
  4805. !
  4806. ! SIDE EFFECTS:
  4807. !
  4808. !    None.
  4809. !
  4810. !--
  4811.  
  4812.     BEGIN
  4813.     TPARSE_ARGS;
  4814.  
  4815.     IF .AP [TPA$V_AMBIG] THEN RETURN KER_AMBIGKEY ELSE RETURN KER_UNKNOWKEY;
  4816.  
  4817.     END;                    ! End of KEY_ERROR
  4818. %SBTTL 'XFR_STATUS - Return the transfer status'
  4819.  
  4820. GLOBAL ROUTINE XFR_STATUS (TYPE, SUB_TYPE) : NOVALUE =
  4821.  
  4822. !++
  4823. ! FUNCTIONAL DESCRIPTION:
  4824. !
  4825. !    This routine is called after either a packet has been received
  4826. !    correctly at the receive level, a packet has been sent, or
  4827. !    either a NAK has been sent or received.
  4828. !
  4829. ! CALLING SEQUENCE:
  4830. !
  4831. !    XFR_STATUS (Type);
  4832. !
  4833. ! INPUT PARAMETERS:
  4834. !
  4835. !    Type - ASCII Characters describing the type of transfer
  4836. !
  4837. ! IMPLICIT INPUTS:
  4838. !
  4839. !    None.
  4840. !
  4841. ! OUPTUT PARAMETERS:
  4842. !
  4843. !    None.
  4844. !
  4845. ! IMPLICIT OUTPUTS:
  4846. !
  4847. !    None.
  4848. !
  4849. ! COMPLETION CODES:
  4850. !
  4851. !    None.
  4852. !
  4853. ! SIDE EFFECTS:
  4854. !
  4855. !    None.
  4856. !
  4857. !--
  4858.  
  4859.     BEGIN
  4860.  
  4861.     EXTERNAL ROUTINE
  4862.     LOG_FAOL;
  4863.  
  4864. !
  4865. ! If we have a journal file (transaction log), then say what we are doing.
  4866. !
  4867.  
  4868.     IF .TRANSACTION_OPEN AND .TYPE EQL %C'F'
  4869.     THEN
  4870.     BEGIN
  4871.     FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE;    ! Make sure size is right
  4872.  
  4873.     SELECTONE .SUB_TYPE OF
  4874.         SET
  4875.  
  4876.         [%C'S'] :
  4877.         LOG_FAOL (%ASCID'!%T!_Sending file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);
  4878.  
  4879.         [%C'R'] :
  4880.         LOG_FAOL (%ASCID'!%T!_Receiving file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);
  4881.  
  4882.         [%C'C'] :
  4883.         LOG_FAOL (%ASCID'!%T!_Closing file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);
  4884.  
  4885.         [%C'X'] :
  4886.         LOG_FAOL (%ASCID'!%T!_Aborting file !AS by user request!/', UPLIT (0, FILE_DESC),
  4887.             TRANSACTION_RAB);
  4888.  
  4889.         [%C'Z'] :
  4890.         LOG_FAOL (%ASCID'!%T!_Aborting file group !AS by user request!/', UPLIT (0, FILE_DESC),
  4891.             TRANSACTION_RAB);
  4892.  
  4893.         [%C'D'] :
  4894.         LOG_FAOL (%ASCID'!%T!_Aborting file !AS, partial file saved!/', UPLIT (0, FILE_DESC),
  4895.             TRANSACTION_RAB);
  4896.  
  4897.         [%C'A'] :
  4898.         LOG_FAOL (%ASCID'!%T!_Aborting file !AS due to protocol error!/', UPLIT (0, FILE_DESC),
  4899.             TRANSACTION_RAB);
  4900.         TES;
  4901.  
  4902.     END;
  4903.  
  4904.     IF .TY_PKT
  4905.     THEN
  4906.     BEGIN
  4907.  
  4908.     SELECTONE .TYPE OF
  4909.         SET
  4910.  
  4911.         [%ASCII'R'] :
  4912.         BEGIN
  4913.  
  4914.         IF .SUB_TYPE EQL %C'P'
  4915.         THEN
  4916.             BEGIN
  4917.             TT_TEXT (UPLIT (%ASCIZ' R'));
  4918.             TT_NUMBER (.RMSG_COUNT);
  4919.             END;
  4920.  
  4921.         IF .SUB_TYPE EQL %C'N'
  4922.         THEN
  4923.             BEGIN
  4924.             TT_TEXT (UPLIT (%ASCIZ' R%'));
  4925.             TT_NUMBER (.RMSG_NAKS);
  4926.             END;
  4927.  
  4928.         END;
  4929.  
  4930.         [%ASCII'S'] :
  4931.         BEGIN
  4932.  
  4933.         IF .SUB_TYPE EQL %C'P'
  4934.         THEN
  4935.             BEGIN
  4936.             TT_TEXT (UPLIT (%ASCIZ' S'));
  4937.             TT_NUMBER (.SMSG_COUNT);
  4938.             END;
  4939.  
  4940.         IF .SUB_TYPE EQL %C'N'
  4941.         THEN
  4942.             BEGIN
  4943.             TT_TEXT (UPLIT (%ASCIZ' S%'));
  4944.             TT_NUMBER (.SMSG_NAKS);
  4945.             END;
  4946.  
  4947.         END;
  4948.         TES;
  4949.  
  4950.     TT_OUTPUT ();
  4951.     END;
  4952.  
  4953.     END;                    ! End of XFR_STATUS
  4954.  
  4955. %SBTTL 'CRCCLC - Calculate the CRC-CCITT for a message'
  4956.  
  4957. GLOBAL ROUTINE CRCCLC (POINTER, SIZE) =
  4958.  
  4959. !++
  4960. ! FUNCTIONAL DESCRIPTION:
  4961. !
  4962. !    This routine will calculate the CRC for a message.  It will use
  4963. !    the VAX LIB$ routine to do all the work.
  4964. !
  4965. ! CALLING SEQUENCE:
  4966. !
  4967. !    CRC = CRCCLC(Pointer, Size)
  4968. !
  4969. ! INPUT PARAMETERS:
  4970. !
  4971. !    Pointer - Character pointer to the message.
  4972. !    Size - Length of the message.
  4973. !
  4974. ! IMPLICIT INPUTS:
  4975. !
  4976. !    None.
  4977. !
  4978. ! OUPTUT PARAMETERS:
  4979. !
  4980. !    CRC for the message.
  4981. !
  4982. ! IMPLICIT OUTPUTS:
  4983. !
  4984. !    None.
  4985. !
  4986. ! COMPLETION CODES:
  4987. !
  4988. !    None.
  4989. !
  4990. ! SIDE EFFECTS:
  4991. !
  4992. !    None.
  4993. !
  4994. !--
  4995.  
  4996.     BEGIN
  4997.  
  4998.     LOCAL
  4999.     TEMP_DESC : BLOCK [8, BYTE],        ! Temporary descriptor
  5000.     CRC_INITIAL;                ! Initial CRC value
  5001.  
  5002.     CRC_INITIAL = 0;                ! Set the initial value
  5003.     INIT_STR_DESC (TEMP_DESC, .POINTER, .SIZE);
  5004.     RETURN LIB$CRC (CRC_TABLE, CRC_INITIAL, TEMP_DESC);
  5005.     END;                    ! End of CRCCLC
  5006.  
  5007. %SBTTL 'KRM_ERROR - Issue an error message given error code'
  5008.  
  5009. GLOBAL ROUTINE KRM_ERROR (ERROR_CODE) : NOVALUE =
  5010.  
  5011. !++
  5012. ! FUNCTIONAL DESCRIPTION:
  5013. !
  5014. !    This routine will cause an error message to be issued to the
  5015. !    user's terminal and/or a message to be sent to the remote KERMIT.
  5016. !
  5017. ! CALLING SEQUENCE:
  5018. !
  5019. !    KRM_ERROR(KER_xxxxxx);
  5020. !
  5021. ! INPUT PARAMETERS:
  5022. !
  5023. !    KER_xxxxxx - Error code from KERERR.REQ
  5024. !
  5025. ! IMPLICIT INPUTS:
  5026. !
  5027. !    None.
  5028. !
  5029. ! OUTPUT PARAMETERS:
  5030. !
  5031. !    None.
  5032. !
  5033. ! IMPLICIT OUTPUTS:
  5034. !
  5035. !    None.
  5036. !
  5037. ! COMPLETION CODES:
  5038. !
  5039. !    None.
  5040. !
  5041. ! SIDE EFFECTS:
  5042. !
  5043. !    None.
  5044. !
  5045. !--
  5046.  
  5047.     BEGIN
  5048.     LIB$SIGNAL (.ERROR_CODE);
  5049.     END;                    ! End of KRM_ERROR
  5050.  
  5051. %SBTTL 'KERM_HANDLER - Condition handler'
  5052. ROUTINE KERM_HANDLER =
  5053.  
  5054. !++
  5055. ! FUNCTIONAL DESCRIPTION:
  5056. !
  5057. !    This is the condition handler for KERMIT-32.
  5058. !
  5059. ! CALLING SEQUENCE:
  5060. !
  5061. !    Called via LIB$SIGNAL.
  5062. !
  5063. ! INPUT PARAMETERS:
  5064. !
  5065. !    None.
  5066. !
  5067. ! IMPLICIT INPUTS:
  5068. !
  5069. !    None.
  5070. !
  5071. ! OUTPUT PARAMETERS:
  5072. !
  5073. !    None.
  5074. !
  5075. ! IMPLICIT OUTPUTS:
  5076. !
  5077. !    None.
  5078. !
  5079. ! COMPLETION CODES:
  5080. !
  5081. !    None.
  5082. !
  5083. ! SIDE EFFECTS:
  5084. !
  5085. !    None.
  5086. !
  5087. !--
  5088.  
  5089.     BEGIN
  5090.  
  5091.     BIND
  5092.     FACILITY_DESC = %ASCID'KERMIT32';
  5093.  
  5094.     BUILTIN
  5095.     AP;
  5096.  
  5097.     LOCAL
  5098.     PUTMSG_VECTOR : VECTOR [10, LONG],
  5099.     SIGARGLST;                ! Address of the signal argument list
  5100.  
  5101.     MAP
  5102.     AP : REF BLOCK [, BYTE],
  5103.     SIGARGLST : REF BLOCK [, BYTE];
  5104.  
  5105. !++
  5106. !
  5107. ! Routine to do the actual output of the error message
  5108. !
  5109. !--
  5110.  
  5111.     ROUTINE HANDLE_MSG =
  5112.     BEGIN
  5113.  
  5114.     EXTERNAL ROUTINE
  5115.         LOG_FAOL;
  5116.  
  5117.     BUILTIN
  5118.         AP;
  5119.  
  5120.     LOCAL
  5121.         ERR_DESC,                ! Address of the error descriptor
  5122.         POINTER;                ! Pointer to get characters
  5123.  
  5124.     MAP
  5125.         ERR_DESC : REF BLOCK [8, BYTE],
  5126.         AP : REF BLOCK [, BYTE];
  5127.  
  5128.     ERR_DESC = .AP [4, 0, 32, 0];
  5129.  
  5130.     IF .TERM_FLAG THEN SND_ERROR (.ERR_DESC [DSC$W_LENGTH], .ERR_DESC [DSC$A_POINTER]);
  5131.  
  5132.     IF .TRANSACTION_OPEN
  5133.     THEN
  5134.         BEGIN
  5135.  
  5136.         OWN
  5137.         TMP_DESC : BLOCK [8, BYTE];
  5138.  
  5139.         INIT_STR_DESC (TMP_DESC, .ERR_DESC [DSC$A_POINTER], .ERR_DESC [DSC$W_LENGTH]);
  5140.         LOG_FAOL (%ASCID'!%T!_!AS!/', UPLIT (0, TMP_DESC), TRANSACTION_RAB);
  5141.         END;
  5142.  
  5143.     IF NOT .CONNECT_FLAG
  5144.     THEN
  5145.         BEGIN
  5146.         TT_CRLF ();
  5147.         POINTER = CH$PTR (.ERR_DESC [DSC$A_POINTER]);
  5148.  
  5149.         INCR I FROM 1 TO .ERR_DESC [DSC$W_LENGTH] DO
  5150.         TT_CHAR (CH$RCHAR_A (POINTER));
  5151.  
  5152.         TT_CRLF ();
  5153.         END;
  5154.  
  5155.     RETURN 0;
  5156.     END;
  5157.     SIGARGLST = .AP [CHF$L_SIGARGLST];
  5158.  
  5159.     IF .SIGARGLST [CHF$L_SIG_NAME] GEQ %X'400' AND .SIGARGLST [CHF$L_SIG_NAME] LEQ %X'5FF'
  5160.     THEN
  5161.     RETURN SS$_RESIGNAL;
  5162.  
  5163.     PUTMSG_VECTOR [0] = .SIGARGLST [CHF$L_SIG_ARGS] - 2;    ! No PC and PSL
  5164.     PUTMSG_VECTOR [1] = .SIGARGLST [CHF$L_SIG_NAME];
  5165. !    PUTMSG_VECTOR [2] = .SIGARGLST [CHF$L_SIG_ARGS] - 3;
  5166.  
  5167. !    INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 4 DO
  5168.     INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 2 DO
  5169.     PUTMSG_VECTOR [.I + 2] = .(SIGARGLST [CHF$L_SIG_ARG1] + (.I*4));
  5170.  
  5171.     Final_Status = .Putmsg_Vector [1];
  5172.     $PUTMSG (MSGVEC = PUTMSG_VECTOR, ACTRTN = HANDLE_MSG, FACNAM = FACILITY_DESC);
  5173.     RETURN SS$_CONTINUE;
  5174.     END;                    ! End of KERM_HANDLER
  5175. %SBTTL 'End of KERMIT.B32'
  5176. END                        ! End of module
  5177.  
  5178. ELUDOM
  5179.