home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / i86ker.plm < prev    next >
Text File  |  2020-01-01  |  178KB  |  4,822 lines
  1. I86KER.PLM -- Kermit for Intel System 86/380 with iRMX-86:
  2.  
  3. The files for this Kermit program are concatenated together into one file.
  4. Each file starts with a line like this:
  5.  
  6. /* [---name---] */
  7.  
  8. The program was contributed by Bob Stanis of the Office of Computer Services,
  9. Grinnell College, POB 805, Grinnell, Iowa 50112-0810, Phone 515-236-2570.
  10.  
  11. The file ends with the line
  12.  
  13. /* [---End of I86KER.PLM---] */
  14.  
  15. Use a text editor to discard this and the above lines and separate the files.
  16.  
  17. /* [---KERMIT.CSD---] */
  18. ;       KERMIT.CSD  (AJG, 6-June-85)
  19. ; This command file is used to compile and link Kermit.
  20. ; Invoke it with the command
  21. ;           SUBMIT KERMIT.CSD
  22. ; (All Kermit files are assumed to be in the default directory.)
  23. ;
  24. ; Compile all Kermit modules:
  25. PLM86   KERMIT.P86
  26. PLM86   KERUTIL.P86
  27. PLM86   KERSYS.P86
  28. ; Link the Kermit modules together and to the system interface libraries:
  29. LINK86  KERMIT.OBJ,            &
  30.         KERUTIL.OBJ,           &
  31.         KERSYS.OBJ,            &
  32.         /RMX86/LIB/HPIFL.LIB,  &
  33.         /RMX86/LIB/LPIFL.LIB,  &
  34.         /RMX86/LIB/EPIFL.LIB,  &
  35.         /RMX86/LIB/IPIFL.LIB,  &
  36.         /RMX86/LIB/RPIFL.LIB   &
  37. TO      KERMIT  OBJECTCONTROLS(PURGE)  BIND  &
  38.         SEGSIZE(STACK(+800H))  MEMPOOL(+1000H,+50000H)
  39. ;
  40. ; generate ITEMIZE program used by human interface
  41. ;
  42. PLM86   ITEMIZE.P86
  43. ; Link the module together with the system interface libraries:
  44. LINK86  ITEMIZE.OBJ,           &
  45.         RMX86/LIB/HPIFL.LIB,   &
  46.         RMX86/LIB/LPIFL.LIB,   &
  47.         RMX86/LIB/EPIFL.LIB,   &
  48.         RMX86/LIB/IPIFL.LIB,   &
  49.         RMX86/LIB/RPIFL.LIB,   &
  50. TO      ITEMIZE  OBJECTCONTROLS(PURGE)  BIND  &
  51.         SEGSIZE(STACK(+800H))  MEMPOOL(+1000H,+50000H)
  52. ;
  53. ; Finished.  Kermit may now be run by typing KERMIT.
  54. ;
  55.  
  56. /* [---KERMIT.HLP---] */
  57. ~ iRMX-86 Kermit help library file (by Albert J. Goodman, revised 6-June-85)
  58. This is iRMX-86 Kermit, a file transfer utility.  It can be used to
  59. transfer text files to or from any system which has an implementation
  60. of Kermit, as well as to make this system act as a "virtual terminal"
  61. to a remote system.  Refer to the Kermit Users Guide for general
  62. information about Kermit.
  63.  
  64. To obtain a list of commands type ? and press [RETURN] at the Kermit
  65. prompt.  Similarly, any keyword in a command may be replaced by a ?
  66. to obtain a list of possible keywords which may go in that position.
  67. The only exceptions are the SEND and GET commands; anything following
  68. these commands (including a single ?) is treated as a filespec (file
  69. specification).  Any command or keyword may be abbreviated as long as
  70. it is unambiguous.  To obtain detailed help on any command type HELP
  71. followed by the name of the command.
  72. ~1~EXIT
  73. The EXIT command is used to leave the Kermit program and return
  74. to the local operating system.  It has no effect on the remote
  75. system.
  76. ~1~SEND
  77. The SEND command is used to send one or more files to the remote system.
  78. Before giving the SEND command you should have given a RECEIVE or SERVER
  79. command to the remote Kermit.  The word SEND should be followed by the
  80. name(s) of the file(s) to be sent.  Normally one name is given, possibly
  81. with wild-cards to specify more than one file:  a "?" will match any
  82. single character in its position and a "*" will match any number of
  83. characters (including zero).  Thus, for example, the command "SEND ?"
  84. will send all files with one-letter names and the command "SEND *" will
  85. send all files (in the default directory).  You may also specify more
  86. than one file name, but if you do so you must separate the names with
  87. commas and you must NOT include any spaces before or after the commas.
  88. A directory pathname or logical name (enclosed in colons) may preceed
  89. any filename.  The filename (but not the directory if specified) will be
  90. sent to the remote Kermit to allow the file to be stored with the same
  91. name on the remote system.  (You can expect a short delay after giving
  92. the SEND command before seeing the first message telling you what file
  93. is being sent.)
  94. ~1~RECEIVE
  95. The RECEIVE command is used to receive files being sent by the
  96. remote Kermit.  Before giving the RECEIVE command you should have
  97. given a SEND command to the remote Kermit.  If you wish to get
  98. files from a Kermit server you should use the GET command.
  99.  
  100. RECEIVE will display the name of each file as it receives it,
  101. and it will store the files, under the name sent by the remote
  102. Kermit, in your current default directory.
  103. ~1~GET
  104. The GET command is used to request a remote Kermit server to send
  105. files to the local system.  To receive files from a remote Kermit
  106. which is not a server you must use the RECEIVE command.
  107. GET must be followed by the filespec for the files on the remote
  108. system.  Whether this filespec may contain wild-cards to get
  109. more than one file with a single command (and in fact the entire
  110. form of the filespec) depends on the remote Kermit.
  111.  
  112. GET will display the name of each file received and store the
  113. files, under the name sent by the remote Kermit, in your current
  114. default directory.
  115. ~1~CONNECT
  116. The CONNECT command is used to make Kermit act as a "virtual terminal"
  117. to the remote system.  After this command is given your terminal will
  118. behave exactly like a terminal directly connected to the remote system,
  119. except for the "escape" character (see HELP CONNECT Escape).  Even the
  120. break key will function to send a break signal to the remote system.
  121. CONNECT is usually used to log on to the remote system and start up
  122. the remote Kermit to allow a file transfer operation to begin.  To
  123. leave connect mode and resume talking to the local Kermit, press the
  124. escape character followed by the letter C.
  125. ~2~Escape-character
  126. The escape character is used to talk to the local Kermit while in
  127. connect mode.  By default it is <Ctrl-]> (which means to hold down
  128. the "control" key while pressing the right bracket key "]"), but
  129. it may be changed if necessary by the SET ESCAPE command.  It
  130. should be something not usually used in communication with the
  131. remote system.
  132.  
  133. When the escape character is pressed, the local Kermit looks at the
  134. next character typed to determine what action to take.
  135.   If the next character is:          Kermit will:
  136.     C (in upper or lower case)    Close the connection, returning you
  137.                                   to the local Kermit's command level.
  138.     the escape character again    Send the escape character itself
  139.                                   to the remote system.
  140.     ? (or in fact anything else)  Display a brief message summarizing
  141.                                   these options and continue the
  142.                                   connection.
  143. If nothing is typed after the escape character for about 5 seconds,
  144. Kermit will act as if a ? was typed.
  145. ~1~BYE
  146. The BYE command is only used after exchanging files with a remote
  147. Kermit server.  It tells the remote server to shut down and log
  148. itself out.  After receiving an acknowledgement that this is being
  149. done, iRMX-86 Kermit will exit to the local operating system.  (BYE
  150. is equivalent to LOGOUT followed by EXIT.)  This prevents the need
  151. to connect back to the remote system to log out.
  152. ~1~LOGOUT
  153. The LOGOUT command is only used after exchanging files with a remote
  154. Kermit server.  It tells the remote server to shut down and log
  155. itself out.  After receiving an acknowledgement that this is being
  156. done, iRMX-86 Kermit will say "Ok" and prompt for another command.
  157. This prevents the need to connect back to the remote system to log
  158. out.  This command is similar to BYE but leaves you at the local
  159. Kermit command level.
  160. ~1~FINISH
  161. The FINISH command is only used after exchanging files with a remote
  162. Kermit server.  It tells the remote server to shut down (stop behaving
  163. as a server) but not to log out.  Thus you may follow this command
  164. with CONNECT and you will be able to give further commands to the
  165. remote system.
  166. ~1~SET
  167. The SET command is used to set various flags and parameters which
  168. affect how iRMX-86 Kermit behaves.
  169. ~2~BEEP
  170. This determines whether Kermit will beep to alert you that it
  171. has finished a file transfer.  If BEEP is set ON, Kermit will
  172. beep after finishing, either successfully or unsuccessfuly, any
  173. SEND, RECEIVE, or GET command.  If BEEP is set OFF you will
  174. not hear any beeps.  The initial state is BEEP ON.
  175. ~2~DEBUG
  176. This determines whether debugging information is displayed on
  177. the screen.  If DEBUG is set ON, each packet sent or received
  178. will be displayed on the screen.  DEBUG is normally OFF.
  179. ~2~ESCAPE
  180. This command sets the escape character used in CONNECT to
  181. get the attention of the local Kermit.  SET ESCAPE must
  182. be followed by a decimal number representing the ASCII
  183. value of the new escape character desired.  (The default
  184. escape character, <Ctrl-]>, is ASCII 29.)  See HELP CONNECT
  185. Escape-character for more information about the escape
  186. character.
  187. ~2~RETRY
  188. This command sets the maximum number of times iRMX-86 Kermit
  189. will attempt to send or receive a packet before giving up
  190. and aborting the operation.  SET RETRY must be followed by a
  191. decimal number.  Typical values are in the range 5 to 20;
  192. the initial value is 10.
  193. ~2~PACKET-LENGTH
  194. This command sets the maximum-length packet for Kermit to
  195. send.  Actually, this value will not necessarily be used;
  196. iRMX-86 Kermit will send packets up to the size requested
  197. by the remote Kermit.  Note that PACKET-LENGTH must NOT be
  198. set greater than 94!  (It usually does not need to be set
  199. at all.)
  200. ~2~TIMEOUT
  201. This command sets the number of seconds to wait for a
  202. character from the remote system.  (If no character is
  203. received within this time limit, the packet is assumed
  204. lost but the entire operation is not terminated unless
  205. this occurs a certain number of times--see HELP SET RETRY.)
  206. SET TIMEOUT must be follwed by the number of seconds
  207. desired (in decimal).  Typical values are in the range 5 to
  208. 15; the intial value is 10.  This parameter may be modified
  209. during a transaction by the remote Kermit, but may need
  210. to be set to get the first packet across.
  211. ~2~PADDING
  212. This command sets the number of padding characters to
  213. send between packets.  It must be follwed by a decimal
  214. number.  The intial (and typical) value is zero.  This
  215. parameter may be modified during a transaction by the
  216. remote Kermit, but may need to be set to get the first
  217. packet across.
  218. ~2~PADCHAR
  219. This command sets the padding character to be sent
  220. between packets (if any padding is needed--see HELP
  221. SET PADDING).  It must be followed by a decimal number
  222. representing the ASCII value of the character desired.
  223. The initial (and typical) value is ASCII 0, a null.
  224. This parameter may be modified during a transaction
  225. by the remote Kermit, but may need to be set to get
  226. the first packet across.
  227. ~2~END-OF-LINE
  228. This command sets the "end-of-line" character sent
  229. after each packet.  SET END-OF-LINE must be followed
  230. by a decimal number giving the ASCII value of the
  231. character desired.  The typical and initial value
  232. is ASCII 13, a carriage-return.  This parameter may
  233. be modified during a transaction by the remote Kermit,
  234. but may need to be set to get the first packet across.
  235. ~2~QUOTE
  236. This command sets the prefix quoting character used
  237. to "quote" control characters in the files being sent.
  238. SET QUOTE must be follwed by a decimal number giving
  239. the ASCII value of the desired character.  Normally
  240. the quote character is "#", ASCII 35.  This can be
  241. changed by the remote Kermit during a transaction, and
  242. should only be set if necessary to get the first packet
  243. across.
  244. ~1~SHOW
  245. The SHOW command can display the current value of
  246. any parameter which may be set by the SET command,
  247. as well as the version identification of Kermit.
  248. ~2~VERSION
  249. This command is used to display the version of Kermit
  250. which you are running.  It displays the same line which
  251. is displayed upon first entering the Kermit program,
  252. which includes this Kermit's name, version number,
  253. date of last modification, and initials of the author.
  254. ~2~BEEP
  255. This displays the current state of the BEEP flag.
  256. See HELP SET BEEP for more information.
  257. ~2~DEBUG
  258. This displays the current state of the debug-mode
  259. flag.  See HELP SET DEBUG for more information
  260. about the debug-mode flag.
  261. ~2~ESCAPE
  262. This displays the current escape character used in
  263. CONNECT to talk to the local Kermit.  Both a
  264. representation of the charcter and its ASCII value
  265. are given.  The character representation is also
  266. displayed upon executing the CONNECT command.  See
  267. HELP CONNECT Escape-character for more information
  268. about the escape character.
  269. ~2~RETRY
  270. This displays the maximum number of retires which will
  271. currently be attempted on any packet.  See HELP SET
  272. RETRY for more information.
  273. ~2~PACKET-LENGTH
  274. This displays the current maximum packet length which
  275. Kermit will send.  See HELP SET PACKET-LENGTH for
  276. more information.
  277. ~2~TIMEOUT
  278. This displays the current number of seconds after which
  279. to time out (assume the current packet was lost) if no
  280. character is received.  See HELP SET TIMEOUT for more
  281. information.
  282. ~2~PADDING
  283. This displays the number of padding characters currently
  284. being sent between packets.  See HELP SET PADDING for
  285. more information.
  286. ~2~PADCHAR
  287. This displays the character currently being used for
  288. padding (if any padding is being done), both in character
  289. representation and its ASCII value.  See HELP SET PADCHAR
  290. for more information.
  291. ~2~END-OF-LINE
  292. This displays the current "end-of-line" character sent
  293. after each packet, both in character representation and
  294. its ASCII value.  See HELP SET END-OF-LINE for more
  295. information.
  296. ~2~QUOTE
  297. This displays the current control-quoting prefix character,
  298. both in character representation and its ASCII value.  See
  299. HELP SET QUOTE for more information.
  300. ~2~ALL
  301. This command is used to show all the information
  302. which SHOW can show with a single command.
  303. ~1~HELP
  304. The HELP command gives information to help in using Kermit.
  305. Simply typing HELP gives a general message; HELP followed by a
  306. command name gives help on that command.  Whenever you see "Further
  307. help available on:" you may get help on any of the topics listed
  308. by typing the HELP command you used to obtain that message followed
  309. by one of the keywords listed below it.  Any keyword in a HELP
  310. command may be abbreviated; if the abbreviation matches more than
  311. one keyword help will be displayed on the first matching one.
  312. ~1~Control-characters
  313. Control characters are typed by holding down the key marked
  314. "Control" or "Ctrl" while pressing another key.  They are usually
  315. written as CTRL/x (where x represents the other key) or <Ctrl-x>.
  316. You may use the normal comman line editing characters while
  317. entering commands to Kermit.  However, CTRL/C, which normally
  318. aborts the program, will have no effect while entering commands
  319. to Kermit.  It may be used, though, to abort any communication
  320. command (SEND, RECEIVE, GET, BYE, LOGOUT, FINISH) and return to
  321. the iRMX-86 Kermit prompt.
  322.  
  323. If you suspect that communication with the other Kermit is stuck,
  324. but you do not wish to entirely abort the process by pressing CTRL/C,
  325. you may press [RETURN]; this will cause Kermit to retry the current
  326. operation.  If you do this repeatedly and the operation still does
  327. not succeed, it will eventually reach the retry maximum and abort
  328. the process.
  329. ~1~Ports
  330. Version 2.3 of iRMX-86 Kermit assumes that the remote system is
  331. connected to T3 (the third serial port on the 534-board) and
  332. communicates through this port at 2400 baud (8 bits, no parity,
  333. one stop bit).  It also assumes that the console is on port T0
  334. unless the answer No is given to "Are you at the system console?"
  335. (which is asked immediately upon starting Kermit), in which case
  336. it assumes that the console is on port T4.
  337. ~1~Summary
  338. Program:            iRMX-86 Kermit
  339. Author:             Albert J. Goodman, Grinnell College
  340. Machine:            Intel System 86/380
  341. Operating system:   iRMX 86
  342. Language:           PL/M-86
  343. Version:            2.3
  344. Date:               June 6, 1985
  345.  
  346. iRMX-86 Kermit Capabilities At A Glance:
  347.  
  348.     Local operation:                    Yes
  349.     Remote operation:                   No
  350.     Transfers text files:               Yes
  351.     Transfers binary files:             No
  352.     Wildcard send:                      Yes
  353.     ^X/^Y interruption:                 No, but ^C interruption
  354.     Filename collision avoidance:       Yes
  355.     Can time out:                       Yes
  356.     8th-bit prefixing:                  No
  357.     Repeat count prefixing:             No
  358.     Alternate block checks:             No
  359.     Terminal emulation:                 Yes
  360.     Communication settings:             Only some packet parameters
  361.     Transmit BREAK:                     Yes
  362.     IBM mainframe communication:        No
  363.     Transaction logging:                No
  364.     Session logging:                    No
  365.     Raw transmit:                       No
  366.     Act as server:                      No
  367.     Talk to server:                     Yes
  368.     Advanced server functions:          No
  369.     Advanced commands for servers:      No
  370.     Local file management:              No
  371.     Handle file attributes:             No
  372.     Command/init files:                 No
  373.     Command macros:                     No
  374. ~END~
  375. /* [---KERMIT.P86---] */
  376. $large
  377.  
  378. Kermit: do;
  379.  
  380. /*
  381.  *      K e r m i t   File Transfer Utility
  382.  *
  383.  *      iRMX-86 Kermit, Version 2.3
  384.  *      by Albert J. Goodman, Grinnell College
  385.  *
  386.  *    Copyright (C), Grinnell College
  387.  *    All Rights Reserved
  388.  *
  389.  *      The Kermit protocol is copyrighted by Columbia University and
  390.  *    probably Frank da Cruz.  We like his approach to publicly
  391.  *    available programs.
  392.  *
  393.  *    This version of Kermit may be used or modified by anyone who
  394.  *    wishes to do so, as long as a profit by the sale or lease of
  395.  *    this program.  I think you understand the intent, please don't
  396.  *    work around it with some legal mumbo-jumbo.  Please send any 
  397.  *    changes to the following address:
  398.  *
  399.  *    Computer Services
  400.  *    Noyce Computer Center
  401.  *    Grinnell College
  402.  *    Grinnell, IA  50112
  403.  *
  404.  *    This program was developed on an Intel System 86/380 which was
  405.  *    donated by the Intel Corporation.  Their generosity is greatly
  406.  *    appreciated.
  407.  *
  408.  *      Main module, containg the main program and all commands.
  409.  *
  410.  *    Version:  Date:        Reason (Programmer)
  411.  *    2.3     02-Jun-85    Original. (Albert J. Goodman)
  412.  */
  413.  
  414.  
  415. declare
  416.                 /* CONSTANTS */
  417.  
  418.             /* Useful text substitutions */
  419.     boolean                 literally   'byte',     /* define a new type */
  420.     TRUE                    literally   '0FFh',     /* and constants */
  421.     FALSE                   literally   '000h',     /*  of that type */
  422.     forever                 literally   'while TRUE',   /* a WHILE condition */
  423.  
  424.             /* ASCII control character constants */
  425.     NUL                     literally   '00h',  /* null */
  426.     SOH                     literally   '01h',  /* start-of-header */
  427.     CTRL$C                  literally   '03h',  /* CTRL/C */
  428.     BEL                     literally   '07h',  /* bell (beep) */
  429.     BS                      literally   '08h',  /* backspace */
  430.     HT                      literally   '09h',  /* horizontal tab */
  431.     LF                      literally   '0Ah',  /* line-feed */
  432.     CR                      literally   '0Dh',  /* carriage-return */
  433.     CTRL$R$BRAK             literally   '1Dh',  /* CTRL/] */
  434.     DEL                     literally   '7Fh',  /* delete (rubout) */
  435.  
  436.             /* String constants */
  437.     sign$on(*)              byte data( 47,
  438.         'iRMX-86 Kermit, Version 2.3  (AJG, 2-June-85)',CR,LF ),
  439.     prompt(*)               byte data( 16, 'iRMX-86 Kermit> ' ),
  440.     dots$string(*)          byte data( 7, ' . . . ' ),
  441.     ok$string(*)            byte data( 2, 'Ok' ),
  442.     currently$string(*)     byte data( 14, ' is currently ' ),
  443.  
  444.             /* Defaults for various Kermit parameters */
  445.     def$esc$char            literally   'CTRL$R$BRAK',
  446.     def$max$retry           literally   '10',
  447.     def$packet$len          literally   '80',
  448.     def$time$limit          literally   '10',
  449.     def$num$pad             literally   '0',
  450.     def$pad$char            literally   'NUL',
  451.     def$eol                 literally   'CR',
  452.     def$quote               literally   '''#''',
  453.  
  454.             /* GET$CONSOLE$CHAR return codes (see KERMIT$SYS) */
  455.     TIMEOUT                 literally   '0FFFFh',   /* Time limit expired */
  456.     BREAK                   literally   '08000h',   /* Break key */
  457.  
  458.             /* Other constants */
  459.     MAX$PACKET$LEN          literally   '94',
  460.     CONNECT$ESC$TIME$LIMIT  literally   '5',
  461.  
  462.  
  463.                 /* GLOBAL VARIABLES */
  464.  
  465.             /* Kermit parameters */
  466.     beep        boolean,        /* Whether to beep when finished */
  467.     debug       boolean public, /* Whether we're debugging the program */
  468.     max$retry   byte public,    /* Maximum number of times to retry a packet */
  469.     packet$len  byte public,    /* The maximum length packet to send */
  470.     time$limit  byte public,    /* Seconds to time out if nothing received */
  471.     num$pad     byte public,    /* The number of padding characters to send */
  472.     pad$char    byte public,    /* The padding character to send */
  473.     eol         byte public,    /* The EOL (end-of-line) character to send */
  474.     quote       byte public,    /* The control-quote character to be used */
  475.     esc$char    byte,   /* The "escape" character for CONNECT */
  476.  
  477.             /* Other Kermit variables */
  478.     state       byte public,  /* Current state (see Kermit Protocol Manual) */
  479.     seq         byte public,    /* The current sequence number (0 to 63) */
  480.     tries       byte public,    /* Number of times current packet retried */
  481.  
  482.             /* Buffers */
  483.     info        structure(      /* Buffer for the contents of a packet */
  484.                     len                 byte,
  485.                     ch(MAX$PACKET$LEN)  byte),
  486.     info2       structure(      /* Another packet buffer */
  487.                     len                 byte,
  488.                     ch(MAX$PACKET$LEN)  byte),
  489.  
  490.             /* Possible command keywords */
  491.     q$mark(*)               byte data( 1, '?' ),
  492.     exit$string(*)          byte data( 4, 'EXIT' ),
  493.     help$string(*)          byte data( 4, 'HELP' ),
  494.     send$string(*)          byte data( 4, 'SEND' ),
  495.     receive$string(*)       byte data( 7, 'RECEIVE' ),
  496.     get$string(*)           byte data( 3, 'GET' ),
  497.     connect$string(*)       byte data( 7, 'CONNECT' ),
  498.     bye$string(*)           byte data( 3, 'BYE' ),
  499.     logout$string(*)        byte data( 6, 'LOGOUT' ),
  500.     finish$string(*)        byte data( 6, 'FINISH' ),
  501.     set$string(*)           byte data( 3, 'SET' ),
  502.     show$string(*)          byte data( 4, 'SHOW' ),
  503.     beep$string(*)          byte data( 4, 'BEEP' ),
  504.     debug$string(*)         byte data( 5, 'DEBUG' ),
  505.     on$string(*)            byte data( 2, 'ON' ),
  506.     off$string(*)           byte data( 3, 'OFF' ),
  507.     escape$string(*)        byte data( 6, 'ESCAPE' ),
  508.     retry$string(*)         byte data( 5, 'RETRY' ),
  509.     packet$len$string(*)    byte data( 13, 'PACKET-LENGTH' ),
  510.     timeout$string(*)       byte data( 7, 'TIMEOUT' ),
  511.     padding$string(*)       byte data( 7, 'PADDING' ),
  512.     padchar$string(*)       byte data( 7, 'PADCHAR' ),
  513.     end$of$line$string(*)   byte data( 11, 'END-OF-LINE' ),
  514.     quote$string(*)         byte data( 5, 'QUOTE' ),
  515.     version$string(*)       byte data( 7, 'VERSION' ),
  516.     all$string(*)           byte data( 3, 'ALL' ),
  517.  
  518.             /* Command and parameter lists */
  519.     command$list(*)         pointer data(
  520.                                         @exit$string,
  521.                                         @send$string,
  522.                                         @receive$string,
  523.                                         @get$string,
  524.                                         @connect$string,
  525.                                         @bye$string,
  526.                                         @logout$string,
  527.                                         @finish$string,
  528.                                         @set$string,
  529.                                         @show$string,
  530.                                         @help$string ),
  531.     set$param$list(*)       pointer data(
  532.                                         @beep$string,
  533.                                         @debug$string,
  534.                                         @escape$string,
  535.                                         @retry$string,
  536.                                         @packet$len$string,
  537.                                         @timeout$string,
  538.                                         @padding$string,
  539.                                         @padchar$string,
  540.                                         @end$of$line$string,
  541.                                         @quote$string ),
  542.     show$param$list(*)      pointer data(
  543.                                         @version$string,
  544.                                         @beep$string,
  545.                                         @debug$string,
  546.                                         @escape$string,
  547.                                         @retry$string,
  548.                                         @packet$len$string,
  549.                                         @timeout$string,
  550.                                         @padding$string,
  551.                                         @padchar$string,
  552.                                         @end$of$line$string,
  553.                                         @quote$string,
  554.                                         @all$string ),
  555.     on$off$list(*)          pointer data(
  556.                                         @on$string,
  557.                                         @off$string ),
  558.  
  559.             /* Comand parsing information (defined in KERMIT$UTIL) */
  560.     num$keywords    byte external;  /* Number of keywords found */
  561.  
  562.  
  563. /*      External procedures defined in KERMIT$SYS   */
  564.  
  565. get$console$char: procedure( time$limit ) word external;
  566.     declare
  567.         time$limit  word;
  568. end get$console$char;
  569.  
  570. xmit$console$char: procedure( ch ) external;
  571.     declare
  572.         ch  byte;
  573. end xmit$console$char;
  574.  
  575. get$remote$char: procedure( time$limit ) word external;
  576.     declare
  577.         time$limit  word;
  578. end get$remote$char;
  579.  
  580. xmit$remote$char: procedure( ch ) external;
  581.     declare
  582.         ch  byte;
  583. end xmit$remote$char;
  584.  
  585. xmit$break: procedure external;
  586. end xmit$break;
  587.  
  588. print: procedure( string$ptr ) external;
  589.     declare
  590.         string$ptr  pointer;
  591. end print;
  592.  
  593. new$line: procedure external;
  594. end new$line;
  595.  
  596. exit$program: procedure external;
  597. end exit$program;
  598.  
  599. setup: procedure external;
  600. end setup;
  601.  
  602. setup$for$communication: procedure external;
  603. end setup$for$communication;
  604.  
  605. finish$communication: procedure external;
  606. end finish$communication;
  607.  
  608. get$first$file$name: procedure( keyword$num, info$ptr ) external;
  609.     declare
  610.         keyword$num     byte,
  611.         info$ptr        pointer;
  612. end get$first$file$name;
  613.  
  614. get$next$file$name: procedure( info$ptr ) external;
  615.     declare
  616.         info$ptr    pointer;
  617. end get$next$file$name;
  618.  
  619. prepare$file$name: procedure( info$ptr ) external;
  620.     declare
  621.         info$ptr    pointer;
  622. end prepare$file$name;
  623.  
  624. open$file: procedure( name$ptr ) boolean external;
  625.     declare
  626.         name$ptr    pointer;
  627. end open$file;
  628.  
  629. create$file: procedure( name$ptr ) boolean external;
  630.     declare
  631.         name$ptr    pointer;
  632. end create$file;
  633.  
  634. close$file: procedure external;
  635. end close$file;
  636.  
  637. get$command$line: procedure( prompt$ptr ) external;
  638.     declare
  639.         prompt$ptr  pointer;
  640. end get$command$line;
  641.  
  642. do$help: procedure( num$params ) external;
  643.     declare
  644.         num$params  byte;
  645. end do$help;
  646.  
  647.  
  648. /*      External procedures defined in KERMIT$UTIL      */
  649.  
  650. upcase: procedure( x ) byte external;
  651.     declare
  652.         x   byte;
  653. end upcase;
  654.  
  655. next$seq: procedure( seq$num ) byte external;
  656.     declare
  657.         seq$num     byte;
  658. end next$seq;
  659.  
  660. previous$seq: procedure( seq$num ) byte external;
  661.     declare
  662.         seq$num     byte;
  663. end previous$seq;
  664.  
  665. show$char: procedure( ch ) external;
  666.     declare
  667.         ch  byte;
  668. end show$char;
  669.  
  670. show$dec$num: procedure( num ) external;
  671.     declare
  672.         num     word;
  673. end show$dec$num;
  674.  
  675. show$flag: procedure( flag ) external;
  676.     declare
  677.         flag    boolean;
  678. end show$flag;
  679.  
  680. send$packet: procedure( type, num, info$ptr ) external;
  681.     declare
  682.         ( type, num )   byte,
  683.         info$ptr        pointer;
  684. end send$packet;
  685.  
  686. receive$packet: procedure( num$ptr, info$ptr ) byte external;
  687.     declare
  688.         ( num$ptr, info$ptr )   pointer;
  689. end receive$packet;
  690.  
  691. send$kermit$params: procedure( info$ptr ) external;
  692.     declare
  693.         info$ptr    pointer;
  694. end send$kermit$params;
  695.  
  696. get$kermit$params: procedure( info$ptr ) external;
  697.     declare
  698.         info$ptr    pointer;
  699. end get$kermit$params;
  700.  
  701. read$packet$from$file: procedure( info$ptr ) external;
  702.     declare
  703.         info$ptr    pointer;
  704. end read$packet$from$file;
  705.  
  706. write$packet$to$file: procedure( info$ptr ) external;
  707.     declare
  708.         info$ptr    pointer;
  709. end write$packet$to$file;
  710.  
  711. error$msg: procedure( msg$ptr ) external;
  712.     declare
  713.         msg$ptr     pointer;
  714. end error$msg;
  715.  
  716. unknown$packet$type: procedure( type, packet$ptr ) external;
  717.     declare
  718.         type        byte,
  719.         packet$ptr  pointer;
  720. end unknown$packet$type;
  721.  
  722. too$many$retries: procedure external;
  723. end too$many$retries;
  724.  
  725. wrong$number: procedure external;
  726. end wrong$number;
  727.  
  728. parse$command: procedure external;
  729. end parse$command;
  730.  
  731. parse$dec$num: procedure( keyword$num, num$ptr ) boolean external;
  732.     declare
  733.         keyword$num     byte,
  734.         num$ptr         pointer;
  735. end parse$dec$num;
  736.  
  737. show$command: procedure( kp1, kp2, kp3 ) external;
  738.     declare
  739.         ( kp1, kp2, kp3 )   pointer;
  740. end show$command;
  741.  
  742. too$few$params: procedure( kp1, kp2, kp3 ) external;
  743.     declare
  744.         ( kp1, kp2, kp3 )   pointer;
  745. end too$few$params;
  746.  
  747. too$many$params: procedure( kp1, kp2, kp3 ) external;
  748.     declare
  749.         ( kp1, kp2, kp3 )   pointer;
  750. end too$many$params;
  751.  
  752. extra$params: procedure( kp1, kp2, kp3 ) external;
  753.     declare
  754.         ( kp1, kp2, kp3 )   pointer;
  755. end extra$params;
  756.  
  757. invalid$param: procedure( k$num, kp1, kp2, kp3 ) external;
  758.     declare
  759.         k$num               byte,
  760.         ( kp1, kp2, kp3 )   pointer;
  761. end invalid$param;
  762.  
  763. keyword$match: procedure( keyword$num, keyword$ptr, min$len ) boolean external;
  764.     declare
  765.         ( keyword$num, min$len )    byte,
  766.         keyword$ptr                 pointer;
  767. end keyword$match;
  768.  
  769. list$choices: procedure( kp1, kp2, kp3, list$ptr, list$last ) external;
  770.     declare
  771.         ( kp1, kp2, kp3, list$ptr )     pointer,
  772.         list$last                       byte;
  773. end list$choices;
  774.  
  775. get$filespec: procedure( keyword$num, info$ptr ) external;
  776.     declare
  777.         keyword$num     byte,
  778.         info$ptr        pointer;
  779. end get$filespec;
  780.  
  781. send$generic$command: procedure( info$ptr, info2$ptr ) boolean external;
  782.     declare
  783.         ( info$ptr, info2$ptr )     pointer;
  784. end send$generic$command;
  785.  
  786.  
  787. /*
  788.  *
  789.  *      Command implementation procedures
  790.  *
  791.  */
  792.  
  793.  
  794. exit: procedure;
  795.  
  796.     /*
  797.      *  Implement the EXIT command.
  798.      */
  799.  
  800.     if ( num$keywords > 1 ) then    /* a parameter followed EXIT */
  801.         call too$many$params( @exit$string, 0, 0 );
  802.     else
  803.         call exit$program;
  804.  
  805. end exit;
  806.  
  807.  
  808. connect: procedure;
  809.  
  810.     /*
  811.      *  Implement the CONNECT command by performing as a virtual
  812.      *  terminal to the remote system.  Everything coming from the
  813.      *  remote computer is sent out to the console screen, and
  814.      *  everything typed on the console keyboard, except for the
  815.      *  "escape" character, is passed through to the remote system.
  816.      *  Even the break key may be pressed on the console terminal
  817.      *  and a break signal will be sent to the remote system.
  818.      *      The escape character is <Ctrl-]> by default; it can be
  819.      *  set by the SET ESCAPE command.
  820.      *      If the escape character is followed by "C" (in upper or
  821.      *  lower case) the connection is closed and you are returned to
  822.      *  the local Kermit's command level.
  823.      *      If the escape character is followed by itself (i.e. it
  824.      *  is typed twice) it will be sent (once) to the remote system,
  825.      *  since this is the only way to send the escape character to
  826.      *  the remote system in CONNECT.
  827.      *      If the escape character is followed by anything else, or
  828.      *  if nothing is typed on the console within CONNECT$ESC$TIME$LIMIT
  829.      *  seconds after the escape character, a message will be displayed
  830.      *  explaining the options and the connection will be continued.
  831.      */
  832.  
  833.     declare
  834.         keep$connected  boolean,
  835.         ch              word;   /* Current character (or TIMEOUT) */
  836.  
  837.     if ( num$keywords > 1 ) then    /* a parameter followed CONNECT */
  838.         call too$many$params( @connect$string, 0, 0 );
  839.     else
  840.       do;
  841.         call setup$for$communication;   /* Prepare to communicate */
  842.         /* Keep the user informed of what we're doing */
  843.         call print( @( 37,'[ Connecting to remote system; type "' ) );
  844.         call show$char( esc$char );
  845.         call print( @( 31,'C" to return to local Kermit. ]' ) );
  846.         call new$line;
  847.         call new$line;  /* Leave a blank line */
  848.  
  849.         /* begin the virtual terminal loop */
  850.         keep$connected = TRUE;
  851.         do while ( keep$connected );
  852.             /* Get the next character (if any) from the remote system */
  853.             ch = get$remote$char( 0 );  /* don't wait */
  854.             if ( ch <> TIMEOUT ) then   /* we got a character */
  855.                 call xmit$console$char( ch ); /* so print it on the console */
  856.             /* Get the next character (if any) from the console */
  857.             ch = get$console$char( 0 ); /* don't wait */
  858.             if ( ch <> TIMEOUT ) then   /* we got a character */
  859.               do;   /* Handle the console character */
  860.                 if ( ch = esc$char ) then   /* we got the escape character */
  861.                   do;   /* Handle the escape sequence */
  862.                     /* Get the next character from the console */
  863.                     ch = get$console$char( CONNECT$ESC$TIME$LIMIT );
  864.                     if ( upcase( ch ) = 'C' ) then  /* If it was C */
  865.                         keep$connected = FALSE;     /* Close the connection */
  866.                     else if ( ch = esc$char ) then  /* They typed it twice */
  867.                         /* Send the escape character to the remote system */
  868.                         call xmit$remote$char( esc$char );
  869.                     else    /* Otherwise tell them what's going on */
  870.                       do;
  871.                         call new$line;
  872.                         call print( @( 19,'[ You are connected' ) );
  873.                         call print( @( 22,' to the remote system.' ) );
  874.                         call new$line;
  875.                         call print( @( 8,'  Type "' ) );
  876.                         call show$char( esc$char );
  877.                         call print( @( 25,'C" to return to the local' ) );
  878.                         call print( @( 24,' Kermit''s command level.' ) );
  879.                         call new$line;
  880.                         call print( @( 8,'  Type "' ) );
  881.                         call show$char( esc$char );
  882.                         call show$char( esc$char );
  883.                         call print( @( 12,'" to send a ' ) );
  884.                         call show$char( esc$char );
  885.                         call print( @( 22,' to the remote system.' ) );
  886.                         call new$line;
  887.                         call print( @( 8,'  Type "' ) );
  888.                         call show$char( esc$char );
  889.                         call print( @( 23,'?" to see this message.' ) );
  890.                         call new$line;
  891.                         call print( @( 26,'  Connection continuing. ]' ) );
  892.                         call new$line;
  893.                       end;  /* else */
  894.                   end;  /* if ( ch = esc$char ) */
  895.                 else if ( ch = BREAK ) then     /* we got the break key */
  896.                     call xmit$break;    /* so send a break signal out */
  897.                 else    /* we got an ordinary character from the console */
  898.                     call xmit$remote$char( ch ); /* Send it to remote system */
  899.               end;  /* if ( ch <> TIMEOUT ) */
  900.         end;    /* do while ( keep$connected ) */
  901.  
  902.         /* Keep the user informed */
  903.         call new$line;
  904.         call print( @( 21,'[ Connection closed, ' ) );
  905.         call print( @( 23,'back at local Kermit. ]' ) );
  906.         call finish$communication;  /* And restore everything */
  907.       end;  /* else -- no parameter */
  908.  
  909. end connect;
  910.  
  911.  
  912. bye: procedure;
  913.  
  914.     /*
  915.      *  Implement the BYE command.
  916.      */
  917.  
  918.     if ( num$keywords > 1 ) then    /* a parameter followed BYE */
  919.         call too$many$params( @bye$string, 0, 0 );
  920.     else
  921.       do;   /* Perform the BYE command */
  922.         call setup$for$communication;
  923.         /* Send Generic Kermit Logout/bye command */
  924.         if send$generic$command( @( 1,'L' ), @info2 ) then
  925.             call exit$program;  /* ACK'd O.K., so exit the program--bye! */
  926.         call finish$communication;
  927.         call new$line;
  928.         call error$msg( @( 15,'Command failed.' ) );
  929.       end;  /* else */
  930.  
  931. end bye;
  932.  
  933.  
  934. finish: procedure;
  935.  
  936.     /*
  937.      *  Implement the FINISH command.
  938.      */
  939.  
  940.     if ( num$keywords > 1 ) then
  941.         call too$many$params( @finish$string, 0, 0 );
  942.     else
  943.       do;
  944.         call setup$for$communication;
  945.         /* Send Generic Kermit Finish command */
  946.         if send$generic$command( @( 1,'F' ), @info2 ) then
  947.             call print( @ok$string );  /* tell them it went O.K. */
  948.         else
  949.           do;
  950.             call new$line;
  951.             call error$msg( @( 15,'Command failed.' ) );
  952.           end;
  953.         call finish$communication;
  954.       end;  /* else */
  955.  
  956. end finish;
  957.  
  958.  
  959. logout: procedure;
  960.  
  961.     /*
  962.      *  Implement the LOGOUT command.
  963.      */
  964.  
  965.     if ( num$keywords > 1 ) then
  966.         call too$many$params( @logout$string, 0, 0 );
  967.     else
  968.       do;
  969.         call setup$for$communication;
  970.         /* Send the Generic Kermit Logout command */
  971.         if send$generic$command( @( 1,'L' ), @info2 ) then
  972.             call print( @ok$string );  /* tell them it went O.K. */
  973.         else
  974.           do;
  975.             call new$line;
  976.             call error$msg( @( 15,'Command failed.' ) );
  977.           end;
  978.         call finish$communication;
  979.       end;  /* else */
  980.  
  981. end logout;
  982.  
  983.  
  984. help: procedure;
  985.  
  986.     /*
  987.      *  Implement the HELP command.
  988.      */
  989.  
  990.     /* Invoke the HELP program */
  991.     call do$help( num$keywords - 1 );
  992.  
  993. end help;
  994.  
  995.  
  996. set: procedure;
  997.  
  998.     /*
  999.      *  Implement the SET command by dispatching to the appropriate
  1000.      *  routine based on the second keyword (the parameter following SET).
  1001.      */
  1002.  
  1003.     set$flag: procedure( kp2, flag$ptr );
  1004.  
  1005.         /*
  1006.          *  SET a flag.  KP2 points to the flag's name and
  1007.          *  FLAG$PTR points the the boolean variable to be set.
  1008.          *  ON means set the flag TRUE, OFF means FALSE.
  1009.          */
  1010.  
  1011.         declare
  1012.             ( kp2, flag$ptr )   pointer,
  1013.             flag based flag$ptr boolean;
  1014.  
  1015.         if ( num$keywords < 3 ) then
  1016.             call too$few$params( @set$string, kp2, 0 );
  1017.         else if ( num$keywords > 3 ) then
  1018.             call extra$params( @set$string, kp2, 0 );
  1019.         else if keyword$match( 2, @q$mark, 1 ) then
  1020.             call list$choices( @set$string, kp2, 0,
  1021.                                 @on$off$list, last( on$off$list ) );
  1022.         else if keyword$match( 2, @on$string, 2 ) then
  1023.           do;
  1024.             flag = TRUE;
  1025.             call print( @ok$string );
  1026.           end;
  1027.         else if keyword$match( 2, @off$string, 2 ) then
  1028.           do;
  1029.             flag = FALSE;
  1030.             call print( @ok$string );
  1031.           end;
  1032.         else
  1033.             call invalid$param( 2, @set$string, kp2, 0 );
  1034.  
  1035.     end set$flag;
  1036.  
  1037.  
  1038.     set$byte: procedure( kp2, byte$ptr );
  1039.  
  1040.         /*
  1041.          *  SET a byte variable.  KP2 points to its name, BYTE$PTR
  1042.          *  points to the byte variable.  A decimal number is used.
  1043.          */
  1044.  
  1045.         declare
  1046.             ( kp2, byte$ptr )   pointer,
  1047.             num based byte$ptr  byte,
  1048.             new$num             word;
  1049.  
  1050.         if ( num$keywords < 3 ) then
  1051.             call too$few$params( @set$string, kp2, 0 );
  1052.         else if ( num$keywords > 3 ) then
  1053.             call extra$params( @set$string, kp2, 0 );
  1054.         else if keyword$match( 2, @q$mark, 1 ) then
  1055.           do;
  1056.             call show$command( @set$string, kp2, 0 );
  1057.             call print( @( 38,' must be followed by a decimal number.' ) );
  1058.           end;  /* if keyword$match( 2, @q$mark, 1 ) */
  1059.         else
  1060.           do;
  1061.             if ( parse$dec$num( 2, @new$num ) ) then
  1062.               do;
  1063.                 num = new$num;
  1064.                 call print( @ok$string );
  1065.               end;  /* if -- valid number */
  1066.             else
  1067.                 call invalid$param( 2, @set$string, kp2, 0 );
  1068.           end;  /* else */
  1069.  
  1070.     end set$byte;
  1071.  
  1072.  
  1073.     /* begin SET */
  1074.     if ( num$keywords < 2 ) then    /* there was no second keyword */
  1075.         call too$few$params( @set$string, 0, 0 );
  1076.     else if keyword$match( 1, @q$mark, 1 ) then
  1077.         call list$choices( @set$string, 0, 0,
  1078.                                 @set$param$list,
  1079.                                 last( set$param$list ) );
  1080.     else if keyword$match( 1, @escape$string, 2 ) then
  1081.         call set$byte( @escape$string, @esc$char );
  1082.     else if keyword$match( 1, @beep$string, 1 ) then
  1083.         call set$flag( @beep$string, @beep );
  1084.     else if keyword$match( 1, @debug$string, 1 ) then
  1085.         call set$flag( @debug$string, @debug );
  1086.     else if keyword$match( 1, @retry$string, 1 ) then
  1087.         call set$byte( @retry$string, @max$retry );
  1088.     else if keyword$match( 1, @packet$len$string, 3 ) then
  1089.         call set$byte( @packet$len$string, @packet$len );
  1090.     else if keyword$match( 1, @timeout$string, 1 ) then
  1091.         call set$byte( @timeout$string, @time$limit );
  1092.     else if keyword$match( 1, @padding$string, 4 ) then
  1093.         call set$byte( @padding$string, @num$pad );
  1094.     else if keyword$match( 1, @padchar$string, 4 ) then
  1095.         call set$byte( @padchar$string, @pad$char );
  1096.     else if keyword$match( 1, @end$of$line$string, 2 ) then
  1097.         call set$byte( @end$of$line$string, @eol );
  1098.     else if keyword$match( 1, @quote$string, 1 ) then
  1099.         call set$byte( @quote$string, @quote );
  1100.     else    /* unknown parameter */
  1101.         call invalid$param( 1, @set$string, 0, 0 );
  1102.  
  1103. end set;
  1104.  
  1105.  
  1106. show: procedure;
  1107.  
  1108.     /*
  1109.      *  Implement the SHOW command by dispatching to the appropriate
  1110.      *  routine based on the second keyword (the parameter after SHOW).
  1111.      */
  1112.  
  1113.     show$version: procedure;
  1114.  
  1115.         /*  Implement the SHOW VERSION command */
  1116.  
  1117.         if ( num$keywords > 2 ) then
  1118.             call too$many$params( @show$string, @version$string, 0 );
  1119.         else
  1120.           do;
  1121.             call print( @( 8,'This is ' ) );
  1122.             call print( @sign$on );
  1123.           end;
  1124.  
  1125.     end show$version;
  1126.  
  1127.  
  1128.     show$flag$value: procedure( kp2, flag$ptr );
  1129.  
  1130.         /*
  1131.          *  Show the value of a flag.  KP2 points to its name,
  1132.          *  and FLAG$PTR points to the boolean variable.
  1133.          */
  1134.  
  1135.         declare
  1136.             ( kp2, flag$ptr )   pointer,
  1137.             flag based flag$ptr boolean;
  1138.  
  1139.         if ( num$keywords > 2 ) then
  1140.             call too$many$params( @show$string, kp2, 0 );
  1141.         else
  1142.           do;
  1143.             call print( kp2 );
  1144.             call print( @currently$string );
  1145.             call show$flag( flag );
  1146.             call new$line;
  1147.           end;  /* else */
  1148.  
  1149.     end show$flag$value;
  1150.  
  1151.  
  1152.     show$byte: procedure( kp2, byte$ptr, char$flag, msg$ptr );
  1153.  
  1154.         /*
  1155.          *  SHOW a byte variable.  KP2 points to its keyword name,
  1156.          *  BYTE$PTR points to the byte itself, MSG$PTR points to
  1157.          *  the message to be displayed before its value, and
  1158.          *  CHAR$FLAG is TRUE if it is a character.
  1159.          */
  1160.  
  1161.         declare
  1162.             ( kp2, byte$ptr, msg$ptr )  pointer,
  1163.             char$flag                   boolean,
  1164.             num based byte$ptr          byte;
  1165.  
  1166.         if ( num$keywords > 2 ) then
  1167.             call too$many$params( @show$string, kp2, 0 );
  1168.         else
  1169.           do;
  1170.             call print( msg$ptr );
  1171.             call print( @currently$string );
  1172.             if ( char$flag ) then
  1173.               do;
  1174.                 call show$char( num );
  1175.                 call print( @( 8,', ASCII ' ) );
  1176.               end;  /* if ( char$flag ) */
  1177.             call show$dec$num( num );
  1178.             call print( @( 10,' (decimal)' ) );
  1179.             call new$line;
  1180.           end;  /* else */
  1181.  
  1182.     end show$byte;
  1183.  
  1184.  
  1185.     show$all: procedure;
  1186.  
  1187.         /*  Implement the SHOW ALL command. */
  1188.  
  1189.         if ( num$keywords > 2 ) then
  1190.             call too$many$params( @show$string, @all$string, 0 );
  1191.         else
  1192.           do;   /* show all the things we can show */
  1193.             call show$version;
  1194.             call show$flag$value( @beep$string, @beep );
  1195.             call show$flag$value( @debug$string, @debug );
  1196.             call show$byte( @escape$string, @esc$char, TRUE,
  1197.                 @( 34,'The "escape" character for CONNECT' ) );
  1198.             call show$byte( @retry$string, @max$retry, FALSE,
  1199.                 @( 31,'Maximum times to retry a packet' ) );
  1200.             call show$byte( @packet$len$string, @packet$len, FALSE,
  1201.                 @( 29,'Maximum length packet to send' ) );
  1202.             call show$byte( @timeout$string, @time$limit, FALSE,
  1203.                 @( 37,'Seconds to wait for receive character' ) );
  1204.             call show$byte( @padding$string, @num$pad, FALSE,
  1205.                 @( 36,'Number of padding characters to send' ) );
  1206.             call show$byte( @padchar$string, @pad$char, TRUE,
  1207.                 @( 25,'Padding character to send' ) );
  1208.             call show$byte( @end$of$line$string, @eol, TRUE,
  1209.                 @( 29,'End-of-line character to send' ) );
  1210.             call show$byte( @quote$string, @quote, TRUE,
  1211.                 @( 25,'Control-quoting character' ) );
  1212.           end;  /* else -- no extra parameter */
  1213.  
  1214.     end show$all;
  1215.  
  1216.  
  1217.     /* begin SHOW */
  1218.     if ( num$keywords < 2 ) then    /* there was no second keyword */
  1219.         call too$few$params( @show$string, 0, 0 );
  1220.     else if keyword$match( 1, @q$mark, 1 ) then
  1221.         call list$choices( @show$string, 0, 0,
  1222.                             @show$param$list,
  1223.                             last( show$param$list ) );
  1224.     else if keyword$match( 1, @version$string, 1 ) then
  1225.         call show$version;
  1226.     else if keyword$match( 1, @beep$string, 1 ) then
  1227.         call show$flag$value( @beep$string, @beep );
  1228.     else if keyword$match( 1, @debug$string, 1 ) then
  1229.         call show$flag$value( @debug$string, @debug );
  1230.     else if keyword$match( 1, @escape$string, 2 ) then
  1231.         call show$byte( @escape$string, @esc$char, TRUE,
  1232.             @( 34,'The "escape" character for CONNECT' ) );
  1233.     else if keyword$match( 1, @retry$string, 1 ) then
  1234.          call show$byte( @retry$string, @max$retry, FALSE,
  1235.             @( 31,'Maximum times to retry a packet' ) );
  1236.     else if keyword$match( 1, @packet$len$string, 3 ) then
  1237.         call show$byte( @packet$len$string, @packet$len, FALSE,
  1238.             @( 29,'Maximum length packet to send' ) );
  1239.     else if keyword$match( 1, @timeout$string, 1 ) then
  1240.         call show$byte( @timeout$string, @time$limit, FALSE,
  1241.             @( 37,'Seconds to wait for receive character' ) );
  1242.     else if keyword$match( 1, @padding$string, 4 ) then
  1243.         call show$byte( @padding$string, @num$pad, FALSE,
  1244.             @( 36,'Number of padding characters to send' ) );
  1245.     else if keyword$match( 1, @padchar$string, 4 ) then
  1246.         call show$byte( @padchar$string, @pad$char, TRUE,
  1247.             @( 25,'Padding character to send' ) );
  1248.     else if keyword$match( 1, @end$of$line$string, 2 ) then
  1249.         call show$byte( @end$of$line$string, @eol, TRUE,
  1250.             @( 29,'End-of-line character to send' ) );
  1251.     else if keyword$match( 1, @quote$string, 1 ) then
  1252.         call show$byte( @quote$string, @quote, TRUE,
  1253.             @( 25,'Control-quoting character' ) );
  1254.     else if keyword$match( 1, @all$string, 1 ) then
  1255.         call show$all;
  1256.     else
  1257.         call invalid$param( 1, @show$string, 0, 0 );
  1258.  
  1259. end show;
  1260.  
  1261.  
  1262. send: procedure;
  1263.  
  1264.     /*
  1265.      *  Implement the SEND command.
  1266.      */
  1267.  
  1268.     send$init: procedure;
  1269.  
  1270.         /*  Implement the Send-initiate state. */
  1271.  
  1272.         declare
  1273.             ( type, num )   byte;   /* Incoming packet type, number */
  1274.  
  1275.         tries = ( tries + 1 );  /* count a try */
  1276.         if ( tries > max$retry ) then       /* too many */
  1277.             call too$many$retries;  /* abort */
  1278.         else
  1279.           do;   /* Send a Send-init packet */
  1280.             /* We would now flush the input buffer if we were using one */
  1281.             call send$kermit$params( @info2 );  /* Load our parameters */
  1282.             call send$packet( 'S', seq, @info2 );   /* Send-initiate */
  1283.             type = receive$packet( @num, @info2 );  /* Get the response */
  1284.             /* If we got an acknowledgement with the proper number */
  1285.             if ( ( type = 'Y' ) and ( num = seq ) ) then
  1286.               do;
  1287.                 call get$kermit$params( @info2 );   /* Extract their params */
  1288.                 tries = 0;      /* reset try count */
  1289.                 seq = next$seq( seq );  /* bump sequence number */
  1290.                 if ( open$file( @info ) ) then  /* open the file to be sent */
  1291.                   do;   /* it was successfully opened */
  1292.                     /* Keep the user informed of our progress */
  1293.                     call print( @( 13,'Sending file ' ) );
  1294.                     call print( @info );
  1295.                     call print( @dots$string );
  1296.                     call prepare$file$name( @info );
  1297.                     state = 'F';    /* go to send-file state */
  1298.                   end;  /* if ( open$file( @info ) ) */
  1299.                 else    /* couldn't open file */
  1300.                     state = 'A';    /* abort--error message already given */
  1301.               end;  /* if ( ( type = 'Y' ) and ( num = seq ) ) */
  1302.             else if ( type = 0FFh ) then    /* CTRL/C abort */
  1303.                 state = 0FFh;
  1304.             else if ( ( type <> 'Y' ) and ( type <> 'N' )
  1305.                         and ( type <> 0 ) ) then    /* got wrong type packet */
  1306.                 call unknown$packet$type( type, @info2 );   /* abort */
  1307.             /* Don't change state if got NAK, bad ACK, or nothing at all */
  1308.           end;  /* else -- send send-init */
  1309.  
  1310.     end send$init;
  1311.  
  1312.  
  1313.     send$file$data: procedure;
  1314.  
  1315.         /*  Implement the Send File-header and Send file-Data states */
  1316.  
  1317.         declare
  1318.             ( type, num )   byte;   /* Incoming packet type, number */
  1319.  
  1320.         tries = ( tries + 1 );  /* count a try */
  1321.         if ( tries > max$retry ) then       /* too many */
  1322.             call too$many$retries;  /* abort */
  1323.         else
  1324.           do;   /* Send packet (file-name or data) */
  1325.             call send$packet( state, seq, @info );
  1326.             type = receive$packet( @num, @info2 );   /* get reply */
  1327.             /* If got ACK for this packet or NAK for next one */
  1328.             if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or
  1329.                     ( ( type = 'Y' ) and ( num = seq ) ) ) then
  1330.               do;
  1331.                 tries = 0;  /* reset try count */
  1332.                 seq = next$seq( seq );  /* bump sequence number */
  1333.                 call read$packet$from$file( @info );    /* Load data packet */
  1334.                 if ( info.len = 0 ) then    /* end-of-file */
  1335.                     state = 'Z';    /* so go to end-of-file state */
  1336.                 else    /* data ready to be sent */
  1337.                     state = 'D';    /* go to (or stay in) send-Data state */
  1338.               end;  /* if ... */
  1339.             else if ( type = 0FFh ) then    /* CTRL/C abort */
  1340.                 state = 0FFh;
  1341.             else if ( ( type <> 'Y' ) and ( type <> 'N' )
  1342.                             and ( type <> 0 ) ) then
  1343.                 call unknown$packet$type( type, @info2 );   /* abort */
  1344.             /* If get NAK, bad ACK, or nothing at all, state doesn't change */
  1345.           end;  /* else -- send packet */
  1346.  
  1347.     end send$file$data;
  1348.  
  1349.  
  1350.     send$eof: procedure;
  1351.  
  1352.         /*  Implement the Send-end-of-file state */
  1353.  
  1354.         declare
  1355.             ( type, num )   byte;   /* Incoming packet type, number */
  1356.  
  1357.         tries = ( tries + 1 );  /* count a try */
  1358.         if ( tries > max$retry ) then       /* too many */
  1359.             call too$many$retries;  /* abort */
  1360.         else
  1361.           do;   /* Send EOF packet */
  1362.             call send$packet( 'Z', seq, 0 );
  1363.             type = receive$packet( @num, @info2 );  /* Get reply */
  1364.             /* If got ACK for this packet or NAK for next one */
  1365.             if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or
  1366.                     ( ( type = 'Y' ) and ( num = seq ) ) ) then
  1367.               do;
  1368.                 call close$file;    /* close the file we're done sending */
  1369.                 call print( @ok$string );  /* terminate the */
  1370.                 call new$line;             /* "Sending file..." message */
  1371.                 tries = 0;      /* reset try count */
  1372.                 seq = next$seq( seq );  /* bump packet sequence number */
  1373.                 call get$next$file$name( @info );   /* Get next file to send */
  1374.                 if ( info.len = 0 ) then    /* no more files */
  1375.                     state = 'B';    /* go to Break-transmission state */
  1376.                 else    /* Another file to be sent */
  1377.                   do;
  1378.                     if ( open$file( @info ) ) then  /* open next file */
  1379.                       do;   /* it was successfully opened */
  1380.                         /* Keep the user informed of our progress */
  1381.                         call print( @( 13,'Sending file ' ) );
  1382.                         call print( @info );
  1383.                         call print( @dots$string );
  1384.                         call prepare$file$name( @info );
  1385.                         state = 'F';    /* go to send-file state */
  1386.                       end;  /* if ( open$file( @info ) ) */
  1387.                     else    /* couldn't open file, so abort */
  1388.                         state = 'A';    /* error message already given */
  1389.                   end;  /* else -- another file to be sent */
  1390.               end;  /* if ... */
  1391.             else if ( type = 0FFh ) then    /* CTRL/C abort */
  1392.                 state = 0FFh;
  1393.             else if ( ( type <> 'Y' ) and ( type <> 'N' )
  1394.                             and ( type <> 0 ) ) then
  1395.                 call unknown$packet$type( type, @info2 );   /* abort */
  1396.             /* If get NAK, bad ACK, or nothing at all, state doesn't change */
  1397.           end;  /* else -- send EOF packet */
  1398.  
  1399.     end send$eof;
  1400.  
  1401.  
  1402.     send$break: procedure;
  1403.  
  1404.         /*  Implement the Send-Break (End-of-Transmission) state */
  1405.  
  1406.         declare
  1407.             ( type, num )   byte;   /* Incoming packet type, number */
  1408.  
  1409.         tries = ( tries + 1 );  /* count a try */
  1410.         if ( tries > max$retry ) then       /* too many */
  1411.             call too$many$retries;  /* abort */
  1412.         else
  1413.           do;   /* send the break (or EOT) packet */
  1414.             call send$packet( 'B', seq, 0 );
  1415.             type = receive$packet( @num, @info2 );  /* Get reply */
  1416.             /* If got ACK for this packet or NAK for next one */
  1417.             if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or
  1418.                     ( ( type = 'Y' ) and ( num = seq ) ) ) then
  1419.               do;
  1420.                 tries = 0;      /* reset try count */
  1421.                 seq = next$seq( seq );  /* bump packet sequence number */
  1422.                 state = 'C';    /* and go to state Complete */
  1423.               end;  /* if ... */
  1424.             else if ( type = 0FFh ) then    /* CTRL/C abort */
  1425.                 state = 0FFh;
  1426.             else if ( ( type <> 'Y' ) and ( type <> 'N' )
  1427.                             and ( type <> 0 ) ) then
  1428.                 call unknown$packet$type( type, @info2 );   /* abort */
  1429.             /* If get NAK, bad ACK, or nothing at all, state doesn't change */
  1430.           end;  /* else -- send break packet */
  1431.  
  1432.     end send$break;
  1433.  
  1434.  
  1435.     /* begin SEND */
  1436.     if ( num$keywords < 2 ) then
  1437.       do;   /* tell them what kind of parameter is required */
  1438.         call print( @send$string );
  1439.         call print( @( 33,' must be followed by the filespec' ) );
  1440.         call print( @( 28,' for the file(s) to be sent.' ) );
  1441.       end;  /* if ( num$keywords < 2 ) */
  1442.     else if ( num$keywords > 2 ) then
  1443.         call extra$params( @send$string, 0, 0 );
  1444.     else    /* We have one parameter, the filespec */
  1445.       do;   /* perform the SEND command */
  1446.         /* Get first filename to send, using second keyword as filespec */
  1447.         call get$first$file$name( 1, @info );
  1448.         if ( info.len > 0 ) then    /* we got a valid filespec */
  1449.           do;   /* Implement the Send state-table switcher */
  1450.             call setup$for$communication;
  1451.             state = 'S';    /* Start with Send-init state */
  1452.             seq = 0;        /* Initialize the packet sequence numbers */
  1453.             tries = 0;      /* no retries yet */
  1454.             /* do this as long as we're in a valid send state */
  1455.             do while ( ( state = 'S' ) or ( state = 'F' ) or ( state = 'D' )
  1456.                         or ( state = 'Z' ) or ( state = 'B' ) );
  1457.                 /* Dispatch to appropriate routine (they switch the state) */
  1458.                 if ( state = 'S' ) then
  1459.                     call send$init;
  1460.                 else if ( ( state = 'F' ) or ( state = 'D' ) ) then
  1461.                     call send$file$data;    /* two states share one routine */
  1462.                 else if ( state = 'Z' ) then
  1463.                     call send$eof;
  1464.                 else    /* state must be B */
  1465.                     call send$break;
  1466.             end;    /* do while ... */
  1467.             if ( beep ) then    /* Alert them that we finished */
  1468.                 call xmit$console$char( BEL );
  1469.             if ( state = 'C' ) then     /* proper completion */
  1470.                 call print( @( 14,'Send complete.' ) );
  1471.             else
  1472.               do;
  1473.                 call new$line;
  1474.                 if ( state = 0FFh ) then    /* it was because of CTRL/C */
  1475.                     call error$msg( @( 23,'Send aborted by CTRL/C.' ) );
  1476.                 else
  1477.                     call error$msg( @( 12, 'Send failed.' ) );
  1478.               end;
  1479.             call finish$communication;
  1480.           end;  /* if ( info.len > 0 ) */
  1481.         else    /* invalid filespec */
  1482.             call print( @( 29,'Bad filespec, send cancelled.' ) );
  1483.       end;  /* else -- we have one parameter */
  1484.  
  1485. end send;
  1486.  
  1487.  
  1488. do$receive: procedure( get );
  1489.  
  1490.     /*
  1491.      *  Perform the RECEIVE (if GET is FALSE)
  1492.      *  or GET (if GET is TRUE) command.
  1493.      */
  1494.  
  1495.     declare
  1496.         get         boolean,
  1497.         oldtries    byte;   /* tries for previous packet */
  1498.  
  1499.     receive$init: procedure;
  1500.  
  1501.         /*  Implement the Receive Send-init state */
  1502.  
  1503.         declare
  1504.             type    byte;   /* Incoming packet type */
  1505.  
  1506.         tries = ( tries + 1 );  /* count a try */
  1507.         if ( tries > max$retry ) then   /* too many tries */
  1508.             call too$many$retries;  /* give up--go to Abort state */
  1509.         else
  1510.           do;   /* try to receive a Send-init packet */
  1511.             /* Get a packet, and set our sequence number to match its */
  1512.             type = receive$packet( @seq, @info2 );
  1513.             if ( type = 'S' ) then  /* we got one */
  1514.               do;
  1515.                 call get$kermit$params( @info2 );   /* extract their params */
  1516.                 call send$kermit$params( @info2 );  /* and load ours */
  1517.                 call send$packet( 'Y', seq, @info2 );   /* send ACK */
  1518.                 oldtries = tries;       /* save number of init tries */
  1519.                 tries = 0;      /* Reset try counter for next packet */
  1520.                 seq = next$seq( seq );  /* Go to next sequence number */
  1521.                 state = 'F';    /* And enter Receive-file state */
  1522.               end;  /* if ( type = 'S' ) */
  1523.             else if ( get and ( type = 'N' ) ) then
  1524.                 /* Got NAK to our Receive-init, so send it again */
  1525.                 call send$packet( 'R', seq, @info );
  1526.             else if ( type = 0FFh ) then    /* CTRL/C abort */
  1527.                 state = 0FFh;
  1528.             else if ( type = 0 ) then   /* got bad packet or none at all */
  1529.                 call send$packet( 'N', seq, 0 );    /* send NAK */
  1530.                 /* And will try again to receive--state didn't change */
  1531.             else    /* we got a packet, but wrong type */
  1532.                 call unknown$packet$type( type, @info2 );   /* abort */
  1533.           end;  /* else -- not too many tries yet */
  1534.  
  1535.     end receive$init;
  1536.  
  1537.  
  1538.     receive$file: procedure;
  1539.  
  1540.         /*  Implement the Receive-file state */
  1541.  
  1542.         declare
  1543.             ( type, num )   byte;   /* Incoming packet type, sequence num */
  1544.  
  1545.         tries = ( tries + 1 );  /* count a try */
  1546.         if ( tries > max$retry ) then   /* too many tries */
  1547.             call too$many$retries;  /* abort */
  1548.         else    /* get a packet */
  1549.           do;
  1550.             type = receive$packet( @num, @info );
  1551.             if ( type = 'S' ) then  /* it was a Send-init */
  1552.               do;
  1553.                 oldtries = ( oldtries + 1 );    /* Increment its tries */
  1554.                 if ( oldtries > max$retry ) then    /* too many */
  1555.                     call too$many$retries;  /* abort */
  1556.                 else if ( num = previous$seq( seq ) ) then
  1557.                   do;   /* It was the previous packet, so our ACK was lost */
  1558.                     call send$kermit$params( @info2 );  /* reload our params */
  1559.                     call send$packet( 'Y', num, @info2 );   /* previous ACK */
  1560.                     tries = 0;  /* reset tries for file-header packet */
  1561.                     /* state and seq don't change, already updated */
  1562.                   end;
  1563.                 else    /* wrong number */
  1564.                     call wrong$number;  /* abort */
  1565.               end;  /* if ( type = 'S' ) */
  1566.             else if ( type = 'Z' ) then     /* it was end-of-file */
  1567.               do;
  1568.                 oldtries = ( oldtries + 1 );    /* Increment its tries */
  1569.                 if ( oldtries > max$retry ) then    /* too many tries */
  1570.                     call too$many$retries;  /* abort */
  1571.                 else if ( num = previous$seq( seq ) ) then
  1572.                   do;   /* It was the previous packet, so our ACK was lost */
  1573.                     call send$packet( 'Y', num, 0 );    /* resend that ACK */
  1574.                     tries = 0;  /* reset tries for file-header */
  1575.                     /* state and seq don't change */
  1576.                   end;
  1577.                 else    /* wrong number */
  1578.                     call wrong$number;  /* abort */
  1579.               end;  /* if ( type = 'Z' ) */
  1580.             else if ( type = 'B' ) then  /* got Break */
  1581.               do;
  1582.                 if ( num = seq ) then   /* got right number */
  1583.                   do;
  1584.                     call send$packet( 'Y', seq, 0 );    /* ACK it */
  1585.                     state = 'C';    /* and go to complete state */
  1586.                   end;  /* if ( num = seq ) */
  1587.                 else    /* wrong number */
  1588.                     call wrong$number;  /* abort */
  1589.               end;  /* if ( type = 'B' ) */
  1590.             else if ( type = 'F' ) then     /* got File header */
  1591.               do;
  1592.                 if ( num = seq ) then   /* got right number */
  1593.                   do;
  1594.                     if ( create$file( @info ) ) then    /* create the file */
  1595.                       do;   /* file successfully created */
  1596.                         /* Keep the user informed of our progress */
  1597.                         call print( @( 15,'Receiving file ' ) );
  1598.                         call print( @info );    /* file name */
  1599.                         call print( @dots$string );
  1600.                         call send$packet( 'Y', seq, 0 );    /* ACK */
  1601.                         oldtries = tries;   /* save previous tries */
  1602.                         tries = 0;  /* and init new packet tries */
  1603.                         seq = next$seq( seq );  /* go to next packet number */
  1604.                         state = 'D';    /* and enter Receive-data state */
  1605.                       end;  /* if ( create$file( @info ) ) */
  1606.                     else    /* a problem creating the file, so abort */
  1607.                         state = 'A';    /* error message already given */
  1608.                   end;  /* if ( num = seq ) */
  1609.                 else    /* wrong number */
  1610.                     call wrong$number;  /* abort */
  1611.               end;  /* if ( type = 'F' ) */
  1612.             else if ( type = 0FFh ) then    /* got CTRL/C */
  1613.                 state = 0FFh;   /* signal CTRL/C abort */
  1614.             else if ( type = 0 ) then   /* got bad packet or none at all */
  1615.                 call send$packet( 'N', seq, 0 );    /* send NAK */
  1616.                 /* And will try again to receive--state didn't change */
  1617.             else    /* we got a packet, but wrong type */
  1618.                 call unknown$packet$type( type, @info );   /* abort */
  1619.           end;  /* else -- not too many tries */
  1620.  
  1621.     end receive$file;
  1622.  
  1623.  
  1624.     receive$data: procedure;
  1625.  
  1626.         /*  Implement the Receive-data state */
  1627.  
  1628.         declare
  1629.             ( type, num )   byte;   /* Incoming packet type, number */
  1630.  
  1631.         tries = ( tries + 1 );  /* count another try */
  1632.         if ( tries > max$retry ) then   /* too many */
  1633.             call too$many$retries;  /* abort */
  1634.         else
  1635.           do;
  1636.             type = receive$packet( @num, @info );   /* get a packet */
  1637.             if ( type = 'D' ) then  /* got Data packet */
  1638.               do;
  1639.                 if ( num = seq ) then   /* right number */
  1640.                   do;
  1641.                     call write$packet$to$file( @info );
  1642.                     call send$packet( 'Y', seq, 0 );    /* ACK it */
  1643.                     oldtries = tries;   /* save old try count */
  1644.                     tries = 0;          /* and start a new one */
  1645.                     seq = next$seq( seq );  /* go to next packet number */
  1646.                     /* Remain in Receive-Data state */
  1647.                   end;  /* if ( num = seq ) */
  1648.                 else    /* wrong number */
  1649.                   do;
  1650.                     oldtries = ( oldtries + 1 );
  1651.                     if ( oldtries > max$retry ) then
  1652.                         call too$many$retries;  /* too many tries, abort */
  1653.                     else if ( num = previous$seq( seq ) ) then
  1654.                       do;   /* got previous packet again */
  1655.                         call send$packet( 'Y', num, 0 );    /* ACK again */
  1656.                         tries = 0;      /* reset tries for this one */
  1657.                         /* Stay in D state */
  1658.                       end;  /* if ( num = previous$seq( seq ) ) */
  1659.                     else    /* totally wrong number */
  1660.                         call wrong$number;  /* abort */
  1661.                   end;  /* else -- wrong number */
  1662.               end;  /* if ( type = 'D' ) */
  1663.             else if ( type = 'F' ) then     /* got file-header */
  1664.               do;
  1665.                 oldtries = ( oldtries + 1 );
  1666.                 if ( oldtries > max$retry ) then
  1667.                     call too$many$retries;  /* abort */
  1668.                 else if ( num = previous$seq( seq ) ) then
  1669.                   do;   /* Got previous packet again */
  1670.                     call send$packet( 'Y', num, 0 );    /* ACK again */
  1671.                     tries = 0;      /* reset tries for this one */
  1672.                     /* State doesn't change */
  1673.                   end;  /* if ( num = previous$seq( seq ) ) */
  1674.                 else    /* wrong number */
  1675.                     call wrong$number;  /* abort */
  1676.               end;  /* if ( type = 'F' ) */
  1677.             else if ( type = 'Z' ) then     /* got end-of-file */
  1678.               do;
  1679.                 if ( num = seq ) then   /* right number */
  1680.                   do;
  1681.                     call close$file;    /* close the output file */
  1682.                     call print( @ok$string );  /* terminate the */
  1683.                     call new$line;     /* "Receiving file..." message */
  1684.                     call send$packet( 'Y', seq, 0 );    /* ACK */
  1685.                     oldtries = tries;   /* save old try count */
  1686.                     tries = 0;      /* and init a new one */
  1687.                     seq = next$seq( seq );  /* go to next packet number */
  1688.                     state = 'F';    /* and go to Receive-File state */
  1689.                   end;  /* if ( num = seq ) */
  1690.                 else    /* wrong number */
  1691.                     call wrong$number;  /* abort */
  1692.               end;  /* if ( type = 'Z' ) */
  1693.             else if ( type = 0FFh ) then
  1694.                 state = 0FFh;   /* signal CTRL/C abort */
  1695.             else if ( type = 0 ) then   /* got bad packet or none at all */
  1696.                 call send$packet( 'N', seq, 0 );    /* send NAK */
  1697.                 /* And will try again to receive--state didn't change */
  1698.             else    /* we got a packet, but wrong type */
  1699.                 call unknown$packet$type( type, @info );   /* abort */
  1700.           end;  /* else -- not too many tries */
  1701.  
  1702.     end receive$data;
  1703.  
  1704.  
  1705.     /* begin DO$RECEIVE */
  1706.     call setup$for$communication;
  1707.     state = 'R';    /* Start with receive-init state */
  1708.     seq = 0;        /* initialize packet sequence number */
  1709.     tries = 0;      /* no retries yet */
  1710.     if ( get ) then
  1711.       do;   /* Request the file(s) from the server */
  1712.         call get$filespec( 1, @info );  /* get second keyword into INFO */
  1713.         call send$packet( 'R', seq, @info );    /* send Receive-initiate */
  1714.         /* And fall through to normal RECEIVE */
  1715.       end;  /* if ( get ) */
  1716.     /* Implement the Receive state-table switcher */
  1717.     /* do this as long as we're in a valid receive state */
  1718.     do while ( ( state = 'R' ) or ( state = 'F' ) or ( state = 'D' ) );
  1719.         /* Dispatch to appropriate routine (they switch the state) */
  1720.         if ( state = 'R' ) then
  1721.             call receive$init;
  1722.         else if ( state = 'F' ) then
  1723.             call receive$file;
  1724.         else    /* state must be D */
  1725.             call receive$data;
  1726.     end;    /* do while ... */
  1727.     if ( beep ) then    /* Alert them that we finished */
  1728.         call xmit$console$char( BEL );
  1729.     if ( state = 'C' ) then     /* proper completion */
  1730.         call print( @( 17,'Receive complete.' ) );
  1731.     else
  1732.       do;
  1733.         call new$line;
  1734.         if ( state = 0FFh ) then    /* it was because of CTRL/C */
  1735.             call error$msg( @( 26,'Receive aborted by CTRL/C.' ) );
  1736.         else
  1737.             call error$msg( @( 15,'Receive failed.' ) );
  1738.       end;
  1739.     call finish$communication;
  1740.  
  1741. end do$receive;
  1742.  
  1743.  
  1744. receive: procedure;
  1745.  
  1746.     /*
  1747.      *  Implement the RECEIVE command.
  1748.      */
  1749.  
  1750.     if ( num$keywords > 1 ) then    /* a parameter followed RECEIVE */
  1751.         call too$many$params( @receive$string, 0, 0 );
  1752.     else    /* Perform the RECEIVE command */
  1753.         call do$receive( FALSE );
  1754.  
  1755. end receive;
  1756.  
  1757.  
  1758. get: procedure;
  1759.  
  1760.     /*
  1761.      *  Implement the GET command.
  1762.      */
  1763.  
  1764.     if ( num$keywords < 2 ) then
  1765.       do;   /* tell them what kind of parameter is required */
  1766.         call print( @get$string );
  1767.         call print( @( 33,' must be followed by the filespec' ) );
  1768.         call print( @( 30,' for the file(s) to be gotten.' ) );
  1769.       end;  /* if ( num$keywords < 2 ) */
  1770.     else if ( num$keywords > 2 ) then
  1771.         call extra$params( @get$string, 0, 0 );
  1772.     else    /* We have one parameter, the filespec */
  1773.         call do$receive( TRUE );    /* perform the GET command */
  1774.  
  1775. end get;
  1776.  
  1777.  
  1778. execute$command: procedure;
  1779.  
  1780.     /*
  1781.      *  Execute the command specified by the first keyword parsed
  1782.      *  from the command line.  If it is not a valid command, issue
  1783.      *  an appropriate error message to the console.
  1784.      */
  1785.  
  1786.     if keyword$match( 0, @q$mark, 1 ) then
  1787.         call list$choices( 0, 0, 0, @command$list, last( command$list ) );
  1788.     else if keyword$match( 0, @exit$string, 1 ) then
  1789.         call exit;
  1790.     else if keyword$match( 0, @help$string, 1 ) then
  1791.         call help;
  1792.     else if keyword$match( 0, @send$string, 3 ) then
  1793.         call send;
  1794.     else if keyword$match( 0, @receive$string, 1 ) then
  1795.         call receive;
  1796.     else if keyword$match( 0, @get$string, 1 ) then
  1797.         call get;
  1798.     else if keyword$match( 0, @connect$string, 1 ) then
  1799.         call connect;
  1800.     else if keyword$match( 0, @bye$string, 1 ) then
  1801.         call bye;
  1802.     else if keyword$match( 0, @logout$string, 1 ) then
  1803.         call logout;
  1804.     else if keyword$match( 0, @finish$string, 1 ) then
  1805.         call finish;
  1806.     else if keyword$match( 0, @set$string, 3 ) then
  1807.         call set;
  1808.     else if keyword$match( 0, @show$string, 2 ) then
  1809.         call show;
  1810.     else
  1811.         call invalid$param( 0, 0, 0, 0 );
  1812.     call new$line;  /* Make sure the next prompt starts on a new line */
  1813.  
  1814. end execute$command;
  1815.  
  1816.  
  1817. /*
  1818.  *
  1819.  *      Main program -- Kermit
  1820.  *
  1821.  */
  1822.  
  1823.  
  1824. /* begin KERMIT */
  1825. call new$line;
  1826. call print( @sign$on );     /* Identify who and what we are */
  1827. call new$line;
  1828.  
  1829. call setup;     /* Do system-dependent setup */
  1830.  
  1831. /* Initialize our parameters to their defaults */
  1832. beep = TRUE;    /* Beep unless told to shut up */
  1833. debug = FALSE;  /* We hope it doesn't need any more debugging... */
  1834. esc$char = def$esc$char;
  1835. max$retry = def$max$retry;
  1836. packet$len = def$packet$len;
  1837. time$limit = def$time$limit;
  1838. num$pad = def$num$pad;
  1839. pad$char = def$pad$char;
  1840. eol = def$eol;
  1841. quote = def$quote;
  1842.  
  1843. /* Begin the main command line loop */
  1844. do forever;     /* Do this until some command exits the program */
  1845.     call get$command$line( @prompt );   /* Get a command line */
  1846.     call parse$command;     /* Parse the command line */
  1847.     if ( num$keywords > 0 ) then    /* If we got at least one keyword */
  1848.         call execute$command;   /* perform the command requested */
  1849. end;    /* do forever */
  1850.  
  1851. end Kermit;
  1852. /* [---KERSYS.P86---] */
  1853. $large ram
  1854.  
  1855. Kermit$sys: do;
  1856.  
  1857. /*
  1858.  *      K e r m i t   File Transfer Utility
  1859.  *
  1860.  *      iRMX-86 Kermit, Version 2.3
  1861.  *      by Albert J. Goodman, Grinnell College
  1862.  *
  1863.  *      System-dependent interface and utility procedures module.
  1864.  *      Edit date:  2-June-1985
  1865.  */
  1866.  
  1867.         /* Define the iRMX-86 operating system interface */
  1868. /* Define the exception codes we use */
  1869. declare
  1870.     E$OK                literally   '0000h',
  1871.     E$FNEXIST           literally   '0021h',    /* non-existent file */
  1872.     E$FACCESS           literally   '0026h',    /* file access not granted */
  1873.     E$FTYPE             literally   '0027h',    /* bad file type */
  1874.     E$CONTINUED         literally   '0083h';    /* continued command line */
  1875. /* Define the system type TOKEN */
  1876. $include(:I:LTKSEL.LIT)
  1877. /* Include external definitions for the iRMX-86 system calls we use */
  1878. $include(:I:HSNCOR.EXT)
  1879. $include(:I:HFMTEX.EXT)
  1880. $include(:I:HGTICN.EXT)
  1881. $include(:I:HCRCCN.EXT)
  1882. $include(:I:HSNCMD.EXT)
  1883. $include(:I:HGTCMD.EXT)
  1884. $include(:I:IEXIOJ.EXT)
  1885. $include(:I:ISATFL.EXT)
  1886. $include(:I:ISCRFL.EXT)
  1887. $include(:I:ISOPEN.EXT)
  1888. $include(:I:ISSPEC.EXT)
  1889. $include(:I:ISRDMV.EXT)
  1890. $include(:I:ISWRMV.EXT)
  1891. $include(:I:ISCLOS.EXT)
  1892. $include(:I:ISDLCN.EXT)
  1893. $include(:I:NSTEXH.EXT)
  1894. $include(:I:NCRSEM.EXT)
  1895. $include(:I:NDSABL.EXT)
  1896. $include(:I:NENABL.EXT)
  1897.  
  1898.  
  1899. declare
  1900.                 /* CONSTANTS */
  1901.  
  1902.             /* Useful text substitutions */
  1903.     boolean                 literally   'byte',     /* define a new type */
  1904.     TRUE                    literally   '0FFh',     /* and constants */
  1905.     FALSE                   literally   '000h',     /*  of that type */
  1906.  
  1907.             /* ASCII control character constants */
  1908.     CTRL$C                  literally   '03h',  /* CTRL/C */
  1909.     HT                      literally   '09h',  /* horizontal tab */
  1910.     LF                      literally   '0Ah',  /* line-feed */
  1911.     CR                      literally   '0Dh',  /* carriage-return */
  1912.  
  1913.             /* Hardware port addresses for our system */
  1914.     T0$data$port            literally   '0D8h', /* T0 data port */
  1915.     T0$status$port          literally   '0DAh', /* T0 status port */
  1916.     base$port               literally   '030h', /* Base port for 534 board */
  1917.  
  1918.             /* Encoded interrupt levels which we might have to disable */
  1919.     level$534               literally   '038h', /* 534-board interrupt level */
  1920.     level$T0$in             literally   '068h', /* T0 (system console) input */
  1921.     level$T0$out            literally   '078h', /* & output interrupt levels */
  1922.  
  1923.             /* String constants */
  1924.     file$list$name(*)       byte data( 20, ':WORK:KERMITFLST.TMP' ),
  1925.  
  1926.             /* GET$CONSOLE$CHAR and GET$REMOTE$CHAR return codes */
  1927.     TIMEOUT                 literally   '0FFFFh',   /* Time limit expired */
  1928.     CTRL$C$CODE             literally   '08003h',   /* CTRL/C abort */
  1929.     BREAK                   literally   '08000h',   /* Break key */
  1930.             /* READ$CHAR return code */
  1931.     EOF$CODE                literally   '0FF00h',   /* end-of-file */
  1932.  
  1933.  
  1934.                 /* GLOBAL VARIABLES */
  1935.  
  1936.             /* Tokens (what the system uses to identify objects) */
  1937.     cur$file    token public,   /* Connection to the current file */
  1938.     comm$conn   token,  /* token for our command connection */
  1939.     file$list   token,  /* Connection to the file containg a filename list */
  1940.  
  1941.             /* Port addresses */
  1942.     console$data$port   word,   /* Data port of the console (usually T0) */
  1943.     console$status$port word,   /* Status port of the console */
  1944.     remote$data$port    word,   /* Data port of T3 (on 534-board) */
  1945.     remote$status$port  word,   /* Status port of T3 (on 534-board) */
  1946.  
  1947.             /* Flag affecting all console output */
  1948.     communicating   boolean initial( FALSE ),
  1949.     /* Whether we're communicating, i.e. console interrupts are disabled */
  1950.  
  1951.             /* Buffers */
  1952.     com$line    structure(      /* The buffer for the command line */
  1953.                     len     byte,
  1954.                     ch(80)  byte) public;
  1955.  
  1956.  
  1957. /*      External procedures defined in KERMIT$UTIL      */
  1958.  
  1959. get$filespec: procedure( keyword$num, info$ptr ) external;
  1960.     declare
  1961.         keyword$num     byte,
  1962.         info$ptr        pointer;
  1963. end get$filespec;
  1964.  
  1965. upcase: procedure( x ) byte external;
  1966.     declare
  1967.         x   byte;
  1968. end upcase;
  1969.  
  1970.  
  1971. /*
  1972.  *
  1973.  *      Hardware port communication routines.
  1974.  *
  1975.  */
  1976.  
  1977.  
  1978. console$char$available: procedure boolean;
  1979.  
  1980.     /*
  1981.      *  Return TRUE if there is a character available
  1982.      *  at the console port.
  1983.      */
  1984.  
  1985.     if ( ( input( console$status$port ) AND 02h ) = 0 ) then
  1986.         return( FALSE );
  1987.     else
  1988.         return( TRUE );
  1989.  
  1990. end console$char$available;
  1991.  
  1992.  
  1993. get$console$char: procedure( time$limit ) word public;
  1994.  
  1995.     /*
  1996.      *  Return the next character from the console, waiting until
  1997.      *  a character is available or until approximately TIME$LIMIT
  1998.      *  seconds have elapsed, whichever comes first.  If the
  1999.      *  break key is pressed when this routine is first called,
  2000.      *  it will return the constant BREAK (which is not a character
  2001.      *  because it is larger than 0FFh).  If not, the break key
  2002.      *  is not checked for while waiting out a time limit.  If the
  2003.      *  time limit expires before any key is pressed, the constant
  2004.      *  TIMEOUT (which also is larger than 0FFh) is returned.
  2005.      *  If TIME$LIMIT is zero it will return immediately, with a
  2006.      *  character if one was waiting or else with TIMEOUT.  If
  2007.      *  TIME$LIMIT = 0FFFFh it is taken to be infinite, i.e. TIMEOUT
  2008.      *  will never be returned.  This procedure assumes that
  2009.      *  interrupts from the console are disabled.
  2010.      */
  2011.  
  2012.     declare
  2013.         ( time$limit, i, j )    word;
  2014.  
  2015.     if ( ( input( console$status$port ) AND 40h ) <> 0 ) then
  2016.         return( BREAK );    /* The break key was pressed */
  2017.     if ( time$limit = 0 ) then
  2018.       do;
  2019.         if ( console$char$available ) then
  2020.             return( input( console$data$port ) );
  2021.         else
  2022.             return( TIMEOUT );
  2023.       end;
  2024.     else if ( time$limit = 0FFFFh ) then
  2025.       do;
  2026.         do while ( not console$char$available );
  2027.             /* just wait for a character */
  2028.         end;
  2029.         return( input( console$data$port ) );
  2030.       end;
  2031.     else
  2032.       do;
  2033.         do i = 1 to time$limit;
  2034.             do j = 1 to 1000;
  2035.                 if ( console$char$available ) then
  2036.                     return( input( console$data$port ) );
  2037.                 else
  2038.                     call time( 9 );  /* wait about a millisecond */
  2039.             end;
  2040.         end;
  2041.         return( TIMEOUT );
  2042.       end;
  2043.  
  2044. end get$console$char;
  2045.  
  2046.  
  2047. xmit$console$char: procedure( ch ) public;
  2048.  
  2049.     /*
  2050.      *  Send character CH to the console.
  2051.      */
  2052.  
  2053.     declare
  2054.         ch  byte;
  2055.  
  2056.     do while ( ( input( console$status$port ) AND 01h ) = 0 );
  2057.         /* Wait for TxRDY (transmitter ready) */
  2058.     end;
  2059.     output( console$data$port ) = ch;
  2060.  
  2061. end xmit$console$char;
  2062.  
  2063.  
  2064. select$data$block: procedure;
  2065.  
  2066.     /*
  2067.      *  Select the 534-board "data block" ports.
  2068.      *  This must be done once before accessing the
  2069.      *  USART status and data ports.
  2070.      */
  2071.  
  2072.     output( base$port + 0Dh ) = 0;
  2073.  
  2074. end select$data$block;
  2075.  
  2076.  
  2077. remote$char$available: procedure boolean;
  2078.  
  2079.     /*
  2080.      *  Return TRUE if there is a character available
  2081.      *  at the remote port.
  2082.      */
  2083.  
  2084.     if ( ( input( remote$status$port ) AND 02h ) = 0 ) then
  2085.         return( FALSE );
  2086.     else
  2087.         return( TRUE );
  2088.  
  2089. end remote$char$available;
  2090.  
  2091.  
  2092. get$remote$char: procedure( time$limit ) word public;
  2093.  
  2094.     /*
  2095.      *  Return the next character from the remote port, waiting until
  2096.      *  a character is available or until approximately TIME$LIMIT
  2097.      *  seconds have elapsed, whichever comes first.  If the time
  2098.      *  limit expires first, the constant TIMEOUT (which cannot be
  2099.      *  a character because it is larger than 0FFh) is returned.
  2100.      *  If TIME$LIMIT is zero it will return immediately, with a
  2101.      *  character if one was waiting or else with TIMEOUT.  If
  2102.      *  TIME$LIMIT = 0FFFFh it is taken to be infinite.  If a key
  2103.      *  is pressed on the console while this procedure is waiting
  2104.      *  for a remote character it will stop waiting; it will return
  2105.      *  CTRL$C$CODE (which also cannot be a character since it too
  2106.      *  is larger than 0FFh) if the key pressed was CTRL/C; otherwise
  2107.      *  it will simply return TIMEOUT.  This procedure assumes
  2108.      *  that interrupts from both the console and the remote port
  2109.      *  are disabled.
  2110.      */
  2111.  
  2112.     declare
  2113.         ( time$limit, i, j )    word;
  2114.  
  2115.     if ( time$limit = 0 ) then
  2116.       do;
  2117.         if ( remote$char$available ) then
  2118.             return( input( remote$data$port ) );
  2119.         else
  2120.             return( TIMEOUT );
  2121.       end;
  2122.     else if ( time$limit = 0FFFFh ) then
  2123.       do;
  2124.         do while ( not remote$char$available );
  2125.             if ( console$char$available ) then
  2126.               do;
  2127.                 if ( input( console$data$port ) = CTRL$C ) then
  2128.                     return( CTRL$C$CODE );
  2129.                 else
  2130.                     return( TIMEOUT );
  2131.               end;
  2132.         end;
  2133.         return( input( remote$data$port ) );
  2134.       end;
  2135.     else
  2136.       do;
  2137.         do i = 1 to time$limit;
  2138.             do j = 1 to 1000;
  2139.                 if ( remote$char$available ) then
  2140.                     return( input( remote$data$port ) );
  2141.                 else if ( console$char$available ) then
  2142.                   do;
  2143.                     if ( input( console$data$port ) = CTRL$C ) then
  2144.                         return( CTRL$C$CODE );
  2145.                     else
  2146.                         return( TIMEOUT );
  2147.                   end;
  2148.                 else
  2149.                     call time( 9 );  /* wait about a millisecond */
  2150.             end;
  2151.         end;
  2152.         return( TIMEOUT );
  2153.       end;
  2154.  
  2155. end get$remote$char;
  2156.  
  2157.  
  2158. xmit$remote$char: procedure( ch ) public;
  2159.  
  2160.     /*
  2161.      *  Send character CH out to the remote port.
  2162.      */
  2163.  
  2164.     declare
  2165.         ch  byte;
  2166.  
  2167.     do while ( ( input( remote$status$port ) AND 01h ) = 0 );
  2168.         /* Wait for TxRDY (transmitter ready) */
  2169.     end;
  2170.     output( remote$data$port ) = ch;
  2171.  
  2172. end xmit$remote$char;
  2173.  
  2174.  
  2175. xmit$break: procedure public;
  2176.  
  2177.     /*
  2178.      *  Send a hardware break signal to the remote port.
  2179.      */
  2180.  
  2181.     do while ( ( input( remote$status$port ) AND 01h ) = 0 );
  2182.         /* Wait for TxRDY (transmitter ready) */
  2183.     end;
  2184.     output( remote$status$port ) = 03Dh;
  2185.     call time( 5000 );  /* Wait about half a second */
  2186.     output( remote$status$port ) = 035h;
  2187.  
  2188. end xmit$break;
  2189.  
  2190.  
  2191. /*
  2192.  *
  2193.  *      System-dependent utility procedures used by Kermit.
  2194.  *
  2195.  */
  2196.  
  2197.  
  2198. print: procedure( string$ptr ) public;
  2199.  
  2200.     /*
  2201.      *  Print the string pointed to by STRING$PTR on the console.
  2202.      *  A string consists of a length byte followed by the specified
  2203.      *  number of characters (bytes).
  2204.      */
  2205.  
  2206.     declare
  2207.         string$ptr              pointer,
  2208.         status                  word,
  2209.         string based string$ptr structure(
  2210.                                     len     byte,
  2211.                                     ch(1)   byte),
  2212.         i                       byte;
  2213.  
  2214.     if ( communicating ) then   /* we must send it directly to the ports */
  2215.       do;
  2216.         if ( string.len > 0 ) then  /* there are some characters */
  2217.             do i = 0 to ( string.len - 1 );
  2218.                 call xmit$console$char( string.ch( i ) );
  2219.             end;
  2220.       end;
  2221.     else    /* we can use a system call */
  2222.         call rq$c$send$co$response( 0, 0, string$ptr, @status );
  2223.  
  2224. end print;
  2225.  
  2226.  
  2227. new$line: procedure public;
  2228.  
  2229.     /*
  2230.      *  Get the cursor to a new line on the console (i.e. print CR/LF).
  2231.      */
  2232.  
  2233.     call print( @( 2,CR,LF ) );
  2234.  
  2235. end new$line;
  2236.  
  2237.  
  2238. print$char: procedure( char ) public;
  2239.  
  2240.     /*
  2241.      *  Print the character CHAR on the console.
  2242.      */
  2243.  
  2244.     declare
  2245.         char    byte,
  2246.         string  structure(
  2247.                     len     byte,
  2248.                     ch      byte);
  2249.  
  2250.     if ( communicating ) then   /* just send it to the hardware ports */
  2251.         call xmit$console$char( char );
  2252.     else
  2253.       do;   /* Form a one-character string and then print it */
  2254.         string.ch = char;
  2255.         string.len = 1;
  2256.         call print( @string );
  2257.       end;
  2258.  
  2259. end print$char;
  2260.  
  2261.  
  2262. setup$for$communication: procedure public;
  2263.  
  2264.     /*
  2265.      *  This procedure does the setup to prepare for
  2266.      *  communication by Kermit.  It disables interrupts
  2267.      *  from the remote port and the console and then
  2268.      *  initializes the ports.
  2269.      */
  2270.  
  2271.     declare
  2272.         i       byte,
  2273.         status  word;
  2274.  
  2275.     communicating = TRUE;       /* flag that we are now communicating */
  2276.  
  2277.     /* Disable the 534-board's interrupt level */
  2278.     call rq$disable( level$534, @status );
  2279.  
  2280.     /* Disable the console's interrupt levels too */
  2281.     if ( console$data$port = T0$data$port ) then    /* the console is T0 */
  2282.       do;   /* disable T0's interrupt levels */
  2283.         call rq$disable( level$T0$in, @status );
  2284.         call rq$disable( level$T0$out, @status );
  2285.       end;
  2286.     /* Otherwise the console is T4 which is on the 534-board and so its */
  2287.     /* interrupts have already been disabled above */
  2288.  
  2289.     /* Next, initialize T3, the port to the remote system */
  2290.     output( base$port + 0Ch ) = 0;  /* select control block */
  2291.     /* put counter 2 in mode 3 (for baud-rate generator) */
  2292.     output( base$port + 3 ) = 0B6h;
  2293.     /* load count of 32 to get 2400 baud */
  2294.     output( base$port + 2 ) = 32;   /* LSB of count */
  2295.     output( base$port + 2 ) = 0;    /* and MSB */
  2296.     remote$data$port = base$port + 4;   /* for T3 */
  2297.     remote$status$port = remote$data$port + 1;
  2298.     call select$data$block;
  2299.     do i = 1 to 4;      /* Send USART 2 four zeros */
  2300.         output( remote$status$port ) = 0;   /* to get it into a known state */
  2301.         call time( 1 ); /* Give the USART time to recover between writes */
  2302.     end;
  2303.     /* Now reset the USART (USART 2 = port T3) */
  2304.     output( remote$status$port ) = 40h;
  2305.     call time( 1 );     /* Give the USART time to recover between writes */
  2306.     /* Send it a mode instruction:  1 stop bit, no parity, 8 bits, */
  2307.     output( remote$status$port ) = 4Eh;     /* and baud rate factor of X16 */
  2308.     call time( 1 );     /* Give the USART time to recover between writes */
  2309.     /* And a standard command instruction:  set RTS, error reset, and */
  2310.     output( remote$status$port ) = 35h; /* enable both receive and transmit */
  2311.  
  2312.     /* We know the console has been initialized by the system */
  2313.     /* So just give it a standard command instruction */
  2314.     output( console$status$port ) = 35h;
  2315.  
  2316. end setup$for$communication;
  2317.  
  2318.  
  2319. finish$communication: procedure public;
  2320.  
  2321.     /*
  2322.      *  This procedure finishes communication by
  2323.      *  re-enabling the interrupt level(s) disabled
  2324.      *  by SETUP$FOR$COMMUNICATION (above).
  2325.      */
  2326.  
  2327.     declare
  2328.         status  word;
  2329.  
  2330.     /* Re-enable the 534-board's interrupt level */
  2331.     call rq$enable( level$534, @status );
  2332.  
  2333.     /* Re-enable the console's interrupt levels too */
  2334.     if ( console$data$port = T0$data$port ) then    /* the console is T0 */
  2335.       do;   /* Re-enable T0's interrupt levels */
  2336.         call rq$enable( level$T0$in, @status );
  2337.         call rq$enable( level$T0$out, @status );
  2338.       end;
  2339.     /* Otherwise the console is T4 which is on the 534-board and so its */
  2340.     /* interrupts have already been re-enabled above */
  2341.  
  2342.     communicating = FALSE;      /* we are no longer communicating */
  2343.  
  2344. end finish$communication;
  2345.  
  2346.  
  2347. exit$program: procedure public;
  2348.  
  2349.     /*
  2350.      *  Exit from the program, i.e. return to the operating system.
  2351.      *  This procedure does not return to the calling routine.
  2352.      */
  2353.  
  2354.     declare
  2355.         status      word;
  2356.  
  2357.     call new$line;  /* make sure the cursor's on a new line */
  2358.     if ( communicating ) then   /* make sure to restore interrupts */
  2359.         call finish$communication;
  2360.     call rq$exit$io$job( 0, 0, @status );
  2361.  
  2362. end exit$program;
  2363.  
  2364.  
  2365. disp$excep: procedure( excep$code );
  2366.  
  2367.     /*
  2368.      *  Display the exception code and associated mnemonic (error
  2369.      *  message) on the console.  (Does not include any CRLFs.)
  2370.      */
  2371.  
  2372.     declare
  2373.         ( excep$code, status )  word,
  2374.         string$buffer           structure(
  2375.                                     len     byte,
  2376.                                     ch(40)  byte);
  2377.  
  2378.     string$buffer.len = 0;  /* Init to null string */
  2379.     /* Get the exception code and mnemonic */
  2380.     call rq$c$format$exception( @string$buffer, size(string$buffer),
  2381.                                     excep$code, 1, @status );
  2382.     call print( @string$buffer );   /* Display the exception message */
  2383.  
  2384. end disp$excep;
  2385.  
  2386.  
  2387. check$status: procedure( status );
  2388.  
  2389.     /*
  2390.      *  Check the exception code returned by a system call to the
  2391.      *  variable STATUS.  If it is not E$OK, display the exception code
  2392.      *  and mnemonic at the console and abort the program.
  2393.      */
  2394.  
  2395.     declare
  2396.         status      word;
  2397.  
  2398.     if ( status <> E$OK ) then
  2399.       do;   /* Handle an exceptional condition */
  2400.         call new$line;  /* Make sure we're at the start of a line */
  2401.         call disp$excep( status );  /* Display the error message */
  2402.         call print( @( 18,', program aborted.' ) ); /* And what we're doing */
  2403.         call new$line;
  2404.         /* And abort the program. */
  2405.         call exit$program;
  2406.       end;  /* if ( status <> E$OK ) */
  2407.  
  2408. end check$status;
  2409.  
  2410.  
  2411. disable$exception$handler: procedure;
  2412.  
  2413.     /*
  2414.      *  Disable the default exception handler, to prevent it from gaining
  2415.      *  control and aborting the program as soon as any exception occurs.
  2416.      */
  2417.  
  2418.     declare
  2419.         status                  word,
  2420.         exception$handler$info  structure(
  2421.                                     offset  word,
  2422.                                     base    word,
  2423.                                     mode    byte);
  2424.  
  2425.     exception$handler$info.offset = 0;
  2426.     exception$handler$info.base = 0;
  2427.     exception$handler$info.mode = 0;    /* Never pass control to EH */
  2428.     call rq$set$exception$handler( @exception$handler$info, @status );
  2429.     call check$status( status );
  2430.  
  2431. end disable$exception$handler;
  2432.  
  2433.  
  2434. setup: procedure public;
  2435.  
  2436.     /*
  2437.      *  This procedure does the system-dependent setup
  2438.      *  which must be done when the Kermit program
  2439.      *  is first started.
  2440.      */
  2441.  
  2442.     declare
  2443.         status      word,
  2444.         console     token,
  2445.         cc$sema4    token,
  2446.         buffer      structure(
  2447.                         len     byte,
  2448.                         ch(5)   byte),
  2449.         signal$pair structure(
  2450.                         semaphore   token,
  2451.                         character   byte);
  2452.  
  2453.     /* First, disable the system's exception handler */
  2454.     call disable$exception$handler;
  2455.  
  2456.     /* Next, determine what ports to use for the console */
  2457.     call rq$c$send$co$response( @buffer, size( buffer ),
  2458.             @( 37,'Are you at the system console <yes>? ' ), @status );
  2459.     call check$status( status );
  2460.     if ( buffer.len > 0 ) and ( upcase( buffer.ch(0) ) = 'N' ) then
  2461.       do;   /* They said no, so assume they're at T4 */
  2462.         console$data$port = base$port + 6;  /* for T4 */
  2463.         console$status$port = console$data$port + 1;
  2464.       end;
  2465.     else
  2466.       do;   /* Otherwise they're at T0 (the system console) */
  2467.         console$data$port = T0$data$port;
  2468.         console$status$port = T0$status$port;
  2469.       end;
  2470.     call new$line;  /* Leave a blank line below that question */
  2471.  
  2472.     /* Now get a connection to the console */
  2473.     console = rq$s$attach$file( @( 4,':CO:' ), @status );
  2474.     call check$status( status );
  2475.     /* Open it for both reading and writing */
  2476.     /* (specify zero buffers for interactive use) */
  2477.     call rq$s$open( console, 3, 0, @status );
  2478.     call check$status( status );
  2479.  
  2480.     /* Create a command connection, using the console for :CI: and :CO: */
  2481.     comm$conn = rq$c$create$command$connection( console, console, 0, @status );
  2482.     call check$status( status );
  2483.  
  2484.     /* Prevent a CTRL/C typed on the console from aborting the program */
  2485.     /* Create a semaphore to receive a unit when a CTRL/C is pressed */
  2486.     cc$sema4 = rq$create$semaphore( 0, 1, 0, @status );
  2487.     call check$status( status );
  2488.     /* Associate CTRL/C from the console with our semaphore */
  2489.     signal$pair.semaphore = cc$sema4;
  2490.     signal$pair.character = CTRL$C;
  2491.     call rq$s$special( console, 6, @signal$pair, 0, @status );
  2492.     call check$status( status );
  2493.  
  2494. end setup;
  2495.  
  2496.  
  2497. read$char: procedure( file ) word public;
  2498.  
  2499.     /*
  2500.      *  Return the next character from the file specified
  2501.      *  by FILE (which must be a connection open for reading).
  2502.      *  Returns the constant EOF$CODE (which cannot be a character
  2503.      *  because it is larger than 0FFh) if the file pointer is
  2504.      *  at end-of-file.
  2505.      */
  2506.  
  2507.     declare
  2508.         file                    token,
  2509.         ( bytes$read, status )  word,
  2510.         ch                      byte;
  2511.  
  2512.     /* Read the next byte from the file */
  2513.     bytes$read = rq$s$read$move( file, @ch, 1, @status );
  2514.     call check$status( status );
  2515.     if ( bytes$read = 0 ) then  /* we ran into end-of-file */
  2516.         return( EOF$CODE );     /* so signal that */
  2517.     else    /* we got a character */
  2518.         return( ch );       /* so return it */
  2519.  
  2520. end read$char;
  2521.  
  2522.  
  2523. get$next$file$name: procedure( info$ptr ) public;
  2524.  
  2525.     /*
  2526.      *  Place the name of the next file to be sent into the buffer
  2527.      *  pointed to by INFO$PTR.  This assumes that GET$FIRST$FILE$NAME
  2528.      *  has previously been called.  When there are no more filenames,
  2529.      *  the buffer receives a null string (length zero).
  2530.      */
  2531.  
  2532.     declare
  2533.         info$ptr            pointer,
  2534.         ( ch, status )      word,
  2535.         info based info$ptr structure(
  2536.                                 len     byte,
  2537.                                 ch(1)   byte);
  2538.  
  2539.     info.len = 0;   /* init to null string */
  2540.     ch = read$char( file$list );    /* read the first character */
  2541.     /* Read characters from the file-list file up to return or EOF */
  2542.     do while ( ( ch <> CR ) and ( ch <> EOF$CODE ) );
  2543.         info.ch( info.len ) = ch;   /* store previous char */
  2544.         info.len = ( info.len + 1 );    /* update length */
  2545.         ch = read$char( file$list );    /* get next char */
  2546.     end;    /* do while ( ( ch <> CR ) and ( ch <> EOF$CODE ) ) */
  2547.     if ( ch = CR ) then     /* we got a return */
  2548.         ch = read$char( file$list );    /* discard the line-feed too */
  2549.     if ( info.len = 0 ) then    /* there are no more filenames */
  2550.       do;   /* Delete the file connection */
  2551.         call rq$s$delete$connection( file$list, @status );
  2552.         call check$status( status );
  2553.       end;
  2554.  
  2555. end get$next$file$name;
  2556.  
  2557.  
  2558. get$first$file$name: procedure( keyword$num, info$ptr ) public;
  2559.  
  2560.     /*
  2561.      *  Get the first filename matching the filespec in keyword number
  2562.      *  KEYWORD$NUM into the buffer pointed to by INFO$PTR.  This routine
  2563.      *  also does the setup necessary for handling wild-card file names so
  2564.      *  that GET$NEXT$FILE$NAME can return the subsequent matching file
  2565.      *  names.  Returns a null string to the buffer if the name cannot
  2566.      *  be parsed (e.g. contains wildcards which don't match any files).
  2567.      */
  2568.  
  2569.     declare
  2570.         keyword$num             byte,
  2571.         info$ptr                pointer,
  2572.         ( status, com$status )  word,
  2573.         info based info$ptr     structure(
  2574.                                     len     byte,
  2575.                                     ch(1)   byte);
  2576.  
  2577.     /* Get the filespec (possibly with wildcards) into the INFO buffer */
  2578.     call get$filespec( keyword$num, info$ptr );
  2579.     /* Send the ITEMIZE command to list the matching filenames */
  2580.     call rq$c$send$command( comm$conn, @( 9,'ITEMIZE &' ), @com$status,
  2581.                                 @status );
  2582.     if ( status <> E$CONTINUED ) then   /* should be continued */
  2583.         call check$status( status );
  2584.     /* Append an ampersand to the filespec */
  2585.     info.ch( info.len ) = '&';
  2586.     info.len = ( info.len + 1 );
  2587.     /* And concatenate it to the ITEMIZE command */
  2588.     call rq$c$send$command( comm$conn, @info, @com$status, @status );
  2589.     if ( status <> E$CONTINUED ) then   /* should still be continued */
  2590.         call check$status( status );
  2591.     /* Form the rest of the command in the INFO buffer */
  2592.     call movb( @( ' OVER ' ), @info.ch( 0 ), 6 );   /* the preposition */
  2593.     /* and the output filename */
  2594.     call movb( @file$list$name( 1 ), @info.ch( 6 ), file$list$name( 0 ) );
  2595.     info.len = ( file$list$name( 0 ) + 8 ); /* store length */
  2596.     info.ch( info.len - 2 ) = CR;
  2597.     info.ch( info.len - 1 ) = LF;
  2598.     /* Send the rest of the command and exectue it */
  2599.     call rq$c$send$command( comm$conn, @info, @com$status, @status );
  2600.     call check$status( status );
  2601.     if ( com$status = E$OK ) then   /* it executed O.K. */
  2602.       do;
  2603.         /* Get a connection to the file produced */
  2604.         file$list = rq$c$get$input$connection( @file$list$name, @status );
  2605.         call check$status( status );
  2606.         call get$next$file$name( @info );   /* and get the first filename */
  2607.       end;  /* if ( com$status = E$OK ) */
  2608.     else    /* A problem with the ITEMIZE command */
  2609.         info.len = 0;   /* Return null-string as the file-name */
  2610.  
  2611. end get$first$file$name;
  2612.  
  2613.  
  2614. prepare$file$name: procedure( info$ptr ) public;
  2615.  
  2616.     /*
  2617.      *  Prepare the filename in the buffer pointed to by INFO$PTR for
  2618.      *  sending to the other Kermit--i.e. remove directory and/or device
  2619.      *  names, leaving only the filename itself in the buffer.
  2620.      */
  2621.  
  2622.     declare
  2623.         info$ptr            pointer,
  2624.         ( i, ch )           byte,
  2625.         info based info$ptr structure(
  2626.                                 len     byte,
  2627.                                 ch(1)   byte);
  2628.  
  2629.     i = info.len;   /* Start at the end of the pathname */
  2630.     ch = info.ch( i - 1 );  /* Get last character */
  2631.     do while ( ( ch <> '/' ) and ( ch <> '^' ) and ( ch <> ':' )
  2632.                 and ( i > 0 ) );    /* while we're still in the filename */
  2633.         i = ( i - 1 );  /* scan backwards to the start of actual filename */
  2634.         ch = info.ch( i - 1 );  /* get current character */
  2635.     end;    /* do while ... */
  2636.     if ( i > 0 ) then   /* there's a logical or directory name to be trimmed */
  2637.       do;
  2638.         /* move the actual filename to the beginning of the buffer */
  2639.         call movb( @info.ch( i ), @info.ch( 0 ), ( info.len - i ) );
  2640.         info.len = ( info.len - i );    /* and update length */
  2641.       end;  /* if ( i > 0 ) */
  2642.  
  2643. end prepare$file$name;
  2644.  
  2645.  
  2646. open$file: procedure( name$ptr ) boolean public;
  2647.  
  2648.     /*
  2649.      *  Open the file specified in the string (length byte followed
  2650.      *  by the characters of the name) pointed to by NAME$PTR, which is
  2651.      *  assumed to already exist, for reading.  Sets the global CUR$FILE.
  2652.      *  Returns TRUE if the open was successful, otherwise it prints
  2653.      *  an error message on the console describing the problem
  2654.      *  encountered and returns FALSE.
  2655.      */
  2656.  
  2657.     declare
  2658.         status      word,
  2659.         name$ptr    pointer;
  2660.  
  2661.     /* Get a connection to the file */
  2662.     cur$file = rq$s$attach$file( name$ptr, @status );
  2663.     if ( status = E$OK ) then   /* we got a connection */
  2664.         /* so open it, for reading only, with two buffers */
  2665.         call rq$s$open( cur$file, 1, 2, @status );
  2666.     if ( status = E$OK ) then   /* we successfully opened the file */
  2667.         return( TRUE );     /* indicate success */
  2668.     else    /* we encountered a problem */
  2669.       do;   /* Display an error message */
  2670.         call print( @( 17,'Can''t open file "' ) );
  2671.         call print( name$ptr );
  2672.         call print( @( 3,'"; ' ) );
  2673.         if ( status = E$FACCESS ) then
  2674.             call print( @( 20,'read access required' ) );
  2675.         else if ( status = E$FNEXIST ) then
  2676.             call print( @( 19,'file does not exist' ) );
  2677.         else if ( status = E$FTYPE ) then
  2678.             call print( @( 32,'can''t use data file as directory' ) );
  2679.         else
  2680.             call disp$excep( status );
  2681.         return( FALSE );    /* and indicate failure */
  2682.       end;
  2683.  
  2684. end open$file;
  2685.  
  2686.  
  2687. create$file: procedure( name$ptr ) boolean public;
  2688.  
  2689.     /*
  2690.      *  Create the file specified in the string (length byte followed
  2691.      *  by the characters of the name pointed to by NAME$PTR and open
  2692.      *  it for writing.  If it already exists the user will be asked
  2693.      *  whether to overwrite it.  If the operation is successful the
  2694.      *  global CUR$FILE is set and TRUE is returned, otherwise an
  2695.      *  error message is displayed at the console and FALSE is returned.
  2696.      */
  2697.  
  2698.     declare
  2699.         status      word,
  2700.         answer      byte,
  2701.         name$ptr    pointer;
  2702.  
  2703.     /* First, check whether the file already exists */
  2704.     cur$file = rq$s$attach$file( name$ptr, @status );
  2705.     if ( status = E$OK ) then   /* the file does already exist */
  2706.       do;
  2707.         /* First, delete the connection we didn't really want */
  2708.         call rq$s$delete$connection( cur$file, @status );
  2709.         call check$status( status );
  2710.         /* Now, ask the user whether to overwrite the file */
  2711.         call print( @( 6,'File "' ) );
  2712.         call print( name$ptr );
  2713.         call print( @( 37,'" already exists; overwrite it <no>? ' ) );
  2714.         answer = get$console$char( 0FFFFh );    /* wait for an answer */
  2715.         call print$char( answer );  /* show them what they typed */
  2716.         call new$line;  /* and that the question is finished */
  2717.         if ( upcase( answer ) = 'Y' ) then
  2718.             status = E$FNEXIST;     /* act as if the file didn't exist */
  2719.         else    /* they don't want to overwrite it */
  2720.             return( FALSE );    /* indicate failure, with no error message */
  2721.       end;
  2722.     if ( status = E$FNEXIST ) then  /* it's O.K. to go ahead and create it */
  2723.       do;
  2724.         cur$file = rq$s$create$file( name$ptr, @status );
  2725.         if ( status = E$OK ) then   /* we created the file O.K. */
  2726.             /* so open it, for writing only, with two buffers */
  2727.             call rq$s$open( cur$file, 2, 2, @status );
  2728.       end;
  2729.     if ( status = E$OK ) then   /* we successfully created the file */
  2730.         return( TRUE );     /* indicate success */
  2731.     else    /* we encountered a problem */
  2732.       do;   /* Display an error message */
  2733.         call print( @( 19,'Can''t create file "' ) );
  2734.         call print( name$ptr );
  2735.         call print( @( 3,'"; ' ) );
  2736.         if ( status = E$FACCESS ) then
  2737.             call print( @( 21,'write access required' ) );
  2738.         else if ( status = E$FNEXIST ) then
  2739.             call print( @( 19,'file does not exist' ) );
  2740.         else if ( status = E$FTYPE ) then
  2741.             call print( @( 32,'can''t use data file as directory' ) );
  2742.         else
  2743.             call disp$excep( status );
  2744.         return( FALSE );    /* and indicate failure */
  2745.       end;
  2746.  
  2747. end create$file;
  2748.  
  2749.  
  2750. close$file: procedure public;
  2751.  
  2752.     /*
  2753.      *  Close the file specified by the connection in the global
  2754.      *  token CUR$FILE.
  2755.      */
  2756.  
  2757.     declare
  2758.         status      word;
  2759.  
  2760.     call rq$s$close( cur$file, @status );   /* close the file */
  2761.     call check$status( status );
  2762.     /* and delete the connection */
  2763.     call rq$s$delete$connection( cur$file, @status );
  2764.     call check$status( status );
  2765.  
  2766. end close$file;
  2767.  
  2768.  
  2769. write$char: procedure( file, ch ) public;
  2770.  
  2771.     /*
  2772.      *  Write the character CH out to the file specified by FILE
  2773.      *  (which must be a connection open for writing).
  2774.      */
  2775.  
  2776.     declare
  2777.         file                        token,
  2778.         ch                          byte,
  2779.         ( bytes$written, status )   word;
  2780.  
  2781.     bytes$written = rq$s$write$move( file, @ch, 1, @status );
  2782.     call check$status( status );
  2783.  
  2784. end write$char;
  2785.  
  2786.  
  2787. get$command$line: procedure( prompt$ptr ) public;
  2788.  
  2789.     /*
  2790.      *  Display the string pointed to by PROMPT$PTR and get a command
  2791.      *  line from the console into the global buffer COM$LINE.  This
  2792.      *  procedure also does some preliminary processing of the command line:
  2793.      *  All letters are converted to upper-case, tabs are converted to
  2794.      *  spaces, spaces which are redundant or at the beginning of the
  2795.      *  command line are removed, and line terminators are removed.
  2796.      *  Thus upon return the COM$LINE buffer should contain simply the
  2797.      *  keyword(s), separated by only one space each.
  2798.      */
  2799.  
  2800.     declare
  2801.         prompt$ptr  pointer,
  2802.         space$flag  boolean,    /* TRUE if a space here is significant */
  2803.         ( i, j )    byte,       /* Indicies into the command line buffer */
  2804.         status      word;
  2805.  
  2806.     /* Issue the prompt and get the command line into the buffer */
  2807.     call rq$c$send$co$response( @com$line, size( com$line ),
  2808.                                     prompt$ptr, @status );
  2809.     call check$status( status );
  2810.  
  2811.     if ( com$line.len = 0 ) then    /* We got EOF (end-of-file, or ^Z) */
  2812.       do;   /* Treat the EOF like an EXIT command */
  2813.         call print( @( 2,'^Z' ) );  /* Echo the ^Z */
  2814.         call new$line;  /* And echo a CRLF */
  2815.         /* Put the EXIT command in the buffer */
  2816.         call movb( @( 4,'EXIT' ), @com$line, 5 );
  2817.       end;  /* if ( com$line.len = 0 ) */
  2818.     else    /* We got a command line */
  2819.       do;   /* do the preliminary processing of the command line */
  2820.         /* If the last character wasn't a line-feed */
  2821.         if ( com$line.ch( com$line.len - 1 ) <> LF ) then
  2822.             call new$line;  /* Get the cursor onto a new line */
  2823.         /* Add a CR at the end in case there isn't one */
  2824.         com$line.ch( com$line.len ) = CR;
  2825.         i, j = 0;   /* init the pointers to the start of the buffer */
  2826.         space$flag = FALSE; /* Initial spaces are meaningless */
  2827.         /* Process the line until the CR */
  2828.         do while ( com$line.ch( i ) <> CR );
  2829.             if ( com$line.ch( i ) = HT ) then
  2830.                 com$line.ch( i ) = ' ';     /* convert tabs to spaces */
  2831.             /* If this is a significant character */
  2832.             if ( space$flag or ( com$line.ch( i ) <> ' ' ) ) then
  2833.               do;   /* Process this character */
  2834.                 /* Store it (capitalized) in the resulting command line */
  2835.                 com$line.ch( j ) = upcase( com$line.ch( i ) );
  2836.                 j = j + 1;  /* Increment the pointer to the result */
  2837.                 if ( com$line.ch( i ) = ' ' ) then  /* if it's a space */
  2838.                     space$flag = FALSE; /* further spaces are redundant */
  2839.                 else    /* it's not a space */
  2840.                     space$flag = TRUE;  /* so a space after it is meaningful */
  2841.               end;  /* if ( space$flag or ( com$line.ch( i ) <> ' ' ) ) */
  2842.             i = i + 1;  /* Move to the next character of input */
  2843.         end;    /* do while ( com$line.ch( i ) <> CR ) */
  2844.         com$line.len = j;   /* Store the length of the result */
  2845.       end;  /* else -- we got a command line */
  2846.  
  2847. end get$command$line;
  2848.  
  2849.  
  2850. do$help: procedure( num$params ) public;
  2851.  
  2852.     /*
  2853.      *  Perform the HELP command.  This procedure passes the name
  2854.      *  of our help library and the number of parameters specified
  2855.      *  by NUM$PARAMS to the HELP program.
  2856.      */
  2857.  
  2858.     declare
  2859.         ( num$params, i )       byte,
  2860.         ( com$status, status )  word,
  2861.         buffer                  structure(
  2862.                                     len     byte,
  2863.                                     ch(50)  byte);
  2864.  
  2865.     /* Get the name of the file containing this program */
  2866.     call rq$c$get$command$name( @buffer, size( buffer ), @status );
  2867.     call check$status( status );
  2868.     /* Append the .HLP suffix to it, forming the name of the help library */
  2869.     call movb( @( '.HLP &' ), @buffer.ch( buffer.len ), 6 );
  2870.     buffer.len = ( buffer.len + 6 );
  2871.     /* Send the HELP command, with @ to signal library name comes next */
  2872.     call rq$c$send$command( comm$conn, @( 7,'HELP @&' ), @com$status,
  2873.                                 @status );
  2874.     if ( status <> E$CONTINUED ) then   /* should be continued */
  2875.         call check$status( status );
  2876.     /* Add our help library name to it */
  2877.     call rq$c$send$command( comm$conn, @buffer, @com$status, @status );
  2878.     if ( status <> E$CONTINUED ) then   /* should still be continued */
  2879.         call check$status( status );
  2880.     /* For each parameter which we have */
  2881.     do i = 1 to num$params;
  2882.         call get$filespec( i, @buffer );    /* get the parameter */
  2883.         buffer.ch( buffer.len ) = ' ';
  2884.         buffer.ch( buffer.len + 1 ) = '&';  /* add space and ampersand */
  2885.         buffer.len = ( buffer.len + 2 );
  2886.         /* Append the parameter to the HELP command line */
  2887.         call rq$c$send$command( comm$conn, @buffer, @com$status, @status );
  2888.         if ( status <> E$CONTINUED ) then   /* should still be continued */
  2889.             call check$status( status );
  2890.     end;    /* do i = 1 to num$params */
  2891.     /* And finally execute the command */
  2892.     call rq$c$send$command( comm$conn, @( 2,CR,LF ), @com$status, @status );
  2893.     call check$status( status );
  2894.  
  2895. end do$help;
  2896.  
  2897.  
  2898. end kermit$sys;
  2899. /* [---KERUTIL.P86---] */
  2900. $large
  2901.  
  2902. Kermit$util: do;
  2903.  
  2904. /*
  2905.  *      K e r m i t   File Transfer Utility
  2906.  *
  2907.  *      iRMX-86 Kermit, Version 2.3
  2908.  *      by Albert J. Goodman, Grinnell College
  2909.  *
  2910.  *      General Kermit utilities module.
  2911.  *      Edit date:  2-June-1985
  2912.  */
  2913.  
  2914.  
  2915. /* Define the system type TOKEN */
  2916. $include(:I:LTKSEL.LIT)
  2917.  
  2918.  
  2919. declare
  2920.                 /* CONSTANTS */
  2921.  
  2922.             /* Useful text substitutions */
  2923.     boolean                 literally   'byte',     /* define a new type */
  2924.     TRUE                    literally   '0FFh',     /* and constants */
  2925.     FALSE                   literally   '000h',     /*  of that type */
  2926.  
  2927.             /* ASCII control character constants */
  2928.     NUL                     literally   '00h',  /* null */
  2929.     SOH                     literally   '01h',  /* start-of-header */
  2930.     CTRL$C                  literally   '03h',  /* CTRL/C */
  2931.     BEL                     literally   '07h',  /* bell (beep) */
  2932.     BS                      literally   '08h',  /* backspace */
  2933.     HT                      literally   '09h',  /* horizontal tab */
  2934.     LF                      literally   '0Ah',  /* line-feed */
  2935.     CR                      literally   '0Dh',  /* carriage-return */
  2936.     CTRL$R$BRAK             literally   '1Dh',  /* CTRL/] */
  2937.     DEL                     literally   '7Fh',  /* delete (rubout) */
  2938.  
  2939.             /* Defaults for various Kermit parameters */
  2940.     def$packet$len          literally   '80',
  2941.     def$time$limit          literally   '10',
  2942.     def$num$pad             literally   '0',
  2943.     def$pad$char            literally   'NUL',
  2944.     def$eol                 literally   'CR',
  2945.     def$quote               literally   '''#''',
  2946.  
  2947.             /* GET$REMOTE$CHAR return codes (see KERMIT$SYS) */
  2948.     TIMEOUT                 literally   '0FFFFh',   /* Time limit expired */
  2949.     CTRL$C$CODE             literally   '08003h',   /* CTRL/C abort */
  2950.             /* READ$CHAR return code (see KERMIT$SYS) */
  2951.     EOF$CODE                literally   '0FF00h',   /* end-of-file */
  2952.  
  2953.             /* Other constants */
  2954.     MAX$PACKET$LEN          literally   '94',
  2955.     MAX$KEYWORDS            literally   '5',
  2956.  
  2957.             /* String constant (for PRINT$SPACES) */
  2958.     spaces$string(*)        byte data( 15, '               ' ),
  2959.  
  2960.  
  2961.                 /* GLOBAL VARIABLES */
  2962.  
  2963.             /* Token (defined in KERMIT$SYS) */
  2964.     cur$file    token external, /* Connection to the current file */
  2965.  
  2966.             /* Kermit parameters (defined in main module) */
  2967.     debug       boolean external,   /* Whether we're debugging the program */
  2968.     max$retry   byte external,  /* Maximum number of times to retry a packet */
  2969.     packet$len  byte external,  /* The maximum length packet to send */
  2970.     time$limit  byte external,  /* Seconds to time out if nothing received */
  2971.     num$pad     byte external,  /* The number of padding characters to send */
  2972.     pad$char    byte external,  /* The padding character to send */
  2973.     eol         byte external,  /* The EOL (end-of-line) character to send */
  2974.     quote       byte external,  /* The control-quote character to be used */
  2975.  
  2976.             /* Other Kermit variables (defined in main module) */
  2977.     state       byte external,  /* Current state */
  2978.     seq         byte external,  /* The current sequence number (0 to 63) */
  2979.     tries       byte external,  /* Number of times current packet retried */
  2980.  
  2981.             /* Buffers */
  2982.     com$line    structure(      /* The buffer for the command line */
  2983.                     len     byte,
  2984.                     ch(80)  byte) external, /* defined in KERMIT$SYS */
  2985.  
  2986.             /* Comand parsing information */
  2987.     num$keywords    byte public,    /* Number of keywords in KEYWORD array */
  2988.     keyword(MAX$KEYWORDS)   structure(      /* the keywords in COM$LINE */
  2989.                                 index   byte,   /* starting index */
  2990.                                 len     byte);  /* length without spaces */
  2991.  
  2992.  
  2993. /*      External procedures defined in KERMIT$SYS   */
  2994.  
  2995. get$remote$char: procedure( time$limit ) word external;
  2996.     declare
  2997.         time$limit  word;
  2998. end get$remote$char;
  2999.  
  3000. xmit$remote$char: procedure( ch ) external;
  3001.     declare
  3002.         ch  byte;
  3003. end xmit$remote$char;
  3004.  
  3005. print: procedure( string$ptr ) external;
  3006.     declare
  3007.         string$ptr  pointer;
  3008. end print;
  3009.  
  3010. new$line: procedure external;
  3011. end new$line;
  3012.  
  3013. print$char: procedure( ch ) external;
  3014.     declare
  3015.         ch  byte;
  3016. end print$char;
  3017.  
  3018. read$char: procedure( file ) word external;
  3019.     declare
  3020.         file    token;
  3021. end read$char;
  3022.  
  3023. write$char: procedure( file, ch ) external;
  3024.     declare
  3025.         file    token,
  3026.         ch      byte;
  3027. end write$char;
  3028.  
  3029.  
  3030. /*
  3031.  *
  3032.  *      General Kermit utility functions
  3033.  *
  3034.  */
  3035.  
  3036.  
  3037. char: procedure( x ) byte;
  3038.  
  3039.     /*
  3040.      *  Transform an integer in the range 0 to 94 (decimal)
  3041.      *  into a printable ASCII character.
  3042.      */
  3043.  
  3044.     declare
  3045.         x   byte;
  3046.  
  3047.     return( x + ' ' );
  3048.  
  3049. end char;
  3050.  
  3051.  
  3052. unchar: procedure( x ) byte;
  3053.  
  3054.     /*
  3055.      *  Reverse the CHAR transformation.
  3056.      */
  3057.  
  3058.     declare
  3059.         x   byte;
  3060.  
  3061.     return( x - ' ' );
  3062.  
  3063. end unchar;
  3064.  
  3065.  
  3066. ctl: procedure( x ) byte;
  3067.  
  3068.     /*
  3069.      *  Transform a control character into its printable representation,
  3070.      *  and vice-versa.  I.e. CTRL/A becomes A, and A becomes CTRL/A.
  3071.      */
  3072.  
  3073.     declare
  3074.         x   byte;
  3075.  
  3076.     return( x XOR 40h );
  3077.  
  3078. end ctl;
  3079.  
  3080.  
  3081. upcase: procedure( x ) byte public;
  3082.  
  3083.     /*
  3084.      *  Force an ASCII letter to upper-case;
  3085.      *  a non-letter is returned unchanged.
  3086.      */
  3087.  
  3088.     declare
  3089.         x   byte;
  3090.  
  3091.     if ( ( x >= 'a' ) and ( x <= 'z' ) ) then   /* it was lower-case */
  3092.         return( x - 'a' + 'A' );    /* return the upper-case equivalent */
  3093.     else    /* it was anything else */
  3094.         return( x );    /* just return it unchanged */
  3095.  
  3096. end upcase;
  3097.  
  3098.  
  3099. low7: procedure( x ) byte;
  3100.  
  3101.     /*
  3102.      *  Return the low-order seven bits of a character,
  3103.      *  i.e. set the eighth bit to zero, stripping the parity bit.
  3104.      */
  3105.  
  3106.     declare
  3107.         x   byte;
  3108.  
  3109.     return( x AND 07Fh );
  3110.  
  3111. end low7;
  3112.  
  3113.  
  3114. not$printable: procedure( x ) boolean;
  3115.  
  3116.     /*
  3117.      *  Determine whether an ASCII character is a printable character
  3118.      *  or not; return TRUE if it is a control character, FALSE if it's
  3119.      *  printable.  Assumes the high-order (parity) bit is not set.
  3120.      */
  3121.  
  3122.     declare
  3123.         x   byte;
  3124.  
  3125.     return( ( x < ' ' ) or ( x = DEL ) );
  3126.  
  3127. end not$printable;
  3128.  
  3129.  
  3130. special$char: procedure( x ) boolean;
  3131.  
  3132.     /*
  3133.      *  Returns TRUE if X is a quoting or prefix
  3134.      *  character currently being used (i.e. if
  3135.      *  it needs to be quoted itself).  Assumes
  3136.      *  the high-order (parity) bit is not set.
  3137.      */
  3138.  
  3139.     declare
  3140.         x       byte;
  3141.  
  3142.     /* Only the control-quote is implemented so far */
  3143.     return( x = quote );
  3144.  
  3145. end special$char;
  3146.  
  3147.  
  3148. next$seq: procedure( seq$num ) byte public;
  3149.  
  3150.     /*
  3151.      *  Return the next sequence number after SEQ$NUM; that is,
  3152.      *  SEQ$NUM + 1 modulo 64.
  3153.      */
  3154.  
  3155.     declare
  3156.         seq$num     byte;
  3157.  
  3158.     return( ( seq$num + 1 ) AND 03Fh );
  3159.  
  3160. end next$seq;
  3161.  
  3162.  
  3163. previous$seq: procedure( seq$num ) byte public;
  3164.  
  3165.     /*
  3166.      *  Return the previous sequence number to SEQ$NUM.
  3167.      */
  3168.  
  3169.     declare
  3170.         seq$num     byte;
  3171.  
  3172.     if ( seq$num = 0 ) then
  3173.         return( 63 );
  3174.     else
  3175.         return( seq$num - 1 );
  3176.  
  3177. end previous$seq;
  3178.  
  3179.  
  3180. /*
  3181.  *
  3182.  *      Output display procedures
  3183.  *
  3184.  */
  3185.  
  3186.  
  3187. show$char: procedure( ch ) public;
  3188.  
  3189.     /*
  3190.      *  Display a character on the console in readable form,
  3191.      *  even if it is a control character.  It is assumed
  3192.      *  that the high-order bit is not set.
  3193.      */
  3194.  
  3195.     declare
  3196.         ch  byte;
  3197.  
  3198.     if ( not$printable( ch ) ) then
  3199.       do;   /* Display the character in a readable form */
  3200.         if ( ch = DEL ) then    /* Display DEL specially */
  3201.             call print( @( 5, '<DEL>' ) );
  3202.         else
  3203.           do;   /* display an ordinary control character */
  3204.             call print( @( 6,'<Ctrl-' ) );
  3205.             call print$char( ctl( ch ) );
  3206.             call print$char( '>' );
  3207.           end;  /* else */
  3208.       end;  /* if ( not$printable( ch ) ) */
  3209.     else    /* It's printable, so just display it */
  3210.         call print$char( ch );
  3211.  
  3212. end show$char;
  3213.  
  3214.  
  3215. show$dec$num: procedure( num ) public;
  3216.  
  3217.     /*
  3218.      *  Display the value of a number in decimal on the console.
  3219.      */
  3220.  
  3221.     declare
  3222.         ( num, digit, i )   word,
  3223.         string              structure(
  3224.                                 len     byte,
  3225.                                 ch(5)   byte);
  3226.  
  3227.     i = 5;  /* Start at the last (least-significant) digit */
  3228.     do while ( num > 0 );   /* As long as there are more digits */
  3229.         digit = num mod 10;     /* Get the current least-significant digit */
  3230.         num = ( num - digit ) / 10;     /* Remove it from the number */
  3231.         i = i - 1;                      /* Back up one place */
  3232.         string.ch(i) = digit + '0';     /* Convert the digit to ASCII */
  3233.     end;    /* do while */
  3234.     string.len = 5 - i;     /* Find the length of the number */
  3235.     if ( string.len = 0 ) then
  3236.         do;     /* Display zero as 0, not a null string */
  3237.             string.ch(0) = '0';
  3238.             string.len = 1;
  3239.         end;    /* if ... */
  3240.     else if ( i > 0 ) then  /* If we didn't use all five spaces, */
  3241.         /* Move the number down to the start of the buffer */
  3242.         call movb( @string.ch(i), @string.ch(0), string.len );
  3243.     call print( @string );  /* display the number */
  3244.  
  3245. end show$dec$num;
  3246.  
  3247.  
  3248. show$flag: procedure( flag ) public;
  3249.  
  3250.     /*
  3251.      *  Display the value of a boolean flag on the console:
  3252.      *  If the flag is TRUE, display ON, if the flag is FALSE,
  3253.      *  display OFF.
  3254.      */
  3255.  
  3256.     declare
  3257.         flag    boolean;
  3258.  
  3259.     if ( flag ) then
  3260.         call print( @( 2,'ON' ) );
  3261.     else
  3262.         call print( @( 3,'OFF' ) );
  3263.  
  3264. end show$flag;
  3265.  
  3266.  
  3267. print$spaces: procedure( num );
  3268.  
  3269.     /*
  3270.      *  Print NUM spaces on the console.
  3271.      */
  3272.  
  3273.     declare
  3274.         num     byte,
  3275.         len     byte at( @spaces$string );
  3276.  
  3277.     len = num;  /* set length to be printed this time--must not be > 15 */
  3278.     call print( @spaces$string );   /* print them */
  3279.  
  3280. end print$spaces;
  3281.  
  3282.  
  3283. /*
  3284.  *
  3285.  *      Kermit protocol communication routines
  3286.  *
  3287.  */
  3288.  
  3289.  
  3290. send$char: procedure( ch );
  3291.  
  3292.     /*
  3293.      *  Send the character CH to the other Kermit.
  3294.      */
  3295.  
  3296.     declare
  3297.         ch      byte;
  3298.  
  3299.     call xmit$remote$char( ch ); /* send it on the remote line */
  3300.  
  3301. end send$char;
  3302.  
  3303.  
  3304. send$packet: procedure( type, num, info$ptr ) public;
  3305.  
  3306.     /*
  3307.      *  Send a packet to the remote Kermit.  TYPE is the character
  3308.      *  for the packet type, NUM is the packet number to be used,
  3309.      *  and INFO$PTR points to a string (length byte followed by
  3310.      *  data bytes) containing the contents of the packet to be sent,
  3311.      *  with all control-quoting or other processing already done.
  3312.      *  INFO$PTR may be zero in which case an "emtpy" packet is sent.
  3313.      *  The length field is assumed to be at least five less than
  3314.      *  PACKET$LEN (the maximum length packet to send, i.e. the other
  3315.      *  Kermit's buffer size)--this is not checked here.
  3316.      */
  3317.  
  3318.     declare
  3319.         ( type, num, i, checksum )  byte,
  3320.         info$ptr                    pointer,
  3321.         info based info$ptr         structure(
  3322.                                         len     byte,
  3323.                                         ch(1)   byte);
  3324.  
  3325.     send$packet$char: procedure( ch );
  3326.  
  3327.         /*
  3328.          *  Send one character of a packet (other than the SOH or
  3329.          *  checksum) by adding it to the checksum and then actually
  3330.          *  sending it.
  3331.          */
  3332.  
  3333.         declare
  3334.             ch      byte;
  3335.  
  3336.         checksum = ( checksum + ch );   /* Accumulate checksum */
  3337.         call send$char( ch );           /* send the char */
  3338.  
  3339.     end send$packet$char;
  3340.  
  3341.  
  3342.     /* begin SEND$PACKET */
  3343.     if ( debug ) then
  3344.       do;
  3345.         call print( @( 20,'Send-packet:  num = ' ) );
  3346.         call show$dec$num( num );
  3347.         call print( @( 9,'; type = ' ) );
  3348.         call show$char( type );
  3349.         call print( @( 10,'; data = "' ) );
  3350.         if ( info$ptr <> 0 ) then
  3351.             call print( info$ptr );
  3352.         call print$char( '"' );
  3353.         call new$line;
  3354.       end;
  3355.     do i = 1 to num$pad;    /* Send any padding requested */
  3356.         call send$char( pad$char );
  3357.     end;    /* do i = 1 to num$pad */
  3358.     call send$char( SOH );  /* Send the synchronization character */
  3359.     checksum = 0;   /* Initialize the checksum */
  3360.     if ( info$ptr = 0 ) then    /* no info to be sent */
  3361.         call send$packet$char( char( 3 ) );     /* so length is three */
  3362.     else    /* send packet length */
  3363.         call send$packet$char( char( info.len + 3 ) );
  3364.     call send$packet$char( char( num ) );   /* send packet number */
  3365.     call send$packet$char( type );  /* send packet type */
  3366.     if ( info$ptr <> 0 ) then   /* they gave us an info string */
  3367.       if ( info.len > 0 ) then    /* there is some data to be sent */
  3368.         do i = 0 to ( info.len - 1 );   /* for each character of data */
  3369.             call send$packet$char( info.ch( i ) );  /* send it */
  3370.         end;    /* do i = 0 to ( info.len - 1 ) */
  3371.     /* Now compute the final checksum by folding the high bits in */
  3372.     checksum = ( ( checksum + shr( checksum, 6 ) ) AND 03Fh );
  3373.     call send$char( char( checksum ) );    /* and send the checksum */
  3374.     /* The packet itself has now been sent */
  3375.     call send$char( eol );   /* now send the EOL character */
  3376.  
  3377. end send$packet;
  3378.  
  3379.  
  3380. receive$char: procedure( time$limit ) word;
  3381.  
  3382.     /*
  3383.      *  Receive a character from the other Kermit, timing out
  3384.      *  after TIME$LIMIT seconds.  Returns the same special
  3385.      *  codes as GET$REMOTE$CHAR.
  3386.      */
  3387.  
  3388.     declare
  3389.         ( time$limit, ch )  word;
  3390.  
  3391.     ch = get$remote$char( time$limit );     /* receive from remote port */
  3392.     if ( ch < 0100h ) then  /* we got a real character, not a special code */
  3393.         ch = low7( ch );    /* so strip the 8th bit in case it's parity */
  3394.     return( ch );   /* and return what we received */
  3395.  
  3396. end receive$char;
  3397.  
  3398.  
  3399. receive$packet: procedure( num$ptr, info$ptr ) byte public;
  3400.  
  3401.     /*
  3402.      *  Receive a packet from the remote Kermit.  NUM$PTR points
  3403.      *  to a byte which receives the sequence number of the incoming
  3404.      *  packet, INFO$PTR points to a string which receives the
  3405.      *  data field of the incoming packet, and the function returns
  3406.      *  the type character of the incoming packet.  If no character
  3407.      *  is received for TIME$LIMIT seconds at any point in the process,
  3408.      *  the receive operation will be abandoned and zero will be returned.
  3409.      *  (TIME$LIMIT is a global used here.)
  3410.      *  Zero will also be returned if a packet with a bad checksum is
  3411.      *  received.  If CTRL/C is pressed on the console the receive
  3412.      *  will be aborted and 0FFh will be returned.  (Note that if a
  3413.      *  character with ASCII value 0 or 0FFh is received during a packet,
  3414.      *  that code will be returned; however this does not apply outside
  3415.      *  the packet, and if a NUL or character 0FFh is received during a
  3416.      *  packet that indicates an error anyway.)
  3417.      */
  3418.  
  3419.     declare
  3420.         ( num$ptr, info$ptr )   pointer,
  3421.         num based num$ptr       byte,
  3422.         ( checksum, type, i )   byte,
  3423.         ch                      word,
  3424.         info based info$ptr     structure(
  3425.                                     len     byte,
  3426.                                     ch(1)   byte);
  3427.  
  3428.     get$packet$char: procedure byte;
  3429.  
  3430.         /*
  3431.          *  Return the next character of a packet and add it to the
  3432.          *  checksum.  Returns zero or 0FFh as described above for
  3433.          *  RECEVIE$PACKET.
  3434.          */
  3435.  
  3436.         declare
  3437.             ch      word;
  3438.  
  3439.         ch = receive$char( time$limit );    /* Get a char */
  3440.         if ( ch = TIMEOUT ) then    /* nothing received in time */
  3441.             return( 0 );
  3442.         else if ( ch = CTRL$C$CODE ) then   /* CTRL/C abort */
  3443.             return( 0FFh );
  3444.         else    /* got a character */
  3445.           do;
  3446.             checksum = ( checksum + ch );   /* accumulate checksum */
  3447.             return( ch );       /* and return the character */
  3448.           end;
  3449.  
  3450.     end get$packet$char;
  3451.  
  3452.  
  3453.     /* begin RECEIVE$PACKET */
  3454.     ch = receive$char( time$limit );    /* Get first character */
  3455.     /* As long as we got characters, but not the synchronization mark */
  3456.     do while ( ( ch <> TIMEOUT ) and ( ch <> CTRL$C$CODE ) and ( ch <> SOH ) );
  3457.         ch = receive$char( time$limit );    /* keep getting them */
  3458.     end;    /* do while ... */
  3459.     /* convert error conditions to our return codes */
  3460.     if ( ch = TIMEOUT ) then
  3461.         ch = 0;
  3462.     else if ( ch = CTRL$C$CODE ) then
  3463.         ch = 0FFh;
  3464.     do while ( ch = SOH );  /* if we got SOH, get the packet which follows */
  3465.         checksum = 0;   /* initialize the checksum */
  3466.         ch = get$packet$char;   /* get what should be the count */
  3467.         /* If we got a character, not SOH */
  3468.         if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then
  3469.           do;
  3470.             info.len = ( unchar( ch ) - 3 );    /* store data length */
  3471.             ch = get$packet$char;   /* now try for the sequence number */
  3472.             if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then
  3473.               do;
  3474.                 num = unchar( ch );     /* store packet number */
  3475.                 ch = get$packet$char;   /* now the type */
  3476.                 if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then
  3477.                   do;
  3478.                     type = ch;  /* store packet type for later */
  3479.                     i = 0;  /* init data index */
  3480.                     /* while we're still getting the data field */
  3481.                     do while ( ( ch <> 0 ) and ( ch <> 0FFh ) and
  3482.                                 ( ch <> SOH ) and ( i < info.len ) );
  3483.                         ch = get$packet$char;   /* get next data char */
  3484.                         info.ch( i ) = ch;  /* store data character */
  3485.                         i = ( i + 1 );  /* and bump data index */
  3486.                     end;    /* do while ... */
  3487.                     if ( ( ch <> 0 ) and ( ch <> 0FFh ) and
  3488.                             ( ch <> SOH ) ) then    /* got data O.K. */
  3489.                       do;
  3490.                         /* Get the incoming checksum */
  3491.                         ch = receive$char( time$limit );
  3492.                         if ( ch = TIMEOUT ) then
  3493.                             ch = 0;     /* signal no packet received */
  3494.                         else if ( ch = CTRL$C$CODE ) then
  3495.                             ch = 0FFh;  /* signal CTRL/C abort */
  3496.                         else if ( ch <> SOH ) then  /* got checksum */
  3497.                           do;
  3498.                             /* finish computing our checksum */
  3499.                             checksum = ( ( checksum + shr( checksum, 6 ) )
  3500.                                                 AND 03Fh );
  3501.                             /* if incoming checksum and ours disagree */
  3502.                             if ( checksum <> unchar( ch ) ) then
  3503.                                 ch = 0; /* signal bad packet received */
  3504.                             else    /* finally got good, complete, packet */
  3505.                                 ch = type;  /* so return its type */
  3506.                           end;  /* else if ( ch <> SOH ) */
  3507.                       end;  /* if ... */
  3508.                   end;  /* if ... */
  3509.               end;  /* if ... */
  3510.           end;  /* if ... */
  3511.     end;    /* do while ( ch = SOH ) */
  3512.     /* Finished with that packet */
  3513.     /* We would now flush the input buffer if we were using one */
  3514.     if ( debug ) then
  3515.       do;
  3516.         call print( @( 17,'Receive-packet:  ' ) );
  3517.         if ( ch = 0 ) then
  3518.             call print( @( 19,'<bad/absent packet>' ) );
  3519.         else if ( ch = 0FFh ) then
  3520.             call print( @( 14,'<CTRL/C abort>' ) );
  3521.         else
  3522.           do;
  3523.             call print( @( 6,'num = ' ) );
  3524.             call show$dec$num( num );
  3525.             call print( @( 9,'; type = ' ) );
  3526.             call show$char( ch );
  3527.             call print( @( 10,'; data = "' ) );
  3528.             call print( info$ptr );
  3529.             call print$char( '"' );
  3530.           end;
  3531.         call new$line;
  3532.       end;
  3533.     return( ch );   /* return packet type or error code (0 or 0FFh) */
  3534.  
  3535. end receive$packet;
  3536.  
  3537.  
  3538. send$kermit$params: procedure( info$ptr ) public;
  3539.  
  3540.     /*
  3541.      *  This procedure places our current parameters into the
  3542.      *  buffer pointed to by INFO$PTR in the format required for
  3543.      *  a Send-init packet or the acknowledgement to one.
  3544.      */
  3545.  
  3546.     declare
  3547.         info$ptr            pointer,
  3548.         info based info$ptr structure(
  3549.                                 len     byte,
  3550.                                 ch(1)   byte);
  3551.  
  3552.     info.len = 6;
  3553.     info.ch( 0 ) = char( packet$len ); /* longest packet to send */
  3554.     info.ch( 1 ) = char( time$limit ); /* number of seconds to time-out */
  3555.     info.ch( 2 ) = char( num$pad );    /* number of padding chars */
  3556.     info.ch( 3 ) = ctl( pad$char );    /* padding character */
  3557.     info.ch( 4 ) = char( eol );        /* end-of-line character */
  3558.     info.ch( 5 ) = quote;              /* control-quote character */
  3559.  
  3560. end send$kermit$params;
  3561.  
  3562.  
  3563. get$kermit$params: procedure( info$ptr ) public;
  3564.  
  3565.     /*
  3566.      *  This procedure sets our parameters based on the contents of
  3567.      *  the buffer pointed to by INFO$PTR which should contain the
  3568.      *  data field from a Send-init packet or the acknowledgement to one.
  3569.      */
  3570.  
  3571.     declare
  3572.         i                   byte,
  3573.         info$ptr            pointer,
  3574.         info based info$ptr structure(
  3575.                                 len     byte,
  3576.                                 ch(1)   byte);
  3577.  
  3578.     do i = info.len to 5;   /* for each field they omitted which we use */
  3579.         info.ch( i ) = ' ';     /* make it a space, i.e. default it */
  3580.     end;    /* do i = info.len to 5 */
  3581.     /* Set buffer size. */
  3582.     if ( info.ch( 0 ) = ' ' ) then
  3583.         packet$len = def$packet$len;    /* use default */
  3584.     else
  3585.         packet$len = unchar( info.ch( 0 ) );    /* use what they sent */
  3586.     /* Set time-out limit. */
  3587.     if ( info.ch( 1 ) = ' ' ) then
  3588.         time$limit = def$time$limit;    /* use default */
  3589.     else
  3590.         time$limit = unchar( info.ch( 1 ) );    /* use theirs */
  3591.     /* Set number of padding chars. */
  3592.     if ( info.ch( 2 ) = ' ' ) then
  3593.         num$pad = def$num$pad;      /* use default */
  3594.     else
  3595.         num$pad = unchar( info.ch( 2 ) );   /* use theirs */
  3596.     /* Set the padding character. */
  3597.     if ( info.ch( 3 ) = ' ' ) then
  3598.         pad$char = def$pad$char;    /* use default */
  3599.     else
  3600.         pad$char = ctl( info.ch( 3 ) );     /* use theirs */
  3601.     /* Set the end-of-line character. */
  3602.     if ( info.ch( 4 ) = ' ' ) then
  3603.         eol = def$eol;      /* use default */
  3604.     else
  3605.         eol = unchar( info.ch( 4 ) );   /* use theirs */
  3606.     /* Set the control-quote character. */
  3607.     if ( info.ch( 5 ) = ' ' ) then
  3608.         quote = def$quote;      /* use default */
  3609.     else
  3610.         quote = info.ch( 5 );   /* use theirs */
  3611.  
  3612. end get$kermit$params;
  3613.  
  3614.  
  3615. read$packet$from$file: procedure( info$ptr ) public;
  3616.  
  3617.     /*
  3618.      *  Fill the buffer pointed to by INFO$PTR with the next packet
  3619.      *  of the current file.  This routine does the quoting/prefixing.
  3620.      *  If zero bytes are loaded into the buffer, then we ran into
  3621.      *  end-of-file.
  3622.      */
  3623.  
  3624.     declare
  3625.         info$ptr            pointer,
  3626.         i                   byte,
  3627.         ch                  word,
  3628.         info based info$ptr structure(
  3629.                                 len     byte,
  3630.                                 ch(1)   byte);
  3631.  
  3632.     i, ch = 0;
  3633.     /* While we have more characters from the file and the packet */
  3634.     /* has room for another char (possibly with control quote) */
  3635.     do while ( ( ch <> EOF$CODE ) and ( i < ( packet$len - 6 ) ) );
  3636.         ch = read$char( cur$file );     /* get a char from the file */
  3637.         if ( ch <> EOF$CODE ) then  /* we got one */
  3638.           do;
  3639.             ch = low7( ch );    /* strip the 8th bit, just in case... */
  3640.             /* If this character needs to be quoted */
  3641.             if ( not$printable( ch ) or special$char( ch ) ) then
  3642.               do;
  3643.                 info.ch( i ) = quote;   /* Put control-quote in buffer */
  3644.                 i = ( i + 1 );  /* and update index */
  3645.                 if ( not$printable( ch ) ) then
  3646.                     ch = ctl( ch );     /* make control characters printable */
  3647.               end;  /* if ... -- needs to be quoted */
  3648.             info.ch( i ) = ch;      /* put character in buffer */
  3649.             i = ( i + 1 );      /* and update index */
  3650.           end;  /* if ( ch <> EOF$CODE ) */
  3651.     end;    /* do while ... */
  3652.     info.len = i;   /* store length of what we put in buffer */
  3653.  
  3654. end read$packet$from$file;
  3655.  
  3656.  
  3657. write$packet$to$file: procedure( info$ptr ) public;
  3658.  
  3659.     /*
  3660.      *  Write the contents of a received packet (in the buffer pointed
  3661.      *  to by INFO$PTR) out to the current file.  This routine deals
  3662.      *  with quoting characters in the incoming data.
  3663.      */
  3664.  
  3665.     declare
  3666.         info$ptr            pointer,
  3667.         ( x, i )            byte,
  3668.         info based info$ptr structure(
  3669.                                 len     byte,
  3670.                                 ch(1)   byte);
  3671.  
  3672.     i = 0;      /* start at the beginning */
  3673.     do while ( i < info.len );  /* while we have any more data */
  3674.         x = info.ch( i );   /* get the current character */
  3675.         if ( x = quote ) then   /* it's the control-quote character */
  3676.           do;
  3677.             i = ( i + 1 );  /* go to the next (quoted) character */
  3678.             x = info.ch( i );   /* and get it */
  3679.             /* If it's not a quoting or prefix character */
  3680.             if ( not special$char( x ) ) then   /* it's a control char */
  3681.                 x = ctl( x );       /* so restore the actual character */
  3682.           end;  /* if ( x = quote ) */
  3683.         call write$char( cur$file, x ); /* write char to file */
  3684.         i = ( i + 1 );      /* now go to next char */
  3685.     end;    /* do while ( i < info.len ) */
  3686.  
  3687. end write$packet$to$file;
  3688.  
  3689.  
  3690. /*
  3691.  *
  3692.  *      Error handling routines
  3693.  *
  3694.  */
  3695.  
  3696.  
  3697. error$msg: procedure( msg$ptr ) public;
  3698.  
  3699.     /*
  3700.      *  Send an error packet to the remote Kermit
  3701.      *  and display the error message on the console too.
  3702.      */
  3703.  
  3704.     declare
  3705.         msg$ptr     pointer;
  3706.  
  3707.     /* Send Error packet to the other Kermit */
  3708.     call send$packet( 'E', seq, msg$ptr );  /* send Error packet */
  3709.     seq = next$seq( seq );  /* and bump sequence number */
  3710.     call print( msg$ptr );  /* print it on the console too */
  3711.  
  3712. end error$msg;
  3713.  
  3714.  
  3715. unknown$packet$type: procedure( type, packet$ptr ) public;
  3716.  
  3717.     /*
  3718.      *  Deal with a received packet of an unexpected type.
  3719.      */
  3720.  
  3721.     declare
  3722.         type        byte,       /* type of the packet received */
  3723.         packet$ptr  pointer;    /* points to contents of the packet */
  3724.  
  3725.     if ( type = 'E' ) then  /* it is an error packet */
  3726.       do;
  3727.         /* Display the error message we received from the remote Kermit */
  3728.         call print( @( 20,'Remote Kermit error:' ) );
  3729.         call new$line;
  3730.         call print( packet$ptr );
  3731.         call new$line;
  3732.       end;
  3733.     else    /* an unknown packet type */
  3734.       do;
  3735.         /* Display an appropriate error message */
  3736.         call print( @( 24,'Unexpected packet type (' ) );
  3737.         call show$char( type );
  3738.         call print( @( 11,') received.' ) );
  3739.       end;
  3740.     state = 'A';    /* In any case, abort the current operation */
  3741.  
  3742. end unknown$packet$type;
  3743.  
  3744.  
  3745. too$many$retries: procedure public;
  3746.  
  3747.     /*
  3748.      *  Deal with the retry count reaching its limit.
  3749.      */
  3750.  
  3751.     /* Display an error message */
  3752.     call print( @( 17,'Too many retries.' ) );
  3753.     state = 'A';    /* and abort the operation */
  3754.  
  3755. end too$many$retries;
  3756.  
  3757.  
  3758. wrong$number: procedure public;
  3759.  
  3760.     /*
  3761.      *  Deal with a received packet with wrong sequence number.
  3762.      */
  3763.  
  3764.     /* Display an error message */
  3765.     call print( @( 27,'Unexpected packet sequence.' ) );
  3766.     state = 'A';    /* and abort the operation */
  3767.  
  3768. end wrong$number;
  3769.  
  3770.  
  3771. /*
  3772.  *
  3773.  *      Command parsing and display procedures
  3774.  *
  3775.  */
  3776.  
  3777.  
  3778. parse$command: procedure public;
  3779.  
  3780.     /*
  3781.      *  Parse the command line in the global buffer COM$LINE into
  3782.      *  keywords, separated by spaces.  The keywords are stored
  3783.      *  in the global KEYWORD array, the count in NUM$KEYWORDS.
  3784.      */
  3785.  
  3786.     declare
  3787.         ( i, j )    word;
  3788.  
  3789.     num$keywords = 0;   /* Initially we don't have any keywords yet */
  3790.     i = 0;              /* Start at the beginning of the command line */
  3791.     /* Go until we get to the end or have the maximum number of keywords */
  3792.     do while ( ( i < com$line.len ) and ( num$keywords < MAX$KEYWORDS ) );
  3793.         keyword( num$keywords ).index = i;  /* store start of this keyword */
  3794.         /* Find the next space (end of this keyword) */
  3795.         j = findb( @com$line.ch( i ), ' ', ( com$line.len - i ) );
  3796.         if ( j = 0FFFFh ) then  /* there isn't another space */
  3797.             j = ( com$line.len - i );   /* this keyword is rest of the line */
  3798.         keyword( num$keywords ).len = j;    /* store its length */
  3799.         num$keywords = ( num$keywords + 1 );    /* bump the keyword count */
  3800.         i = ( i + j + 1 );  /* next keyword starts after the space */
  3801.     end;    /* do while ( i < com$line.len ) */
  3802.  
  3803. end parse$command;
  3804.  
  3805.  
  3806. parse$dec$num: procedure( keyword$num, num$ptr ) boolean public;
  3807.  
  3808.     /*
  3809.      *  Parse a decimal number out of keyword number KEYWORD$NUM;
  3810.      *  i.e. interpret the string of characters that make up that
  3811.      *  keyword as a decimal number, and place its value into
  3812.      *  the word pointed to by NUM$PTR.  It returns a value of
  3813.      *  TRUE if this was successful, FALSE if the keyword does not
  3814.      *  represent a number (e.g. contains letters).
  3815.      */
  3816.  
  3817.     declare
  3818.         ( keyword$num, i )  byte,
  3819.         num$ptr             pointer,
  3820.         num based num$ptr   word,
  3821.         ( first, last, ch ) byte,
  3822.         valid               boolean;
  3823.  
  3824.     num = 0;    /* Init the number to zero */
  3825.     valid = TRUE;   /* Assume it's valid until proven otherwise */
  3826.     first = keyword( keyword$num ).index;   /* Get starting position */
  3827.     last = first + keyword( keyword$num ).len - 1;  /* and ending one */
  3828.     do i = first to last;   /* Step through each character in turn */
  3829.         ch = com$line.ch( i );  /* Get current character */
  3830.         if ( ( ch >= '0' ) and ( ch <= '9' ) ) then /* valid digit */
  3831.             num = ( num * 10 ) + ( ch - '0' );  /* Accumulate value */
  3832.         else    /* not a decimal digit */
  3833.             valid = FALSE;  /* Flag that it's invalid--NUM is meaningless */
  3834.     end;    /* do i = first to last */
  3835.     return( valid );
  3836.  
  3837. end parse$dec$num;
  3838.  
  3839.  
  3840. show$keyword: procedure( keyword$num );
  3841.  
  3842.     /*
  3843.      *  Display keyword number KEYWORD$NUM (as parsed into the
  3844.      *  global array KEYWORD) on the console.
  3845.      */
  3846.  
  3847.     declare
  3848.         ( keyword$num, first, last, i ) byte;
  3849.  
  3850.     /* Get the location of the first character of the keyword */
  3851.     first = keyword( keyword$num ).index;
  3852.     /* and the location of the last character of the keyword */
  3853.     last = first + keyword( keyword$num ).len - 1;
  3854.     /* Display each character in turn */
  3855.     do i = first to last;
  3856.         call print$char( com$line.ch( i ) );
  3857.     end;    /* do i = first to last */
  3858.  
  3859. end show$keyword;
  3860.  
  3861.  
  3862. show$command: procedure( kp1, kp2, kp3 ) public;
  3863.  
  3864.     /*
  3865.      *  Display a command (one to three keywords) on the console.
  3866.      *  Used for error messages.
  3867.      */
  3868.  
  3869.     declare
  3870.         ( kp1, kp2, kp3 )   pointer;
  3871.  
  3872.     call print( kp1 );
  3873.     if ( kp2 <> 0 ) then
  3874.       do;
  3875.         call print$char( ' ' );
  3876.         call print( kp2 );
  3877.         if ( kp3 <> 0 ) then
  3878.           do;
  3879.             call print$char( ' ' );
  3880.             call print( kp3 );
  3881.           end;  /* if ( kp3 <> 0 ) */
  3882.       end;  /* if ( kp2 <> 0 ) */
  3883.  
  3884. end show$command;
  3885.  
  3886.  
  3887. hint$command: procedure( kp1, kp2, kp3 );
  3888.  
  3889.     /*
  3890.      *  Give a hint on using the command (called if too few
  3891.      *  parameters or invalid parameter).
  3892.      */
  3893.  
  3894.     declare
  3895.         ( kp1, kp2, kp3 )   pointer;
  3896.  
  3897.     call print( @( 7,'  (Type' ) );
  3898.     if ( kp1 <> 0 ) then    /* it's a subcommand */
  3899.       do;
  3900.         call print$char( ' ' );
  3901.         call show$command( kp1, kp2, kp3 );
  3902.       end;  /* if ( kp1 <> 0 ) */
  3903.     call print( @( 23,' ? to see the choices.)' ) );
  3904.  
  3905. end hint$command;
  3906.  
  3907.  
  3908. too$few$params: procedure( kp1, kp2, kp3 ) public;
  3909.  
  3910.     /*
  3911.      *  Issue the error messages for commands which require
  3912.      *  parameters when they were not followed by any keywords.
  3913.      */
  3914.  
  3915.     declare
  3916.         ( kp1, kp2, kp3 )   pointer;
  3917.  
  3918.     call show$command( kp1, kp2, kp3 );
  3919.     call print( @( 22,' requires a parameter.' ) );
  3920.     call hint$command( kp1, kp2, kp3 );
  3921.  
  3922. end too$few$params;
  3923.  
  3924.  
  3925. too$many$params: procedure( kp1, kp2, kp3 ) public;
  3926.  
  3927.     /*
  3928.      *  Issue the error messages for commands which don't take
  3929.      *  parameters when they are followed by extra keyword(s).
  3930.      */
  3931.  
  3932.     declare
  3933.         ( kp1, kp2, kp3 )   pointer;
  3934.  
  3935.     call show$command( kp1, kp2, kp3 );
  3936.     call print( @( 26,' does not take parameters.' ) );
  3937.  
  3938. end too$many$params;
  3939.  
  3940.  
  3941. extra$params: procedure( kp1, kp2, kp3 ) public;
  3942.  
  3943.     /*
  3944.      *  Issue the error messages for commands which take only
  3945.      *  one parameter when they are followed by more than one
  3946.      *  keyword.
  3947.      */
  3948.  
  3949.     declare
  3950.         ( kp1, kp2, kp3 )   pointer;
  3951.  
  3952.     call show$command( kp1, kp2, kp3 );
  3953.     call print( @( 26,' takes only one parameter.' ) );
  3954.  
  3955. end extra$params;
  3956.  
  3957.  
  3958. invalid$param: procedure( k$num, kp1, kp2, kp3 ) public;
  3959.  
  3960.     /*
  3961.      *  Issue the error messages for invalid parameters.
  3962.      */
  3963.  
  3964.     declare
  3965.         k$num               byte,
  3966.         ( kp1, kp2, kp3 )   pointer;
  3967.  
  3968.     call show$keyword( k$num );
  3969.     call print( @( 16,' is not a valid ' ) );
  3970.     if ( kp1 = 0 ) then
  3971.         call print( @( 8,'command.' ) );
  3972.     else
  3973.       do;
  3974.         call print( @( 13,'parameter to ' ) );
  3975.         call show$command( kp1, kp2, kp3 );
  3976.         call print$char( '.' );
  3977.       end;  /* else */
  3978.     call hint$command( kp1, kp2, kp3 );
  3979.  
  3980. end invalid$param;
  3981.  
  3982.  
  3983. keyword$match: procedure( keyword$num, keyword$ptr, min$len ) boolean public;
  3984.  
  3985.     /*
  3986.      *  Compare keyword number KEYWORD$NUM (as parsed into the KEYWORD
  3987.      *  array) with the keyword (string) pointed to by KEYWORD$PTR,
  3988.      *  and return TRUE if the keyword is an abbreviation of the string
  3989.      *  containing at least MIN$LEN characters, otherwise return FALSE.
  3990.      */
  3991.  
  3992.     declare
  3993.         ( keyword$num, min$len )    byte,
  3994.         keyword$ptr                 pointer,
  3995.         string based keyword$ptr    structure(
  3996.                                         len     byte,
  3997.                                         ch(1)   byte);
  3998.  
  3999.     if ( keyword( keyword$num ).len < min$len ) then
  4000.         return( FALSE );    /* the keyword is too short */
  4001.     else if ( keyword( keyword$num ).len > string.len ) then
  4002.         return( FALSE );    /* the keyword is too long */
  4003.     else if ( cmpb( @com$line.ch( keyword( keyword$num ).index ),
  4004.                     @string.ch,
  4005.                     keyword( keyword$num ).len ) = 0FFFFh ) then
  4006.         return( TRUE );     /* the keyword matches */
  4007.     else
  4008.         return( FALSE );    /* the keyword doesn't match */
  4009.  
  4010. end keyword$match;
  4011.  
  4012.  
  4013. list$choices: procedure( kp1, kp2, kp3, list$ptr, list$last ) public;
  4014.  
  4015.     /*
  4016.      *  List the choices for commands or parameters to commands,
  4017.      *  in response to the ? "parameter."
  4018.      */
  4019.  
  4020.     declare
  4021.         ( kp1, kp2, kp3, list$ptr )         pointer,
  4022.         (list$element based list$ptr)(1)    pointer,
  4023.         element$ptr                         pointer,
  4024.         element$len based element$ptr       byte,
  4025.         ( list$last, i, j, k )              byte;
  4026.  
  4027.     call print$spaces( 2 );
  4028.     call print( @( 10,'Available ' ) );
  4029.     if ( kp1 = 0 ) then
  4030.         call print( @( 8,'commands' ) );
  4031.     else
  4032.       do;
  4033.         call print( @( 14,'parameters to ' ) );
  4034.         call show$command( kp1, kp2, kp3 );
  4035.       end;  /* else */
  4036.     call print( @( 5,' are:' ) );
  4037.     k = 5;  /* Set to start a new line immediately */
  4038.     do i = 0 to list$last;  /* for each entry in the list */
  4039.         if ( k > 4 ) then   /* start a new line every 5 columns */
  4040.           do;
  4041.             call new$line;
  4042.             call print$spaces( 4 );    /* indent */
  4043.             k = 0;  /* reset column counter */
  4044.           end;  /* if ( k > 4 ) */
  4045.         element$ptr = list$element( i );
  4046.         /* Compute number of spaces to next column */
  4047.         j = ( 15 - ( element$len MOD 15 ) );
  4048.         /* And update columns on this line so far */
  4049.         k = ( k + ( element$len / 15 ) + 1 );
  4050.         call print( element$ptr );
  4051.         call print$spaces( j );
  4052.     end;    /* do i = 0 to list$last */
  4053.  
  4054. end list$choices;
  4055.  
  4056. /*
  4057.  *
  4058.  *      Other utility procedures
  4059.  *
  4060.  */
  4061.  
  4062.  
  4063. get$filespec: procedure( keyword$num, info$ptr ) public;
  4064.  
  4065.     /*
  4066.      *  Get the filespec in keyword number KEYWORD$NUM into
  4067.      *  the buffer pointed to by INFO$PTR.
  4068.      */
  4069.  
  4070.     declare
  4071.         keyword$num         byte,
  4072.         info$ptr            pointer,
  4073.         info based info$ptr structure(
  4074.                                 len     byte,
  4075.                                 ch(1)   byte);
  4076.  
  4077.     /* Copy the keyword into the INFO buffer */
  4078.     info.len = keyword( keyword$num ).len;
  4079.     call movb( @com$line.ch( keyword( keyword$num ).index ),
  4080.                     @info.ch, info.len );
  4081.  
  4082. end get$filespec;
  4083.  
  4084.  
  4085. send$generic$command: procedure( info$ptr, info2$ptr ) boolean public;
  4086.  
  4087.     /*
  4088.      *  Send a Generic Kermit Command (the data field of which
  4089.      *  INFO$PTR must point to) to the other Kermit.  This only
  4090.      *  deals with commands to which no reply other than ACK or NAK
  4091.      *  or possibly an Error message is expected.  If an Error packet
  4092.      *  is received the error message is displayed and FALSE is returned;
  4093.      *  if a NAK is received the packet is retransmitted up to the
  4094.      *  global MAX$RETRY count, at which point an error message is
  4095.      *  displayed and FALSE is returned; if an ACK is received TRUE
  4096.      *  is returned.  INFO2$PTR points to the buffer which receives
  4097.      *  the contents of the response packet.
  4098.      */
  4099.  
  4100.     declare
  4101.         ( info$ptr, info2$ptr ) pointer,
  4102.         ( type, num )           byte;   /* Incoming packet type, number */
  4103.  
  4104.     seq = 0;    /* Set packet sequence number */
  4105.     tries = 0;  /* Init try count */
  4106.     do while ( tries < max$retry );
  4107.         tries = ( tries + 1 );  /* count a try */
  4108.         call send$packet( 'G', seq, info$ptr ); /* send generic command */
  4109.         type = receive$packet( @num, info2$ptr );   /* get response */
  4110.         if ( ( type = 'Y' ) and ( num = seq ) ) then    /* got good ACK */
  4111.             return( TRUE );
  4112.         else if ( type = 0FFh ) then    /* CTRL/C abort */
  4113.           do;
  4114.             call print( @( 26,'Command aborted by CTRL/C.' ) );
  4115.             return( FALSE );
  4116.           end;
  4117.         else if ( ( type <> 'N' ) and ( type <> 'Y' ) and ( type <> 0 ) ) then
  4118.           do;
  4119.             call unknown$packet$type( type, info2$ptr );
  4120.             return( FALSE );
  4121.           end;
  4122.     end;    /* do while ( tries < max$retry ) */
  4123.     call too$many$retries;
  4124.     return( FALSE );
  4125.  
  4126. end send$generic$command;
  4127.  
  4128.  
  4129. end kermit$util;
  4130. /* [---HELP.P86---] */
  4131. $large
  4132.  
  4133. help: do;
  4134.  
  4135. /*
  4136.  *              HELP Utility Program
  4137.  *  by Albert J. Goodman;  Edit date:  6-June-85
  4138.  *
  4139.  *  Gives help on a topic specified on the command line.  The
  4140.  *  format of the command line is one or more keywords (separated
  4141.  *  by one or more spaces and/or tabs), where each keyword after
  4142.  *  the first is treated as a subtopic of topic specified by the
  4143.  *  preceeding keyword(s).  Topic keywords may be abbreviated by any
  4144.  *  amount; if an abbreviation is given which matches the beginning
  4145.  *  of more than one topic in the help library file, the first matching
  4146.  *  topic will be displayed.  If the first keyword begins with an
  4147.  *  at-sign (@) the remainder of it is assumed to be the complete
  4148.  *  pathname of the help library to be used for the source of the
  4149.  *  help information.  If the command line does not begin with an
  4150.  *  at-sign, the default help library will be used, which has the
  4151.  *  same name (presumably HELP) and directory as this program with
  4152.  *  the extension ".HLP".  The information required to create a
  4153.  *  help library file is given below:
  4154.  *
  4155.  *  A help library is conceptually a tree structure, with a root
  4156.  *  help message and a list of subtopics, and similarly a help
  4157.  *  message and a list of sub-subtopics for each of the subtopics,
  4158.  *  and so on.  The structure of a help library file is defined by
  4159.  *  control lines beginning with a delimiter character (which may
  4160.  *  nevertheless be used freely within help text if not at the
  4161.  *  beginning of a line).  Each help file has its own delimiter
  4162.  *  character (which may be any character desired, but should not
  4163.  *  be a digit because it's used to delimit numbers), defined by the
  4164.  *  first character of the file.  The remainder of the first line
  4165.  *  of the file is ignored (thus it may be used for identification
  4166.  *  of author, date, or other comments).  Normal control lines each
  4167.  *  begin with the delmiter, followed by a (decimal) number indicating
  4168.  *  the nesting level of the help which follows this control line,
  4169.  *  followed by the delimiter again to mark the end of the number.
  4170.  *  A nesting level of one means a subtopic of the root; in other words,
  4171.  *  the nesting level is the position of the associated keyword in a
  4172.  *  command line (which may range from 1 to MAX$KEYWORDS minus one).
  4173.  *  The rest of the control line contains the (sub)topic keyword for that
  4174.  *  level which identifies the help text which follows this control line.
  4175.  *  Thus the file begins with the delimiter on a line the rest of which
  4176.  *  is ignored; following that comes zero or more lines of root help
  4177.  *  text, terminated by the next line beginning with the delimiter; this
  4178.  *  should contain the first subtopic keyword and a nesting level of
  4179.  *  one.  All sub-subtopic control lines are taken to be subtopics of
  4180.  *  the most recent previous control line with a nesting level one
  4181.  *  lower than theirs.  Finally, the last help text in the file (for
  4182.  *  the deepest nested help under the last keyword at each level above
  4183.  *  it) must be terminated by a special control line consisting of the
  4184.  *  delimiter followed by the word END (in upper or lower case) followed
  4185.  *  by a final occurrence of the delimter.  This marks the end of the help
  4186.  *  library file as far as the HELP program is concerned:  anything in
  4187.  *  the file after this control line will be ignored, and if the physical
  4188.  *  end-of-file is encountered before this control line an error message
  4189.  *  will be generated.  Also, the HELP program will indent all help text
  4190.  *  by an amount determined by its nesting level, so there is no need for
  4191.  *  indentation in the help library file.  Similarly, blank lines between
  4192.  *  the control lines and the help text are supplied and thus need not be
  4193.  *  in the file.
  4194.  */
  4195.  
  4196.  
  4197. /* Get all iRMX 86 system call external declarations */
  4198. $include(:I:RMX.EXT)
  4199.  
  4200. declare
  4201.         MAX$KEYWORDS    literally   '9',    /* Maximum topic keywords + 1 */
  4202.         MAX$KEYWORD$LEN literally   '23',   /* Maximum length of a keyword */
  4203.         boolean         literally   'byte', /* Another useful type */
  4204.         TRUE            literally   '0FFh', /* Boolean constant */
  4205.         FALSE           literally   '000h', /* ditto */
  4206.         CR              literally   '0Dh',  /* ASCII Carriage-return */
  4207.         LF              literally   '0Ah',  /* ASCII Line-feed character */
  4208.         HT              literally   '09h',  /* ASCII tab character */
  4209.         status          word,   /* Used for every system call */
  4210.         file$token      token,  /* Connection to the help library file */
  4211.         delim           byte,   /* Special delimiter character in help file */
  4212.         level           byte,   /* Current nesting level being scanned for */
  4213.         char            byte,   /* Current character being scanned */
  4214.         ( i, j )        byte,   /* General-purpose array index or counters */
  4215.         finished        boolean,    /* Whether finished giving help */
  4216.         file$name       structure(  /* Buffer for help library file name */
  4217.                             len         byte,
  4218.                             ch( 50 )    byte),
  4219.         num$keywords    byte,   /* Number of keywords in KEYWORD buffer */
  4220.         keyword( MAX$KEYWORDS ) structure(  /* Buffer for topic keywords */
  4221.                             len                     byte,
  4222.                             ch( MAX$KEYWORD$LEN )   byte),
  4223.         line$buffer     structure(  /* General-purpose line buffer */
  4224.                             len         byte,
  4225.                             ch( 80 )    byte);
  4226.  
  4227.  
  4228. /*
  4229.  *
  4230.  *      System-dependent utility procedures.
  4231.  *
  4232.  */
  4233.  
  4234.  
  4235. print: procedure( string$ptr );
  4236.  
  4237.     /*
  4238.      *  Print a string (length byte followed by that many
  4239.      *  characters) on the console.
  4240.      */
  4241.  
  4242.     declare
  4243.         string$ptr  pointer;
  4244.  
  4245.     call rq$c$send$co$response( 0, 0, string$ptr, @status );
  4246.  
  4247. end print;
  4248.  
  4249.  
  4250. new$line: procedure;
  4251.  
  4252.     /*
  4253.      *  Get the cursor to a new line (i.e. print CR/LF).
  4254.      */
  4255.  
  4256.     call print( @( 2,CR,LF ) );
  4257.  
  4258. end new$line;
  4259.  
  4260.  
  4261. print$char: procedure( char );
  4262.  
  4263.     /*
  4264.      *  Print a single character (since PRINT only prints a string).
  4265.      */
  4266.  
  4267.     declare
  4268.         char    byte,
  4269.         string  structure(
  4270.                     len     byte,
  4271.                     ch      byte);
  4272.  
  4273.     string.len = 1;     /* Form a one-character string */
  4274.     string.ch = char;
  4275.     call print( @string );  /* and print it */
  4276.  
  4277. end print$char;
  4278.  
  4279.  
  4280. abort$program: procedure( error$msg$ptr, file$name$ptr );
  4281.  
  4282.     /*
  4283.      *  Abort the program, displaying the error message pointed to
  4284.      *  by ERROR$MSG$PTR, followed by the string pointed to by
  4285.      *  FILE$NAME$PTR in quotes, followed by " -- HELP aborted."
  4286.      *  If FILE$NAME$PTR is zero then it is skipped (including the
  4287.      *  quotes), and if ERROR$MSG$PTR is zero no message is displayed.
  4288.      */
  4289.  
  4290.     declare
  4291.         ( error$msg$ptr, file$name$ptr )    pointer;
  4292.  
  4293.     if ( error$msg$ptr <> 0 ) then  /* If we have an error message */
  4294.       do;
  4295.         call print( error$msg$ptr );    /* Print error message */
  4296.         if ( file$name$ptr <> 0 ) then  /* we have a filename also */
  4297.           do;
  4298.             call print( @( 2,' "' ) );  /* open quote */
  4299.             call print( file$name$ptr );    /* the filename */
  4300.             call print$char( '"' );     /* close quote */
  4301.           end;
  4302.         call print( @( 17,' -- HELP aborted.' ) );
  4303.       end;  /* if ( error$msg$ptr <> 0 ) */
  4304.     call new$line;  /* Get to a new line to tidy up display */
  4305.     call rq$exit$io$job( 0, 0, @status );   /* And exit the program */
  4306.  
  4307. end abort$program;
  4308.  
  4309.  
  4310. check$status: procedure;
  4311.  
  4312.     /*
  4313.      *  Check the exception code returned by a system call to the global
  4314.      *  variable STATUS.  If it is not E$OK, display the exception code
  4315.      *  and mnemonic at the console and abort the program.
  4316.      */
  4317.  
  4318.     if ( status <> E$OK ) then
  4319.       do;   /* Handle an exceptional condition */
  4320.         /* Get the exception code and mnemonic into the line buffer */
  4321.         line$buffer.len = 0;    /* Init to null string */
  4322.         call rq$c$format$exception( @line$buffer, size( line$buffer ),
  4323.                                         status, 1, @status );
  4324.         /* Display the error message and abort the program */
  4325.         call abort$program( @line$buffer, 0 );
  4326.       end;  /* if ( status <> E$OK ) */
  4327.  
  4328. end check$status;
  4329.  
  4330.  
  4331. disable$exception$handler: procedure;
  4332.  
  4333.     /*
  4334.      *  Disable the default exception handler, to prevent it from gaining
  4335.      *  control and aborting the program as soon as any exception occurs.
  4336.      */
  4337.  
  4338.     declare
  4339.         exception$handler$info  structure(
  4340.                                     offset  word,
  4341.                                     base    word,
  4342.                                     mode    byte);
  4343.  
  4344.     exception$handler$info.offset = 0;
  4345.     exception$handler$info.base = 0;
  4346.     exception$handler$info.mode = 0;    /* Never pass control to EH */
  4347.     call rq$set$exception$handler( @exception$handler$info, @status );
  4348.     call check$status;
  4349.  
  4350. end disable$exception$handler;
  4351.  
  4352.  
  4353. open$file: procedure( name$ptr ) boolean;
  4354.  
  4355.     /*
  4356.      *  Open the file specified in the string (length byte followed
  4357.      *  by the characters of the name) pointed to by NAME$PTR, which is
  4358.      *  assumed to already exist, for reading.  Sets the global FILE$TOKEN.
  4359.      *  Returns TRUE if the open was successful, otherwise it prints
  4360.      *  an error message on the console describing the problem
  4361.      *  encountered and returns FALSE.
  4362.      */
  4363.  
  4364.     declare
  4365.         name$ptr    pointer;
  4366.  
  4367.     /* Try to open the file */
  4368.     file$token = rq$c$get$input$connection( name$ptr, @status );
  4369.     if ( status = E$OK ) then   /* we were successful */
  4370.         return( TRUE );
  4371.     else    /* the operation failed */
  4372.         return( FALSE );    /* an error message has already been displayed */
  4373.  
  4374. end open$file;
  4375.  
  4376.  
  4377. read$char: procedure byte;
  4378.  
  4379.     /*
  4380.      *  Return the next character from the file specified by the global
  4381.      *  token FILE$TOKEN (which must be open for reading).
  4382.      *  If end-of-file is encountered, it aborts the program with an
  4383.      *  error message.
  4384.      */
  4385.  
  4386.     declare
  4387.         bytes$read              word,
  4388.         ch                      byte;
  4389.  
  4390.     /* Read the next byte from the file */
  4391.     bytes$read = rq$s$read$move( file$token, @ch, 1, @status );
  4392.     call check$status;
  4393.     if ( bytes$read = 0 ) then  /* we ran into end-of-file */
  4394.         call abort$program( @( 25,'Unexpected end-of-file in' ), @file$name );
  4395.     else    /* we got a character */
  4396.         return( ch );       /* so return it */
  4397.  
  4398. end read$char;
  4399.  
  4400.  
  4401. upcase: procedure( x ) byte;
  4402.  
  4403.     /*
  4404.      *  Force an ASCII letter to upper-case;
  4405.      *  a non-letter is returned unchanged.
  4406.      */
  4407.  
  4408.     declare
  4409.         x   byte;
  4410.  
  4411.     if ( ( x >= 'a' ) and ( x <= 'z' ) ) then   /* it was lower-case */
  4412.         return( x - 'a' + 'A' );    /* return the upper-case equivalent */
  4413.     else    /* it was anything else */
  4414.         return( x );    /* just return it unchanged */
  4415.  
  4416. end upcase;
  4417.  
  4418.  
  4419. read$number: procedure byte;
  4420.  
  4421.     /*
  4422.      *  Read a number from the file, terminated by the delimiter.
  4423.      *  If the characters up to the next delimiter do not form an
  4424.      *  integer (i.e. contain a non-digit--other than the word END--
  4425.      *  or contain no characters at all), abort with an appropriate
  4426.      *  error message; otherwise, return the value of the number.
  4427.      *  The file pointer is left after the terminating delimiter.
  4428.      *  If the "number" consists of the word END, zero is returned.
  4429.      *  (Otherwise the number is in base 10.)  If the number has
  4430.      *  more than 8 characters it will be truncated.
  4431.      */
  4432.  
  4433.     declare
  4434.         num     byte,
  4435.         i       byte,
  4436.         string  structure(
  4437.                     len     byte,
  4438.                     ch( 8 ) byte);
  4439.  
  4440.     string.len = 0;
  4441.     string.ch( string.len ) = read$char;    /* Read first char of number */
  4442.     do while ( string.ch( string.len ) <> delim );  /* Read rest of number */
  4443.         if ( string.len < last( string.ch ) ) then  /* room for more digits */
  4444.             string.len = ( string.len + 1 );    /* move to next digit */
  4445.         string.ch( string.len ) = read$char;    /* Read next character */
  4446.     end;    /* do while ( string.ch( string.len ) <> delim ) */
  4447.     num = 0;    /* Init number to zero */
  4448.     if ( string.len = 0 ) then  /* we got nothing at all */
  4449.         call abort$program( @( 17,'Missing number in' ), @file$name );
  4450.     else if ( ( string.len <> 3 ) or
  4451.                 ( upcase( string.ch( 0 ) ) <> 'E' ) or
  4452.                 ( upcase( string.ch( 1 ) ) <> 'N' ) or
  4453.                 ( upcase( string.ch( 2 ) ) <> 'D' ) ) then  /* it's not END */
  4454.         do i = 0 to ( string.len - 1 );     /* for each digit */
  4455.             if ( ( string.ch( i ) < '0' ) or ( string.ch( i ) > '9' ) ) then
  4456.               do;   /* Handle error of non-digit */
  4457.                 call print( @( 16,'Invalid number "' ) );
  4458.                 call print( @string );  /* show what we got */
  4459.                 call abort$program( @( 4,'" in' ), @file$name );
  4460.               end;  /* if ... -- it's not a digit */
  4461.             /* Combine this digit into the number */
  4462.             num = ( ( num * 10 ) + ( string.ch( i ) - '0' ) );
  4463.         end;    /* do i = 0 to ( string.len - 1 ) */
  4464.     return( num );      /* Return the number we got (zero if it was END) */
  4465.  
  4466. end read$number;
  4467.  
  4468.  
  4469. read$line: procedure;
  4470.  
  4471.     /*
  4472.      *  Read the current line from the file into the global LINE$BUFFER
  4473.      *  up to the next LF (line-feed) character.
  4474.      */
  4475.  
  4476.     declare
  4477.         ch      byte;
  4478.  
  4479.     line$buffer.len = 0;
  4480.     line$buffer.ch( line$buffer.len ) = read$char;  /* Read first char */
  4481.     do while ( line$buffer.ch( line$buffer.len ) <> LF );
  4482.         if ( line$buffer.len < last( line$buffer.ch ) ) then
  4483.             line$buffer.len = ( line$buffer.len + 1 );  /* Bump len if room */
  4484.         line$buffer.ch( line$buffer.len ) = read$char;  /* Read next char */
  4485.     end;    /* do while ( line$buffer.ch( line$buffer.len ) <> LF ) */
  4486.     line$buffer.len = ( line$buffer.len + 1 );  /* Count final char (LF) */
  4487.  
  4488. end read$line;
  4489.  
  4490.  
  4491. skip$text: procedure;
  4492.  
  4493.     /*
  4494.      *  Skip a single help text entry.  That is, read and discard lines
  4495.      *  from the file until reaching a line which begins with DELIM.
  4496.      *  The file pointer will be left just after this character, i.e.
  4497.      *  the second character of the control line.  If the first character
  4498.      *  read at the current position is DELIM, only that character will
  4499.      *  be read (i.e. it is assumed that we are at the beginning of a
  4500.      *  line now).
  4501.      */
  4502.  
  4503.     declare
  4504.         ch      byte;
  4505.  
  4506.     ch = read$char;     /* Get first character of this line */
  4507.     do while ( ch <> delim );   /* As long as it's not a control line */
  4508.         call read$line;     /* Skip that line */
  4509.         ch = read$char;     /* And check on the next one */
  4510.     end;    /* do while ( ch <> delim ) */
  4511.  
  4512. end skip$text;
  4513.  
  4514.  
  4515. keyword$match: procedure( knum ) boolean;
  4516.  
  4517.     /*
  4518.      *  Compare KEYWORD( KNUM ) with the contents of LINE$BUFFER.
  4519.      *  Return TRUE if they match (the keyword may be an abbreviation
  4520.      *  of LINE$BUFFER), FALSE otherwise.
  4521.      */
  4522.  
  4523.     declare
  4524.         ( knum, i ) byte;
  4525.  
  4526.     i = 0;
  4527.     do while ( ( i < keyword( knum ).len ) and
  4528.                 ( i < line$buffer.len ) and
  4529.                 ( line$buffer.ch( i ) <> CR ) );
  4530.         if keyword( knum ).ch( i ) <> upcase( line$buffer.ch( i ) ) then
  4531.             return( FALSE );    /* Don't match */
  4532.         i = ( i + 1 );  /* check next character */
  4533.     end;    /* do while ... */
  4534.     if ( i < keyword( knum ).len ) then     /* keyword too long */
  4535.         return( FALSE );
  4536.     else    /* It matches */
  4537.         return( TRUE );
  4538.  
  4539. end keyword$match;
  4540.  
  4541.  
  4542. print$spaces: procedure( num );
  4543.  
  4544.     /*
  4545.      *  Print NUM spaces (i.e. indent by that many characters).
  4546.      *  NUM must be no more than 20 unless the length of SPACES
  4547.      *  (below) is increased.
  4548.      */
  4549.  
  4550.     declare
  4551.         num         byte,
  4552.         spaces(*)   byte data( 20,'                    ' ),
  4553.         count       byte at ( @spaces );
  4554.  
  4555.     count = num;    /* Set the length to be printed this time */
  4556.     call print( @spaces );  /* Print COUNT spaces */
  4557.  
  4558. end print$spaces;
  4559.  
  4560.  
  4561. show$line: procedure( level, char, line$ptr );
  4562.  
  4563.     /*
  4564.      *  Display the string pointed to by LINE$PTR, preceeded by the
  4565.      *  character CHAR, indented appropriately for LEVEL of nesting.
  4566.      */
  4567.  
  4568.     declare
  4569.         ( level, char ) byte,
  4570.         line$ptr        pointer;
  4571.  
  4572.     call print$spaces( 2 * level ); /* Indent two spaces per level */
  4573.     if ( char <> 0 ) then   /* if we got a leading charcter */
  4574.         call print$char( char );    /* Display it */
  4575.     call print( line$ptr ); /* And print the line */
  4576.  
  4577. end show$line;
  4578.  
  4579.  
  4580. /*
  4581.  *
  4582.  *      Main program -- HELP
  4583.  *
  4584.  */
  4585.  
  4586.  
  4587. call new$line;  /* Leave a blank line */
  4588. call disable$exception$handler;
  4589.  
  4590. /* Parse the command line */
  4591. char = ' ';     /* Insure at least one pass through the WHILE loop: */
  4592. do while ( char = ' ' );    /* Until we get the first non-space */
  4593.     char = rq$c$get$char( @status );    /* Get next char from command line */
  4594.     call check$status;
  4595. end;    /* do while ( char = ' ' ) */
  4596. if ( char = '@' ) then      /* We have a help library filespec */
  4597.   do;   /* Get the filespec into the filename buffer */
  4598.     call rq$c$get$input$path$name( @file$name, size( file$name ), @status );
  4599.     call check$status;
  4600.     if ( file$name.len = 0 ) then   /* no pathname there */
  4601.         call abort$program( @( 34,'No help library pathname follows @' ), 0 );
  4602.     char = rq$c$get$char( @status );    /* And get next character */
  4603.     call check$status;
  4604.   end;  /* if ( char = '@' ) */
  4605. else    /* No at-sign, so use default help library */
  4606.   do;   /* Get its name into the filename buffer */
  4607.     /* Get the name of the file containing this program */
  4608.     call rq$c$get$command$name( @file$name, size( file$name ), @status );
  4609.     call check$status;
  4610.     /* Append the .HLP suffix to it, forming the name of the help library */
  4611.     call movb( @( '.HLP' ), @file$name.ch( filename.len ), 4 );
  4612.     file$name.len = ( file$name.len + 4 );
  4613.   end;  /* else -- no at-sign */
  4614. if ( open$file( @file$name ) ) then   /* Open the help library file */
  4615.   do;   /* Successfully opened, so parse rest of command line and give help */
  4616.     i = 0;  /* Start with the first keyword */
  4617.     keyword( i ).len = 0;   /* Init first keyword to null */
  4618.     do while ( ( char <> 0 ) and ( char <> CR ) );  /* until end of line */
  4619.         if ( ( char = HT ) or ( char = ' ' ) ) then /* it's a space or tab */
  4620.           do;
  4621.             if ( keyword( i ).len > 0 ) then    /* end of this keyword */
  4622.               do;
  4623.                 if ( i < last( keyword ) ) then
  4624.                     i = ( i + 1 );      /* Move to next keyword */
  4625.                 keyword( i ).len = 0;   /* and init it to null */
  4626.               end;  /* if ( keyword( i ).len > 0 ) */
  4627.             /* else ignore redundant space or tab */
  4628.           end;  /* if ( ( char = HT ) or ( char = ' ' ) ) */
  4629.         else    /* non-space and non-tab character */
  4630.           do;
  4631.             if ( keyword( i ).len < size( keyword.ch ) ) then
  4632.               do;
  4633.                 /* Store character of keyword, capitalized */
  4634.                 keyword( i ).ch( keyword( i ).len ) = upcase( char );
  4635.                 keyword( i ).len = ( keyword( i ).len + 1 );
  4636.               end;  /* if ( keyword( i ).len < size( keyword.ch ) ) */
  4637.           end;  /* else -- non-space and non-tab character */
  4638.         char = rq$c$get$char( @status );    /* Get the next character */
  4639.     end;    /* do while ( ( char <> 0 ) and ( char <> CR ) ) */
  4640.     if ( ( keyword( i ).len > 0 ) and ( i < last( keyword ) ) ) then
  4641.         i = ( i + 1 );      /* Count final keyword */
  4642.     num$keywords = i;   /* Save number of keywords we got */
  4643.  
  4644.     /* Begin reading help library file */
  4645.     char = read$char;   /* Get first character of file (special delimiter) */
  4646.     delim = char;   /* Save special delimiter for this file */
  4647.     call read$line; /* Discard the rest of the first line */
  4648.     level = 1;      /* Init level number we're looking for */
  4649.     finished = FALSE;   /* not finished yet */
  4650.     do while ( not finished );      /* until we're finished giving help */
  4651.         if ( num$keywords >= level ) then   /* got a keyword for this level */
  4652.           do;
  4653.             call skip$text;     /* Skip previous entry */
  4654.             i = read$number;    /* Get nesting level for next entry */
  4655.             call read$line;     /* And read its keyword */
  4656.             if ( i < level ) then   /* found an entry at a lower level */
  4657.               do;
  4658.                 call show$line( level, 0,
  4659.                             @( 28,'Sorry, no help available on' ) );
  4660.                 do i = 0 to ( level - 1 );
  4661.                     call print$char( ' ' );
  4662.                     call print( @keyword( i ) );
  4663.                 end;    /* do i = 0 to ( level - 1 ) */
  4664.                 call new$line;
  4665.                 finished = TRUE;    /* No more help to give on this topic */
  4666.               end;  /* if ( i < level ) */
  4667.             else if ( i = level ) then  /* found entry for level we want */
  4668.               do;
  4669.                 if keyword$match( level - 1 ) then  /* keyword matches */
  4670.                   do;   /* Show matching keyword */
  4671.                     call show$line( level, 0, @line$buffer );
  4672.                     call new$line;      /* And leave a blank line */
  4673.                     level = ( level + 1 );  /* And go to next lower level */
  4674.                   end;  /* if keyword$match( level - 1 ) */
  4675.               end;  /* if ( i = level ) */
  4676.           end;  /* if ( num$keywords >= level ) */
  4677.         else if ( num$keywords = ( level - 1 ) ) then
  4678.           do;   /* Display selected help text */
  4679.             char = read$char;   /* Get first char */
  4680.             do while ( char <> delim ); /* Until next control line */
  4681.                 call read$line; /* Read the rest of this line of text */
  4682.                 call show$line( level, char, @line$buffer );    /* show it */
  4683.                 char = read$char;   /* Read first char of next line */
  4684.             end;    /* do while ( char <> delim ) */
  4685.             i = read$number;    /* Get level of next entry */
  4686.             if ( i < level ) then   /* not a subtopic of selected entry */
  4687.                 finished = TRUE;    /* no subtopics, so nothing more to do */
  4688.             else    /* we have subtopic(s) to list */
  4689.               do;
  4690.                 call new$line;  /* Leave a blank line */
  4691.                 call show$line( level, 0,
  4692.                             @( 28,'Further help available on:',CR,LF ) );
  4693.                 call new$line;  /* And leave another blank line */
  4694.                 level = ( level + 1 );  /* Set level to list subtopics */
  4695.                 call read$line; /* Read first subtopic keyword */
  4696.                 line$buffer.len = ( line$buffer.len - 2 );  /* Remove CR/LF */
  4697.                 j = line$buffer.len;    /* Save chars so far on this line */
  4698.                 call show$line( level, 0, @line$buffer ); /* show keyword */
  4699.               end;  /* else -- we have to list subtopics */
  4700.           end;  /* if ( num$keywords = ( level - 1 ) ) */
  4701.         else    /* we must be listing subtopics */
  4702.           do;
  4703.             call skip$text;     /* Skip previous entry */
  4704.             i = read$number;    /* Get nesting level for next entry */
  4705.             call read$line;     /* Read its keyword */
  4706.             line$buffer.len = ( line$buffer.len - 2 );  /* And remove CR/LF */
  4707.             if ( i < ( level - 1 ) ) then   /* found entry at a lower level */
  4708.               do;   /* So no more subtopics of selected entry */
  4709.                 call new$line;  /* Finish last line of list */
  4710.                 finished = TRUE;    /* And we're all done */
  4711.               end;  /* if ( i < ( level - 1 ) ) */
  4712.             else if ( i = ( level - 1 ) ) then  /* found right level entry */
  4713.               do;   /* Show another subtopic keyword */
  4714.                 if ( j > 60 ) then  /* time to start a new line (60=4*15) */
  4715.                   do;
  4716.                     call new$line;
  4717.                     call show$line( level, 0, @line$buffer );
  4718.                     j = line$buffer.len;    /* Count chars on this line */
  4719.                   end;  /* if ( j > 48 ) */
  4720.                 else    /* Make another entry on this line */
  4721.                   do;
  4722.                     call print$spaces( 15 - ( j mod 15 ) ); /* align columns */
  4723.                     j = ( j + ( 15 - ( j mod 15 ) ) + line$buffer.len );
  4724.                     call print( @line$buffer );
  4725.                   end;  /* else -- continue this line */
  4726.               end;  /* if ( i = ( level - 1 ) ) */
  4727.           end;  /* else -- listing subtopics */
  4728.     end;    /* do while ( not finished ) */
  4729.     /* Finished giving help on the selected topic */
  4730.   end;  /* if ( open$file( @file$name ) ) */
  4731. else    /* Error occurred when opening file, abort with message. */
  4732.     call abort$program( @( 30,'Can''t access help library file' ),
  4733.                                             @file$name );
  4734.  
  4735. call abort$program( 0, 0 );     /* Exit with no error message */
  4736.  
  4737. end help;
  4738. /* [---ITEMIZE.P86---] */
  4739. $large
  4740.  
  4741. itemize: do;
  4742.     /*
  4743.      *  This program copies each pathname given by the input filespec
  4744.      *  to the corresponding output file.  It is intended to be used
  4745.      *  with a single output file and a wild-card input pathname, in
  4746.      *  which case it places in that output file all pathnames matching
  4747.      *  the input filespec.
  4748.      *
  4749.      *  by Albert J. Goodman; Edit date:  6-June-1985
  4750.      */
  4751.  
  4752. /* Get all iRMX 86 system call external declarations */
  4753. $include(:I:RMX.EXT)
  4754.  
  4755. declare
  4756.     CR      literally   '0Dh',      /* ASCII Carriage-return character */
  4757.     LF      literally   '0Ah',      /* ASCII Line-feed character */
  4758.     ( input$pathname, output$pathname ) structure(
  4759.                                             len     byte,
  4760.                                             ch(80)  byte),
  4761.     output$preposition                  byte,
  4762.     output$connection                   token,
  4763.     ( bytes$written, status )           word,
  4764.     exception$handler$info              structure(
  4765.                                             offset  word,
  4766.                                             base    word,
  4767.                                             mode    byte);
  4768.  
  4769. check$excep: procedure;     /* Check for an exception code */
  4770.     if ( status <> E$OK ) then  /* we got an exceptional condition */
  4771.         call rq$exit$io$job( status, 0, @status );  /* abort the program */
  4772. end check$excep;
  4773.  
  4774. /* begin ITEMIZE */
  4775. /* Disable our exception handler, so control never passes to it. */
  4776. exception$handler$info.offset = 0;
  4777. exception$handler$info.base = 0;
  4778. exception$handler$info.mode = 0;
  4779. call rq$set$exception$handler( @exception$handler$info, @status );
  4780. call check$excep;
  4781.  
  4782. /* get the first input pathname */
  4783. call rq$c$get$input$pathname( @input$pathname, size( input$pathname ),
  4784.                                     @status );
  4785. call check$excep;
  4786. /* while we have any more pathnames */
  4787. do while ( input$pathname.len > 0 );
  4788.     /* Get the matching output pathname (default to command output) */
  4789.     output$preposition = rq$c$get$output$pathname( @output$pathname,
  4790.                                     size( output$pathname ),
  4791.                                     @( 7,'TO :CO:' ), @status );
  4792.     call check$excep;
  4793.     /* Get a connection to the output file */
  4794.     output$connection = rq$c$get$output$connection( @output$pathname,
  4795.                                     output$preposition, @status );
  4796.     call check$excep;
  4797.     /* Copy the input pathname to the output file */
  4798.     bytes$written = rq$s$write$move( output$connection, @input$pathname.ch,
  4799.                                     input$pathname.len, @status );
  4800.     call check$excep;
  4801.     /* Append a carriage-return/line-feed line terminator */
  4802.     bytes$written = rq$s$write$move( output$connection, @( CR,LF ),
  4803.                                     2, @status );
  4804.     call check$excep;
  4805.     /* Close the output file */
  4806.     call rq$s$close( output$connection, @status );
  4807.     call check$excep;
  4808.     /* And delete the output connection */
  4809.     call rq$s$delete$connection( output$connection, @status );
  4810.     call check$excep;
  4811.     /* Get the next input pathname, if any */
  4812.     call rq$c$get$input$pathname( @input$pathname, size( input$pathname ),
  4813.                                     @status );
  4814.     call check$excep;
  4815. end;    /* do while ( input$pathname.len > 0 ) */
  4816.  
  4817. /* Terminate the program, signalling O.K. */
  4818. call rq$exit$io$job( E$OK, 0, @status );
  4819.  
  4820. end itemize;
  4821. /* [---End of I86KER.PLM---] */
  4822.