home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp10 / k10mit.mac < prev    next >
Text File  |  2020-01-01  |  178KB  |  5,613 lines

  1.     TITLE    KERMIT-10
  2.  
  3. ; Universals
  4.  
  5.     SEARCH    GLXMAC            ; Galaxy definitions
  6.     SEARCH    ORNMAC            ; Parser interface definitions
  7.     SEARCH    KERUNV            ; Kermit definitions
  8.  
  9. ; Directives
  10.  
  11.     PROLOG    (KERMIT)
  12.     .DIREC    FLBLST            ; List file line of binary only
  13.     PARSET                ; Define entries into the parser
  14.  
  15.   ; Version number
  16.  
  17.     MITVER==3            ; Major version number
  18.     MITMIN==0            ; Minor version number
  19.     MITEDT==136            ; Edit level
  20.     MITWHO==0            ; Customer edit
  21.  
  22.     TWOSEG    400K            ; Make this a two segment program
  23.     RELOC    0            ; Low segment
  24.     RELOC                ; Back to the high segment
  25.  
  26. TOPS10<
  27.     SEARCH    SCNMAC            ; WILD interface definitions
  28.     LOC    <.JBVER==:137>        ; Version number location
  29.     VRSN.(KER)            ; Store version number
  30.     RELOC                ; Back to the high segment
  31. >; End of TOPS10 condition
  32.     SUBTTL    Table of Contents
  33.  
  34. ;+
  35. ;.pag.lit
  36. ;                          Table of Contents of KERMIT
  37. ;
  38. ;
  39. ;                                    Section                             Page
  40. ;   1.   Revision History . . . . . . . . . . . . . . . . . . . . . . . .   3
  41. ;   2.   Command tables
  42. ;      2.1.   Prompt strings. . . . . . . . . . . . . . . . . . . . . . .   4
  43. ;      2.2.   Initial state . . . . . . . . . . . . . . . . . . . . . . .   5
  44. ;      2.3.   Final state . . . . . . . . . . . . . . . . . . . . . . . .   5
  45. ;      2.4.   BYE command . . . . . . . . . . . . . . . . . . . . . . . .   5
  46. ;      2.5.   CONNECT command . . . . . . . . . . . . . . . . . . . . . .   6
  47. ;      2.6.   DEFINE command. . . . . . . . . . . . . . . . . . . . . . .   7
  48. ;      2.7.   EXIT command. . . . . . . . . . . . . . . . . . . . . . . .   8
  49. ;      2.8.   FINISH command. . . . . . . . . . . . . . . . . . . . . . .   9
  50. ;      2.9.   GET command . . . . . . . . . . . . . . . . . . . . . . . .   9
  51. ;      2.10.  HELP command. . . . . . . . . . . . . . . . . . . . . . . .   9
  52. ;      2.11.  LOGOUT command. . . . . . . . . . . . . . . . . . . . . . .  10
  53. ;      2.12.  RECEIVE command . . . . . . . . . . . . . . . . . . . . . .  10
  54. ;      2.13.  SEND command. . . . . . . . . . . . . . . . . . . . . . . .  10
  55. ;      2.14.  SERVER command. . . . . . . . . . . . . . . . . . . . . . .  11
  56. ;      2.15.  SET command
  57. ;         2.15.1.   Dispatch table. . . . . . . . . . . . . . . . . . . .  12
  58. ;         2.15.2.   ON/OFF table. . . . . . . . . . . . . . . . . . . . .  13
  59. ;         2.15.3.   incomplete-file . . . . . . . . . . . . . . . . . . .  14
  60. ;         2.15.4.   Block-check-type. . . . . . . . . . . . . . . . . . .  14
  61. ;         2.15.5.   DEBUGGING . . . . . . . . . . . . . . . . . . . . . .  14
  62. ;         2.15.6.   DELAY . . . . . . . . . . . . . . . . . . . . . . . .  14
  63. ;         2.15.7.   ESCAPE. . . . . . . . . . . . . . . . . . . . . . . .  14
  64. ;         2.15.8.   FILE-BYTE-SIZE. . . . . . . . . . . . . . . . . . . .  15
  65. ;         2.15.9.   Line. . . . . . . . . . . . . . . . . . . . . . . . .  16
  66. ;         2.15.10.  Message . . . . . . . . . . . . . . . . . . . . . . .  17
  67. ;         2.15.11.  Parity. . . . . . . . . . . . . . . . . . . . . . . .  18
  68. ;         2.15.12.  Receive . . . . . . . . . . . . . . . . . . . . . . .  19
  69. ;         2.15.13.  Repeat-quote. . . . . . . . . . . . . . . . . . . . .  20
  70. ;         2.15.14.  Retry . . . . . . . . . . . . . . . . . . . . . . . .  21
  71. ;         2.15.15.  Send. . . . . . . . . . . . . . . . . . . . . . . . .  22
  72. ;      2.16.  STATUS command. . . . . . . . . . . . . . . . . . . . . . .  23
  73. ;      2.17.  SHOW command. . . . . . . . . . . . . . . . . . . . . . . .  24
  74. ;   3.   Entry vector and initialization. . . . . . . . . . . . . . . . .  25
  75. ;   4.   Kermit initialization. . . . . . . . . . . . . . . . . . . . . .  29
  76. ;   5.   KERMIT.INI processing. . . . . . . . . . . . . . . . . . . . . .  30
  77. ;   6.   CCL entry processing
  78. ;      6.1.   SETTMP. . . . . . . . . . . . . . . . . . . . . . . . . . .  31
  79. ;      6.2.   ADVTMP. . . . . . . . . . . . . . . . . . . . . . . . . . .  32
  80. ;      6.3.   ABRTAK. . . . . . . . . . . . . . . . . . . . . . . . . . .  33
  81. ;   7.   Command parsing utility routines
  82. ;      7.1.   CHKCTL. . . . . . . . . . . . . . . . . . . . . . . . . . .  34
  83. ;   8.   Command execution
  84. ;      8.1.   CONNECT command . . . . . . . . . . . . . . . . . . . . . .  35
  85. ;      8.2.   DEFINE command. . . . . . . . . . . . . . . . . . . . . . .  36
  86. ;      8.3.   EXIT command. . . . . . . . . . . . . . . . . . . . . . . .  37
  87. ;      8.4.   BYE command . . . . . . . . . . . . . . . . . . . . . . . .  38
  88. ;      8.5.   FINISH command. . . . . . . . . . . . . . . . . . . . . . .  39
  89. ;      8.6.   LOGOUT command. . . . . . . . . . . . . . . . . . . . . . .  40
  90. ;      8.7.   HELP command. . . . . . . . . . . . . . . . . . . . . . . .  41
  91. ;      8.8.   PROMPT command. . . . . . . . . . . . . . . . . . . . . . .  42
  92. ;      8.9.   SEND command. . . . . . . . . . . . . . . . . . . . . . . .  43
  93. ;      8.10.  GET command . . . . . . . . . . . . . . . . . . . . . . . .  44
  94. ;      8.11.  RECEIVE command . . . . . . . . . . . . . . . . . . . . . .  45
  95. ;      8.12.  SERVER command. . . . . . . . . . . . . . . . . . . . . . .  46
  96. ;      8.13.  SET command
  97. ;         8.13.1.   Top level . . . . . . . . . . . . . . . . . . . . . .  47
  98. ;         8.13.2.   SETKYW - Parse a keyword and store the value. . . . .  47
  99. ;         8.13.3.   DEBUGGING parameter . . . . . . . . . . . . . . . . .  48
  100. ;         8.13.4.   Initial DELAY . . . . . . . . . . . . . . . . . . . .  49
  101. ;         8.13.5.   LINE to use . . . . . . . . . . . . . . . . . . . . .  50
  102. ;         8.13.6.   MESSAGE parameters. . . . . . . . . . . . . . . . . .  51
  103. ;         8.13.7.   RECEIVE parameters. . . . . . . . . . . . . . . . . .  52
  104. ;      8.14.  SHOW command. . . . . . . . . . . . . . . . . . . . . . . .  55
  105. ;         8.14.1.   SHOW MACROS . . . . . . . . . . . . . . . . . . . . .  56
  106. ;         8.14.2.   SHOW VERSION. . . . . . . . . . . . . . . . . . . . .  57
  107. ;         8.14.3.   SHOW DAYTIME. . . . . . . . . . . . . . . . . . . . .  57
  108. ;         8.14.4.   SHOW DEBUGGING. . . . . . . . . . . . . . . . . . . .  58
  109. ;         8.14.5.   SHOW FILE-INFORMATION . . . . . . . . . . . . . . . .  59
  110. ;         8.14.6.   SHOW LINE-INFORMATION . . . . . . . . . . . . . . . .  60
  111. ;         8.14.7.   SHOW PACKET-INFORMATION . . . . . . . . . . . . . . .  61
  112. ;         8.14.8.   SHOW TIMING-INFORMATION . . . . . . . . . . . . . . .  62
  113. ;         8.14.9.   Support routines
  114. ;            8.14.9.1.   TONOFF . . . . . . . . . . . . . . . . . . . . .  63
  115. ;            8.14.9.2.   CHITXT . . . . . . . . . . . . . . . . . . . . .  64
  116. ;      8.15.  STATUS command. . . . . . . . . . . . . . . . . . . . . . .  65
  117. ;   9.   File processing
  118. ;      9.1.   INIFILE - Initialization. . . . . . . . . . . . . . . . . .  66
  119. ;      9.2.   FILE%OPEN . . . . . . . . . . . . . . . . . . . . . . . . .  67
  120. ;      9.3.   Routine to type the file specification. . . . . . . . . . .  69
  121. ;   10.  Routine to setup FILOP/ELB/PATH blocks . . . . . . . . . . . . .  70
  122. ;   11.  File processing
  123. ;      11.1.   Routine to convert FX blocks . . . . . . . . . . . . . . .  71
  124. ;      11.2.   FILE%CLOSE . . . . . . . . . . . . . . . . . . . . . . . .  72
  125. ;      11.3.   NEXT%FILE. . . . . . . . . . . . . . . . . . . . . . . . .  73
  126. ;      11.4.   GET%FILE - Get a byte. . . . . . . . . . . . . . . . . . .  74
  127. ;      11.5.   PUT%FILE - Store a byte. . . . . . . . . . . . . . . . . .  75
  128. ;      11.6.   FILE%DUMP - Not needed . . . . . . . . . . . . . . . . . .  76
  129. ;   12.  Support routines
  130. ;      12.1.   PRSFIL - Parse a file specification. . . . . . . . . . . .  77
  131. ;      12.2.   PRSSX$ - Parse a sixbit field. . . . . . . . . . . . . . .  78
  132. ;      12.3.   PRSWS$ - Parse a wild sixbit field . . . . . . . . . . . .  79
  133. ;      12.4.   CHKAL$ - Check for alphanumeric. . . . . . . . . . . . . .  80
  134. ;      12.5.   PRSOC$ - Parse a wild octal number . . . . . . . . . . . .  81
  135. ;      12.6.   INPCH$ - Input a character . . . . . . . . . . . . . . . .  82
  136. ;   13.  Packet count processing
  137. ;      13.1.   XFR%STATUS . . . . . . . . . . . . . . . . . . . . . . . .  83
  138. ;   14.  Terminal processing
  139. ;      14.1.   Message routines
  140. ;         14.1.1.   Initialization. . . . . . . . . . . . . . . . . . . .  84
  141. ;         14.1.2.   Open the terminal . . . . . . . . . . . . . . . . . .  85
  142. ;         14.1.3.   Close the terminal. . . . . . . . . . . . . . . . . .  86
  143. ;         14.1.4.   Send a message. . . . . . . . . . . . . . . . . . . .  87
  144. ;         14.1.5.   Wait for turnaround . . . . . . . . . . . . . . . . .  88
  145. ;         14.1.6.   Receive a message . . . . . . . . . . . . . . . . . .  89
  146. ;         14.1.7.   Check for keyboard input. . . . . . . . . . . . . . .  90
  147. ;         14.1.8.   Set time out timer. . . . . . . . . . . . . . . . . .  91
  148. ;      14.2.   General
  149. ;         14.2.1.   Determine using local line. . . . . . . . . . . . . .  92
  150. ;         14.2.2.   Open a terminal . . . . . . . . . . . . . . . . . . .  93
  151. ;         14.2.3.   T$CLOS - Close the terminal channel . . . . . . . . .  94
  152. ;         14.2.4.   Input a character . . . . . . . . . . . . . . . . . .  95
  153. ;         14.2.5.   Output a character. . . . . . . . . . . . . . . . . .  96
  154. ;         14.2.6.   Output a character for CONNECT. . . . . . . . . . . .  97
  155. ;         14.2.7.   Connect a terminal line . . . . . . . . . . . . . . .  98
  156. ;         14.2.8.   Set PIM break set . . . . . . . . . . . . . . . . . .  99
  157. ;      14.3.   Text output
  158. ;         14.3.1.   TERM%DUMP & DBG%DUMP. . . . . . . . . . . . . . . . . 100
  159. ;   15.  Error processing
  160. ;      15.1.   .KERERR - Handle KERMIT-10 errors. . . . . . . . . . . . . 101
  161. ;      15.2.   KRM%ERROR - Handle the KERMSG errors . . . . . . . . . . . 102
  162. ;   16.  CRC calculation routine. . . . . . . . . . . . . . . . . . . . . 104
  163. ;   17.  Data area. . . . . . . . . . . . . . . . . . . . . . . . . . . . 105
  164. ;   18.  End of Kermit. . . . . . . . . . . . . . . . . . . . . . . . . . 107
  165. ;
  166. ;.end lit.pag
  167. ;-
  168.     SUBTTL    Revision History
  169.  
  170. COMMENT    |
  171. 100    By: Robert C. McQueen        On: Yes.
  172.     Lots of rewritting and other things.
  173.  
  174. 101    By: Nick Bush            On: 22-August-1983
  175.     Fix setting up of seven or eight bit byte pointers for file
  176.     I/O.  Do this once when the file is opened, not each time
  177.     a buffer is read.  TOPS-10 is quite happy to use whatever
  178.     byte size is stored in the buffer header byte pointer, and will
  179.     use that size to determine the byte count.
  180.  
  181. 102    By: Robert C. McQueen        On: 29-August-1983
  182.     Remove the TT% routines and use the common TT_ routines in the
  183.     Bliss module KERTT.
  184.  
  185. 103    By: Robert C. McQueen        On: 16-September-1983
  186.     Add XFR%STATUS and baud rate stats.
  187.  
  188. 104    By: Robert C. McQueen & Nick Bush    On: Many days
  189.     - Add CRC support
  190.     - Redo the SHOW command processing
  191.     - Fix random bugs.
  192.  
  193. 105    By: Robert C. McQueen & Nick Bush    On: Many days
  194.     - Implement IBM mode
  195.     - Implement file disposition
  196.     - Make CCL entry work
  197.  
  198. 106    By: Nick Bush        On: 3-November-1983
  199.     Fix terminal handling for non-network systems.  Also make sure
  200.     the terminal will be available when we try to use it by grabing
  201.     it when we set the line.
  202.     Modules: KERMIT
  203.  
  204. 107    By: Nick Bush        On: 12-November-1983
  205.     Add macro definition capability for SET options.
  206.     Modules: KERMIT
  207.  
  208. 111    By: Nick Bush        On: 16-November-1983
  209.     Add TAKE command.
  210.     Modules: KERMIT
  211.  
  212. 112    By: Nick Bush        On: 17-November-1983
  213.     Clear the input buffer before we send a message.  This ignores any garbage
  214.     which came in on the line since the last message we received.
  215.     Modules: KERMIT
  216.  
  217. 113    By: Nick Bush        On: 14-December-1983
  218.     Add some more single character commands for use during transfers.
  219.     Control-A will type a status line, control-D will toggle debugging, and
  220.     carriage return will force a timeout (therefore either a NAK or
  221.  retransmission).
  222.     Modules: KERMIT
  223.  
  224. 114    By: Nick Bush        On: 19-December-1983
  225.     Default the transfer terminal to KERMIT: if the logical name exists and
  226.     is a terminal.
  227.  
  228.     Remove FILE%DUMP, since KERMSG no longer references it.
  229.     Modules: KERMIT
  230.  
  231. 115    By: Nick Bush        On: 5-January-1983
  232.     Add support for different types of file names.  This changes the
  233.     SET FILE-xxx commands to be SET FILE xxx and adds a SET FILE NAMING
  234.     command.
  235.     Modules: KERMIT
  236.  
  237. 116    By: Nick Bush        On: 14-March-1984
  238.     Add parsing for all REMOTE commands.
  239.     Add support for some generic and local commands.
  240.     Fix wild card processing to handle pathological names correctly.
  241.     Modules: KERMIT,KERSYS,KERWLD
  242.  
  243. 120    By: Robert C. McQueen        On: 28-March-1984
  244.     Add bug fixes from WMU.  Many thanks to the people out in Kalamazoo.
  245.     Modules: KERMIT,KERWLD
  246.  
  247. 121    By: Robert C. McQueen        On: 28-March-1984
  248.     Add SET PROMPT command.  Start adding support for generic COPY and
  249.     RENAME commands.
  250.     Modules: KERUNV,KERMIT,KERWLD
  251.  
  252. 122    By: Robert C. McQueen        On: 29-March-1984
  253.     Remove ADJBP instructions and add the five instructions that adjust byte
  254.     pointers for the KI10s that use Kermit.'
  255.     Modules: KERMIT
  256.  
  257. 123    By: Nick Bush        On: 2-April-1984
  258.     Change SPACE generic command to use PPN of default path instead of users
  259.     PPN if no argument is supplied.
  260.     Make DIRECTORY and DELETE generic commands print out a header at the
  261.     top of the list, and print file size in both words and allocated blocks.
  262.     Add SPACE as synonym for DISK-USAGE command and ERASE as synonym for
  263.     DELETE.
  264.  
  265.     Modules: KERMIT,KERSYS
  266.  
  267. Start of Version 3(124)
  268.  
  269. 125    By: Nick Bush        On: 26-June-1984
  270.     Add patches from CSM:
  271.  
  272.     - Wrong AC when setting PIM break set.
  273.     - Checks for not-logged-in Kermits
  274.     - Parity for CONNECT (implemented differently)
  275.  
  276.     Modules: KERMIT,KERSYS
  277.  
  278. 126    By: Nick Bush        On: 11-July-1984
  279.     RECEIVE FOO.BAR would not work correctly.  It thought the extension was
  280.     wild-carded.
  281.  
  282.     Modules: KERMIT
  283.  
  284. 127    By: David Stevens    On: 9-July-1985
  285.     Add patches from PIMA:
  286.  
  287.     - Fix IFN stopcode if syntax error in KERMIT.INI.
  288.     - Add help text for connect mode escape commands
  289.         Q (quit) and R (resume) logging
  290.     - Add SET XON-XOFF-PROCESSING to determine how XON/XOF
  291.         should be handled during CONNECT.
  292.     - Add a new file byte-size 36-bit for 10 to 10/20 transfers.
  293.  
  294.     Modules: KERMIT, KERUNV
  295.  
  296. 130    By: David Stevens    On: 15-July-1985
  297.  
  298.     Fix multiple file sending problem.
  299.     - note this resulted in a patch to all kermits using KERMSG
  300.  
  301.     Modules: KERMIT, KERMSG
  302.  
  303. 131    By: David Stevens        On: 25-July-1985
  304.     Add SET HANSHAKE to set up an IBM hanshaking character
  305.  
  306.     Modules: KERMIT
  307.  
  308. 132    By David Stevens        On: 29-July-1985
  309.     Fix DFNMAC - IBM to set the handshake character instead of the
  310.     IBM-MODE
  311.  
  312.     Modules: KERMIT
  313.  
  314. 133    By David Stevens        On: 30-July-1985
  315.     Eliminate SET IBM-MODE.
  316.  
  317.     Modules: KERMIT
  318.  
  319. 134    By Dan Norstedt            On: 17-June-1989
  320.     Incorperated VMS enhancements, added Extended Length packets
  321.  
  322.     Modules: KERMIT, KERMSG (VMS version + updates), KERGLB
  323.  
  324. 135    By Nick Bush            On: 1-April-2006
  325.     Kludge implemented by OCTERM to reset terminal status for GLXLIB
  326.     appears to no longer be necessary.  Until we can determine
  327.     which version of GLXLIB fixed it, just treat the routine as a
  328.     noop.
  329.  
  330. 136    By Nick Bush            On: 17-April-2006
  331.     Try better fix for OCTERM - get bits for K%OPEN and just call
  332.     that routine.  Previous fix left <ESC> echoing as "$".
  333.     Also fix CAXE in T$CONN to have double brackets
  334.     to avoid problem with the macro. This fix was one 
  335.     originally identified by Miike Freeman, but was
  336.     not included in the source with other fixes.  This
  337.     edit also officializes the other Mike Freeman fixes
  338.     that have been in the .BWR file.
  339. |
  340.     SUBTTL    Command tables -- Initial state
  341.  
  342. ; The following is the initial state for the command tables.  These
  343. ; point to all of the other tables.
  344.  
  345. MON000:    $INIT    (MON010)
  346.  
  347. MON010:    $KEYDSP    (MON020,$ALTERNATE(KER010))
  348.  
  349. MON020:    $STAB
  350.      DSPTAB    (MON030,IGNORE,<CONTINUE>)    ; CONTINUE command
  351.      DSPTAB    (MON040,KERCMD,<KERMIT>)    ; KERMIT command
  352.      DSPTAB    (MON030,SHOVER,<RUN>)        ; RUN command
  353.      DSPTAB    (MON030,IGNORE,<START>)        ; START command
  354.     $ETAB
  355.  
  356. MON030:    $UQSTR    (CONFRM,IGNBRK)
  357.  
  358.  
  359. MON040:    $CRLF    ($ALTERNATE(KER010))
  360.  
  361. IGNORE:    $RETT
  362.  
  363.     BRINI$(IGN)            ; Mask for ignoring monitor commands
  364.     BRKCH$(IGN,.CHLFD,.CHFFD)    ; Only break on command terminators
  365.  
  366. IGNBRK:    BRGEN$(IGN)            ; Generate the mask
  367.  
  368. KER000:    $INIT    (KER010)
  369.  
  370. KER010:    $KEYDSP    (KER020)        ; Dispatch table
  371.  
  372. KER020:    $STAB
  373.      DSPTAB    (,C$EXI0,\"<.CHCNZ>,CM%INV)    ; Control-Z is same as EXIT
  374.      DSPTAB    (BYE000,C$BYE,<Bye>)        ; Bye command
  375.      DSPTAB    (CON000,C$CONNECT,<Connect>)    ; CONNECT to terminal line
  376.      DSPTAB    (DFN000,C$DEFINE,<Define>)    ;[107] Define set of parameters
  377.      DSPTAB    (EXI000,C$EXIT,<Exit>)        ; EXIT to monitor level
  378.      DSPTAB    (FIN000,C$FINISH,<Finish>)    ; Finish command
  379.      DSPTAB    (GET000,C$GET,<Get>)        ; GET command
  380.      DSPTAB    (HLP000,C$HELP,<Help>)        ; HELP command
  381.      DSPTAB    (LCL000,C$LOCAL,<Local>)    ; LOCAL command
  382.      DSPTAB    (LOG000,C$LOG,<Log>)        ; LOG command
  383.      DSPTAB    (LGO000,C$LOGOUT,<Logout>)    ; LOGOUT remote kermit
  384.      DSPTAB    (CONFRM,C$PROMPT,<PROMPT>,CM%INV) ; PROMPT command
  385.      DSPTAB    (EXI000,C$EXIT,<Quit>)        ; QUIT command
  386.      DSPTAB    (RCV000,C$RECEIVE,<R>,CM%INV!CM%ABR) ; Receive command
  387.      DSPTAB    (RCV000,C$RECEIVE,<Receive>)    ; RECEIVE command
  388.      DSPTAB    (REM000,C$REMOTE,<Remote>)    ;[116] Remote xxx command
  389.      DSPTAB    (SND000,C$SEND,<S>,CM%INV!CM%ABR) ; SEND command
  390.      DSPTAB    (SND000,C$SEND,<Send>)        ; SEND command
  391.      DSPTAB    (SRV000,C$SERVER,<Server>)    ; SERVER command
  392.      DSPTAB    (SET000,C$SET,<Set>)        ; SET command
  393.      DSPTAB    (SHO000,C$SHOW,<Show>)        ; Show information
  394.      DSPTAB    (STA000,C$STATUS,<Status>)    ; STATUS command
  395.      DSPTAB    (TAKFDB##,.KYTAK,<Take>)    ;[111] Take command
  396.     $ETAB
  397.  
  398. KER100:    $INIT    (KER110)
  399.  
  400. KER110:    $KEYDSP    (KER120)        ; Dispatch table
  401.  
  402. KER120:    $STAB
  403.      DSPTAB    (,C$EXI0,\"<.CHCNZ>,CM%INV)    ; Control-Z is same as EXIT
  404.      DSPTAB    (CON100,C$CONNECT,<Connect>)    ; CONNECT to terminal line
  405.      DSPTAB    (DFN000,C$DEFINE,<Define>)    ;[107] Define set of parameters
  406.      DSPTAB    (EXI000,C$EXIT,<Exit>)        ; EXIT to monitor level
  407.      DSPTAB    (HLP000,C$HELP,<Help>)        ; HELP command
  408.      DSPTAB    (LCL000,C$LOCAL,<Local>)    ; LOCAL command
  409.      DSPTAB    (LOG000,C$LOG,<Log>)        ; LOG command
  410.      DSPTAB    (CONFRM,C$PROMPT,<PROMPT>,CM%INV) ; PROMPT command
  411.      DSPTAB    (EXI000,C$EXIT,<Quit>)        ; QUIT command
  412.      DSPTAB    (RCV000,C$RECEIVE,<Receive>)    ; RECEIVE command
  413.      DSPTAB    (SND000,C$SEND,<S>,CM%INV!CM%ABR) ; SEND command
  414.      DSPTAB    (SND000,C$SEND,<Send>)        ; SEND command
  415.      DSPTAB    (SRV000,C$SERVER,<Server>)    ; SERVER command
  416.      DSPTAB    (SET000,C$SET,<Set>)        ; SET command
  417.      DSPTAB    (SHO000,C$SHOW,<Show>)        ; Show information
  418.      DSPTAB    (STA000,C$STATUS,<Status>)    ; STATUS command
  419.      DSPTAB    (TAKFDB##,.KYTAK,<Take>)    ;[111] Take command
  420.     $ETAB
  421.  
  422.  
  423.     SUBTTL    Command tables -- Final state
  424.  
  425. CONFRM:    $CRLF
  426.  
  427.  
  428.  
  429.  
  430.     SUBTTL    Command tables -- BYE command
  431.  
  432. BYE000:    $NOISE    (CONFRM,<to remote server>)
  433.     SUBTTL    Command tables -- CONNECT command
  434.  
  435. CON000:    $NOISE    (CON010,<to line>)
  436.  
  437. TOPS20<
  438. CON010:    $NUMBER    (CONFRM,^D8,<line number to use for virtual terminal>,$ALTERNATE(CONFRM))
  439. >; End of TOPS20 conditional
  440.  
  441. TOPS10<
  442. CON010:    $DEV    (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON020),$ERRPDB(CON020)>)
  443.  
  444. CON020:    $NODNM    (CON030,<Node name terminal line is connected to>,<$ALTERNATE(CON050),$ERRPDB(CON050)>)
  445.  
  446. CON030:    $NOISE    (CON040,<Line number>)
  447.  
  448. CON040:    $NUMBER    (CONFRM,^D8,<Line number on specified node>)
  449.  
  450. CON050:    $NUMBER    (CONFRM,^D8,<line number to use for virtual terminal>,$ALTERNATE(CONFRM))
  451. >; End of TOPS10 conditional
  452.  
  453. CON100:    $NOISE    (CON110,<to line>)
  454.  
  455. TOPS20<
  456. CON110:    $NUMBER    (CONFRM,^D8,<line number to use for virtual terminal>)
  457. >; End of TOPS20 conditional
  458.  
  459. TOPS10<
  460. CON110:    $DEV    (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON120),$ERRPDB(CON120)>)
  461.  
  462. CON120:    $NODNM    (CON130,<Node name terminal line is connected to>,<$ALTERNATE(CON150),$ERRPDB(CON150)>)
  463.  
  464. CON130:    $NOISE    (CON140,<Line number>)
  465.  
  466. CON140:    $NUMBER    (CONFRM,^D8,<Line number on specified node>)
  467.  
  468. CON150:    $NUMBER    (CONFRM,^D8,<line number to use for virtual terminal>)
  469. >; End of TOPS10 conditional
  470.     SUBTTL    Command tables -- DEFINE command
  471.  
  472. ;[107] Format:
  473. ;[107]    DEFINE macro-name {List of set options}
  474. ;[107]    DEFINE macro-name <CRLF> ! to delete macro definition
  475.  
  476. DFN000:    $NOISE    (DFN010,<macro name>)
  477.  
  478. DFN010:    $KEY    (DFN020,DFNTAB,<$ALTERNATE(DFN030)>)
  479.  
  480. DFN020:    $CRLF    (<$HELP(Confirm to delete macro)>)
  481.  
  482. DFN030:    $FIELD    (SET001,<macro name to define>)
  483.  
  484. ;[107] Tables used during macro expansion
  485.  
  486. SMC000:    $KEY    (SMC010,KER020)        ;[107] Allow any command (can only be define anyway)
  487.  
  488. SMC010:    $NOISE    (SMC020,<macro name>)
  489.  
  490. SMC020:    $KEY    (SET001,DFNTAB)        ;[107] Allow any macro name then set options
  491.     SUBTTL    Command tables -- EXIT command
  492.  
  493. EXI000:    $NOISE    (CONFRM,<to the monitor>)
  494.     SUBTTL    Command tables -- FINISH command
  495.  
  496. FIN000:    $NOISE    (CONFRM,<remote server operation>)
  497.  
  498.  
  499.  
  500.     SUBTTL    Command tables -- GET command
  501.  
  502. GET000:    $NOISE    (GET010,<remote files>)
  503.  
  504. GET010:    $FIELD    (CONFRM,<File specification>,<$BREAK(FILBRK)>)
  505.  
  506.  
  507.  
  508.     SUBTTL    Command tables -- HELP command
  509.  
  510. HLP000:    $NOISE    (HLP010,<with>)
  511.  
  512. HLP010:    $CTEXT    (CONFRM,<Topic for which help is wanted>,$ALTERNATE(CONFRM))
  513.     SUBTTL    Command tables -- LOGOUT command
  514.  
  515. LGO000:    $NOISE    (CONFRM,<remote server>)
  516.  
  517.  
  518.     SUBTTL    Command tables -- LOG command
  519.  
  520. LOG000:    $KEY    (LOG010,LOG001)
  521.  
  522. LOG001:    $STAB
  523.      KEYTAB    (DBGLOG,<Debugging-output>)
  524.      KEYTAB    (SESLOG,<Session>)
  525.      KEYTAB    (TRNLOG,<Transactions>)
  526.     $ETAB
  527.  
  528. LOG010:    $NOISE    (LOG020,<to file>)
  529.  
  530. LOG020:    $OFILE    (LOG030,<Log file name>,$ALTERNATE(CONFRM))
  531.  
  532. LOG030:    $SWITCH    (CONFRM,LOG031,$ALTERNATE(CONFRM))
  533.  
  534. LOG031:    $STAB
  535.      KEYTAB    (0,<Append>)
  536.     $ETAB
  537.  
  538.  
  539.     SUBTTL    Command tables -- RECEIVE command
  540.  
  541. RCV000:    $NOISE    (RCV010,<into files>)
  542.  
  543. RCV010:    $OFILE    (CONFRM,<File name to receive information into>,$ALTERNATIVE(CONFRM))
  544.     SUBTTL    Command tables -- REMOTE command
  545.  
  546. REM000:    $KEYDSP    (REM010)
  547.  
  548. REM010:    $STAB
  549.      DSPTAB    (REM080,<[XWD GETNFL,GC%COPY##]>,<Copy>)    ; Copy file
  550.      DSPTAB    (REM070,<[XWD GETPSW,GC%CONNECT##]>,<CWD>) ; Change working directory
  551.      DSPTAB    (REM020,<[XWD 0,GC%DELETE##]>,<Delete>)    ; Delete file
  552.      DSPTAB    (REM030,<[XWD 0,GC%DIRECTORY##]>,<Directory>) ; Directory command
  553.      DSPTAB    (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Disk-usage>) ; Disk-usage report
  554.      DSPTAB    (REM020,<[XWD 0,GC%DELETE##]>,<Erase>)    ; Delete file
  555.      DSPTAB    (CONFRM,<[XWD 0,GC%EXIT##]>,<Exit>)    ; Exit
  556.      DSPTAB    (REM050,<[XWD 0,GC%HELP##]>,<Help>)    ; Help command
  557.      DSPTAB    (REM060,<[XWD 0,GC%COMMAND##]>,<Host-command>) ; Host command
  558.      DSPTAB    (REM100,<[XWD GETLGN,GC%LGN##]>,<Login>) ; Login
  559.      DSPTAB    (CONFRM,<[XWD 0,GC%LOGOUT##]>,<Logout>)    ; Logout command
  560.      DSPTAB    (REM090,<[XWD GETNFL,GC%RENAME##]>,<Rename>) ; Rename file
  561.      DSPTAB    (REM120,<[XWD GETMSG,GC%SEND%MSG##]>,<Send-message>) ; Send message command
  562.      DSPTAB    (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Space>) ; Disk-usage report
  563.      DSPTAB    (CONFRM,<[XWD 0,GC%STATUS##]>,<Status>)    ; Status command
  564.      DSPTAB    (REM020,<[XWD 0,GC%TYPE##]>,<Type>)    ; Type file command
  565.      DSPTAB    (REM110,<[XWD GETOPT,GC%WHO##]>,<Who>)    ; Who is logged in
  566.     $ETAB
  567.  
  568. ; LOCAL commands.  Basically the same as the remote commands, the
  569. ;results are just typed locally instead of being transmitted.
  570.  
  571. LCL000:    $KEYDSP    (LCL010)
  572.  
  573. LCL010:    $STAB
  574.      DSPTAB    (REM070,<[XWD 0,GC%CONNECT##]>,<CWD>)    ; Change path
  575.      DSPTAB    (REM020,<[XWD 0,GC%DELETE##]>,<Delete>)    ; Delete file
  576.      DSPTAB    (REM030,<[XWD 0,GC%DIRECTORY##]>,<Directory>) ; Directory command
  577.      DSPTAB    (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Disk-usage>) ; Disk-usage report
  578.      DSPTAB    (REM020,<[XWD 0,GC%DELETE##]>,<Erase>)    ; Delete file
  579.      DSPTAB    (REM050,<[XWD 0,GC%HELP##]>,<Help>)    ; Help command
  580.      DSPTAB    (REM070,<[XWD 0,GC%CONNECT##]>,<Set-path>) ; Set default path
  581.      DSPTAB    (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Space>) ; Disk-usage report
  582.      DSPTAB    (CONFRM,<[XWD 0,GC%STATUS##]>,<Status>)    ; Status command
  583.      DSPTAB    (REM020,<[XWD 0,GC%TYPE##]>,<Type>)    ; Type file command
  584.     $ETAB
  585.  
  586. ; Here for items which take a required file spec (Type and Delete)
  587.  
  588. REM020:    $NOISE    (REM021,<file>)
  589.  
  590. REM021:    $CTEXT    (CONFRM,<file specification>)
  591.  
  592. ; Here for a directory command.  Accept an optional file spec.
  593.  
  594. REM030:    $NOISE    (REM031,<of files>)
  595.  
  596. REM031:    $CTEXT    (CONFRM,<file specification>,$ALTERNATE(CONFRM))
  597.  
  598. ; Here for a disk-usage and CWD commands
  599.  
  600. REM040:    $NOISE    (REM041,<of directory>)
  601. REM070:    $NOISE    (REM041,<to directory>)
  602.  
  603. REM041:    $CTEXT    (REM042,<directory specification>,$ALTERNATE(REM042))
  604.  
  605. REM042:    $CRLF    (<$HELP(<Confirm for default directory>)>)
  606.  
  607. ; Here for a help command
  608.  
  609. REM050:    $NOISE    (REM051,<with Kermit server>)
  610.  
  611. REM051:    $CTEXT    (CONFRM,<Topic for which help is wanted>,$ALTERNATE(CONFRM))
  612.  
  613. ; Here for a remote HOST command
  614.  
  615. REM060:    $CTEXT    (CONFRM,<Command to be executed by the remote host>)
  616.  
  617. ; Here for copy and rename commands
  618.  
  619. REM080:    $NOISE    (REM081,<from file>)
  620. REM090:    $NOISE    (REM081,<old file>)
  621.  
  622. REM081:    $CTEXT    (CONFRM,<old file name>)
  623.  
  624. ; Here for login command
  625.  
  626. REM100:    $NOISE    (REM101,<as user>)
  627.  
  628. REM101:    $CTEXT    (CONFRM,<User identification>)
  629.  
  630. ; Here for WHO command
  631.  
  632. REM110:    $NOISE    (REM111,<is using system>)
  633.  
  634. REM111:    $CTEXT    (CONFRM,<user identification or network host>,<$ALTERNATE(CONFRM)>)
  635.  
  636. ; Here for send message
  637.  
  638. REM120:    $NOISE    (REM121,<to>)
  639.  
  640. REM121:    $CTEXT    (CONFRM,<destination identification>)
  641.     SUBTTL    Command tables -- SEND command
  642.  
  643. SND000:    $NOISE    (SND010,<from files>)
  644.  
  645. SND010:    $FIELD    (CONFRM,<File specification>,<$BREAK(FILBRK)>)
  646.  
  647.     BRINI$(FIL,ALL)            ; Initialize the mask
  648.     UNBRK$(FIL,"A","Z")        ; Allow alphabetics
  649.     UNBRK$(FIL,"a","z")        ; And lower case
  650.     UNBRK$(FIL,"0","9")        ; And numbers
  651.     UNBRK$(FIL,"*")            ; Full wild card
  652.     UNBRK$(FIL,"%")            ; Single character wild-card
  653.     UNBRK$(FIL,"[")            ; Start of PPN or UIC
  654.     UNBRK$(FIL,"]")            ; End of PPN or UIC
  655.     .CHCMA==","            ; Value of a comma
  656.     UNBRK$(FIL,.CHCMA)        ; Separator in PPN's and UIC's
  657.     UNBRK$(FIL,".")            ; Between file name and extension (and generation)
  658.     UNBRK$(FIL,":")            ; After device names
  659.     UNBRK$(FIL,"$")            ; Part of VMS device names
  660.     UNBRK$(FIL,";")            ; Before generation or attributes
  661.     UNBRK$(FIL,"-")            ; For TOPS-20 file names
  662.     UNBRK$(FIL,.CHLAB)        ; Left angle bracket for TOPS-20 directories
  663.     UNBRK$(FIL,.CHRAB)        ; Right angle bracket for TOPS-20
  664.  
  665. FILBRK:    BRGEN$(FIL)            ; Generate the mask
  666.     SUBTTL    Command tables -- SERVER command
  667.  
  668. SRV000:    $NOISE    (CONFRM,<mode>)
  669.     SUBTTL    Command tables -- SET command -- Dispatch table
  670. ;[107]
  671. ;[107] Can be either a macro name or list of keyword/value pairs
  672. ;[107]
  673.  
  674. SET000:    $KEY    (CONFRM,DFNTAB,<$ALTERNATE(SET001)>)
  675.  
  676. SET001:    $KEYDSP    (SET010)        ;[107] Return here after comma
  677.  
  678. SET005:    $COMMA    (SET001,<$ALTERNATE(CONFRM)>)
  679.  
  680. SET010:    $STAB
  681.      DSPTAB    (BLK000,<[XWD CHKTYPE##,SETKYW]>,<block-check-type>)
  682.      DSPTAB    (DBG000,<[EXP SETDBG]>,<debugging>)
  683.      DSPTAB    (DEL000,<[XWD DELAY##,SETNUM]>,<delay>)
  684.      DSPTAB    (ESC000,<[EXP SETESC]>,<escape>)
  685.      DSPTAB    (FIL000,<[EXP SETFIL]>,<file>)
  686. ;[115];     DSPTAB    (FBS000,<[XWD FILTYP,SETKYW]>,<file-byte-size>)
  687. ;[115];TOPS10<     DSPTAB    (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,<file-warning>)>; End of TOPS10
  688.      DSPTAB    (HSK000,<[EXP SETHSK]>,<handshake>);    [131]
  689. ;[133]     DSPTAB    (ONOFF,<[XWD IBM%FLAG##,SETKYW]>,<IBM-mode>)
  690.      DSPTAB    (ABT000,<[XWD ABT%FLAG##,SETKYW]>,<incomplete-file>)
  691.      DSPTAB    (LIN000,<[EXP SETLIN]>,<line>)
  692.      DSPTAB    (ONOFF,<[XWD LCLECH,SETKYW]>,<local-echo>)
  693.      DSPTAB    (MSG000,<[EXP SETMSG]>,<message>)
  694.      DSPTAB    (PAR000,<[XWD PARITY%TYPE##,SETKYW]>,<parity>)
  695.      DSPTAB    (PRM000,<[EXP SETPRM]>,<prompt>)
  696.      DSPTAB    (SRC000,<[EXP SETRCV]>,<receive>)
  697.      DSPTAB (RPT000,<[EXP SETRPT]>,<repeat>)
  698.      DSPTAB    (RTY000,<[EXP SETRTY]>,<retry>)
  699.      DSPTAB    (SSN000,<[EXP SETSND]>,<send>)
  700.      DSPTAB    (SSR000,<[XWD SRV%TIMEOUT##,SETNUM]>,<server-timer>)
  701.      DSPTAB    (XXP000,<[XWD XXPMOD,SETKYW]>,<XON-XOFF-processing>)    ;[127]
  702.     $ETAB
  703.     SUBTTL    Command tables -- SET command -- ON/OFF table
  704.  
  705. ONOFF:    $KEYDSP    (ONOFFT)
  706.  
  707. ONOFFT:    $STAB
  708.      DSPTAB    (SET005,BLSFAL,<off>)
  709.      DSPTAB    (SET005,BLSTRU,<on>)
  710.     $ETAB
  711.     SUBTTL    Command tables -- SET command -- incomplete-file
  712.  
  713. ABT000:    $NOISE    (ABT010,<disposition>)
  714.  
  715. ABT010:    $KEY    (SET005,ABT01T)
  716.  
  717. ABT01T:    $STAB
  718.      KEYTAB    (BLSTRU,<discard>)
  719.      KEYTAB    (BLSFAL,<keep>)
  720.     $ETAB
  721.  
  722.  
  723.     SUBTTL    Command tables -- SET command -- Block-check-type
  724.  
  725. BLK000:    $KEY    (SET005,BLK01T)
  726.  
  727. BLK01T:    $STAB
  728.      KEYTAB    (CHK%1C##,<1-character-checksum>)
  729.      KEYTAB    (CHK%2C##,<2-character-checksum>)
  730.      KEYTAB    (CHK%CR##,<3-character-CRC-CCITT>)
  731.      KEYTAB    (CHK%1C##,<one-character-checksum>)
  732.      KEYTAB    (CHK%CR##,<three-character-CRC-CCITT>)
  733.      KEYTAB    (CHK%2C##,<two-character-checksum>)
  734.     $ETAB
  735.  
  736.  
  737.     SUBTTL    Command tables -- SET command -- DEBUGGING
  738.  
  739. DBG000:    $KEYDSP(DBG00T)
  740.  
  741. DBG00T:    $STAB
  742.      DSPTAB    (DBG010,<[XWD SETODF,0]>,<log-file>)
  743.      DSPTAB    (SET005,<[XWD SETCDF,0]>,<no-log-file>)
  744.      DSPTAB    (SET005,<[XWD SETDBF,BLSFAL]>,<off>)
  745.      DSPTAB    (SET005,<[XWD SETDBF,BLSTRU]>,<on>)
  746.     $ETAB
  747.  
  748. DBG010:    $NOISE    (DBG011,<to>)
  749.  
  750. DBG011:    $OFILE    (SET005,<File name for debugging log>)
  751.  
  752.  
  753.     SUBTTL    Command tables -- SET command -- DELAY
  754.  
  755. DEL000:    $NOISE    (DEL010,<to>)
  756.  
  757. DEL010:    $NUMBER    (SET005,^D10,<decimal number of seconds>,<$ACTION(CHKPOS)>)
  758.  
  759.  
  760.  
  761.     SUBTTL    Command tables -- SET command -- ESCAPE
  762.  
  763. ESC000:    $NOISE    (ESC010,<character for connect to>)
  764.  
  765. ESC010:    $NUMBER    (SET005,^D8,<Octal value of ASCII control character>,<$DEFAULT(31)>)
  766.     SUBTTL    Command tables -- SET command -- FILE
  767.  
  768. FIL000:    $NOISE    (FIL010,<parameter>)
  769.  
  770. FIL010:    $KEYDSP    (FIL020)
  771.  
  772. FIL020:    $STAB
  773.      DSPTAB    (FBS000,<[XWD FILTYP,SETKYW]>,<byte-size>)
  774.      DSPTAB    (FNM000,<[XWD FIL%NORMAL%FORM##,SETKYW]>,<naming>)
  775. TOPS10<     DSPTAB    (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,<warning>)>; End of TOPS10
  776.     $ETAB
  777.  
  778.  
  779.     SUBTTL    Command tables -- SET command -- FILE -- BYTE-SIZE
  780.  
  781. FBS000:    $NOISE    (FBS010,<to>)
  782.  
  783. FBS010:    $KEYDSP    (FBS020)
  784.  
  785. FBS020:    $STAB
  786.      DSPTAB (SET005,$FBS36,<36-bit>)        ;[127]
  787.      DSPTAB    (SET005,$FBS7,<7-bit>)
  788.      DSPTAB    (SET005,$FBS8,<8-bit>)
  789.      DSPTAB    (SET005,$FBAUT,<auto-byte>)
  790.      DSPTAB    (SET005,$FBS8,<eight-bit>)
  791.      DSPTAB    (SET005,$FBS7,<seven-bit>)
  792.      DSPTAB    (SET005,$FBS36,<thirty-six-bit>)    ;[127]
  793.     $ETAB
  794.  
  795.  
  796.     SUBTTL    Command tables -- SET command -- FILE -- BYTE-SIZE
  797.  
  798. FNM000:    $NOISE    (FNM010,<to>)
  799.  
  800. FNM010:    $KEYDSP    (FNM020)
  801.  
  802. FNM020:    $STAB
  803.      DSPTAB    (SET005,FNM%FULL##,<full-file-specification>)
  804.      DSPTAB    (SET005,FNM%NORMAL##,<normal-form>)
  805.      DSPTAB    (SET005,FNM%UNTRAN##,<untranslated>)
  806.     $ETAB
  807.     SUBTTL    Command tables -- SET command -- HANDSHAKE
  808.  
  809.  
  810. HSK000:    $NOISE    (HSK010,<character for IBM handshake>)        ;[131]
  811.  
  812. HSK010:    $NUMBER    (SET005,^D8,<Octal value of ASCII character>,<$DEFAULT(-1)>)    ;[131]
  813.  
  814.  
  815.  
  816.  
  817.     SUBTTL    Command tables -- SET command -- Line
  818.  
  819. LIN000:    $NOISE    (LIN010,<to>)
  820.  
  821. TOPS20<
  822. LIN010:    $NUMBER    (SET005,^D8,<line number to use for virtual terminal>)
  823. >; End of TOPS20 conditional
  824.  
  825. TOPS10<
  826. LIN010:    $DEV    (SET005,<$HELP(Name of terminal to use),$ALTERNATE(LIN020),$ERRPDB(LIN020)>)
  827.  
  828. LIN020:    $NODNM    (LIN030,<Node name terminal line is connected to>,<$ALTERNATE(LIN050),$ERRPDB(LIN050)>)
  829.  
  830. LIN030:    $NOISE    (LIN040,<Line number>)
  831.  
  832. LIN040:    $NUMBER    (SET005,^D8,<Line number on specified node>)
  833.  
  834. LIN050:    $NUMBER    (SET005,^D8,<line number to use for virtual terminal>,$ALTERNATE(SET005))
  835. >; End of TOPS10 conditional
  836.     SUBTTL    Command tables -- SET command -- Message
  837.  
  838. MSG000:    $NOISE    (MSG010,<type out to be>)
  839.  
  840. MSG010:    $KEY    (MSG020,MSG030,<$ALTERNATE(MSG020)>)
  841.  
  842. MSG020:    $KEY    (SET005,MSG040)
  843.  
  844. MSG030:    $STAB
  845.      KEYTAB    (BLSFAL,<no>)
  846.     $ETAB
  847.  
  848. MSG040:    $STAB
  849.      KEYTAB    (TY%FIL##,<file-specifications>)
  850.      KEYTAB    (TY%PKT##,<packet-numbers>)
  851.     $ETAB
  852.     SUBTTL    Command tables -- SET command -- Parity
  853.  
  854. PAR000:    $NOISE    (PAR010,<to>)
  855.  
  856. PAR010:    $KEYDSP    (PAR020)
  857.  
  858. PAR020:    $STAB
  859.      DSPTAB    (SET005,PR%EVEN##,<even>)
  860.      DSPTAB    (SET005,PR%MARK##,<mark>)
  861.      DSPTAB    (SET005,PR%NONE##,<none>)
  862.      DSPTAB    (SET005,PR%ODD##,<odd>)
  863.      DSPTAB    (SET005,PR%SPAC##,<space>)
  864.     $ETAB
  865.     SUBTTL    Command tables -- SET command -- Prompt
  866.  
  867. PRM000:    $FIELD    (SET005,<KERMIT prompt>,<$ALTERNATE(SET005),$BREAK(FILBRK)>)
  868.  
  869.     SUBTTL    Command tables -- SET command -- Receive
  870.  
  871. SRC000:    $KEYDSP    (SRC010)
  872.  
  873. SRC010:    $STAB
  874.      DSPTAB    (R8Q000,SETR8Q,<8th-bit-quote>)
  875.      DSPTAB    (R8Q000,SETR8Q,<eighth-bit-quote>)
  876.      DSPTAB    (REO000,SETREL,<end-of-line>)
  877.      DSPTAB    (RPL000,SETRPL,<packet-length>)
  878.      DSPTAB    (RPC000,SETRPC,<padchar>)
  879.      DSPTAB    (RPD000,SETRPD,<padding>)
  880.      DSPTAB    (RQU000,SETRQU,<quote>)
  881.      DSPTAB    (RSH000,SETRSH,<start-of-packet>)
  882.      DSPTAB    (RTI000,SETRTI,<timeout>)
  883.     $ETAB
  884.  
  885. R8Q000:    $NOISE    (R8Q010,<to>)
  886. R8Q010:    $NUMBER    (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
  887.  
  888. REO000:    $NOISE    (REO010,<to>)
  889. REO010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKCTL)>)
  890.  
  891. RPL000:    $NOISE    (RPL010,<to>)
  892. RPL010:    $NUMBER    (SET005,^D10,<decimal number between 10 and 1000>,<$ACTION(CHKPKT)>) ; [134]
  893.  
  894. RPC000:    $NOISE    (RPC010,<to>)
  895. RPC010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37 or 177>,<$ACTION(CHKPDC)>)
  896.  
  897. RPD000:    $NOISE    (RPD010,<to>)
  898. RPD010:    $NUMBER    (SET005,^D10,<positive decimal number of padding characters>,<$ACTION(CHKPOS)>)
  899.  
  900. RQU000:    $NOISE    (RQU010,<to>)
  901. RQU010:    $NUMBER    (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
  902.  
  903. RSH000:    $NOISE    (RSH010,<to>)
  904. RSH010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKSHC)>)
  905.  
  906. RTI000:    $NOISE    (RTI010,<to>)
  907. RTI010:    $NUMBER    (SET005,^D10,<Number of seconds before timing out, between 1 and 94>,<$ACTION(CHKTIM)>)
  908.     SUBTTL    Command tables -- SET command -- Repeat-quote
  909.  
  910. RPT000:    $NOISE    (RPT010,<to>)
  911.  
  912. RPT010:    $KEY    (SET005,RPT011,<$ALTERNATE(RPT020)>)
  913.  
  914. RPT011:    $STAB
  915.      KEYTAB    (<" ">,<none>)
  916.     $ETAB
  917.  
  918. RPT020:    $NUMBER    (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
  919.  
  920.     SUBTTL    Command tables -- SET command -- Retry
  921.  
  922. RTY000:    $NOISE    (RTY010,<maximum for>)
  923.  
  924. RTY010:    $KEY    (RTY030,RTY020)
  925.  
  926. RTY020:    $STAB
  927.      KEYTAB    (SI%RETRIES##,<initial-connection>)
  928.      KEYTAB    (PKT%RETRIES##,<packets>)
  929.     $ETAB
  930.  
  931. RTY030:    $NUMBER    (SET005,^D10,<Number of retries>,<$ACTION(CHKPOS)>)
  932.     SUBTTL    Command tables -- SET command -- Send
  933.  
  934.  
  935. SSN000:    $KEYDSP    (SSN010)
  936.  
  937. SSN010:    $STAB
  938.      DSPTAB    (SEO000,SETSEL,<end-of-line>)
  939.      DSPTAB    (SPL000,SETSPL,<packet-length>)
  940.      DSPTAB    (SPC000,SETSPC,<padchar>)
  941.      DSPTAB    (SPD000,SETSPD,<padding>)
  942.      DSPTAB    (SQU000,SETSQU,<quote>)
  943.      DSPTAB    (SSH000,SETSSH,<start-of-packet>)
  944.      DSPTAB    (STI000,SETSTI,<timeout>)
  945.     $ETAB
  946.  
  947. SEO000:    $NOISE    (SEO010,<to>)
  948. SEO010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKCTL)>)
  949.  
  950. SPL000:    $NOISE    (SPL010,<to>)
  951. SPL010:    $NUMBER    (SET005,^D10,<decimal number between 10 and 1000>,<$ACTION(CHKPKT)>) ; [134]
  952.  
  953. SPC000:    $NOISE    (SPC010,<to>)
  954. SPC010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37 or 177>,<$ACTION(CHKPDC)>)
  955.  
  956. SPD000:    $NOISE    (SPD000,<to>)
  957. SPD010:    $NUMBER    (SET005,^D10,<positive decimal number of padding characters>,<$ACTION(CHKPOS)>)
  958.  
  959. SQU000:    $NOISE    (SQU010,<to>)
  960. SQU010:    $NUMBER    (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
  961.  
  962. SSH000:    $NOISE    (SSH010,<to>)
  963. SSH010:    $NUMBER    (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKSHC)>)
  964.  
  965. STI000:    $NOISE    (RTI010,<to>)
  966. STI010:    $NUMBER    (SET005,^D10,<Number of seconds before timing out, between 1 and 94>,<$ACTION(CHKTIM)>)
  967.     SUBTTL    Command tables -- SET SERVER-TIMER
  968.  
  969. SSR000:    $NOISE    (SSR001,<to>)
  970.  
  971. SSR001:    $NUMBER    (SET005,^D10,<Number of seconds between idle server NAK's>)
  972.     SUBTTL    Command tables --SET command -- XON-XOFF-processing
  973.  
  974. XXP000:    $NOISE    (XXP010,<during connect to>)    ;[127]
  975. XXP010:    $KEYDSP    (XXP020)            ;[127]
  976. XXP020:    $STAB                    ;[127]
  977.      DSPTAB    (SET005,$XXDEF,<default>)    ;[127]
  978.      DSPTAB    (SET005,$XXLCL,<local>)        ;[127]
  979.      DSPTAB    (SET005,$XXREM,<remote>)    ;[127]
  980.     $ETAB
  981.     SUBTTL    Command tables -- STATUS command
  982.  
  983. STA000:    $NOISE    (CONFRM,<of Kermit>)
  984.     SUBTTL    Command tables -- SHOW command
  985.  
  986. SHO000:    $KEYDSP    (SHO010,<$DEFAULT(all)>)
  987.  
  988. SHO010:    $STAB
  989.      DSPTAB    (CONFRM,SHOALL,<all>)
  990.      DSPTAB    (CONFRM,SHODAY,<daytime>)
  991.      DSPTAB    (CONFRM,SHODEB,<debugging>)
  992.      DSPTAB    (CONFRM,SHOFIL,<file-information>)
  993.      DSPTAB    (CONFRM,SHOLIN,<line-information>)
  994.      DSPTAB    (CONFRM,SHOMAC,<macros>)
  995.      DSPTAB    (CONFRM,SHOPKT,<packet-information>)
  996.      DSPTAB    (CONFRM,SHOTIM,<timing-information>)
  997.      DSPTAB    (CONFRM,SHOVER,<version>)
  998.     $ETAB
  999.     SUBTTL    Entry vector and initialization
  1000.  
  1001. TOPS20<
  1002. KERMIT:    JRST    START            ; Start program entry
  1003.     JRST    START            ; Reenter address
  1004.     BYTE    (3)KERWHO(9)KERVER(6)KERMIN(18)KEREDT
  1005. >; End of TOPS20 entry vector
  1006.  
  1007.  
  1008. TOPS10<
  1009. KERMIT:    PORTAL    .+2            ; Allow EXO entry
  1010.     PORTAL    .+2            ; Allow EXO entry
  1011.     TDZA    S1,S1            ; Determine if CCL entry or not
  1012.      SETO    S1,            ; Flag CCL entry
  1013.     MOVEM    S1,CCLOFS        ; Store the CCL offset
  1014. >; End of TOPS10 conditional
  1015.  
  1016. START:    RESET                ; Reset everthing
  1017.     MOVE    P,[IOWD PDLLEN,PDL]    ; Set up the stack
  1018.     MOVE    S1,[XWD PHABEG,LOWPHA]    ; Set up to move the phased code
  1019.     BLT    S1,PHAEND        ; All of it
  1020.     MOVEI    S1,IB.SZ        ; Get the initialization block size
  1021.     XMOVEI    S2,IB            ; And the address
  1022.     $CALL    I%INIT            ; Initialize GLXLIB
  1023.     $CALL    MSG%INIT##        ; Initialize the message processing
  1024.     $CALL    TT%INIT##        ; Initialize the type out routines
  1025.  
  1026.     MOVEI    S1,LOWSIZ        ; Get the size of the low seg
  1027.     XMOVEI    S2,LOWBEG        ; And the start address
  1028.     $CALL    .ZCHNK            ; Clear the low segment out
  1029.     $CALL    SY%INIT##        ; Initialize KERSYS
  1030.     $CALL    LOKINI##        ; Initialize KERWLD data
  1031.  
  1032.     $CALL    INIKER            ; Initialize Kermit processing
  1033.     $CALL    INITRM            ; Initialize the terminal processing
  1034.     $CALL    INIFIL            ; Initialize the file processing
  1035.  
  1036. ; Determine node number of central site
  1037.  
  1038. TOPS10<
  1039.     MOVX    S1,<SIXBIT |CTY|>    ; Get console's name
  1040.     WHERE    S1,            ; Determine location
  1041.      SETZ    S1,            ; Assume no network support
  1042.     HRRZM    S1,HSTNOD        ; Save host node number
  1043.     TXNE    S1,RHMASK        ; Network support on?
  1044.      SKIPA    S1,[EXP [ITEXT(<^N/HSTNOD/::>)]] ; Yes, use node name
  1045.       MOVEI    S1,[ITEXT(<>)]        ; No, don't print node names
  1046.     MOVEM    S1,HSTITX        ; Save host name ITEXT address
  1047.  
  1048. ; Determine if we are logged in.
  1049.  
  1050.     PJOB    S1,            ;[125] Get our job number
  1051.     MOVNS    S1            ;[125] Set up for JOBSTS
  1052.     JOBSTS    S1,            ;[125] Get status for us
  1053.      MOVX    S1,JB.ULI        ;[125] If it doesn't work, this must be ancient
  1054.     TXNN    S1,JB.ULI        ;[125] Logged in?
  1055.      SETZ    S1,            ;[125] No, remember that
  1056.     MOVEM    S1,LOGDIN        ;[125] Save flag for file creation time
  1057. > ; End of TOPS10
  1058.  
  1059. ; Initialize the parser interface blocks
  1060.  
  1061.     XMOVEI    S1,KER000        ; Start of the tables
  1062.     MOVEM    S1,PRBLK+PAR.TB        ; Store it
  1063.     XMOVEI    S1,PROMPT        ; Address of the prompt string
  1064.     MOVEM    S1,PRBLK+PAR.PM        ; Store it
  1065.  
  1066. TOPS10<
  1067.     XMOVEI    S1,MON000        ; Monitor command block
  1068.     MOVEM    S1,MONBLK+PAR.TB    ; Store it
  1069.     XMOVEI    S1,[EXP 0]        ; No prompt string
  1070.     MOVEM    S1,MONBLK+PAR.PM    ; Store it
  1071.     SETOM    MONBLK+PAR.SR        ; Rescan the monitor command
  1072. >; End of TOPS10 conditional
  1073.  
  1074.     SETZB    S1,S2            ; No arguments
  1075.     $CALL    P$INIT            ; Initialize the parser
  1076.  
  1077.     $CALL    REDINI            ; Read the KERMIT.INI file
  1078.  
  1079. TOPS10<
  1080.     SKIPE    CCLOFS            ; CCL Entry ?
  1081.     $CALL    SETTMP            ; Yes, set up CCL file
  1082.     MOVEI    S2,MONBLK        ; Get the monitor Kermit paring
  1083.     SKIPN    CCLOFS            ; CCL Entry ?
  1084.      JRST    PARL.0            ; Monitor entry, use rescan block
  1085. >; End of TOPS10 conditional
  1086.     JRST    PARL.1            ; Enter the parsing loop
  1087.  
  1088. ; Here to set up to call the parser again
  1089.  
  1090. PARLOP:
  1091. TOPS10<
  1092.     SKIPN    TMPADR            ; Have a TMPCOR file?
  1093.      SKIPE    CCLIFN            ; Of a take file?
  1094.       JRST    PARL.8            ; Yes, don't exit yet
  1095. >; End of TOPS10 conditional
  1096.  
  1097.     SKIPE    INIIFN            ; Processing a KERMIT.INI?
  1098.      JRST    PARL.8            ; Yes, can not exit yet
  1099.  
  1100.     SKIPE    XITFLG            ; No, want out?
  1101.      $CALL    C$EXI0            ;[125] And exit
  1102.  
  1103. TOPS10<
  1104. PARL.8:    SKIPE    TMPADR            ; Have TMPCOR data?
  1105.      $CALL    ADVTMP            ; Yes, advance it
  1106. >; End of TOPS10 conditional
  1107.     SKIPN    S1,PAR.CM+PRBLK        ; Have some parsed data around?
  1108.      JRST    PARL.1            ; No, skip this
  1109.     MOVX    S2,COM.SZ-1        ; Get the size
  1110.     STORE    S2,.MSTYP(S1),MS.CNT    ; Store it
  1111.     SETZM    COM.CM(S1)        ; And clear text pointer
  1112.  
  1113. PARL.1:    $CALL    T$LOCAL            ; Determine if we are a local or remote
  1114.     MOVEI    S1,KER000        ; Assume remote
  1115.     SKIPF                ; Are we?
  1116.      MOVEI    S1,KER100        ; No, use local table
  1117.     MOVEM    S1,PRBLK+PAR.TB        ; Store it
  1118.     MOVEI    S2,PRBLK        ; Get the address of the arguments
  1119. PARL.0:    MOVX    S1,PAR.SZ        ; And the size
  1120.     $CALL    PARSER##        ; Parse a command
  1121.     DMOVEM    S1,PRTARG        ; Save the argument pointers
  1122.     LOAD    T1,PRT.CM(S2)        ; Get the address of the parsed data
  1123.     STORE    T1,PAR.CM+PRBLK        ; Save for next try
  1124.     LOAD    T2,PRT.FL(S2)        ; Get the flags
  1125.     TXC    T2,P.CTAK!P.ERRO    ; Error?
  1126.     TXCN    T2,P.CTAK!P.ERRO    ; from a TAKE file?
  1127.      JRST    PARL.D            ; Yes, display the line also
  1128.     TXNE    T2,P.DSPT        ; Need to display this?
  1129. PARL.D:     $TEXT    (,<^T/PROMPT/^T/@PRT.MS(S2)/^A>) ; Yes, do it
  1130.  
  1131.     JUMPF    PARL.E            ; Get an error on the command?
  1132.  
  1133.     MOVEI    S1,COM.SZ(T1)        ; No, get the address
  1134.     $CALL    P$SETU            ; Set up to parse the command
  1135.  
  1136.     $CALL    P$KEYW            ; Get the first keyword
  1137.     CAIN    S1,.KYTAK        ;[111] Take command is special
  1138.      JRST    PARLOP            ;[111] It gets handled before the return
  1139.     $CALL    (S1)            ; And call the processor for it
  1140.     JUMPT    PARLOP            ; If no error, keep going
  1141.  
  1142.     $CALL    ABRTAK            ; Abort any TAKE processing
  1143.     JRST    PARLOP            ; And try again
  1144. ; Here if the command parsing got and error.  Check for running out of data
  1145. ;on TMPCOR processing or rescan processing.  If we have run out of TMPCOR
  1146. ;If we have run out of data on a rescan, we will just prompt.
  1147.  
  1148. PARL.E:    TXNE    T2,P.CEOF!P.ENDT    ; Run out of data?
  1149.      JRST    PARL.F            ; Yes, go check what we should do
  1150.     $TEXT(,<? ^T/@PRT.EM(S2)/>)    ; Give the error
  1151.  
  1152. PARL.F:    TXNN    T2,P.ENDT        ; End of TAKE file?
  1153.      JRST    PARL.G            ; No, punt the take file if any
  1154.  
  1155.     SKIPE    INIIFN            ; Doing KERMIT.INI?
  1156.      $RETT                ; Yes, pop up a level
  1157.     $CALL    ABRT.0            ; No, end of normal TAKE file or CCL entry
  1158.     SKIPA                ; And continue on
  1159. PARL.G:     $CALL    ABRTAK            ; Abort what TAKE processing we can
  1160.     SKIPE    INIIFN            ; .INI file?
  1161.      $RETT                ; Yes, all done with it
  1162.     SKIPE    CCLOFS            ; CCL entry?
  1163.      $HALT                ; Yes, exit, but let him continue
  1164.     JRST    PARLOP            ; Go for next command
  1165. ; Here to handle the monitor command dispatch. We just see if we have
  1166. ; a CRLF or an item to dispatch on.  If we have a CRLF just return, else
  1167. ; we dispatch
  1168.  
  1169. KERCMD:    SETOM    XITFLG            ; Flag we must exit
  1170.     $CALL    P$CFM            ; Is this a confirm?
  1171.     JUMPF    KERCM0            ; If this is not a confirm, jump
  1172.     $CALL    SHOVER            ; Show the version
  1173.     SETZM    XITFLG            ; Clear the exit flag
  1174.     $RETT                ; Give a good return to the caller
  1175.  
  1176. ; Here if we got a command that we are to process
  1177.  
  1178. KERCM0:    $CALL    P$KEYW            ; Must have a keyword
  1179.     $RETIF                ; Return if something else
  1180.     $CALL    (S1)            ; Call the routine
  1181.     $RET                ; Pass back failures
  1182.  
  1183.     SUBTTL    Kermit initialization
  1184.  
  1185. ;+
  1186. ;.hl1 INIKER
  1187. ;This routine will initialize the Kermit processing.  It will get whatever
  1188. ;general information is required for Kermit.
  1189. ;.literal
  1190. ;
  1191. ; Usage:
  1192. ;    $CALL    INIKER
  1193. ;    (Return)
  1194. ;
  1195. ;.end literal
  1196. ;-
  1197.  
  1198. INIKER:    $CALL    DEFPRM            ; Default the prompt
  1199.     MOVX    S2,JI.USR        ; Get the user directory number
  1200.     SETO    S1,            ;  for this job
  1201.     $CALL    I%JINF            ; Get it
  1202.     MOVEM    S2,.MYPPN        ; Store for later
  1203.     MOVX    S1,D$ESCAPE        ; Get the default escape character
  1204.     MOVEM    S1,ESCAPE        ; Store it
  1205.     ADDI    S1,"A"-.CHCNA        ; Convert to printing character
  1206.     $TEXT    (<-1,,ESCTXT>,<^^^7/S1/^0>) ; Store the text
  1207.  
  1208. ;[107] Now define any default macros.  We will use a macro to do this.
  1209. ;[107]Arguments to the macro are:
  1210. ;[107]DFNMAC(macro.name,<Macro expansion>)
  1211. ;[107]
  1212. ;[107] Macro expansion must be a completely valid set of SET keywords/values
  1213. ;[107]
  1214. DEFINE DFNMAC(MNAME,MTEXT)<
  1215.     ...MNL==<...MTL==0>        ;;[107] Clear length counters
  1216.     .XCREF    ...MNL,...MTL        ;;[107] No need to CREF these
  1217.     IRPC <MNAME>,<...MNL==...MNL+1>    ;;[107] Count characters in the name
  1218.     IRPC <MTEXT>,<...MTL==...MTL+1>    ;;[107] And in the expansion text
  1219.     ...MTL==<6+1+...MNL+1+...MTL+2+5>/5 ;;[107] Length of full expansion in words
  1220.     ...MNL==<...MNL+5>/5        ;;[107] Get length of name in words (with null)
  1221. ;;[107] Now generate the code to insert the items into the table
  1222.  
  1223.     MOVEI    S1,$MBNAM+...MNL+...MTL    ;;[107] Get the length of the block
  1224.     $CALL    M%GMEM            ;;[107] Get the memory we need
  1225.     STORE    S1,$MBLEN(S2),MB$LEN    ;;[107] Store the length of the block
  1226.     MOVEI    S1,SETMAC        ;;[107] Store the routine
  1227.     HRLI    S1,(S2)            ;;[107] And block address
  1228.     MOVEM    S1,$MBRTN(S2)        ;;[107]  .  .  .
  1229.     MOVEI    S1,...MNL+$MBNAM    ;;[107] Store offset to expansion
  1230.     STORE    S1,$MBOFS(S2),MB$OFS    ;;[107]  .  .  .
  1231.     MOVEI    S1,$MBNAM(S2)        ;;[107] Point at name storage
  1232.     HRLI    S1,[ASCIZ |'MNAME'|]    ;;[107] And at name text
  1233.     BLT    S1,$MBNAM+...MNL-1(S2)    ;;[107] Copy the name
  1234.     MOVEI    S1,$MBNAM+...MNL(S2)    ;;[107] Point at expansion storage
  1235.     HRLI    S1,[ASCIZ |DEFINE MNAME MTEXT
  1236. |] ;;[107] And at the text
  1237.     BLT    S1,$MBNAM+...MNL+...MTL-1(S2) ;;[107] Copy it
  1238.     HRLI    S2,$MBNAM(S2)        ;;[107] Point at the name
  1239.     MOVEI    S1,DFNTAB        ;;[107] And at the table header
  1240.     $CALL    S%TBAD            ;;[107] Put the macro in the table
  1241.     JUMPF    [$STOP(BMD,<Bad macro definition>)]
  1242. > ;[107] End of DFNMAC
  1243. ;[107]
  1244. ;[107] Now actually define our default macro(s)
  1245. ;[107]
  1246.  
  1247. ;[133]    DFNMAC(IBM,<Handshake 21, IBM-mode on, Parity mark, Local-echo on>)
  1248.     DFNMAC(IBM,<Handshake 21, Parity mark, Local-echo on>)
  1249.     $RETT                ; Return to the caller
  1250.     SUBTTL    KERMIT.INI processing
  1251.  
  1252. ; This routine will set up for processing KERMIT.INI
  1253.  
  1254. REDINI:    SETZM    INIIFN            ; Assume no .INI file
  1255.     MOVX    S1,<<SIXBIT |INI|>>    ;[125] Try INI:KERMIT.INI first
  1256.     MOVEM    S1,INIFD+.FDSTR        ;[125] for global defs
  1257.     MOVEI    S1,INIFD        ;[125] Get the FD address
  1258.     SETZ    S2,            ;[125] No log file FD
  1259.     $CALL    P$TAKE            ;[125] Set up the take
  1260.     JUMPF    REDIN0            ;[125] If not there, don't worry about it
  1261.     MOVEM    S1,INIIFN        ;[125] Found the file, save the IFN
  1262.     $CALL    PARL.1            ;[125] Parse the file
  1263.     SETZM    INIIFN            ;[136] Again assume no .INI file
  1264. REDIN0:    MOVX    S1,<<SIXBIT |DSK|>>    ;[125] Now we will use
  1265.     MOVEM    S1,INIFD+.FDSTR        ;[125] DSK:KERMIT.INI[,]
  1266.     GETPPN    S1,            ; Get our logged in PPN
  1267.      JFCL                ; Silly return
  1268.     STORE    S1,INIFD+.FDPPN        ; Store for where to find the KERMIT.INI
  1269.     MOVEI    S1,INIFD        ; Get the FD address
  1270.     SETZ    S2,            ; And clear the LOG file FD
  1271.     $CALL    P$TAKE            ; Set it up
  1272.     $RETIF                ; Just punt if none
  1273.     MOVEM    S1,INIIFN        ; Save the IFN
  1274.     $CALL    PARL.1            ; Parse the file
  1275.     SETZM    INIIFN            ; Clear the IFN
  1276.     $RETT                ; And return
  1277.     SUBTTL    CCL entry processing -- SETTMP
  1278.  
  1279. ; This routine will set up to read from either TMPCOR or a .TMP file on
  1280. ;disk.  This is used when we have been started at CCL entry.
  1281.  
  1282. TOPS10<
  1283.  
  1284. SETTMP:    SETZM    CCLIFN            ; Clear the IFN for disk file
  1285.     MOVX    S1,<XWD .TCRRF,T1>    ; Get the arg pointer
  1286.     MOVX    T1,<SIXBIT |KER|>    ; And the file name
  1287.     SETZ    T2,            ; No buffer
  1288.     TMPCOR    S1,            ; See if the file exists
  1289.      JRST    SETT.D            ; No, try on DSK:
  1290.     AOJ    S1,            ; Yes, bump the size
  1291.     MOVEM    S1,TMPSIZ        ; And remember it
  1292.     $CALL    M%GMEM            ; Get the memory
  1293.     MOVEM    S2,TMPADR        ; Save the address
  1294.     MOVN    T2,TMPSIZ        ; Get the buffer size
  1295.     MOVSI    T2,(T2)            ; In the left half
  1296.     HRRI    T2,-1(S2)        ; And make the IOWD
  1297.     MOVX    T1,<SIXBIT |KER|>    ; Get the name
  1298.     MOVX    S1,<XWD .TCRDF,T1>    ; Get the pointer
  1299.     TMPCOR    S1,            ; And read the file
  1300.      $STOP    TFD,<Temp file disappeared> ; Where did it go?
  1301.     MOVE    S1,TMPADR        ; Get the address
  1302.     HRLI    S1,(POINT 7,)        ; And make it a byte pointer
  1303.     STORE    S1,PRBLK+PAR.SR        ; Save the source
  1304.     ADD    S1,TMPSIZ        ; Point to last word+2
  1305.     HRLI    S1,(POINT 7,,34)    ; Point at last character
  1306.     SUBI    S1,2            ;  .  .  .
  1307.     MOVE    T1,TMPSIZ        ; Get the size
  1308.     SOJ    T1,            ; Minus one word
  1309.     IMULI    T1,5            ; Make it the max number of characters
  1310.  
  1311. SETT.0:    LDB    S2,S1            ; Get the character
  1312.     CAIN    S2,.CHLFD        ; End of command?
  1313.      $RETT                ; Yes, no problem
  1314.     JUMPN    S2,SETT.1        ; Some non-null character?
  1315.     ADDX    S1,<INSVL.(7,BP.POS)>    ; Back up the position
  1316.     JUMPG    S1,.+2            ; Go over a word boundary?
  1317.      SUBX    S1,<INSVL.(^D35,BP.POS)+1> ; Back to previous word
  1318.     SOJG    T1,SETT.0        ; Try again if anything left
  1319.     PJRST    ABRTAK            ; Nothing really there, all done
  1320.  
  1321. SETT.1:    MOVX    S2,.CHLFD        ; Doesn't end with a LF, get one
  1322.     IDPB    S2,S1            ; And store it
  1323.     $RETT                ; And return
  1324.  
  1325. ; Here to attempt to read the file from disk
  1326.  
  1327. SETT.D:    SETZM    TMPADR            ; Flag nothing in core
  1328.     MOVE    S1,[POINT 6,CCLFD+.FDNAM] ; Get the byte pointer to the name field
  1329.     MOVEM    S1,TMPBP        ; Save it
  1330.     PJOB    S1,            ; Get out job number
  1331.     $TEXT    (TMPDBP,<^D3R0/S1/KER^A>) ; Store the name
  1332.     MOVEI    S1,CCLFD        ; Get the FD for the file
  1333.     SETZ    S2,            ; Want no log file
  1334.     $CALL    P$TAKE            ; Set up the file
  1335.      $RETIF                ; If not found, just return
  1336.     MOVEM    S1,CCLIFN        ; Save the IFN so we can abort any TAKE file
  1337.  
  1338. ; Now cheat and delete the file on another channel
  1339.  
  1340.     MOVEI    S1,FOB.MZ        ; Get the size
  1341.     MOVEI    S2,CCLFOB        ; And the address
  1342.     $CALL    F%DEL            ; And delete it (other channel has open copy)
  1343.     $RETT                ; And return
  1344.  
  1345. ; Routine to store sixbit characters
  1346.  
  1347. TMPDBP:    CAIL    S1,"`"            ; Lower case?
  1348.      SUBI    S1,"a"-"A"        ; Yes, make upper
  1349.     SUBI    S1,"A"-'A'        ; Convert to SIXBIT
  1350.     JUMPL    S1,.RETT        ; Ignore control characters
  1351.     IDPB    S1,TMPBP        ; Store the character
  1352.     $RETT                ; And return
  1353. >; End of TOPS10 conditional
  1354.     SUBTTL    CCL entry processing -- ADVTMP
  1355.  
  1356. ; This routine is used to advance the byte pointer for the TMPCOR data.
  1357. ;It will step through the parsed data returned from PARSER while advancing
  1358. ;our own byte pointer to the TMPCOR data.
  1359.  
  1360. TOPS10<
  1361.  
  1362. ADVTMP:    MOVE    S1,PRTARG+1        ; Get the address of the arg block
  1363.     MOVE    S1,PRT.MS(S1)        ; Get the address of OPRPAR's buffer
  1364.     HRLI    S1,(POINT 7,)        ; Make it a byte pointer
  1365.  
  1366. ADVT.1:    ILDB    S2,S1            ; Get a character
  1367.     JUMPE    S2,ADVT.2        ; Done?
  1368.     IBP    PRBLK+PAR.SR        ; No, advance the pointer
  1369.     JRST    ADVT.1            ; And try again
  1370.  
  1371. ADVT.2:    MOVE    S1,PRBLK+PAR.SR        ; Get the current pointer
  1372.     ILDB    S2,S1            ; And peek at the next character
  1373.     JUMPN    S2,.RETT        ; If something left, try again
  1374.     $CALL    ABRTAK            ; All done, clear the take file
  1375.     SKIPE    CCLOFS            ; CCL entry?
  1376.      $HALT                ; Yes, then exit
  1377.     $RETT                ; Otherwise, try again
  1378. >; End of TOPS10 conditional
  1379.     SUBTTL    CCL entry processing -- ABRTAK
  1380.  
  1381. ; This routine will abort the current take file.
  1382.  
  1383. TOPS10<
  1384.  
  1385. ABRTAK:    SKIPN    S2,TMPADR        ; Have an incore file?
  1386.      JRST    ABRT.1            ; No, check for disk .TMP or TAKE file
  1387.     MOVE    S1,TMPSIZ        ; Yes, get the size
  1388.     $CALL    M%RMEM            ; Return the memory
  1389.     SETZM    TMPADR            ; Clear the address
  1390.     SETZM    PRBLK+PAR.SR        ; Clear the source pointer
  1391.     $RETT                ; And return
  1392.  
  1393. ABRT.1:    SKIPN    S1,INIIFN        ;[127] Have a KERMI.INI file?
  1394.     MOVE    S1,CCLIFN        ;[127] or anything else
  1395.      JUMPE    S1,.RETT        ;[127] All done if not
  1396.     SETO    S2,            ; Yes, position it to EOF
  1397.     $CALL    F%POS            ;  .  .  .
  1398. ABRT.0:    SKIPN    INIIFN            ;[127] Unless doing KERMIT.INI
  1399.     SETZM    CCLIFN            ; Remember we have done this
  1400.     $RETT                ; And return
  1401.  
  1402. >; End of TOPS10 conditional
  1403.     SUBTTL    Command parsing utility routines -- GETANS - Get an answer
  1404.  
  1405. ; This routine will prompt the user and get his string answer.
  1406. ;
  1407. ; Usage:
  1408. ;    S1/ Echo flag,,address of prompt(as ITEXT)
  1409. ;    S2/ Length in chars,,address for answer
  1410. ;    $CALL    GETANS
  1411. ;     (return true always, S1= Length of response in characters)
  1412. ;
  1413.     ND    ANSLEN,    ^D40        ; Allow lots of room for answers
  1414.  
  1415. GETANS:    DMOVE    T1,S1            ; Get the args
  1416.     MOVEI    S1,.RDRTY+1        ; Get the length
  1417.     MOVEI    S2,TXIBLK        ; Get the address of the block
  1418.     $CALL    .ZCHNK            ; Clear it out
  1419.     MOVEI    S1,ANSLEN        ; Get the buffer length
  1420.     MOVEI    S2,ANSBUF        ; And the address
  1421.     $CALL    .ZCHNK            ; Clear it out
  1422.  
  1423.     MOVX    S1,.RDRTY        ; Get the last word we have
  1424.     MOVEM    S1,TXIBLK+.RDCWB    ; Save it
  1425.     MOVX    S1,RD%TOP!RD%CRF!RD%JFN    ; Get the flags
  1426.     TXNE    T1,LHMASK        ; Want no echo?
  1427.      TXO    S1,RD%NEC        ; Yes, flag that also
  1428.     MOVEM    S1,TXIBLK+.RDFLG    ; Store the flags
  1429.     MOVX    S1,<XWD .PRIIN,.PRIOU>    ; Get the JFN's for the terminal
  1430.     MOVEM    S1,TXIBLK+.RDIOJ    ; Save them
  1431.  
  1432.     MOVE    S1,[POINT 7,ANSBUF]    ; Get the buffer pointer
  1433.     MOVEM    S1,TXIBLK+.RDDBP    ; Save it for storing the prompt
  1434.     MOVX    S1,<ANSLEN*5>-1        ; Get the length of the buffer
  1435.     MOVEM    S1,TXIBLK+.RDDBC    ; Save as initial count
  1436.  
  1437.     $TEXT(ANSDBP,<^I/(T1)/^A>)    ; Get the prompt into the buffer
  1438.     MOVE    S1,TXIBLK+.RDDBP    ; Get the updated byte pointer
  1439.     MOVEM    S1,TXIBLK+.RDBFP    ; Save as start of destination buffer also
  1440.     $TEXT(<-1,,PRMPTB>,<^I/(T1)/^A^0>) ; Store in prompt buffer
  1441.     HRROI    S1,PRMPTB        ; Get the address of the buffer
  1442.     MOVEM    S1,TXIBLK+.RDRTY    ; Save it for ^R
  1443.     $CALL    K%SOUT            ; Output the string also
  1444.  
  1445.     MOVEI    S1,TXIBLK        ; Get the block address
  1446.     $CALL    K%TXTI            ; And do the TEXTI simulation
  1447.     TXNE    T1,LHMASK        ; No-echo flag?
  1448.      $TEXT    (,<>)            ; Yes, force a CRLF
  1449.     MOVE    T1,TXIBLK+.RDBFP    ; Get the pointer to the text we got
  1450.     HRLI    T2,(POINT 7,)        ; Get the destination byte pointer
  1451.     SETO    S1,            ; Clear the character counter
  1452.  
  1453. GETA.L:    ILDB    S2,T1            ; Get a character
  1454.     CAXN    S2,.CHLFD        ; Line break?
  1455.      SETZ    S2,            ; Yes, change to a null
  1456.     IDPB    S2,T2            ; Store the character
  1457.     AOJ    S1,            ; Count the character
  1458.     JUMPN    S2,GETA.L        ; And loop for more unless done
  1459.     $RETT                ; And return
  1460.  
  1461. ANSDBP:    SOSLE    TXIBLK+.RDDBC        ; Count the character
  1462.      IDPB    S1,TXIBLK+.RDDBP    ; Store the character
  1463.     $RETT                ; And return
  1464.     SUBTTL    Command parsing utility routines -- CHKCTL
  1465.  
  1466. ;+
  1467. ;.HL1 Command parsing utility routines
  1468. ; These routines are called as $ACTION routines during parsing to
  1469. ;check if the values typed for a field are reasonable.  If the
  1470. ;value is not, an error is returned.
  1471. ;
  1472. ;.HL2 CHKCTL
  1473. ; This routine will check that the value typed represents a valid ASCII
  1474. ;control character.
  1475. ;octal.
  1476. ;-
  1477.  
  1478. CHKCTL:    SKIPL    T1,CR.RES(S2)        ; Get the result value
  1479.      CAIL    T1," "            ; Legal character?
  1480.       TRNA                ; Failed, skip
  1481.     $RETT                ; Everything is OK
  1482.     $CALL    FIXIT            ; Back up the pointer
  1483.     MOVEI    S2,[ASCIZ |Value must be between 0 and 37 octal|]
  1484.     $RETF                ; Pass back the error
  1485.  
  1486. ;+
  1487. ;.HL2 CHK8QU
  1488. ; This routine will check that the value typed is a valid 8-bit quoting
  1489. ;character.
  1490. ;-
  1491.  
  1492. CHK8QU:    MOVE    T1,CR.RES(S2)        ; Get the result value
  1493.     CAIL    T1,41            ; Less than 41?
  1494.      CAILE    T1,76            ; And less than 76  (range of 41 to 76)
  1495.       TRNA                ; No, continue checks
  1496.     $RETT                ; Yes, give a good return
  1497.     CAIL    T1,140            ; Within the range of 140 to
  1498.      CAILE    T1,176            ;  176
  1499.       TRNA                ; No, give an error return
  1500.     $RETT                ; Yes, give an ok return
  1501.     $CALL    FIXIT            ; Fix up the pointers
  1502.     MOVEI    S2,[ASCIZ |Value must be within the ranges of 41 to 76 or 140 to 176|]
  1503.     $RETF                ; Give a failure return
  1504.  
  1505. ;+
  1506. ;.HL2 CHKTIM
  1507. ;This routine will check to see if the time out time is valid.  Valid time out
  1508. ;times are within the range of 1 to 94.
  1509. ;-
  1510.  
  1511. CHKTIM:    SKIPL    T1,CR.RES(S2)        ; Get the result value
  1512.      CAILE    T1,^D94            ; Within range?
  1513.       TRNA                ; No, give the error return
  1514.       $RETT                ; Valid, return now
  1515.     $CALL    FIXIT            ; Fix up the command block
  1516.     MOVEI    S2,[ASCIZ |Time out must be between 0 and 94|]
  1517.     $RETF                ; Give a failure return
  1518.  
  1519. ;+
  1520. ;.HL2 CHKPOS
  1521. ;This routine will check to see if the number is positive.  If it is not then
  1522. ;an error will be issued.
  1523. ;-
  1524.  
  1525. CHKPOS:    SKIPL    CR.RES(S2)        ; Valid number?
  1526.      $RETT                ; Yes, just return
  1527.     $CALL    FIXIT            ; No, error out
  1528.     MOVEI    S2,[ASCIZ |Must be a positive number|]
  1529.     $RETF                ; Give a failure return
  1530.  
  1531. ;+
  1532. ;.HL2 CHKPKT
  1533. ;This routine will check to see if the packet length if valid.
  1534. ;-
  1535.  
  1536. CHKPKT:    MOVE    T1,CR.RES(S2)        ; Get the value given
  1537.     CAIL    T1,^D10            ; Is this within range?
  1538.      CAILE    T1,^D1000 ; [134] 94    ; . . .
  1539.       TRNA                ; No, issue an error
  1540.     $RETT                ; it is ok, just return
  1541.     $CALL    FIXIT            ; Fix up pointers
  1542.     MOVEI    S2,[ASCIZ |Packet length must be between 10 and 1000|] ; [134]
  1543.     $RETF                ; Give a failure return
  1544.  
  1545. ;+
  1546. ;.HL2 CHKPDC
  1547. ;This routine will check to see if the padding character is valid.  It will
  1548. ;make sure that it is either 177 or in the range of 0 to 37.
  1549. ;-
  1550.  
  1551. CHKPDC:    MOVE    T1,CR.RES(S2)        ; Get the value
  1552.     CAIN    T1,.CHDEL        ; Delete?
  1553.       $RETT                ; Yes, just return
  1554.     CAIL    T1,.CHNUL        ; At least a null
  1555.      CAILE    T1," "-1        ; And less than a space?
  1556.       TRNA                ; No, illegal value
  1557.     $RETT                ; Yes, give a good return
  1558.     $CALL    FIXIT            ; Fix up the pointers
  1559.     MOVEI    S2,[ASCIZ |Illegal padding character|]
  1560.     $RETF                ; Give a failure return
  1561.  
  1562. ;+
  1563. ;.HL2 CHKSHC
  1564. ;This routine will check to see if the start of header character is valid.
  1565. ;It will make sure that it is either 177 or in the range of 0 to 37.
  1566. ;-
  1567.  
  1568. CHKSHC:    MOVE    T1,CR.RES(S2)        ; Get the value
  1569.     CAIL    T1,.CHNUL        ; At least a null
  1570.      CAILE    T1," "-1        ; And less than a space?
  1571.       TRNA                ; No, illegal value
  1572.     $RETT                ; Yes, give a good return
  1573.     $CALL    FIXIT            ; Fix up the pointers
  1574.     MOVEI    S2,[ASCIZ |Illegal start of packet character|]
  1575.     $RETF                ; Give a failure return
  1576.  
  1577. ;+
  1578. ;.HL2 FIXIT
  1579. ;This routine will adjust the pointers back so that the command
  1580. ;can be Ctl-H'd.
  1581. ;-
  1582.  
  1583. FIXIT:    HRRZ    T4,CR.FLG(S2)        ; Get the address of the command block
  1584.     MOVE    T1,.CMPTR(T4)        ; Get the command pointer
  1585.     MOVE    T2,.CMABP(T4)        ; Get the byte pointer to the atom buffer
  1586. FIXI.1:    ADDX    T1,<INSVL.(7,BP.POS)>    ;; Back up the position
  1587.     JUMPG    T1,.+2            ;; Go over a word boundary?
  1588.      SUBX    T1,<INSVL.(^D35,BP.POS)+1> ; Back to previous word
  1589.     AOS    .CMCNT(T4)        ; Increment the count
  1590.     ILDB    T3,T2            ; Get a character
  1591.     JUMPN    T3,FIXI.1        ; If zero then finished
  1592.     MOVEM    T1,.CMPTR(T4)        ; Store the adjusted byte pointer
  1593.     POPJ    P,0
  1594.     SUBTTL    Command execution -- CONNECT command
  1595.  
  1596. ;+
  1597. ;.hl1 C$CONNECT
  1598. ;This routine will parse and process the CONNECT command.  This routine
  1599. ;will check to determine that the line that is being set is not the same as
  1600. ;a line that is currently being used.
  1601. ;-
  1602.  
  1603. C$CONNECT:
  1604.     $CALL    P$CFM            ; User type a CONNECT <CRLF>?
  1605.     JUMPT    CNCT.1            ; Yes, skip the setting of this
  1606.     $CALL    LINSBR            ; Parse the line information
  1607.     $RETIF                ; Just return if that failed
  1608.  
  1609. CNCT.1:    MOVE    S1,XFRTRM+$TTNOD    ; Get the transfer line node number
  1610.     MOVE    S2,XFRTRM+$TTLIN    ; Get the transfer line number
  1611.     CAMN    S1,MYTERM+$TTNOD    ; Different from this?
  1612.      CAME    S2,MYTERM+$TTLIN    ; Same node and line number?
  1613.       JRST    CNCT.0            ; No, different, so open the terminals
  1614.     $KERR    (<Can not connect to your terminal line>)
  1615.     $RETF                ; Return a failure
  1616.  
  1617. ; Here if we can open the terminal lines.
  1618.  
  1619. CNCT.0:    RELEAS    TTY,            ; Close this terminal channel
  1620.     XMOVEI    S1,XFRTRM        ; Point to the remote terminal
  1621.     $CALL    T$OPEN            ; Open the terminal
  1622.     $RETIF                ; Return if that fails
  1623.     SETZ    S1,            ; Break on all characters
  1624.     XMOVEI    S2,XFRTRM        ; Point to the block
  1625.     $CALL    T$SBRK            ; Set the break information
  1626.  
  1627.     XMOVEI    S1,MYTERM        ; Now open my terminal
  1628.     $CALL    T$OPEN            ; Open it
  1629.     JUMPF    [XMOVEI    S1,XFRTRM        ; Close the other terminal
  1630.         $CALL    T$CLOS            ; . . .
  1631.         $RETF]                ; And return
  1632.  
  1633.     SETZ    S1,            ; Break on all characters
  1634.     XMOVEI    S2,MYTERM        ;[125] Point to the block
  1635.     $CALL    T$SBRK            ; Set the PIM mode break set
  1636.  
  1637.     MOVE    S1,XXPMOD        ;[127] Get XON-XOFF-processing
  1638.     CAIN    S1,$XXDEF        ;[127] Should we set it?
  1639.      JRST    CNCT.2            ;[127] No, skip this
  1640.     MOVX    T1,.TOPAG+.TOSET    ;[127] want to set it
  1641.     MOVE    T2,MYTERM+$TTUDX    ;[127] and UDX
  1642.     CAIN    S1,$XXLCL        ;[127] Local mode?
  1643.      MOVEI    T3,1            ;[127] Yes, turn page on
  1644.     CAIN    S1,$XXREM        ;[127] Remote mode?
  1645.      MOVEI    T3,0            ;[127] Yes, turn page off
  1646.     MOVE    S1,[XWD 3,T1]        ;[127]
  1647.     TRMOP.    S1,            ;[127] do it
  1648.       JFCL                ;[127] oh well
  1649.     MOVE    T2,XFRTRM+$TTUDX    ;[127] Also do Xfr line
  1650.     MOVE    S1,[XWD 3,T1]        ;[127]
  1651.     TRMOP.    S1,            ;[127] do it
  1652.       JFCL                ;[127] oh well
  1653. CNCT.2:                    ;[127]
  1654.  
  1655.     MOVE    S1,$TTUDX+XFRTRM    ; Get the UDX we are using
  1656.     DEVNAM    S1,            ; Convert to real name
  1657.      SETZ    S1,            ; No device?
  1658.     $TEXT(CN.TYP,<[Connecting to remote host via line ^W/S1/:^A>)
  1659.     SKIPE    XFRTRM+$TTNOD        ; If no network, don't confuse him
  1660.      $TEXT(CN.TYP,< (^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>)
  1661.     $TEXT(CN.TYP,<]>)
  1662.  
  1663.  
  1664.     $TEXT(CN.TYP,<Type ^T/ESCTXT/C to return to local KERMIT, ^T/ESCTXT/? for help>)    ;
  1665.     MOVEI    P1,"S"            ; Send chrs state
  1666.  
  1667. ; Set up session log if desired
  1668.  
  1669.     SETZ    P2,            ; Assume no log file
  1670.     MOVE    T1,SESLOG+$LGFLG    ; Get flags
  1671.     TXNN    T1,LG$SET        ; Have one?
  1672.      JRST    CN.LP            ; No, just enter loop
  1673.     MOVX    S1,FOB.MZ        ; Yes, get size of FOB
  1674.     MOVEI    S2,SESLOG+$LGFOB    ; Point at FOB
  1675.     TXNE    T1,LG$APP        ; Want to append?
  1676.      $CALL    F%AOPN            ; Yes, do it
  1677.     TXON    T1,LG$APP        ; No, we will next time
  1678.      $CALL    F%OOPN            ; Create new file this time
  1679.     MOVEM    S1,SESLOG+$LGIFN    ; Save possible IFN
  1680.     TXO    T1,LG$OPN        ; Assume file opened OK
  1681.     MOVEM    T1,SESLOG+$LGFLG    ; Save new flags
  1682.     MOVE    P2,S1            ; Get IFN in convenient place
  1683.     JUMPT    CN.LP            ; And go enter loop
  1684.     $KERR    (<Cannot open session log file ^F/SESLOG+$LGFD/ - ^E/S1/>)
  1685.     SETZB    P2,SESLOG+$LGFLG    ; Give up on session log
  1686.  
  1687. ; This the main CONNECT loop. Get chrs from terminal and
  1688. ; send them down the data line and vice versa.
  1689. ; Within this loop, P1 contains the state, P2 the IFN of the session log
  1690. ;file (if any).
  1691.  
  1692. CN.LP:    XMOVEI    S2,MYTERM        ; Get the address of my terminal block
  1693.     $CALL    T$CIN            ; Input a character if possible
  1694.     JUMPF    CN.LP1            ; Failed, try to output
  1695.     MOVE    S2,S1            ;[125] Get a copy of the character
  1696.     ANDI    S2,177            ;[125] Keep only 7 bits
  1697.     CAIN    P1,"E"            ; In escape sequence?
  1698.      JRST    CN.ESC            ; Yes
  1699.     CAIN    P1,"C"            ; control chr mode?
  1700.      JRST    CN.CTL            ; yes
  1701.     CAME    S2,ESCAPE        ; Is this escape?
  1702.      JRST    CN.SND            ; no, just send it
  1703.     MOVEI    P1,"E"            ; Yes, set escape mode
  1704.     JRST    CN.LP            ; and loop
  1705.  
  1706. ; Previous chr was an escape chr, check for special commands
  1707. CN.ESC:    CAIE    S2,"C"            ; Is is C
  1708.      CAIN    S2,"c"            ; or lower case c?
  1709.       JRST    CN.END            ; Yes done
  1710.     MOVEI    P1,"S"            ; Assume not send control chr
  1711.     CAMN    S2,ESCAPE        ; Another escape?
  1712.      JRST    CN.SND            ; Yes, send a real one
  1713.     CAIN    S2,"?"            ; want help?
  1714.      JRST    CN.HLP            ; Yes, do it
  1715.     CAIE    S2,"S"            ; Want status?
  1716.      CAIN    S2,"s"            ; or lower case "s"
  1717.       JRST    CN.STS            ; Yes
  1718.     CAIE    S2,"O"            ; Clear buffers?
  1719.      CAIN    S2,"o"            ;  .  .  .
  1720.        JRST    CN.CLR            ; Yes, go clear terminal buffers
  1721.     CAIE    S2,"Q"            ; Quit logging?
  1722.      CAIN    S2,"q"            ;  .  .  .
  1723.       JRST    CN.QUT        ; Quit logging
  1724.     CAIE    S2,"R"            ; Resume logging
  1725.      CAIN    S2,"r"            ;  .  .  .
  1726.       JRST    CN.RSM            ; Yes, do it
  1727.     CAIE    S2,"^"            ; Want control chr?
  1728.       JRST    CN.ESE            ; No, bad
  1729.     MOVEI    P1,"C"            ; Yes, set state
  1730.     JRST    CN.LP            ; and loop
  1731.  
  1732. ; Here to ding the user because he typed a bad command
  1733.  
  1734. CN.ESE:    MOVX    S1,.CHBEL        ; Control-G
  1735.     $CALL    CN.TYP            ; DING
  1736.     JRST    CN.LP            ; And loop
  1737.  
  1738. ; Quit logging
  1739.  
  1740. CN.QUT:    JUMPN    P2,CN.QU1        ; Are we logging now?
  1741.     $TEXT    (CN.TYP,<[^I/@HSTITX/Logging already disabled]>)
  1742.     JRST    CN.LP            ; Try again
  1743.  
  1744. CN.QU1:    $TEXT    (CN.TYP,<[^I/@HSTITX/Logging disabled]>)
  1745.     SETZ    P2,            ; Flag no log
  1746.     JRST    CN.LP            ; And back to top of loop
  1747.  
  1748. ; Resume logging to session log
  1749.  
  1750. CN.RSM:    MOVX    S2,LG$OPN        ; File open?
  1751.     TDNE    S2,SESLOG+$LGFLG    ; Is it?
  1752.      JRST    CN.RS1            ; Yes, go get IFN
  1753.     $TEXT    (CN.TYP,<[^I/@HSTITX/No log file open]>)
  1754.     JRST    CN.LP            ; No, back to top of loop
  1755.  
  1756. CN.RS1:    $TEXT    (CN.TYP,<[^I/@HSTITX/Logging to file ^F/SESLOG+$LGFD/ resumed]>)
  1757.     MOVE    P2,SESLOG+$LGIFN    ; Yes, get the IFN
  1758.     JRST    CN.LP            ; Try next character
  1759.  
  1760. ; Control chr mode - change next chr to control chr
  1761. CN.CTL:    MOVEI    P1,"S"            ; Next state
  1762.     CAIL    S1,"@"            ; See if reasonable
  1763.      CAILE    S1,"~"            ; also allow lower case
  1764.       JRST    CN.ESE            ; No, ignore it
  1765.     CAIL    S1,"`"            ;[125] Lower case range?
  1766.      XORI    S1,240            ;[125] Yes, toggle parity bit and convert to upper
  1767.     XORI    S1,300            ;[125] Convert to control character
  1768.  
  1769.     JRST    CN.SND            ; and send it
  1770.  
  1771. ; Process <escape chr>? - give them some hints
  1772. CN.HLP:    $TEXT(CN.TYP,<^M^J^I/@HSTITX/CONNECT escape commands:>)    ;
  1773.     $TEXT(CN.TYP,<  ^T/ESCTXT/C - Close connect and return to local KERMIT>)    ;
  1774.     $TEXT(CN.TYP,<  ^T/ESCTXT/O - Clear terminal input and output buffer>)
  1775.     $TEXT(CN.TYP,<    ^T/ESCTXT/Q - Turn off session logging (if enabled)>)    ;[127]
  1776.     $TEXT(CN.TYP,<    ^T/ESCTXT/R - Resume session logging after ^T/ESCTXT/Q>)    ;[127]
  1777.     $TEXT(CN.TYP,<  ^T/ESCTXT/S - Type status>)    ;
  1778.     $TEXT(CN.TYP,<  ^T/ESCTXT/? - Help (this message)>)    ;
  1779.     $TEXT(CN.TYP,<  ^T/ESCTXT/^T/ESCTXT/ - Send actual ^T/ESCTXT/>)    ;
  1780.     MOVEI    S1,[ASCIZ |^x (where x is A-Z,[,\,],^,_) - Send CONTROL-x.  Only|]    ;
  1781.     $TEXT(CN.TYP,<  ^T/ESCTXT/^Q/S1/>)    ; Avoid confusing $TEXT
  1782.     $TEXT(CN.TYP,<                 needed to send CONTROL-S and CONTROL-Q, since other>)    ;
  1783.     $TEXT(CN.TYP,<                 control characters can be typed directly.>)    ;
  1784.     JRST    CN.LP            ; and loop
  1785.  
  1786. ; Process <escape chr>S - give status
  1787. CN.STS:    MOVE    S1,$TTUDX+XFRTRM    ; Get the UDX we are using
  1788.     DEVNAM    S1,            ; Convert to real name
  1789.      SETZ    S1,            ; No device?
  1790.     $TEXT(CN.TYP,<^M^J[^I/@HSTITX/Connecting to remote host via line ^W/S1/:^A>)
  1791.     SKIPE    XFRTRM+$TTNOD        ; If no network, don't confuse him
  1792.      $TEXT(CN.TYP,< (^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>)
  1793.     $TEXT(CN.TYP,<]>)
  1794.     JUMPE    P2,CN.LP        ; Session log open?
  1795.     $TEXT    (CN.TYP,<[^I/@HSTITX/Logging session to ^F/SESLOG+$LGFD/]>)
  1796.     JRST    CN.LP            ; and loop
  1797.  
  1798. ; Clear terminal buffers
  1799.  
  1800. CN.CLR:    MOVX    T1,.TOCIB        ; Clear input buffer
  1801.     MOVE    T2,XFRTRM+$TTUDX    ; Get UDX
  1802.     MOVE    S1,[XWD 2,T1]        ; Arg pointer
  1803.     TRMOP.    S1,            ; Clear input
  1804.      MOVE    S1,[XWD 2,T1]        ; Reload pointer
  1805.     MOVX    T1,.TOCOB        ; Clear output buffer also
  1806.     TRMOP.    S1,            ; Clear it
  1807.      JFCL                ; Ignore error
  1808.     JRST    CN.LP            ; And loop back
  1809.  
  1810. ; Send the chr in S1 down the data line
  1811. CN.SND:    BLSCAL    GEN%PARITY##,<S1>    ; Generate correct parity for other terminal
  1812.     XMOVEI    S2,XFRTRM        ; Get the terminal control block
  1813.     $CALL    T$CCOT            ; Send chr down line
  1814.     SKIPN    LCLECH            ; Check if local echo
  1815.      JRST    CN.LP            ; No, just get another character
  1816.     $CALL    CN.PAR            ; Tack on even parity bit unless PR%NONE
  1817.     XMOVEI    S2,MYTERM        ; Yes, output to our terminal also
  1818.     $CALL    T$CCOT            ;  .  .  .
  1819. CN.LOG:    JUMPE    P2,CN.LP        ; If we echo it, log it also
  1820.     MOVE    S2,S1            ; Get the character
  1821.     MOVE    S1,P2            ; And the IFN
  1822.     $CALL    F%OBYT            ; Write the character
  1823.     JUMPT    CN.LP            ; Return to loop
  1824.     $TEXT    (CN.TYP,<% Output error for log file - ^E/S1/, logging disabled>)
  1825.     SETZ    P2,            ; Disable the logging
  1826.     JRST    CN.LP            ; and loop
  1827.  
  1828. ; No more Terminal input just now, see if we did any at all
  1829. CN.LP1:    XMOVEI    S2,XFRTRM        ; Point to the remote terminal line
  1830.     $CALL    T$CIN            ; Get a chr from line
  1831.     JUMPF    CN.HIB            ; None
  1832.     $CALL    CN.TYP            ; Type it on TTY
  1833.     JRST    CN.LOG            ; Go log the character (maybe) and try again
  1834.  
  1835. ; No output either, take a break
  1836.  
  1837. CN.HIB:    MOVE    S1,[HB.RIO+HB.RTC+HB.RWJ+^D1000]    ;
  1838.     HIBER    S1,            ; Wait a bit
  1839.       JFCL                ; ignore error
  1840.     JRST    CN.LP            ; and again
  1841.  
  1842. ; Here when done to close line and reset TTY status
  1843.  
  1844. CN.END:    MOVX    S2,LG$OPN        ; Log file open?
  1845.     TDNN    S2,SESLOG+$LGFLG    ; Is it?
  1846.      JRST    CN.EN1            ; No, continue
  1847.     ANDCAM    S2,SESLOG+$LGFLG    ; Clear open flag
  1848.     MOVE    S1,SESLOG+$LGIFN    ; Get the IFN
  1849.     $CALL    F%REL            ; Close it
  1850. CN.EN1:    XMOVEI    S1,XFRTRM        ; Close all the channels
  1851.     $CALL    T$CLOS            ; Close this off
  1852.     XMOVEI    S1,MYTERM        ; Point to my terminal block
  1853.     $CALL    T$CLOS            ; Close that one too
  1854.     $CALL    OCTERM            ; Kludge the terminal back
  1855.     $TEXT(,<^M^J[Connection closed. Returning to local KERMIT]>)    ;
  1856.     $RETT                ;
  1857.  
  1858. CN.TYP:    $CALL    CN.PAR            ;[125] Tack on even parity bit if needed
  1859.     XMOVEI    S2,MYTERM        ; Point to the terminal block
  1860.     $CALL    T$CCOT            ; Output the character
  1861.     $RETT                ; and return
  1862.  
  1863. ;[125] Here to put even parity on a character.
  1864.  
  1865. CN.PAR:    MOVE    S2,PARITY%TYPE##    ;[125] Get the parity type
  1866.     CAIN    S2,PR%NONE##        ;[125] No parity?
  1867.      $RET                ;[125] Yes, leave it alone
  1868.     ANDI    S1,177            ;[125] Keep only 7 bits
  1869.     MOVEI    S2,(S1)            ;[125] Get a copy
  1870.     LSH    S2,-4            ;[125] Shift back 4 bits
  1871.     XORI    S2,(S1)            ;[125] Combine halves
  1872.     TRCE    S2,14            ;[125] Left bits both 0
  1873.      TRNN    S2,14            ;[125] Or both 1?
  1874.       XORI    S1,200            ;[125] Yes, change high bit
  1875.     TRCE    S2,3            ;[125] Right bits both zero
  1876.      TRNN    S2,3            ;[125] Or both one?
  1877.       XORI    S1,200            ;[125] Yes, change high bit
  1878.     $RET                ;[125] All done
  1879.     SUBTTL    Command execution -- DEFINE command
  1880.  
  1881. ;[107]
  1882. ;[107] This command allows definition (and deletion) of macros which
  1883. ;[107]consist of options setable by the SET command.
  1884. ;[107]
  1885. ;[107] The table is a standard TBLUK table.  The value stored in the
  1886. ;[107]right halfword will be the address of the macro block.  Each macro block
  1887. ;[107]has the following format:
  1888. ;[107]
  1889. ;[107]    XWD    block address,SETMAC    ;[111] So SET dispatch works
  1890. ;[107]    XWD    offset to macro text,length of block in words
  1891. ;[107]    ASCIZ    /macro name/
  1892. ;[107]    ASCIZ    /macro text/
  1893. ;[107]
  1894. ;[107] These blocks are allocated using M%GMEM.
  1895.  
  1896. C$DEFINE:
  1897.     $CALL    P$KEYW            ;[107] Get a keyword
  1898.     JUMPF    DEFI.1            ;[107] If not a keyword, go get new definition
  1899.  
  1900. ;[107] Here if we got a macro to delete.  We must remove the keyword from
  1901. ;[107]the table and delete the text storage.  The storage is the keyword
  1902. ;[107]value. First we must find the correct entry in the table.
  1903.  
  1904.     MOVE    P1,S1            ;[107] Copy macro block address
  1905.     HRROI    S2,$MBNAM(P1)        ;[107] Point at macro name
  1906.     MOVEI    S1,DFNTAB        ;[107] And point to table
  1907.     $CALL    S%TBLK            ;[107] Lookup in table
  1908.     TXNN    S2,TL%EXM        ;[107] Must be exact match (we put it there)
  1909.      JRST    [$KERR    (<Macro table inconsistent>)    ;[107] Give up
  1910.         $RETF]            ;[107] Since table is screwed up
  1911.     MOVE    S2,S1            ;[107] Get address of entry
  1912.     MOVEI    S1,DFNTAB        ;[107] Point at table
  1913.     $CALL    S%TBDL            ;[107] Delete the entry
  1914.      JUMPF    [$KERR    (<Macro table inconsistent>)    ;[107] Couldn't?
  1915.         $RETF]            ;[107] Then punt
  1916.     MOVE    S2,P1            ;[107] Get the macro block address
  1917.     LOAD    S1,$MBLEN(S2),MB$LEN    ;[107] Get the length
  1918.     $CALL    M%RMEM            ;[107] Return the block
  1919.     $RETT                ;[107] And return
  1920.  
  1921. ;[107] Here to define a new macro
  1922.  
  1923. DEFI.1:    $CALL    P$FLD            ;[107] Must be a field here if not keyword
  1924.     $RETIF                ;[107] Give up if not (should really be here)
  1925.     MOVE    T2,S2            ;[107] Save the length (+1)
  1926.     MOVEI    T1,PFD.D1(S1)        ;[107] Point at the data
  1927.     MOVE    S1,PRTARG+1        ;[107] Get the address of returned arguments
  1928.     MOVE    S1,PRT.CM(S1)        ;[107] Get the address of the command message
  1929.     ADD    S1,COM.CM(S1)        ;[107] And get offset to command string
  1930.     MOVEI    T3,PFD.D1(S1)        ;[107] Save the pointer
  1931.     LOAD    S1,PFD.HD(S2),PF.LEN    ;[107] Get the length of the text (+1)
  1932.     ADDI    S1,$MBNAM-2(T1)        ;[107] Get the length of the block we need
  1933.     $CALL    M%GMEM            ;[107] Get a block
  1934.     STORE    S1,$MBLEN(S2),MB$LEN    ;[107] Store the block length
  1935.     MOVEI    S1,SETMAC        ;[107] Get the address of the action routine
  1936.     HRLI    S1,(S2)            ;[107] Also save pointer to the block
  1937.     MOVEM    S1,$MBRTN(S2)        ;[107] Store it
  1938.     ADDI    T2,$MBNAM-1        ;[107] Get offset to text
  1939.     STORE    T2,$MBOFS(S2),MB$OFS    ;[107] Store the offset
  1940.     $TEXT    (<-1,,$MBNAM(S2)>,<^T/(T1)/^0^A>) ;[107] Move the name text
  1941.     ADDI    T2,(S2)            ;[107] Point at macro expansion storage
  1942.     $TEXT    (<-1,,(T2)>,<^T/(T3)/^0>) ;[107] Store the string
  1943.  
  1944. ;[107] Now insert the table entry
  1945.  
  1946.     MOVEI    S1,DFNTAB        ;[107] Point at the table header
  1947.     HRLI    S2,$MBNAM(S2)        ;[107] Get the entry value
  1948.     MOVE    T1,S2            ;[107] Save copy just in case
  1949.     $CALL    S%TBAD            ;[107] Put it in
  1950.     $RETIT                ;[107] If it went in ok, all done
  1951.     $KERR    (<Cannot define macro ^T/$MBNAM(T1)/>) ;[107] Couldn't do it?
  1952.     HRRZ    S2,T1            ;[107] Point at macro block
  1953.     LOAD    S1,$MBLEN(T1),MB$LEN    ;[107] Get the length
  1954.     $CALL    M%RMEM            ;[107] Return it
  1955.     $RETF                ;[107] And return
  1956.  
  1957.  
  1958. ;[107] Macro expansion routine
  1959. ;[107]This routine is called from the SET command processor when it is
  1960. ;[107]given a macro name.  We must now parse the text of the macro
  1961. ;[107]expansion.
  1962. ;[107] We enter with the macro block address in P1
  1963.  
  1964. SETMAC:    STKVAR    <<MPRDAT,PAR.SZ>>    ;[107] Allocate the space for the args to parser
  1965.     MOVEI    S1,SMC000        ;[107] Get address of initial macro expansion PDB
  1966.     MOVEM    S1,PAR.TB+MPRDAT    ;[107] Store it
  1967.     MOVEI    S1,[ASCIZ ||]        ;[107] No prompt
  1968.     MOVEM    S1,PAR.PM+MPRDAT    ;[107]  .  .  .
  1969.     SETZM    PAR.CM+MPRDAT        ;[107] Let OPRPAR get a page
  1970.     LOAD    S1,$MBOFS(P1),MB$OFS    ;[107] Get offset to expansion of macro
  1971.     ADDI    S1,(P1)            ;[107] Point at the text
  1972.     MOVEM    S1,PAR.SR+MPRDAT    ;[107] Store the pointer
  1973.     MOVEI    S1,PAR.SZ        ;[107] Get the size of the block
  1974.     MOVEI    S2,MPRDAT        ;[107] And the address
  1975.     $CALL    PARSER            ;[107] And parse the expansion
  1976.     JUMPF    [$KERR    (<Error parsing macro expansion - Internal table conflict>)
  1977.         $RETF]            ;[107] Should never get an error, we did this once
  1978.     MOVE    S1,PRT.CM(S2)        ;[107] Get address of data
  1979.     MOVEM    S1,PAR.CM+MPRDAT    ;[107] Save the page so we know what to return
  1980.     ADDI    S1,COM.SZ        ;[107] Point at first word
  1981.     $CALL    P$SETU            ;[107] Set up for P$xxx routines
  1982.  
  1983.     $CALL    P$KEYW            ;[107] First field is a keyword
  1984.     $CALL    P$KEYW            ;[107] And another
  1985.     $CALL    C$SET            ;[107] Can now process set options
  1986.     MOVE    S1,PAR.CM+MPRDAT    ;[107] Get the address of the data page back
  1987.     $CALL    M%RPAG            ;[107] Return it
  1988.     $RETT                ;[107] And return
  1989.     SUBTTL    Command execution -- EXIT command
  1990.  
  1991. C$EXIT:    $CALL    P$CFM            ; Make sure we have a confirm
  1992.     $RETIF                ; Return if we don't
  1993.  
  1994. ; Here on a control-Z
  1995.  
  1996. C$EXI0:    SKIPN    LOGDIN            ;[125] Are we logged in?
  1997.      JRST    [$TEXT    (,<.KJOB^M^J.^A>)    ;[125] No, make a nice message
  1998.         LOGOUT    1,            ;[125] And quit
  1999.         JRST    .+1]            ;[125] Shouldn't really get here, but...
  2000.     $HALT                ; Exit to the monitor
  2001.     $RETT                ; Allow continues
  2002.     SUBTTL    Command execution -- BYE command
  2003.  
  2004. ;+
  2005. ;.hl1 C$BYE
  2006. ;This routine will process the BYE command.  It will cause the remote
  2007. ;server to exit and then will cause the local Kermit to exit.
  2008. ;.literal
  2009. ;
  2010. ; Usage:
  2011. ;    $CALL    C$BYE
  2012. ;    (Return)
  2013. ;
  2014. ;.end literal
  2015. ;-
  2016.  
  2017. C$BYE:    $CALL    C$LOGOUT        ; Cause the remote to go away
  2018.     $RETIF                ; Return if that failed
  2019.     SETOM    XITFLG            ; Flag we must exit
  2020.     $RETT                ; Give a good return
  2021.     SUBTTL    Command execution -- FINISH command
  2022.  
  2023. ;+
  2024. ;.hl1 C$FINISH
  2025. ;This routine will cause the remote server to exit to its operating system.
  2026. ;.literal
  2027. ;
  2028. ; Usage:
  2029. ;    $CALL    C$FINISH
  2030. ;    (Return)
  2031. ;
  2032. ;.end literal
  2033. ;-
  2034.  
  2035. C$FINISH:
  2036.     $CALL    T$LOCAL            ; Is this my terminal?
  2037.     JUMPT    [$KERR(<Must use SET LINE first>)
  2038.         $RETF]            ; And return
  2039.     $CALL    OPNTRM            ; Open the terminal
  2040.     $RETIF                ; Just return if this fails
  2041.     $CALL    CLRGEN            ; Clear generic arguments
  2042.     BLSCAL    (DO%GENERIC##,<[EXP GC%EXIT##]>)
  2043.     $CALL    CLSTRM            ; Close the terminal
  2044.     $RETT                ; Give a good return
  2045.  
  2046. ; Subroutine to clear generic arguments
  2047.  
  2048. CLRGEN:    SETZM    GEN%1SIZE##        ; No first argument
  2049.     SETZM    GEN%2SIZE##        ; Nor second
  2050.     SETZM    GEN%3SIZE##        ; Or third
  2051.     MOVEI    S1,<MAX%MSG##+4>/5    ; Get length of arguments
  2052.     MOVEI    S2,GEN%1DATA##        ; First buffer address
  2053.     $CALL    .ZCHNK            ; Clear it
  2054.     MOVEI    S1,<MAX%MSG##+4>/5    ; Get length of arguments
  2055.     MOVEI    S2,GEN%2DATA##        ; First buffer address
  2056.     $CALL    .ZCHNK            ; Clear it
  2057.     MOVEI    S1,<MAX%MSG##+4>/5    ; Get length of arguments
  2058.     MOVEI    S2,GEN%3DATA##        ; First buffer address
  2059.     $CALL    .ZCHNK            ; Clear it
  2060.     $RETT                ; Return
  2061.     SUBTTL    Command execution -- LOG command
  2062.  
  2063. ;+
  2064. ;.hl1 C$LOG
  2065. ; This routine will store the file specification for various log files.
  2066. ;-
  2067.  
  2068. C$LOG:    $CALL    P$KEYW            ; Next item should be a keyword
  2069.     MOVE    P1,S1            ; Save the address of the storage
  2070.     $CALL    P$OFIL            ; Now we want an output file spec
  2071.     JUMPT    LOG.1            ; If we got one, go store it
  2072.  
  2073. ; Here for LOG keyword <CRLF>.  This means we no longer want the
  2074. ;specified log file.
  2075.  
  2076.     SETZM    $LGFLG(P1)        ; Clear flags to indicate no file
  2077.     $RETT                ; And return
  2078.  
  2079. ; Here with S1 pointing at FD returned from P$OFIL.  Copy the FD to
  2080. ;the correct storage.
  2081.  
  2082. LOG.1:    ADDI    S2,$LGFD(P1)        ; Point at end of FD
  2083.     HRLI    S1,(S1)            ; Set up pointer to move FD
  2084.     HRRI    S1,$LGFD(P1)        ;  .  .  .
  2085.     BLT    S1,-1(S2)        ; Copy it
  2086.  
  2087.     $CALL    P$SWITCH        ; Get a switch
  2088.     SKIPT                ; Get something?
  2089.      SETZ    S1,            ; No, get a zero
  2090.     TXO    S1,LG$SET        ; Flag we have the file spec
  2091.     MOVEM    S1,$LGFLG(P1)        ; Store the flags
  2092.     $RETT                ; And return
  2093.  
  2094.     SUBTTL    Command execution -- LOGOUT command
  2095.  
  2096. ;+
  2097. ;.hl1 C$LOGOUT
  2098. ;This routine will cause the remote server to LOGOUT of the remote system.
  2099. ;.literal
  2100. ;
  2101. ; Usage:
  2102. ;    $CALL    C$LOGOUT
  2103. ;    (RETURN)
  2104. ;
  2105. ;.END LITERAL
  2106. ;-
  2107.  
  2108. C$LOGOUT:
  2109.     $CALL    T$LOCAL            ; Is this my terminal?
  2110.     JUMPT    [$KERR(<Must use SET LINE first>)
  2111.         $RETF]
  2112.     $CALL    OPNTRM            ; Open the terminal
  2113.     $RETIF                ; Just return if this fails
  2114.     $CALL    CLRGEN            ; Clear the generic args
  2115.     BLSCAL    (DO%GENERIC##,<[EXP GC%LOGOUT##]>)
  2116.     $CALL    CLSTRM            ; Close the terminal
  2117.     $RETT                ; Give a good return
  2118.     SUBTTL    Command execution -- HELP command
  2119.  
  2120. ;+
  2121. ;.hl1 C$HELP
  2122. ;This routine will process the HELP command.  It will call the OPRPAR routine
  2123. ;to do the actual processing of the HELP command.
  2124. ;.literal
  2125. ;
  2126. ; Usage:
  2127. ;    $CALL    C$HELP
  2128. ;    (Return)
  2129. ;
  2130. ;.end literal
  2131. ;-
  2132.  
  2133. C$HELP:    $CALL    P$CFM            ; Confirm?
  2134.     JUMPT    HELP.0            ; Yes, Skip this then
  2135.     $CALL    P$TEXT            ; Parse the text
  2136.     ADD    S1,[POINT 7,PFD.D1]    ; Point to the data
  2137.     JRST    HELP.1            ; Continue on
  2138.  
  2139. HELP.0:    MOVE    S1,[POINT 7,[BYTE (7).CHNUL,.CHNUL]] ; Null string
  2140.  
  2141. HELP.1:    MOVEI    S2,HLPFD        ; Point to the FD to use
  2142.     EXCH    S1,S2            ; Put into the right registers
  2143.     $CALL    P$HELP##        ; Call the help processor
  2144.     $RETT                ; Give a good return
  2145.     SUBTTL    Command execution -- PROMPT command
  2146.  
  2147. ;+
  2148. ;.HL1 PROMPT
  2149. ;This routine will just cause KERMIT-10 to prompt the user again.
  2150. ;It is used when the user needs to get to the KERMIT-10> prompt when
  2151. ;KERMIT is run from the monitor KERMIT command.
  2152. ;.LITERAL
  2153. ;
  2154. ; Usage:
  2155. ;    $CALL    C$PROMPT
  2156. ;    (Return)
  2157. ;
  2158. ;.end literal
  2159. ;-
  2160.  
  2161. C$PROMPT:
  2162.     $CALL    P$CFM            ; See if there is a confirm
  2163.     $RETIF                ; Just return if false
  2164.     SETZM    CCLOFS            ; Clear the CCL offset
  2165.     SETZM    XITFLG            ; Don't exit now
  2166.     $CALL    SHOVER            ; Show the version (ala KERMIT-20)
  2167.     $RETT                ; Give a good return
  2168.     SUBTTL    Command execution -- REMOTE command
  2169.  
  2170. ;+
  2171. ;.HL1 C$REMOTE
  2172. ;This routine will parse the REMOTE command.  It will set up the
  2173. ;correct arguments and call KERMSG to handle the generic command.
  2174. ;-
  2175.  
  2176. C$REMOTE:
  2177.     $CALL    T$LOCAL            ; Is this my terminal?
  2178.     JUMPT    [$KERR(<Must use SET LINE first>)
  2179.         $RETF]            ; And return
  2180.     $CALL    CLRGEN            ; Clear the generic args
  2181.     $CALL    P$KEYW            ; Get a keyword
  2182.     $RETIF                ; Should really be there
  2183.     MOVE    P1,(S1)            ; Get the command type (arg for DO_GENERIC)
  2184.     $CALL    P$TEXT            ; Get some text
  2185.     JUMPF    REMO.2            ; If none, go do the command
  2186.  
  2187.     ADD    S1,[POINT 7,PFD.D1]    ; Point at the data
  2188.     MOVE    S2,[POINT 7,GEN%1DATA##] ; Point at where to store it
  2189.  
  2190. REMO.1:    ILDB    T1,S1            ; Get a character
  2191.     IDPB    T1,S2            ; Store it
  2192.     AOS    GEN%1SIZE##        ; Count it
  2193.     JUMPN    T1,REMO.1        ; And copy all the characters
  2194.     SOS    GEN%1SIZE##        ; Don't count the null
  2195.  
  2196. ; If more arguments are needed, get them
  2197.  
  2198.     HLRZ    S1,P1            ; Get routine address
  2199.     JUMPE    S1,REMO.2        ; Any routine to call?
  2200.     SKIPE    GEN%1SIZE        ; If no first arg, don't need rest
  2201.      $CALL    (S1)            ; Yes, do it
  2202.  
  2203. ; Here to request KERMSG to perform the command.
  2204.  
  2205. REMO.2:    $CALL    OPNTRM            ; Open the terminal
  2206.     $RETIF                ; Just return if this fails
  2207.     TXZ    P1,LHMASK        ; Clear any left half data
  2208.     BLSCAL    (DO%GENERIC##,<P1>)
  2209.     $CALL    CLSTRM            ; Close the terminal
  2210.     $RETT                ; Give a good return
  2211.  
  2212. ; Subroutines to get arguments.
  2213. ; Get login information
  2214.  
  2215. GETLGN:    MOVEI    S1,[ITEXT(<Account: >)] ; Get the prompt, echo input
  2216.     MOVE    S2,[XWD MAX%MSG##,GEN%3DATA##] ; Point at storage
  2217.     $CALL    GETANS            ; Get the result
  2218.     MOVEM    S1,GEN%3SIZE##        ; Store size
  2219. ;    PJRST    GETPSW            ; And get password
  2220.  
  2221. ; Get a password.  This is done with no echo.  The password is put in
  2222. ; GEN%2DATA.
  2223. ; Get message for short send
  2224.  
  2225. GETPSW:    SKIPA    S1,[XWD -1,[ITEXT(<Password: >)]] ; Point at the prompt, no echo
  2226. GETMSG:     MOVEI    S1,[ITEXT(<Message: >)]    ; Get the prompt
  2227. GET2GN:    MOVE    S2,[XWD MAX%MSG##,GEN%2DATA##] ; Point at buffer
  2228.     $CALL    GETANS            ; Get the result
  2229.     MOVEM    S1,GEN%2SIZE##        ; Store size we got
  2230.     $RETT                ; And return
  2231.  
  2232. ; Get a new file specification
  2233. ; Get options for "finger"
  2234.  
  2235. GETNFL:    SKIPA    S1,[XWD 0,[ITEXT(<New file name: >)]] ; Get the prompt
  2236. GETOPT:     MOVEI    S1,[ITEXT(<Options: >)]    ; Get the prompt for options
  2237.     JRST    GET2GN            ; Go get the second argument
  2238.     SUBTTL    Command execution -- LOCAL command
  2239.  
  2240. ;+
  2241. ;.HL1 C$LOCAL
  2242. ;This routine will parse the LOCAL command.  It will set up the
  2243. ;correct arguments and call SY%GENERIC to generate the text.
  2244. ;The resulting text will then be typed on the terminal.
  2245. ;-
  2246.  
  2247. C$LOCAL:
  2248.     $CALL    CLRGEN            ; Clear the generic args
  2249.     $CALL    P$KEYW            ; Get a keyword
  2250.     $RETIF                ; Should really be there
  2251.     MOVE    P1,(S1)            ; Get the command type (arg for DO_GENERIC)
  2252.     $CALL    P$TEXT            ; Get some text
  2253.     JUMPF    LOCA.2            ; If none, go do the command
  2254.  
  2255.     ADD    S1,[POINT 7,PFD.D1]    ; Point at the data
  2256.     MOVE    S2,[POINT 7,GEN%1DATA##] ; Point at where to store it
  2257.  
  2258. LOCA.1:    ILDB    T1,S1            ; Get a character
  2259.     IDPB    T1,S2            ; Store it
  2260.     AOS    GEN%1SIZE##        ; Count it
  2261.     JUMPN    T1,LOCA.1        ; And copy all the characters
  2262.     SOS    GEN%1SIZE##        ; Don't count the null
  2263.  
  2264. LOCA.2:    SETZM    LCLSIZ            ; Make sure these are clear now
  2265.     SETZM    LCLRTN            ;  .  .  .
  2266.  
  2267.     BLSCAL    SY%GENERIC##,<P1,[EXP LCLSTR],[EXP LCLSIZ],[EXP LCLRTN]> ; Generate result
  2268.     CAXN    S1,RMS32        ; File processing error?
  2269.      $RETF                ; Yes, just give up, error already typed
  2270.     TXNN    S1,BLSTRU        ; Good result?
  2271.      JRST    [$KERR(Unimplemented local command)
  2272.         $RETF]            ; Punt
  2273.     SKIPN    LCLSIZ            ; Have a string result?
  2274.      JRST    LOCA.3            ; No, check for routine
  2275.     $TEXT    (,<^T/@LCLSTR/>)    ; Yes, type it
  2276.     $RETT                ; And return
  2277.  
  2278. ; Here if we did not get a string result.  Check if we have a routine
  2279. ;to call for each character.
  2280.  
  2281. LOCA.3:    SKIPE    LCLRTN            ; Have one?
  2282.      JRST    LOCA.4            ; Yes, go handle it
  2283.  
  2284. ; Here if we have a file to type.  The file spec is in FILE%NAME, all
  2285. ;set up for FILE%OPEN to open it up.  Just open it and then type
  2286. ;the file.
  2287.  
  2288.     $SAVE    <TY%FIL##>        ; Save type files flag
  2289.     SETZB    S1,TY%FIL##        ; Want to read the file
  2290.     BLSCAL    FILE%OPEN,<S1>
  2291.     TXNN    S1,BLSTRU        ; Error?
  2292.      $RETF                ; Yes, should have been typed already
  2293.  
  2294.     MOVEI    S1,GET%FILE        ; Now use get file to fetch chars
  2295.     TXO    S1,1B0            ; Remember file is open
  2296.     MOVEM    S1,LCLRTN        ; Save the address
  2297.  
  2298. ; Here to fetch characters and type them
  2299.  
  2300. LOCA.4:    BLSCAL    @LCLRTN,<[EXP LCLCHR]>    ; Get a character
  2301.     TXNE    S1,BLSTRU        ; Error?
  2302.      CAIN    S1,EOF            ; End of file?
  2303.       JRST    LOCA.5            ; Yes, assume EOF
  2304.     OUTCHR    LCLCHR            ; Type it
  2305.     JRST    LOCA.4            ; Keep looping until eof
  2306.  
  2307. ; Here when all has been typed, close file (if necessary), and return
  2308.  
  2309. LOCA.5:    SKIPL    LCLRTN            ; Need to close a file?
  2310.      $RETT                ; No, all done
  2311.     BLSCAL    FILE%CLOSE,<[EXP 0]>    ; Close the file
  2312.     $RETT                ; And return
  2313.     SUBTTL    Command execution -- SEND command
  2314.  
  2315. ;+
  2316. ;.HL1 C$SEND
  2317. ;This routine will parse the SEND command for KERMIT-10.  It will call
  2318. ;the lower level routines with the ASCIZ of the file specification.
  2319. ;-
  2320.  
  2321. C$SEND:
  2322.     $CALL    P$QSTR            ; Parse the argument
  2323.      SKIPT                ; Ok?
  2324.       $CALL    P$FLD            ; Parse a field
  2325.     $RETIF                ; Return if that failed
  2326.  
  2327.     ADD    S1,[POINT 7,PFD.D1]    ; Point to the data
  2328.     MOVE    T1,[POINT 7,FILE%NAME##] ; Point to the information
  2329.     IMULX    S2,5            ; Determine the number of characters
  2330.     SUBX    S2,PFD.D1*5        ; Remove the size of the header
  2331.     SETZM    FILE%SIZE##        ; Clear the character count
  2332.  
  2333. SEND.0:    SOJL    S2,SEND.1        ; Finished?
  2334.     ILDB    T2,S1            ; Get a byte
  2335.     IDPB    T2,T1            ; Store it
  2336.     JUMPE    T2,SEND.2        ; Null byte finally
  2337.     AOS    FILE%SIZE##        ; Increment the count of the characters
  2338.     JRST    SEND.0            ; Loop for all characters
  2339.  
  2340. SEND.1:    SETZ    T2,            ; Clear this
  2341.     IDPB    T2,T1            ; End of file specification
  2342.  
  2343. ; Now that the file specification is copied to the KERMSG area we can now
  2344. ; attempt to transfer the file
  2345.  
  2346. SEND.2:    $CALL    OPNTRM            ; Open the terminal
  2347.     $RETIF                ; Return if that failed
  2348.  
  2349.     $CALL    SEND%SWITCH##        ; Send the file specification
  2350.  
  2351.     $CALL    CLSTRM            ; Close the terminal
  2352.     $RETT                ; Return to the caller
  2353.     SUBTTL    Command execution -- GET command
  2354.  
  2355. ;+
  2356. ;.hl1 C$GET
  2357. ;this routine will get a file(s) from the remote Kermit.  It will
  2358. ;use the RECEIVE routine for most of the work.
  2359. ;.literal
  2360. ;
  2361. ; Usage:
  2362. ;    $CALL    C$GET
  2363. ;    (Return)
  2364. ;
  2365. ;.end literal
  2366. ;-
  2367.  
  2368. C$GET:
  2369.     SETZM    USRFIL            ; No user supplied name
  2370.     $CALL    T$LOCAL            ; Is this my terminal?
  2371.     JUMPT    [$KERR(<Must use SET LINE first>)
  2372.         $RETF]
  2373.     $CALL    P$QSTR            ; Parse the argument
  2374.      SKIPT                ; Ok?
  2375.       $CALL    P$FLD            ; Parse a field
  2376.     $RETIF                ; Return if that failed
  2377.  
  2378.     ADD    S1,[POINT 7,PFD.D1]    ; Point to the data
  2379.     MOVE    T1,[POINT 7,FILE%NAME##] ; Point to the information
  2380.     IMULX    S2,5            ; Determine the number of characters
  2381.     SUBX    S2,PFD.D1*5        ; Remove the size of the header
  2382.     SETZM    FILE%SIZE##        ; Clear the character count
  2383.  
  2384. GET.0:    SOJL    S2,GET.1        ; Finished?
  2385.     ILDB    T2,S1            ; Get a byte
  2386.     IDPB    T2,T1            ; Store it
  2387.     JUMPE    T2,GET.2        ; Null byte finally
  2388.     AOS    FILE%SIZE##        ; Increment the count of the characters
  2389.     JRST    GET.0            ; Loop for all characters
  2390.  
  2391. GET.1:    SETZ    T2,            ; Clear this
  2392.     IDPB    T2,T1            ; End of file specification
  2393.  
  2394. GET.2:    JRST    RECE.1            ; Get the files
  2395.     SUBTTL    Command execution -- RECEIVE command
  2396.  
  2397. ;+
  2398. ;.HL1 C$RECEIVE
  2399. ;This routine will copy the unquoted string that is the file specification
  2400. ;to the FILE%NAME data area in KERMSG and the length of the string into
  2401. ;FILE%SIZE.
  2402. ; After that is done the terminal will be opened and the SEND%SWITCH
  2403. ;BLISS routine called.
  2404. ;-
  2405.  
  2406. C$RECEIVE:
  2407.     SETZM    FILE%SIZE##        ; Flag we will accept whatever we get
  2408.     SETZM    USRFIL            ; Flag user didn't supply specification
  2409.     $CALL    P$OFIL            ; Have an output file specification?
  2410.     JUMPF    RECE.0            ; No, skip this
  2411.     SETOM    USRFIL            ; User supplied output specification
  2412.     HRL    S1,S1            ; Get set to move it
  2413.     HRRI    S1,USRFX        ; Point to the user block
  2414.     ADDI    S2,USRFX        ; Point to the end
  2415.     BLT    S1,-1(S2)        ; Move all of the file specification
  2416.     SETOM    USRFX+.FDNMM        ; Flag not wild
  2417. ;[126];@C$RECEIVE + 9
  2418.     HRROS    USRFX+.FDEXM        ;[126] . . .
  2419.     SETOM    USRFX+.FDDIM        ; . . .
  2420.     MOVE    S1,[XWD USRFX+.FDDIM,USRFX+.FDSFM] ; Fill all of the path
  2421.     BLT    S1,USRFX+.FDSFM+4    ; All SFDs
  2422.     $CALL    P$CFM            ; Parse the confirm
  2423.     $RETIF                ; Return if that fails
  2424.     JRST    RECE.1            ; Continue processing
  2425.  
  2426. RECE.0:    $CALL    P$CFM            ; Parse the confirm
  2427.     $RETIF                ; Return if that fails
  2428.     SETZM    FILE%SIZE##        ; No file specification
  2429.  
  2430. RECE.1:    $CALL    OPNTRM            ; Open the terminal
  2431.     $RETIF                ; Return if that fails
  2432.     $CALL    REC%SWITCH##        ; Call the BLISS routine
  2433.     $CALL    CLSTRM            ; Close the terminal
  2434.     $RETT                ; Return to the caller
  2435.  
  2436. FILSTO:    IDPB    S1,FILPTR        ; Store the byte
  2437.     AOS    FILE%SIZE##        ; Increment the number of characters
  2438.     $RETT                ; Return to the caller
  2439.     SUBTTL    Command execution -- SERVER command
  2440.  
  2441. ;+
  2442. ;.hl1 SERVER
  2443. ;This command will cause KERMIT to go into SERVER mode as desribed in
  2444. ;the protocol manual version 2 or later.
  2445. ;-
  2446.  
  2447. SRVTXT:    ASCIZ    |
  2448. [Kermit Server running  on  the  DEC  Host.   Please  type  your  escape
  2449. sequence   to  return  to  your  local  machine.  Shut down the server by
  2450. typing the Kermit BYE command on your local machine.]
  2451. |                    ;[127]
  2452.  
  2453. C$SERVER:
  2454.     $CALL    P$CFM            ; Have a confirm?
  2455.     $RETIF                ; Just return if not
  2456.     $TEXT    (,<^T/SRVTXT/>)        ; Output the text
  2457.  
  2458.     $CALL    OPNTRM            ; Open the user terminal
  2459.     $RETIF                ; Return if it failed
  2460.  
  2461.     $CALL    SERVER##        ; Call the server processor
  2462.     MOVE    P1,S1            ; Copy the value returned
  2463.     $CALL    CLSTRM            ; Close the terminal
  2464.  
  2465.     CAXE    P1,ABORTED        ; Was the transfer aborted (Ctl-C)?
  2466.      SETOM    XITFLG            ; No, flag we must exit
  2467.     $RETT                ; Give a good return
  2468.     SUBTTL    Command execution -- SET command -- Top level
  2469.  
  2470. ;+
  2471. ;.hl1 C$SET
  2472. ;This routine will handle the SET command.  It will determine which of
  2473. ;the keywords was typed and then dispatch to the correct routine to process
  2474. ;the command.
  2475. ;-
  2476.  
  2477. C$SET:    $CALL    P$KEYW            ; Parse a keyword
  2478.     $RETIF                ; Return if that fails
  2479.     MOVE    S1,(S1)            ; Get the information supplied
  2480.     HLRZ    P1,S1            ; Get the extra data
  2481.     CAIN    S1,SETMAC        ;[107] Macro setting is special
  2482.      PJRST    (S1)            ;[107] We just go there
  2483.     $CALL    (S1)            ; Call the correct routine
  2484.     $CALL    P$COMMA            ;[107] Check for a comma
  2485.     JUMPT    C$SET            ;[107] If we get one, we have another keyword
  2486.     $RETT                ;[107] Return to the top level
  2487.  
  2488.  
  2489.     SUBTTL    Command execution -- SET command -- SETKYW - Parse a keyword and store the value
  2490.  
  2491. ;+
  2492. ;.HL2 SETKYW
  2493. ;This routine is used for the various SET commands that take only a keyword.
  2494. ;It will then store the information into the address pointed to by P1.
  2495. ;-
  2496.  
  2497. SETKYW:    $CALL    P$KEYW            ; Get the keyword supplied
  2498.     $RETIF                ; Return if there is no keyword
  2499.     MOVEM    S1,(P1)            ; Store the information
  2500.     $RETT                ; Give a good return
  2501.  
  2502.  
  2503.     SUBTTL    Command execution -- SET command -- SETNUM - Parse a number
  2504.  
  2505. ;+
  2506. ;.HL2 SETNUM
  2507. ;This routine is used for the various SET commands that take only a
  2508. ;numeric value.
  2509. ;It will then store the information into the address pointed to by P1.
  2510. ;-
  2511.  
  2512. SETNUM:    $CALL    P$NUM            ; Get the number supplied
  2513.     $RETIF                ; Return if there is no number
  2514.     MOVEM    S1,(P1)            ; Store the information
  2515.     $RETT                ; Give a good return
  2516.     SUBTTL    Command execution -- SET command -- DEBUGGING parameter
  2517.  
  2518. ;+
  2519. ;.HL2 SETDBG
  2520. ; This routine will handle the SET DEBUG command.  This command allows
  2521. ;debugging typeout to be turned on or off, and also allows a log file
  2522. ;of debugging info to be created.
  2523. ; It will determine which format of the command was given, and either
  2524. ;store the ON/OFF value or open/close the log file.
  2525. ;-
  2526.  
  2527. SETDBG:    $CALL    P$KEYW            ; Get the keyword
  2528.     HLRZ    S2,(S1)            ; Get the routine to call
  2529.     HRRZ    S1,(S1)            ; And a possible value
  2530.     JRST    (S2)            ; Go handle type of keyword
  2531.  
  2532. ; Here for SET DEBUGGING ON/OFF
  2533.  
  2534. SETDBF:    MOVEM    S1,DEBUG%FLAG##        ; Store the flag value
  2535.     $RETT                ; And return
  2536.  
  2537. ; Here for SET DEBUGGING LOG-FILE filename
  2538.  
  2539. SETODF:    $CALL    P$OFIL            ; Get an output file FD
  2540.     HRLI    S1,(S1)            ; Set up pointer to copy file
  2541.     HRRI    S1,DBGLOG+$LGFD        ; Point at destination
  2542.     ADDI    S2,DBGLOG+$LGFD        ; And final word
  2543.     BLT    S1,-1(S2)        ; Copy block
  2544.     MOVX    S1,LG$SET!LG$APP    ; Get the flags
  2545.     MOVEM    S1,DBGLOG+$LGFLG    ; Save them
  2546.     MOVX    S1,BLSTRU        ; Get a true
  2547.     MOVEM    S1,DEBUG%FLAG##        ; Save it so debugging runs
  2548.     $RETT                ; And return
  2549.  
  2550. ; Here for SET DEBUGGING NO-LOG-FILE.
  2551.  
  2552. SETCDF:    MOVX    S1,BLSFAL        ; Flag it as false
  2553.     MOVEM    S1,DEBUG%FLAG##        ; Store it
  2554.     SETZM    DBGLOG+$LGFLG        ; No log file anymore
  2555.     $RETT                ; And return
  2556. ;+
  2557. ;.HL2 SETESC
  2558. ;This routine will set the escape character.  It will check to determine if the
  2559. ;escape character is valid.
  2560. ;-
  2561.  
  2562. SETESC:    $CALL    P$NUM            ; get the number
  2563.     JUMPF    SETES0            ; Failed, issue an error
  2564.     JUMPLE    S1,SETES0        ; Issue an error
  2565.     CAIL    S1," "            ; Must be a control character
  2566.      JRST    SETES0            ; Failed
  2567.     MOVEM    S1,ESCAPE        ; Store the character
  2568.     ADDI    S1,"A"-.CHCNA        ; Convert to printing equivalent
  2569.     $TEXT    (<-1,,ESCTXT>,<^^^7/S1/^0>) ; Store the text
  2570.     $RETT
  2571.  
  2572. SETES0:    $KERR    (Illegal escape character ^O/S1/)
  2573.     $RETF                ; Failure return
  2574.  
  2575.  
  2576.     SUBTTL    Command execution -- SET command -- FILE parameters
  2577.  
  2578. ;+
  2579. ; This will handle the dispatch of the SET FILE command.
  2580. ;-
  2581.  
  2582. SETFIL:    $CALL    P$KEYW            ; Parse a keyword
  2583.     $RETIF                ; Return if that fails
  2584.     MOVE    S1,(S1)            ; Get the information supplied
  2585.     HLRZ    P1,S1            ; Get the extra data
  2586.     $CALL    (S1)            ; Call the correct routine
  2587.     $RET                ; And return
  2588.  
  2589.  
  2590.     SUBTTL    Command execution -- SET command -- HANDSHAKE
  2591.  
  2592. ;+
  2593. ;[131] This routine will set up the IBM handshaking character
  2594. ;-
  2595.  
  2596. SETHSK:    $CALL    P$NUM            ;[131] Get the number
  2597.     CAIN    S1,""            ;[131] Is it a NULL
  2598.      JRST    SETHS0            ;[131] Yes, set default value
  2599.     CAIG    S1,""            ;[131] Is it a negative number
  2600.      JRST    SETHS1            ;[131] Yes, give error
  2601.     MOVEM    S1,IBM%CHAR##        ;[131] Move in Handshake character
  2602.     $RETT                ;[131] True return
  2603.  
  2604. SETHS0:    SETOM    IBM%CHAR##        ;[131] Move in default character
  2605.     $RETT                ;[131] True return
  2606.  
  2607. SETHS1:    $KERR    (Illegal handshake character ^O/S1/)    ;[131]
  2608.     $RETF                ;[131] Failure return
  2609.     SUBTTL    Command execution -- SET command -- LINE to use
  2610.  
  2611.  
  2612. ;+
  2613. ;.HL2 SETLIN
  2614. ;This routine will store the line number to use to talk to the remote
  2615. ;Kermit.
  2616. ;-
  2617.  
  2618. SETLIN:    $CALL    P$CFM            ; Do we have a confirm?
  2619.     JUMPF    LINSBR            ; No, do the set stuff
  2620.  
  2621.     MOVE    S1,$TTNOD+MYTERM    ; Use my terminal
  2622.     MOVEM    S1,$TTNOD+XFRTRM    ; Store it
  2623.     MOVE    S1,$TTLIN+MYTERM    ; . . .
  2624.     MOVEM    S1,$TTLIN+XFRTRM    ; Store it
  2625.     RELEAS    TTYHLD,            ; Give up on terminal we grabbed
  2626.     $RETT                ; Return to the caller
  2627.  
  2628.  
  2629. ; Here to set the line to use for transfering information
  2630.  
  2631. LINSBR:    $CALL    P$NUM            ; Get the line number
  2632.     JUMPF    SETLI0            ; Failed, see if other type
  2633.     $TEXT    (<-1,,.TEMP>,<TTY^O/S1/^0>) ; Build the device name
  2634.     HRROI    S1,.TEMP        ; Point to the text
  2635.     JRST    SETLI2            ; Convert to node and line number
  2636.  
  2637. SETLI0:    $CALL    P$NODE            ; Parse a node name/number
  2638.     JUMPF    SETLI1            ; Failed, try for device
  2639.     TLNN    S1,-1            ; Is this a name?
  2640.       JRST    SETLI4            ; No, store the number
  2641.  
  2642.     MOVE    S2,S1            ; Move the information
  2643.     MOVEI    S1,2            ; Get the length of this
  2644.     MOVX    T1,<XWD .NDRNN,S1>    ; Point to the arguments
  2645.     NODE.    T1,            ; Do it
  2646.      JRST    [$KERR    (<Illegal node name>)
  2647.         $RETF]
  2648.     MOVE    S1,T1            ; Get the number now
  2649. SETLI4:    MOVEM    S1,XFRTRM+$TTNOD    ; Store the node information
  2650.     $CALL    P$NUM            ; Parse the line number
  2651.     MOVEM    S1,XFRTRM+$TTLIN    ; Store as the line number
  2652.  
  2653. ; Now make sure we can get the terminal
  2654.  
  2655. SETLI6:    MOVEI    S1,XFRTRM        ; Get the terminal descriptor address
  2656.     $CALL    T$CONN            ; Make sure the terminal is
  2657.     MOVE    T2,S1            ; Get the name
  2658.     IONDX.    S1,            ; Available
  2659.      JRST    [$KERR    (<Terminal not available>)
  2660.         $RETF]            ; Punt
  2661.     MOVEM    S1,XFRTRM+$TTUDX    ; Store the UDX
  2662.     MOVE    S1,T2            ; Reget device name
  2663.     DEVTYP    S1,            ; Get the device type bits
  2664.      JRST    [$KERR    (<Illegal terminal name>)
  2665.         $RETF]            ; Give up
  2666.     TXNN    S1,TY.AVL        ; Device available?
  2667.      JRST    [$KERR    (<Terminal in use by job ^D/S1,TY.JOB/>)
  2668.         $RETF]            ; We can't get the terminal
  2669.     $CALL    T$LOCAL            ; Check if using own terminal
  2670.     JUMPT    [RELEAS    TTYHLD,        ; Yes, let go of other terminal
  2671.         $RETT]            ; And return
  2672.     MOVX    T1,.IOASC        ; Get the mode
  2673.     SETZ    T3,            ; No buffers
  2674.     OPEN    TTYHLD,T1        ; Get the terminal so no one steals it
  2675.      JRST    [$KERR    (<Cannot open terminal>)
  2676.         $RETF]            ; Give up
  2677.     $RETT                ; And return to the caller
  2678.  
  2679. SETLI1:    $CALL    P$DEV            ; Parse the terminal name
  2680.     $RETIF                ; Return if that failed
  2681.     ADD    S1,[POINT 7,PFD.D1]    ; Point to the data area
  2682. SETLI2:    $CALL    S%SIXB            ; Convert to a device name
  2683.     $RETIF                ; Return if this fails
  2684.     MOVE    S1,S2            ; Save a copy
  2685.     GTNTN.    S2,            ; Convert to node and line number
  2686.      JRST    SETLI3            ; Failed, issue error message
  2687.     HLRZM    S2,XFRTRM+$TTNOD    ; Store the node number
  2688.     HRRZM    S2,XFRTRM+$TTLIN    ; And the line number
  2689.     JRST    SETLI6            ; Go grab the terminal
  2690.  
  2691. SETLI3:    CAMN    S2,S1            ; Non-network system?
  2692.      JRST    SETLI5            ; Yes, go store correct things
  2693.     $KERR    (<^T/@GTNERR(S2)/>)    ; Issue the error
  2694.     $RETF                ; Return to the caller
  2695.  
  2696. ; Here if system does not have network support
  2697.  
  2698. SETLI5:    SETZM    XFRTRM+$TTNOD        ; No node
  2699.     IONDX.    S2,            ; Convert to UDX (for line number)
  2700.      JRST    [$KERR    (<Nonexistent device>)    ; Must not be valid
  2701.         $RETF]            ; Can't set the line here
  2702.     CAXL    S2,.UXTRM        ; Check if valid terminal
  2703.      CAXLE    S2,.UXTRM+^O777        ;  .  .  .
  2704.       JRST    [$KERR    (<Device is not a terminal>) ; Nope, give up
  2705.         $RETF]            ; Give up
  2706.     MOVEM    S2,XFRTRM+$TTUDX    ; Store UDX
  2707.     SUBX    S2,.UXTRM        ; Convert to line number
  2708.     MOVEM    S2,XFRTRM+$TTLIN    ; And line number
  2709.     JRST    SETLI6            ; Go grab the terminal
  2710.  
  2711. ; Error text
  2712.  
  2713. GTNERR:    [ASCIZ    /Nonexistent device/]
  2714.     [ASCIZ    /Device is not a terminal/]
  2715.     [ASCIZ    /Terminal is not connected/]
  2716.     SUBTTL    Command execution -- SET command -- MESSAGE parameters
  2717.  
  2718. ;+
  2719. ;.hl2 SETMSG
  2720. ;This routine will set the level of message type out the user wishes to see.
  2721. ;This current parameters include the typing of file specifications on
  2722. ;receive or send and the packet numbers.
  2723. ;-
  2724.  
  2725. SETMSG:    $CALL    P$KEYW            ; Parse a keyword
  2726.     $RETIF                ; Return if that failed
  2727.  
  2728.     MOVE    P1,S1            ; Get the information parsed
  2729.     $CALL    P$KEYW            ; Get the next keyword (could have
  2730.                     ;  gotten NO as the first)
  2731.     JUMPF    [MOVX    S1,TRUE        ; If no second keyword, get a true
  2732.         MOVEM    S1,(P1)        ; And set the argument
  2733.         $RETT]            ; All done
  2734.     MOVEM    P1,(S1)            ; Otherwise, store the false
  2735.     $RETT                ; Return to the caller
  2736.     SUBTTL    Command execution -- SET command -- PROMPT
  2737.  
  2738. ;+
  2739. ;.HL2 SETPRM
  2740. ;This routine will set the user prompt.  This is used to allow the user
  2741. ;to set how he/she wants Kermit to prompt for commands.  This allows you
  2742. ;to be connected through various Kermits and always keep which wants input
  2743. ;straight.
  2744. ;-
  2745.  
  2746. SETPRM:    $CALL    P$FLD            ; Parse an unquoted string
  2747.     JUMPF    DEFPRM            ; Failed, so reset the prompt
  2748. ;
  2749. ; Here to copy the new prompt to the low segment
  2750. ;
  2751.     CAXLE    S2,D$PSIZ        ; Smaller than max?
  2752.      $RETF                ; Don't set it if it is
  2753.     ADD    S1,[POINT 7,PFD.D1]    ; Point to the data
  2754.  
  2755. SPRM.0:    MOVE    T1,[POINT 7,PROMPT]    ; Point to the prompt area
  2756. SPRM.1:    ILDB    S2,S1            ; Get a character
  2757.     IDPB    S2,T1            ; Store it
  2758.     JUMPN    S2,SPRM.1        ; Loop for all characters
  2759.     $RET                ; Return to the caller
  2760.  
  2761. DEFPRM:    MOVE    S1,[POINT 7,[ASCIZ /Kermit-10>/]] ; Get the prompt
  2762.     JRST    SPRM.0            ; Join common code
  2763.     SUBTTL    Command execution -- SET command -- RECEIVE parameters
  2764.  
  2765.  
  2766. ;+
  2767. ;.hl2 SETRCV
  2768. ;This routine is used to set the various RECEIVE parameters.  It will
  2769. ;dispatch to lower level routines to do the real work.
  2770. ;-
  2771.  
  2772. SETRCV:    $CALL    P$KEYW            ; Get the keywd the user supplied
  2773.     $RETIF                ; Return if false
  2774.     $CALL    (S1)            ; Call the user routine
  2775.     $RET                ; Return to the user
  2776.  
  2777. ;+
  2778. ;.HL2 SETR8Q
  2779. ;This routine will set the 8bit quoting character.
  2780. ;-
  2781.  
  2782. SETR8Q:    $CALL    P$NUM            ; Get the number
  2783.     MOVEM    S1,RCV%8QUOTE%CHAR##    ; Store the value
  2784.     $RETT                ; Give a good return
  2785.  
  2786. ;+
  2787. ;.hl2 SETREL
  2788. ;Routine to set the end of line character for the receiver side.
  2789. ;-
  2790.  
  2791. SETREL:    $CALL    P$NUM            ; Get the number
  2792.     $RETIF                ; Return
  2793.     MOVEM    S1,RCV%EOL##        ; Store the parameter
  2794.     $RETT                ; Give a good return
  2795. ;+
  2796. ;.HL2 SETRPC
  2797. ;This routine will set the padding character for the receive side.
  2798. ;-
  2799.  
  2800. SETRPC:    $CALL    P$NUM            ; Parse a number
  2801.     $RETIF                ; Return if false
  2802.     CAIN    S1,.CHDEL        ; Is this a delete?
  2803.       JRST    STRPC0            ; Yes, ok
  2804.     SKIPL    S1            ; Less than zero?
  2805.      CAILE    S1,^O37            ; Or greater than 37?
  2806.       JRST    STRPC1            ; Yes, illegal
  2807. STRPC0:    MOVEM    S1,RCV%PADCHAR##    ; Store the padding character
  2808.     $RETT                ; Give a good return
  2809.  
  2810. STRPC1:    $KERR    (Illegal padding cahracter)
  2811.     $RETF                ; Give a failure return
  2812.  
  2813. ;+
  2814. ;.HL2 SETRPD
  2815. ;This routine will store the number of padding characters that should be
  2816. ;sent to the remote Kermit.
  2817. ;-
  2818.  
  2819. SETRPD:    $CALL    P$NUM            ; Get the number we parsed
  2820.     $RETIF                ; Return if that failed
  2821.     JUMPL    S1,[$KERR(Must be a postive number)
  2822.         $RETF    ]        ; Issue the error and return
  2823.     MOVEM    S1,RCV%NPAD##        ; Store the number of characters
  2824.     $RETT                ; Give a good return
  2825.  
  2826. ;+
  2827. ;.hl2 SETRPL
  2828. ;This routine will set the length of the packets to receive.
  2829. ;-
  2830.  
  2831. SETRPL:    $CALL    P$NUM            ; Get the number parsed
  2832.     $RETIF                ; Return if that failed
  2833.     CAIL    S1,^D10            ; Min length
  2834.      CAILE    S1,^D1000 ; [134] 94    ; Max length
  2835.       JRST    [$KERR(Illegal packet size)
  2836.         $RETF]            ; Issue error and return
  2837.     MOVEM    S1,RCV%PKT%SIZE##    ; Store the packet length
  2838.     $RETT                ; Return to the caller
  2839.  
  2840. ;+
  2841. ;.hl2 SETRQU
  2842. ;This routine will set the receive quoting character.
  2843. ;-
  2844.  
  2845. SETRQU:    $CALL    P$NUM            ; Get the value
  2846.     MOVEM    S1,RCV%QUOTE##        ; Store the quote character
  2847.     $RETT
  2848.  
  2849. ;+
  2850. ;.HL2 SETRSH
  2851. ; This routine will store the parsed start of header character.
  2852. ;-
  2853.  
  2854. SETRSH:    $CALL    P$NUM            ; Get a number
  2855.     $RETIF                ; Punt if we can't
  2856.     MOVEM    S1,RCV%SOH##        ; Store it
  2857.     $RETT                ; And give a good return
  2858.  
  2859. ;+
  2860. ;.HL2 SETRTI
  2861. ;This routine will store the parsed time out time.
  2862. ;-
  2863.  
  2864. SETRTI:    $CALL    P$NUM            ; Get the number
  2865.     $RETIF                ; Return if that fails
  2866.     MOVEM    S1,RCV%TIMEOUT##    ; Store it
  2867.     $RETT                ; Give a good return
  2868. ;+
  2869. ;.HL2 SETRTY
  2870. ;This routine will set the retry count for either the initial connection or
  2871. ;the number of packets.
  2872. ;-
  2873.  
  2874. SETRTY:    $CALL    P$KEYW            ; Parse a keyword
  2875.     $RETIF                ; Return if that fails
  2876.     MOVE    P1,S1            ; Copy the store address
  2877.     $CALL    P$NUM        ; Get the number of retries allowed
  2878.     $RETIF                ; Return if that fails
  2879.     MOVEM    S1,(P1)            ; Store the number of retries
  2880.     $RETT                ; Give a good return to the caller
  2881. ;+
  2882. ;.HL2 SETSND
  2883. ;This routine will set the various SEND parameters.  It will dispatch
  2884. ;to lower level routines to do the real work.
  2885. ;-
  2886.  
  2887. SETSND:    $CALL    P$KEYW            ; Parse a keyword
  2888.     $RETIF                ; Return if it isn't
  2889.     $CALL    (S1)            ; Call the routine
  2890.     $RET                ; Return to the caller
  2891. ;+
  2892. ;.HL2 SETSEL
  2893. ;This routine will set the send side end of line character.
  2894. ;-
  2895.  
  2896. SETSEL:    $CALL    P$NUM            ; Get the number
  2897.     $RETIF                ; Return
  2898.     MOVEM    S1,SND%EOL##        ; Store the parameter
  2899.     $RETT                ; Give a good return
  2900.  
  2901. ;+
  2902. ;.HL2 SETSPC
  2903. ;This routine will store the send padding character.
  2904. ;-
  2905.  
  2906. SETSPC:    $CALL    P$NUM            ; Parse a number
  2907.     $RETIF                ; Return if false
  2908.     CAIN    S1,.CHDEL        ; Is this a delete?
  2909.       JRST    STSPC0            ; Yes, ok
  2910.     SKIPL    S1            ; Less than zero?
  2911.      CAILE    S1,^O37            ; Or greater than 37?
  2912.       JRST    STRPC1            ; Yes, illegal
  2913. STSPC0:    MOVEM    S1,SND%PADCHAR##    ; Store the padding character
  2914.     $RETT                ; Give a good return
  2915.  
  2916. ;+
  2917. ;.hl2 SETSPD
  2918. ;This routine will store the number of send padding characters to expect.
  2919. ;-
  2920.  
  2921. SETSPD:    $CALL    P$NUM            ; Get the number we parsed
  2922.     $RETIF                ; Return if that failed
  2923.     JUMPL    S1,[$KERR(Must be a postive number)
  2924.         $RETF    ]        ; Issue the error and return
  2925.     MOVEM    S1,SND%NPAD##        ; Store the number of characters
  2926.     $RETT                ; Give a good return
  2927.  
  2928. ;+
  2929. ;.HL2 SETSPL
  2930. ;This routine will set the send packet length.
  2931. ;-
  2932.  
  2933. SETSPL:    $CALL    P$NUM            ; Get the number parsed
  2934.     $RETIF                ; Return if that failed
  2935.     CAIL    S1,^D10            ; Min length
  2936.      CAILE    S1,^D1000 ; [134] 94    ; Max length
  2937.       JRST    [$KERR(Illegal packet size)
  2938.         $RETF]            ; Issue error and return
  2939.     MOVEM    S1,SND%PKT%SIZE##    ; Store the packet length
  2940.     $RETT                ; Return to the caller
  2941.  
  2942. ;+
  2943. ;.HL2 SETSQU
  2944. ;This routine will set the sending quoting character
  2945. ;-
  2946.  
  2947. SETSQU:    $CALL    P$NUM        ; Gett he value
  2948.     MOVEM    S1,SND%QUOTE##        ; Store the quote character
  2949.     $RETT
  2950.  
  2951. ;+
  2952. ;.HL2 SETSSH
  2953. ; This routine will store the parsed start of header character.
  2954. ;-
  2955.  
  2956. SETSSH:    $CALL    P$NUM            ; Get a number
  2957.     $RETIF                ; Punt if we can't
  2958.     MOVEM    S1,SND%SOH##        ; Store it
  2959.     $RETT                ; And give a good return
  2960.  
  2961. ;+
  2962. ;.hl2 SETSTI
  2963. ;This routine will set the sending time out time.
  2964. ;-
  2965.  
  2966. SETSTI:    $CALL    P$NUM            ; Get the number
  2967.     $RETIF                ; Return if that fails
  2968.     MOVEM    S1,SND%TIMEOUT##    ; Store it
  2969.     $RETT                ; Give a good return
  2970.  
  2971.  
  2972. ;+
  2973. ;.HL2 SETRPT
  2974. ;This routine will set the repeat quoting character
  2975. ;-
  2976.  
  2977. SETRPT:    $CALL    P$NUM            ; Get the number
  2978.     JUMPT    SETRP0            ; If we got it, store it
  2979.     $CALL    P$KEYW            ; Otherwise, get a keyword
  2980.     $RETIF                ; If not, give up
  2981. SETRP0:    MOVEM    S1,SET%REPT%CHR##    ; Store the repeat character
  2982.     $RETT
  2983.  
  2984.     SUBTTL    Command execution -- SHOW command
  2985.  
  2986. ;+
  2987. ;.HL1 C$SHOW
  2988. ;This command will show the current values of the parameters that can be
  2989. ;set with the SET command.  This routine is called after the SHOW command
  2990. ;has been parsed.
  2991. ;-
  2992.  
  2993. C$SHOW:
  2994.     $CALL    P$KEYW            ; Get the keyword parsed
  2995.     $RETIF                ; Return if not a keyword
  2996.     $CALL    (S1)            ; Call the correct routine
  2997.     $RET                ; Return to the caller
  2998.  
  2999. ;+
  3000. ;.HL2 SHOALL
  3001. ;This routine will show all of the various parameters.  This routine
  3002. ;is called from the SHOW command dispatch routine.
  3003. ;.literal
  3004. ;
  3005. ; Usage:
  3006. ;    $CALL    SHOALL
  3007. ;    (Return)
  3008. ;
  3009. ;.end literal
  3010. ;-
  3011.  
  3012. SHOALL:    $CALL    SHOVER            ; Show the version first
  3013.     $CALL    SHODAY            ; Show the date/time
  3014.     $TEXT    (,<>)            ; Issue a blank line
  3015.     $CALL    SHOLIN            ; Output the line information
  3016.     $TEXT    (,<>)            ; Issue a blank line.
  3017.     $CALL    SHOFIL            ; Show the file information
  3018.     $TEXT    (,<>)            ; Issue a blank line.
  3019.     $CALL    SHODEB            ; Show debugging flag
  3020.     $TEXT    (,<>)            ; Issue a blank line.
  3021.     $CALL    SHOPKT            ; Show the packet information
  3022.     $TEXT    (,<>)            ; Issue a blank line.
  3023.     $CALL    SHOTIM            ; Show the timing information
  3024.     $TEXT    (,<>)            ; Issue a blank line
  3025.     $CALL    SHOMAC            ; Show the defined macros
  3026.     $TEXT    (,<>)            ; And a CRLF
  3027.     $RETT                ; Give a good return
  3028.     SUBTTL    Command execution -- SHOW command -- SHOW MACROS
  3029.  
  3030. ;+
  3031. ;.hl2 SHOMAC
  3032. ; This routine will list all defined macros.
  3033. ;See definition of macro blocks in header of routine C$DEFINE
  3034. ;-
  3035.  
  3036. SHOMAC:    HLRZ    P1,DFNTAB        ; Get the count of defined macros
  3037.     JUMPE    P1,[$TEXT    (,< No defined macros>)    ; If nothing, say so
  3038.         $RETT]            ; And return
  3039.     MOVN    P1,P1            ; Negate the count
  3040.     HRLI    P1,DFNTAB+1        ; Build the pointer
  3041.     MOVS    P1,P1            ;  .  .  .
  3042.     $TEXT    (,< Macros:>)        ; Say what we are typing
  3043.  
  3044. SHOM.1:    HRRZ    S1,(P1)            ; Get the macro block address
  3045.     LOAD    S2,$MBOFS(S1),MB$OFS    ; Get offset to string
  3046.     ADD    S1,S2            ; Point at it
  3047.     $TEXT    (,<  ^T/(S1)/^A>)    ; Type the definition (includes name and CRLF)
  3048.     AOBJN    P1,SHOM.1        ; Loop for all macros
  3049.     $RETT                ; And return
  3050.     SUBTTL    Command execution -- SHOW command -- SHOW VERSION
  3051.  
  3052. ;+
  3053. ;.HL2 SHOVER
  3054. ;This routine will display the version of KERMIT-10.  This is compatible with
  3055. ;KERMIT-20.
  3056. ;.literal
  3057. ;
  3058. ; Usage:
  3059. ;    $CALL    SHOVER
  3060. ;    (Return)
  3061. ;
  3062. ;.end literal
  3063. ;-
  3064.  
  3065. SHOVER:    $TEXT    (,<TOPS-10 KERMIT version ^V/.JBVER/>)
  3066.     $RETT                ; Give a good return
  3067.  
  3068.  
  3069.  
  3070.  
  3071.     SUBTTL    Command execution -- SHOW command -- SHOW DAYTIME
  3072.  
  3073. ;+
  3074. ;.HL2 SHODAY
  3075. ;This routine will display the current date/time.  This is compatible with
  3076. ;KERMIT-20.
  3077. ;.literal
  3078. ;
  3079. ; Usage:
  3080. ;    $CALL    SHODAY
  3081. ;    (Return)
  3082. ;
  3083. ;.end literal
  3084. ;-
  3085.  
  3086. SHODAY:    $TEXT    (,<^H/[EXP -1]/>)    ; Output the date/time
  3087.     $RETT                ; Give a good return
  3088.     SUBTTL    Command execution -- SHOW command -- SHOW DEBUGGING
  3089.  
  3090. ;+
  3091. ;.HL2 SHODEB
  3092. ;This rotine will display the state of the debugging parameters.  This
  3093. ;routine is called by the SHOW command dispatcher and SHOW ALL command.
  3094. ;.literal
  3095. ;
  3096. ; Usage:
  3097. ;    $CALL    SHODEB
  3098. ;    (Return)
  3099. ;
  3100. ;.end literal
  3101. ;-
  3102.  
  3103. SHODEB:    MOVE    S1,TY%FIL##        ; Get the file specification type out
  3104.     $CALL    TONOFF            ; Get the text associated with it
  3105.     $TEXT    (,<File specification type out is ^T/(S1)/>)
  3106.     MOVE    S1,TY%PKT##        ; Get the packet number type out flag
  3107.     $CALL    TONOFF            ; Get the text associated with it
  3108.     $TEXT    (,<Packet number type out is ^T/(S1)/>)
  3109.     MOVE    S1,DEBUG%FLAG##        ; Get the flag value
  3110.     $CALL    TONOFF            ; Get the text
  3111.     $TEXT    (,<Debugging is ^T/(S1)/>)
  3112.     MOVEI    S1,DBGLOG        ; Point at debugging log info
  3113.     MOVEI    S2,[ASCIZ |Debugging|] ; And the text
  3114.     $CALL    SDEB.1            ; Type out if necessary
  3115.     MOVEI    S1,SESLOG        ; Point at session info
  3116.     MOVEI    S2,[ASCIZ |Session|]    ; And text
  3117.     $CALL    SDEB.1            ; Type it
  3118.     MOVEI    S1,TRNLOG        ; And transaction log
  3119.     MOVEI    S2,[ASCIZ |Transaction|] ; And its text
  3120. ;    PJRST    SDEB.1            ; Type it out
  3121.  
  3122. SDEB.1:    MOVE    TF,S2            ; Copy text to type
  3123.     MOVE    S2,$LGFLG(S1)        ; Get log file flags
  3124.     TXNN    S2,LG$SET        ; File set?
  3125.      $RETT                ; No, just return
  3126.     TXNE    S2,LG$APP        ; Want to append to it?
  3127.      SKIPA    S2,[[ASCIZ |/Append|]]    ; Yes, get the switch
  3128.       MOVEI    S2,[ASCIZ ||]        ; No, no switch
  3129.     $TEXT    (,<^T/@TF/ log file is ^F/$LGFD(S1)/^T/(S2)/>) ; Say what it is
  3130.     $RETT                ; Give a good return
  3131.     SUBTTL    Command execution -- SHOW command -- SHOW FILE-INFORMATION
  3132.  
  3133. ;+
  3134. ;.HL2 SHOFIL
  3135. ;This routine will display the various file information parameters that
  3136. ;are possible to set.
  3137. ;-
  3138.  
  3139. SHOFIL:    MOVE    S1,FILTYP        ; Get the file type being used
  3140.     $TEXT    (,<File type is ^T/@FBSTBL(S1)/>)
  3141.  
  3142.     MOVEI    S1,[ASCIZ |Unknown|]    ; Unkown file naming
  3143.     MOVE    S2,FIL%NORMAL%FORM##    ; Get the file name type
  3144.     CAIN    S2,FNM%NORMAL##        ; Normalized file names?
  3145.      MOVEI    S1,[ASCIZ |Normal form|] ; Yes, use that
  3146.     CAIN    S2,FNM%FULL##        ; Full file specs?
  3147.      MOVEI    S1,[ASCIZ |Full|]    ; Yes, say so
  3148.     CAIN    S2,FNM%UNTRAN##        ; Untranslated?
  3149.      MOVEI    S1,[ASCIZ |Untranslated|] ; Yes, get the text
  3150.     $TEXT    (,<File naming: ^T/(S1)/ file specifications>)
  3151.  
  3152. TOPS10<
  3153.     MOVE    S1,WARN%FLAG##        ; Get the flag value
  3154.     $CALL    TONOFF            ; Get the value
  3155.     $TEXT    (,<File warning is ^T/(S1)/>)
  3156. >; End of TOPS10 conditional
  3157.  
  3158.     MOVE    S1,ABT%FLAG##        ; Get aborted file flag
  3159.     TXNE    S1,BLSTRU        ; True?
  3160.      SKIPA    S1,[[ASCIZ |Discard|]]    ; Yes, discard
  3161.       MOVEI    S1,[ASCIZ |Keep (whatever portion was received)|] ; No, Keep
  3162.     $TEXT    (,<Disposition for incomplete received files: ^T/(S1)/>)
  3163.     $RETT                ; Return to the caller
  3164.  
  3165. DEFINE FT(NUM,TEXT)<[ASCIZ |TEXT|]>
  3166. FBSTBL:    $FLTYP
  3167.     SUBTTL    Command execution -- SHOW command -- SHOW LINE-INFORMATION
  3168.  
  3169. ;+
  3170. ;.hl2 SHOLIN
  3171. ;This routine will display the line that is being used for the transfer of
  3172. ;information to the remote Kermit.
  3173. ;-
  3174.  
  3175. SHOLIN:    MOVEI    S1,XFRTRM        ; Point to the information
  3176.     $CALL    T$CONN            ; Connect the terminal to the system
  3177.     $TEXT    (,<Line being used is ^W/S1/: ^A>)
  3178.     SKIPE    XFRTRM+$TTNOD        ; Non-network?
  3179.      $TEXT    (,<(^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>)
  3180.     $TEXT    (,<>)            ; And a CRLF
  3181.  
  3182. ;[133]    MOVE    S1,IBM%FLAG##        ; Get the flag
  3183. ;[133]    $CALL    TONOFF            ; Get the value
  3184. ;[133]    $TEXT    (,<  IBM-mode:    ^T/(S1)/^A>)
  3185.     MOVE    S1,IBM%CHAR##        ; Get the IBM hand shake character
  3186.     $CALL    CHITXT            ; Get the text for it
  3187. ;[133]    $TEXT    (,<, Handshake: ^T/.TEMP/>)
  3188.     $TEXT    (,<  Handshake: ^T/.TEMP/>)
  3189.  
  3190.     MOVE    S1,PARITY%TYPE##    ; Get the parity type
  3191. ;[133]    MOVE    S2,IBM%FLAG##        ; Get the IBM flag
  3192. ;[133]    TXNN    S2,BLSTRU        ; Is it on?
  3193.      CAIN    S1,PR%MARK        ; Mark?
  3194.       MOVEI    S2,[ASCIZ |mark|]    ; Yes, either mark set or IBM mode
  3195.     CAIN    S1,PR%NONE        ; None?
  3196.      MOVEI    S2,[ASCIZ |none|]    ; Yes
  3197.     CAIN    S1,PR%SPACE        ; Space?
  3198.      MOVEI    S2,[ASCIZ |space|]    ; Yes
  3199.     CAIN    S1,PR%ODD        ; Odd?
  3200.      MOVEI    S2,[ASCIZ |odd|]    ; Yes
  3201.     CAIN    S1,PR%EVEN        ; Even parity?
  3202.      MOVEI    S2,[ASCIZ |even|]    ; Yes
  3203.     $TEXT    (,<  Parity:      ^T/(S2)/>)
  3204.  
  3205. ;    MOVE    S1,DUPLEX##        ; Get the duplex variable
  3206. ;    MOVEI    S2,[ASCIZ /Half/]    ; Default text
  3207. ;    CAIN    S1,DP%FULL##        ; Is this full duplex?
  3208. ;     MOVEI    S2,[ASCIZ /Full/]    ; Yes, use this text instead
  3209. ;    $TEXT    (,<  Duplex:    ^T/(S2)/>)
  3210.  
  3211.     MOVE    S1,LCLECH        ; Get the flag
  3212.     $CALL    TONOFF            ; Get the value
  3213.     $TEXT    (,<  Local echo:  ^T/(S1)/^A>)
  3214.  
  3215.     MOVE    S1,ESCAPE        ; Get the escape character
  3216.     $CALL    CHITXT            ; Get the correct way to type it
  3217.     $TEXT    (,<  Escape:      ^T/.TEMP/>)
  3218.     MOVE    S1,XXPMOD        ;[127] get XON-XOFF-processing
  3219.     CAIN    S1,$XXDEF        ;[127] Default?
  3220.      MOVEI    S2,[ASCIZ /default/]    ;[127]
  3221.     CAIN    S1,$XXLCL        ;[127] Local?
  3222.      MOVEI    S2,[ASCIZ /local/]    ;[127]
  3223.     CAIN    S1,$XXREM        ;[127] Remote?
  3224.      MOVEI    S2,[ASCIZ /remote/]    ;[127]
  3225.     $TEXT    (,<  XON-XOFF-processing:  ^T/(S2)/>)    ;[127]
  3226.     $RETT                ; Give a good return
  3227.     SUBTTL    Command execution -- SHOW command -- SHOW PACKET-INFORMATION
  3228.  
  3229. ;+
  3230. ;.hl2 SHOPKT
  3231. ;This routine will show the packet information.
  3232. ;-
  3233.  
  3234. SHOPKT:    $TEXT    (,<Packet parameters:^M^J                    Receive        Send>)
  3235.     MOVM    S1,SND%PKT%LENGTH##    ; Get the length
  3236.     $TEXT    (,<  Size:             ^D7 /RCV%PKT%LENGTH##/       ^D5 /S1/ chars>)
  3237.     MOVM    S1,SND%NPAD##        ; Get the padding value
  3238.     $TEXT    (,<  Padding:          ^D7 /RCV%NPAD##/       ^D5 /S1/>)
  3239.     MOVE    S1,RCV%PAD##        ; Get the padding character
  3240.     $CALL    CHITXT            ; Convert it to text
  3241.     $TEXT    (,<  Pad Character:    ^T7R /.TEMP/       ^A>)
  3242.     MOVM    S1,SND%PAD        ; Get the send pad character
  3243.     $CALL    CHITXT            ; Get the text
  3244.     $TEXT    (,<^T5R /.TEMP/>)
  3245.     MOVE    S1,RCV%EOL##        ; Get the receive EOL character
  3246.     $CALL    CHITXT            ; Convert it
  3247.     $TEXT    (,<  End-Of-Line:      ^T7R /.TEMP/       ^A>)
  3248.     MOVM    S1,SND%EOL##        ; Get the end of line character
  3249.     $CALL    CHITXT            ; Get the text
  3250.     $TEXT    (,<^T5R /.TEMP/>)
  3251.     MOVE    S1,RCV%QUOTE##        ; Get the receive quoting character
  3252.     $CALL    CHITXT            ; Convert it to text
  3253.     $TEXT    (,<  Control Quote:    ^T7R /.TEMP/       ^A>)
  3254.     MOVM    S1,SND%QUOTE##        ; Get the send quoting character
  3255.     $CALL    CHITXT            ; Convert it to text
  3256.     $TEXT    (,<^T5R /.TEMP/>)
  3257.     MOVE    S1,RCV%SOH##        ; Get the start of header character
  3258.     $CALL    CHITXT            ; Make it text
  3259.     $TEXT    (,<  Start-of-Packet:  ^T7R /.TEMP/       ^A>)
  3260.     MOVM    S1,SND%SOH##        ; Get the send start of header
  3261.     $CALL    CHITXT            ; Make it text
  3262.     $TEXT    (,<^T5R /.TEMP/>)    ; Output it
  3263.     MOVE    S1,RCV%8QUOTE##        ; Get the quoting character
  3264.     $CALL    CHITXT            ; Convert to text
  3265.     $TEXT    (,<^M^J 8th-bit Quote character ^T/.TEMP/>)
  3266.     MOVE    S1,SET%REPT%CHR##    ; Get the repeat character
  3267.     $CALL    CHITXT            ; Make it printable
  3268.     MOVE    S1,SET%REPT%CHR##    ; Get the charcter back
  3269.     CAIN    S1," "            ; Is it a space?
  3270.      JRST    [MOVE    S1,[ASCII |None|] ; Yes, that really means no repeats
  3271.         MOVEM    S1,.TEMP    ; So say that
  3272.         JRST    .+1]        ; Continue
  3273.     $TEXT    (,< Repeat Quote character  ^T/.TEMP/>)
  3274.     MOVE    S1,CHKTYPE##        ; Get the block check type
  3275.     MOVE    S1,SHOBLT-CHK%1C##(S1)    ; Get the text to type
  3276.     $TEXT    (,< Block check type is ^T/(S1)/>) ; Type it
  3277.     $RETT                ; And return
  3278.  
  3279. SHOBLT:    EXP    [ASCIZ |1 character checksum|]
  3280.     EXP    [ASCIZ |2 character checksum|]
  3281.     EXP    [ASCIZ |3 character CRC-CCITT|]
  3282.     SUBTTL    Command execution -- SHOW command -- SHOW TIMING-INFORMATION
  3283.  
  3284. ;+
  3285. ;.hl2 SHOTIM
  3286. ;This routine will show the timing parameters.
  3287. ;-
  3288.  
  3289. SHOTIM:    $TEXT    (,<Timing parameters:^M^J                    Receive        Send>)
  3290.     MOVM    S1,SND%TIMEOUT##        ; Get the time out
  3291.     $TEXT    (,<  Time out:         ^D7 /RCV%TIMEOUT##/       ^D5 /S1/ secs>)
  3292.     $TEXT    (,<^M^J  Delay before sending first packet: ^D/DELAY##/ secs>)
  3293.     $TEXT    (,<  Packet retries before timeout: ^D/PKT%RETRIES##/>)
  3294.     $TEXT    (,<  Number of retries for initial packet: ^D/SI%RETRIES##/>)
  3295.     $TEXT    (,<  Server NAKs every ^D/SRV%TIMEOUT##/ seconds while waiting for commands>)
  3296.     $RETT                ; Give a good return
  3297.     SUBTTL    Command execution -- SHOW command -- Support routines -- TONOFF
  3298.  
  3299. ;+
  3300. ;.hl3 TONOFF
  3301. ;This routine is a utility routine that will return the address of the
  3302. ;string "on" or "off" or "unknown" depending on if the value passed to
  3303. ;it is either the BLISS value for TRUE or FALSE or neither.
  3304. ;.literal
  3305. ;
  3306. ; Usage:
  3307. ;    MOVE    S1,Value
  3308. ;    $CALL    TONOFF
  3309. ;    (Return)
  3310. ;
  3311. ; On return:
  3312. ;    S1/ Address of the text
  3313. ;
  3314. ;.end literal
  3315. ;-
  3316.  
  3317. TONOFF:    MOVE    S2,S1            ; Copy this
  3318.     MOVEI    S1,[ASCIZ |unknown|]    ; Start with unknown
  3319.     CAIN    S2,BLSTRU        ; On?
  3320.      MOVEI    S1,[ASCIZ |on|]        ; Yes, use this
  3321.     CAIN    S2,BLSFAL        ; Off?
  3322.      MOVEI    S1,[ASCIZ |off|]    ; Yes, use this instead
  3323.     $RET                ; Return to the caller
  3324.     SUBTTL    Command execution -- SHOW command -- Support routines -- CHITXT
  3325.  
  3326. ;+
  3327. ;.hl3 CHITXT
  3328. ;This routine will store the text associated with the character that is
  3329. ;passed to it.  The text will be stored in .TEMP in the low segment.
  3330. ;.literal
  3331. ;
  3332. ; Usage:
  3333. ;    MOVE    S1,Character value
  3334. ;    $CALL    CHITXT
  3335. ;    (Return)
  3336. ;
  3337. ; On return:
  3338. ;    .TEMP/ Contains the ASCIZ text of the character
  3339. ;
  3340. ;.end ltieral
  3341. ;-
  3342.  
  3343. CHITXT:    CAIE    S1,.CHDEL        ; Delete?
  3344.       JRST    CHITX0            ; No, skip this
  3345.     $TEXT    (<-1,,.TEMP>,<^7/[EXP .CHLAB]/del^7/[EXP .CHRAB]/^0>) ; Yes, get the text
  3346.     $RET                ; Return to the caller
  3347.  
  3348. CHITX0:    CAIGE    S1," "            ; Greater than a space?
  3349.       JRST    CHITX1            ; No, control characer
  3350.     $TEXT    (<-1,,.TEMP>,<^7/S1/^0>) ; Yes, normal character
  3351.     $RET                ; Return to the caller
  3352.  
  3353. CHITX1:    MOVEI    S2,"A"-1(S1)        ; Make it a printing character
  3354.     $TEXT    (<-1,,.TEMP>,<^^^7/S2/^0>) ; Get the text
  3355.     $RET                ; Return to the caller
  3356.     SUBTTL    Command execution -- STATUS command
  3357.  
  3358. ;+
  3359. ;.HL1 C$STATUS
  3360. ;This routine will give some information about the last transfer and
  3361. ;all transfers that we have done.
  3362. ;-
  3363.  
  3364. C$STATUS:
  3365.     MOVEI    S1,T%TTY        ; Output to terminal
  3366.     $CALL    WRTSTS            ; Do totals
  3367.     $TEXT    (,<^M^JTotals for the last transfer>)
  3368.     MOVE    T1,XFR%TIME##        ; Get the total time spent
  3369.     IDIVX    T1,^D<60*60*1000>    ; Get hours
  3370.     IDIVX    T2,^D<60*1000>        ; Minutes
  3371.     IDIVX    T3,^D1000        ; Seconds and milliseconds
  3372.     MOVE    S1,XFR%TIME##        ; Also get
  3373.     IDIVI    S1,^D1000        ; As seconds and milliseconds
  3374.     $TEXT    (,< Last transfer time ^D/T1/:^D2R0/T2/:^D2R0/T3/.^D3R0/T4/(^D/S1/.^D3R0/S2/ seconds)>)
  3375.     $TEXT    (,< Characters sent ^D/SMSG%TOTAL%CHARS##/>)
  3376.     $TEXT    (,< Characters received ^D/RMSG%TOTAL%CHARS##/>)
  3377.     $TEXT    (,< Data characters sent ^D/SMSG%DATA%CHARS##/>)
  3378.     $TEXT    (,< Data characters received ^D/RMSG%DATA%CHARS##/>)
  3379.     $TEXT    (,< NAKs sent ^D/SMSG%NAKS##/>)
  3380.     $TEXT    (,< NAKs received ^D/RMSG%NAKS##/>)
  3381.     SKIPN    T2,XFR%TIME##        ; Get the time of the last transfer
  3382.       JRST    STAT.1            ; Skip it, hasn't happened
  3383.     MOVE    T1,RMSG%DATA%CHARS##    ; Get the number of data characters
  3384.                     ;  received
  3385.     CAMGE    T1,SMSG%DATA%CHARS##    ; Should we use the other?
  3386.      MOVE    T1,SMSG%DATA%CHARS##    ; Yes, get it
  3387.     IMULI    T1,^D10            ; Make this 10 times for baud rate
  3388.     ADDI    T2,^D500        ; Round up
  3389.     IDIVI    T2,^D1000        ; Milliseconds to seconds
  3390.     IDIV    T1,T2            ; Compute the baud rate
  3391.     $TEXT    (,< Effective data rate: ^D/T1/ baud>)
  3392. STAT.1:    $TEXT    (,<>)
  3393.     $RETT                ; All done
  3394.  
  3395. ; Here to write total values.  This is also used for generic status command.
  3396.  
  3397. WRTSTS::$SAVE    <P1>            ; Save P1
  3398.     MOVE    P1,S1            ; Get the output routine
  3399.     $TEXT    (@P1,<^M^JTotals since Kermit was started>)
  3400.     MOVE    T1,TOTAL%TIME##        ; Get the total time spent
  3401.     IDIVX    T1,^D<60*60*1000>    ; Get hours
  3402.     IDIVX    T2,^D<60*1000>        ; Minutes
  3403.     IDIVX    T3,^D1000        ; Seconds and milliseconds
  3404.     MOVE    S1,TOTAL%TIME##        ; Also get
  3405.     IDIVI    S1,^D1000        ; As seconds and milliseconds
  3406.     $TEXT    (@P1,< Total transfer time ^D/T1/:^D2R0/T2/:^D2R0/T3/.^D3R0/T4/(^D/S1/.^D3R0/S2/ seconds)>)
  3407.     $TEXT    (@P1,< Characters sent ^D/SND%TOTAL%CHARS##/>)
  3408.     $TEXT    (@P1,< Characters received ^D/RCV%TOTAL%CHARS##/>)
  3409.     $TEXT    (@P1,< Data characters sent ^D/SND%DATA%CHARS##/>)
  3410.     $TEXT    (@P1,< Data characters received ^D/RCV%DATA%CHARS##/>)
  3411.     $TEXT    (@P1,< NAKs sent ^D/SND%NAKS##/>)
  3412.     $TEXT    (@P1,< NAKs received ^D/RCV%NAKS##/>)
  3413.     $TEXT    (@P1,< Total packets sent ^D/SND%COUNT/>)
  3414.     $TEXT    (@P1,< Total packets received ^D/RCV%COUNT/>)
  3415.     SKIPN    T2,TOTAL%TIME##        ; Get the amount of time
  3416.       JRST    WRTS.0            ; None, so skip this
  3417.     MOVE    T1,RCV%DATA%CHARS##    ; Get the number of data characters
  3418.                     ;  received
  3419.     ADD    T1,SND%DATA%CHARS##    ; Add in to get total data characters
  3420.                     ;  transfered
  3421.     IMULI    T1,^D10            ; Make this 10 times for baud rate
  3422.     ADDI    T2,^D500        ; Round up
  3423.     IDIVI    T2,^D1000        ; Milliseconds to seconds
  3424.     IDIV    T1,T2            ; Compute the baud rate
  3425.     $TEXT    (@P1,< Effective data rate: ^D/T1/ baud>)
  3426. WRTS.0:    LDB    S1,[POINT 7,LAST%ERROR##] ; Check if any error text
  3427.     JUMPE    S1,WRTS.1        ; If none, don't type line
  3428.     $TEXT    (,<^M^JLast error: ^T/LAST%ERROR/>)
  3429. WRTS.1:    $RETT
  3430.     SUBTTL    File processing -- INIFILE - Initialization
  3431.  
  3432. ;+
  3433. ;.hl1 INIFIL
  3434. ;This routine will initialize the file processing for KERMIT.
  3435. ;.LITERAL
  3436. ;
  3437. ; Usage:
  3438. ;    $CALL    INIFIL
  3439. ;    (Return)
  3440. ;
  3441. ;
  3442. ;.end literal
  3443. ;-
  3444.  
  3445. INIFIL:    MOVX    S1,D$FTP        ; Get the default file type
  3446.     MOVEM    S1,FILTYP        ; Store it
  3447.     $RETT                ; Return to the caller
  3448.     SUBTTL    File processing -- FILE%OPEN
  3449.  
  3450. ;+
  3451. ;.HL1 FILE%OPEN (Function)
  3452. ; This routine will open the file for reading or writing.
  3453. ;-
  3454.  
  3455. BLSRTN(FILE%OPEN,<FUNCTION>)
  3456. TOPS10<
  3457.     $SAVE    <T1,T2,T3,T4>        ; Save a few registers
  3458.     $SAVE    <TF,S2>            ; Save this too
  3459.     $SAVE    <P1>            ; Save as a flag
  3460.     MOVEI    S1,.FDSIZ        ; Get the size of the FX block
  3461.     MOVEI    S2,FX            ; And the address
  3462.     $CALL    .ZCHNK            ; Clear out the block
  3463.     SETZ    P1,            ; Flag from FILE%OPEN
  3464.     MOVE    S1,[POINT 7,FILE%N##]    ; Point to the file name
  3465.     MOVEI    S2,FX            ; Point to the FX block
  3466.     $CALL    PRSFIL            ; Parse the file spec
  3467.     MOVE    S1,FUNCTION        ; Get the function
  3468.     JUMPE    S1,OPNREA        ; Open for reading?
  3469.  
  3470. ; Here if we are opening the file for writing.  We just make sure that we are
  3471. ; not overwriting any files if WARN%FLAG is true.
  3472.  
  3473.     SKIPN    LOGDIN            ; Are we logged in?
  3474.      JRST    [KERERR    (<Cannot write files without LOGIN first>) ;[125] No, don't write files now
  3475.         BLSRET    RMS32]        ;[125] So we don't compromise security
  3476.     SETO    S1,            ; Flag for output
  3477.     $CALL    SETFLP            ; Set up FILOP block
  3478.     MOVEI    T1,FX            ; Point to the scanner block
  3479.     SKIPE    USRFIL            ; User supply a file specification?
  3480.      MOVEI    T1,USRFX        ; Yes, point to that block instead
  3481.     MOVEI    T2,FLP+.FOIOS        ; Point to the open block
  3482.     MOVEI    T3,ELB            ; Point to the LOOKUP/ENTER block
  3483.     MOVEI    T4,PTH            ; Point to the path block
  3484.     $CALL    .STOPB            ; Convert to FILOP block
  3485.       JRST    [KERERR (<Wild file specifications illegal on RECEIVE>)
  3486.         BLSRET    RMS32]
  3487.     MOVE    S1,FILTYP        ; Get the file type we are using
  3488.     CAXE    S1,$FBS8        ; 8-bit file?
  3489. IFE .IOASC,<TDZA S1,S1>            ; No, Use ASCII mode
  3490. IFN .IOASC,<SKIPA S1,[EXP .IOASC]>    ; No, Use ASCII mode
  3491.      MOVX    S1,.IOBIN        ; Yes, use binary mode
  3492.     MOVEM    S1,FLP+.FOIOS        ; Store the mode
  3493.     MOVX    S1,FO.PRV        ; Use priv's if we have any
  3494.     MOVEM    S1,FLP+.FOFNC        ; Store it
  3495.     MOVX    S1,FIL            ; Get the channel
  3496.     STORE    S1,FLP+.FOFNC,FO.CHN    ; Store the channel
  3497.     MOVX    S1,.FOCRE        ; Create a new file
  3498.     MOVX    S2,BLSTRU        ; File warning on or off?
  3499.     CAME    S2,WARN%FLAG##        ; On?
  3500.       MOVX    S1,.FOWRT        ; No, just write this file
  3501.     STORE    S1,FLP+.FOFNC,FO.FNC    ; Store the function
  3502.  
  3503.     MOVEI    S1,FLP+.FOIOS        ; Point to the argument block
  3504.     DEVSIZ    S1,            ; Get the buffer size
  3505.      JRST    [KERERR(<DEVSIZ UUO failure (^D/S1/)>)
  3506.         BLSRET    RMS32]        ; Claim RMS error
  3507.     HLRZ    S2,S1            ; Get the number of buffers
  3508.     MOVEI    S1,(S1)            ; Get the size
  3509.     IMULI    S1,(S2)            ; Compute the total size
  3510.     MOVEM    S1,FBFSIZ        ; Store the number of words
  3511.     $CALL    M%GMEM            ; Allocate the memory
  3512.     JUMPF    [KERERR(<^E/S1/>)
  3513.         BLSRET    RMS32]
  3514.     MOVEM    S2,FBFADR        ; Store the buffer address
  3515.     EXCH    S2,.JBFF        ; Exchange with .JBFF
  3516.  
  3517.     MOVE    T4,ELB+.RBPPN        ;[125] Remember path or PPN in case of failure
  3518.     MOVE    S1,[XWD .FOMAX-1,FLP]    ; Point to the argument block
  3519.     FILOP.    S1,            ; Do the FILOP.
  3520.       JRST    OPNWR0            ; Failed, see why
  3521.  
  3522. OPNWR3:    MOVEM    S2,.JBFF        ; Restore .JBFF
  3523.  
  3524. ; Set up byte pointer in buffer header.  The monitor will correctly calculate
  3525. ;the byte count if we do so.
  3526.  
  3527.     MOVX    S1,<POINT 7,,34>    ; Assume ASCII files
  3528.     MOVX    S2,$FBS8        ; Is it really 8-bit?
  3529.     CAMN    S2,FILTYP        ; . . .
  3530.      MOVX    S1,<POINT 8,,31>    ; Yes, use 8 bit
  3531.     HLLM    S1,BH+.BFPTR        ; Store in the pointer
  3532.     MOVE    S1,TY%FIL##        ; Get the type file flag
  3533.     TXNN    S1,BLSTRU        ; Want type out?
  3534.      BLSRET    NORMAL            ; Give a good return
  3535.     MOVEI    S1,[ASCIZ | as |]    ; Get the text to type
  3536.     $CALL    TYPFIL            ; Type the file specification
  3537.     BLSRET    NORMAL            ; Give a good return
  3538.  
  3539. ; Here if we have gotten an error.  Restore .JBFF and then see if the error
  3540. ; is allowed (WARN%FLAG and superceeding error)
  3541.  
  3542. OPNWR0:    MOVE    T1,S1            ; Copy the error code
  3543.     MOVEM    S2,.JBFF        ; Store .JBFF back
  3544.     MOVX    S2,BLSFAL        ; Get the false value
  3545.     CAME    S2,WARN%FLAG##        ; Can we change the name (to protect the inocent?)
  3546.       JRST    OPNWR1            ; Yes, change the name
  3547. OPNWR2:    MOVE    S1,FBFSIZ        ; Get the size of the buffers
  3548.     MOVE    S2,FBFADR        ; Get the address
  3549.     $CALL    M%RMEM            ; Return the memory
  3550.     KERERR    (<^T/FILERR##(T1)/>)
  3551.     BLSRET    RMS32            ; Failure return
  3552.  
  3553. ; Here to change the extension of the file to something different.
  3554.  
  3555. OPNWR1:    CAIE    T1,ERAEF%        ; Already exist error?
  3556.       JRST    OPNWR2            ; No, just return the buffers and exit
  3557.     MOVSI    S1,(<SIXBIT |000|>)    ; Get the initial extension
  3558.     MOVEM    S1,ELB+.RBEXT        ; Store it
  3559.     MOVE    S2,FBFADR        ; Get the buffer's address again
  3560.     EXCH    S2,.JBFF        ; Exchange this
  3561. OPNWR4:    MOVEM    T4,ELB+.RBPPN        ;[125] Reset path or PPN so file goes correct place
  3562.     MOVE    S1,[XWD .FOMAX-1,FLP]    ; Point to the argument block
  3563.     FILOP.    S1,            ; Do it
  3564.       SKIPA                ; Failed
  3565.     JRST    OPNWR3            ; Worked this time, just exit now
  3566.     CAIE    T1,ERAEF%        ; Same problem still?
  3567.       JRST    OPNWR0            ; No, something else this time
  3568.     HLRZ    S1,ELB+.RBEXT        ; Get the extension
  3569.     TXZ    S1,<'000'>        ; Turn this off
  3570.     TXO    S1,707070        ; Turn this on
  3571.     AOJ    S1,            ; Increment this
  3572.     TXZ    S1,707070        ; Reverse it
  3573.     TXO    S1,<'000'>        ; Make it sixbit again
  3574.     HRLZM    S1,ELB+.RBEXT        ; Store this back
  3575.     JRST    OPNWR4            ; Try again
  3576. >; End of TOPS10 conditional
  3577. ; Here if we are reading a stream of files.  Call .LKWLD if we are under
  3578. ; TOPS-10, else TOPS-20 will do the right thing.
  3579.  
  3580. TOPS10<
  3581. OPNREA:    SETZ    S1,            ; Clear this
  3582.     $CALL    SETFLP            ; Set up the FILOP. block
  3583.     MOVEI    S1,FX            ; Point to the argument block
  3584.     MOVEM    S1,WLD+$LKFDB        ; Store it
  3585.     MOVX    S1,.FOMAX        ; Get the length
  3586.     STORE    S1,WLD+$LKFLP,LK$FLN    ; Store the length
  3587.     MOVEI    S1,FLP            ; Point to the argument block
  3588.     STORE    S1,WLD+$LKFLP,LK$FLP    ; Store the address
  3589.     MOVX    S1,LK$FRS        ; Flag this is the first time
  3590.     SKIPGE    P1            ; First time?
  3591.      SETZ    S1,            ; No, not the first time
  3592.     MOVEM    S1,WLD+$LKFLG        ; Store in the flag word
  3593.     MOVEI    S1,$LKLEN        ; Get the length
  3594.     MOVEI    S2,WLD            ; And the argument block
  3595.     $CALL    LOKWLD##        ; Look for the file.
  3596.     JUMPF    OPNRE0            ; Failed, process error
  3597.  
  3598. ; Here if we have the a file from the remote
  3599.  
  3600.     MOVEI    S1,FIL            ; Get the channel number
  3601.     STORE    S1,FLP+.FOFNC,FO.CHN    ; Store it
  3602.     MOVEI    S1,.FORED        ; Get the function
  3603.     STORE    S1,FLP+.FOFNC,FO.FNC    ; Store the function
  3604.     MOVX    S1,FO.PRV        ; Use privs
  3605.     IORM    S1,FLP+.FOFNC        ; Light the bit
  3606.  
  3607.     MOVEI    S1,FLP+.FOIOS        ; Point to the open block
  3608.     DEVSIZ    S1,            ; Attempt to determine the size
  3609.       JRST    [KERERR(<DEVSIZ UUO failure (^D/S1/)>)
  3610.         BLSRET    RMS32]            ; Error return
  3611.     HLRZ    S2,S1            ; Get the number of buffers
  3612.     MOVEI    S1,(S1)            ; Get the buffer size
  3613.     IMULI    S1,(S2)            ; Compute the total size
  3614.     MOVEM    S1,FBFSIZ        ; Store it
  3615.     $CALL    M%GMEM            ; Allocate the memory
  3616.      JUMPF    [KERERR(<^E/S1/>)    ; Output the error
  3617.         BLSRET    RMS32]        ; Return the failure
  3618.     MOVEM    S2,FBFADR        ; Store the address
  3619.     EXCH    S2,.JBFF        ; Exchange with the first free
  3620.     MOVX    S1,<XWD .FOMAX,FLP>    ; Point to the argument block
  3621.     FILOP.    S1,            ; Attempt to read the file
  3622.       JRST    OPNRE1            ; Failed, try again
  3623.  
  3624.     SKIPGE    P1            ;[130] Skip if first pass
  3625.     $TEXT    (,<Sending: ^A>)    ;[130] Give prompt
  3626.     MOVEM    S2,.JBFF        ; Store .JBFF back
  3627.     MOVE    S1,[POINT 7,FILE%NAME##] ; Point to the file name
  3628.     MOVEM    S1,FILPTR        ; Store the byte pointer
  3629.     SETOM    FILE%SIZE##        ; Clear the count
  3630.     MOVE    S2,FIL%NORMAL%FORM##    ; Get name type
  3631.     CAIE    S2,FNM%FULL##        ; Full file specs?
  3632.      JRST    OPNRE8            ; No, use short name
  3633.     $TEXT    (FILSTO,<^W/FLP+.FODEV/:^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^A>)
  3634.     SKIPN    FPTH+.PTPPN        ; Is there a PPN?
  3635.       JRST    OPNRE5            ; No, finish up and return
  3636.     $TEXT    (FILSTO,<[^O/FPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>)
  3637.     MOVSI    S1,-5            ; Get the number of SFDs possible
  3638. OPNRE6:    SKIPN    FPTH+.PTSFD(S1)        ; Finished?
  3639.      JRST    OPNRE7            ; Yes, close off
  3640.     $TEXT    (FILSTO,<,^W/FPTH+.PTSFD(S1)/^A>) ; Type the SFD
  3641.     AOBJN    S1,OPNRE6        ; Loop for all SFDs
  3642. OPNRE7:    $TEXT    (FILSTO,<]^A>)        ; Type the closing bracket
  3643. OPNRE5:    $TEXT    (FILSTO,<^0>)        ; Store final null
  3644.     JRST    OPNRE9            ; And go set up pointers
  3645.  
  3646. OPNRE8:    $TEXT    (FILSTO,<^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^0>)
  3647.  
  3648. ; Now set up the correct size byte pointers.
  3649.  
  3650. OPNRE9:    MOVE    S2,FILTYP        ; Get the file type
  3651.     CAXE    S2,$FBAUT        ; Automatic?
  3652.      JRST    OPNRE2            ; No, use what was set
  3653.     LOAD    S1,ELB+.RBPRV,RB.MOD    ; Get the mode the file was written in
  3654.     CAXE    S1,.IOIMG        ; Image?
  3655.      CAXN    S1,.IOIBN        ; Or image binary?
  3656.       MOVX    S2,$FBS8        ; Yes, 8-bit
  3657.     CAXE    S1,.IOBIN        ; Binary?
  3658.      CAXN    S1,.IODPR        ; Or dump record?
  3659.       MOVX    S2,$FBS8        ; Yes, 8-bit
  3660. OPNRE2:    MOVEM    S2,CURFTP        ; Save the file type for this file
  3661.     MOVX    S1,<POINT 7,,34>    ; Assume ASCII files
  3662.     CAXN    S2,$FBS8        ; Is it ASCII?
  3663.      MOVX    S1,<POINT 8,,31>    ; No, use 8 bit
  3664.     HLLM    S1,BH+.BFPTR        ; Store in the pointer
  3665.  
  3666.     $CALL    T$LOCAL            ; Check if local
  3667.      JUMPT    [BLSRET    NORMAL]        ; If no terminal, just return
  3668.     MOVE    S1,TY%FIL##        ; Get the type file flag
  3669.     TXNN    S1,BLSTRU        ; Want type out?
  3670.      BLSRET    NORMAL            ; Give a good return
  3671.     MOVEI    S1,[ASCIZ ||]        ; Get the text
  3672.     $CALL    TYPFIL            ; Type the file specification
  3673.     $TEXT    (,< as ^A>)        ; Say what we send it out as
  3674.     BLSRET    NORMAL            ; Give a good return
  3675.  
  3676. ; Here if there were no files
  3677.  
  3678. OPNRE0:    JUMPN    P1,[BLSRET NOMORFILES]    ; Flag no more and return
  3679.     KERERR    (<No such files as ^F/FX/>)
  3680.     BLSRET    RMS32            ; Give a failure
  3681.  
  3682. ; Here if the FILOP. failed.
  3683.  
  3684. OPNRE1:    PUSH    P,S1            ; Save the error code
  3685.     MOVE    S1,FBFSIZ        ; Get the size of the buffers
  3686.     MOVE    S2,FBFADR        ; Get the address of them
  3687.     $CALL    M%RMEM            ; Return the memory
  3688.     POP    P,S1            ; Restore S1
  3689.     KERERR    (<^T/FILERR##(S1)/ - ^F/FX/>)
  3690.     BLSRET    RMS32            ; Give the failure return
  3691. >; End of TOPS10 conditional
  3692.     SUBTTL    File processing -- Routine to type the file specification
  3693.  
  3694. ;+
  3695. ;.hl1 TYPFIL
  3696. ;This routine will type the file specification that we are processing
  3697. ;on the user's terminal.  It will output the text passed to this routine
  3698. ;first.  Type out will only happen if we are using a different terminal
  3699. ;line other than the controlling terminal.
  3700. ;.literal
  3701. ;
  3702. ; Usage:
  3703. ;    MOVEI    S1,[ASCIZ |Text|]
  3704. ;    $CALL    TYPFIL
  3705. ;    (Return)
  3706. ;
  3707. ;.end literal
  3708. ;-
  3709.  
  3710. TYPFIL:    $SAVE    <P1>            ; Save a registers
  3711.     MOVE    P1,S1            ; Copy the text
  3712.     $CALL    T$LOCAL            ; Are we connected to a different line?
  3713.      $RETIT                ; If nowhere to type, just return
  3714.     $TEXT    (,<^T/(P1)/^W/FLP+.FODEV/:^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^A>)
  3715.     SKIPN    FPTH+.PTPPN        ; Is there a PPN?
  3716.       JRST    TYPF.0            ; No, finish up and return
  3717.     $TEXT    (,<[^O/FPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>)
  3718.     MOVSI    S1,-5            ; Get the number of SFDs possible
  3719. TYPF.2:    SKIPN    FPTH+.PTSFD(S1)        ; Finished?
  3720.      JRST    TYPF.1            ; Yes, close off
  3721.     $TEXT    (,<,^W/FPTH+.PTSFD(S1)/^A>) ; Type the SFD
  3722.     AOBJN    S1,TYPF.2        ; Loop for all SFDs
  3723. TYPF.1:    $TEXT    (,<]^A>)        ; Type the closing bracket
  3724.  
  3725. TYPF.0:    $RETT                ; Return to the caller
  3726.     SUBTTL    Routine to setup FILOP/ELB/PATH blocks
  3727.  
  3728. ;+
  3729. ;.HL1 SETFLP
  3730. ;This routine will clear and initialize the FILOP. block.
  3731. ;.literal
  3732. ;
  3733. ; Usage:
  3734. ;    S1/ -1 for output, 0 for input
  3735. ;    $CALL    SETFLP
  3736. ;    (Return)
  3737. ;
  3738. ;.end literal
  3739. ;-
  3740.  
  3741. TOPS10<
  3742. SETFLP:    $SAVE    <P1>            ; Save the flag
  3743.     MOVE    P1,S1            ; Copy the flag
  3744.     MOVEI    S1,.FOMAX        ; Get the length
  3745.     MOVEI    S2,FLP            ; Get the address
  3746.     $CALL    .ZCHNK            ; Clear the block
  3747.     MOVEI    S1,.PTMAX        ; Get the length
  3748.     MOVEI    S2,PTH            ; Get the address
  3749.     $CALL    .ZCHNK            ; Clear the block
  3750.     MOVEI    S1,.RBMAX        ; Get the length
  3751.     MOVEI    S2,ELB            ; Get the address
  3752.     $CALL    .ZCHNK            ; Clear the block
  3753.  
  3754.     MOVX    S1,.RBMAX        ; Get the length
  3755.     MOVEM    S1,ELB+.RBCNT        ; Store it
  3756.     MOVEI    S1,PTH            ; Get the PATH block address
  3757.     MOVEM    S1,ELB+.RBPPN        ; Store it
  3758.     MOVEI    S1,ELB            ; Point to the LOOKUP/ENTER block
  3759.     MOVEM    S1,FLP+.FOLEB        ; Store it
  3760.     MOVE    S1,[XWD .PTMAX,FPTH]    ; Get the file found in path block
  3761.     MOVEM    S1,FLP+.FOPAT        ; Store it for later
  3762.     MOVEI    S1,BH            ; Get the buffer header address
  3763.     SKIPGE    P1            ; Output?
  3764.      MOVSS    S1            ; Yes, move to the other half
  3765.     MOVEM    S1,FLP+.FOBRH        ; Store the buffer header
  3766.     SKIPL    P1            ; Input?
  3767.      HLLOS    FLP+.FONBF        ; Yes, set default number of buffers
  3768.     SKIPGE    P1            ; Output?
  3769.      HRROS    FLP+.FONBF        ; Yes, set the other way
  3770.     MOVE    S1,FILTYP        ; Get the file type
  3771.     CAXE    S1,$FBS8        ; 8-bit?
  3772. IFE .IOASC,<TDZA S1,S1>            ; No, use ascii
  3773. IFN .IOASC,<SKIPA S1,[EXP .IOASC]>    ; No, use ascii
  3774.      MOVX    S1,.IOBIN        ; Get the mode
  3775.     MOVEM    S1,FLP+.FOIOS        ; Store the status
  3776.     $RET                ; Return to the caller
  3777. >; End of TOPS10 conditional
  3778.     SUBTTL    File processing -- Routine to convert FX blocks
  3779.  
  3780. ;.STOPB -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS
  3781. ;  WILD-CARDS ARE ILLEGAL
  3782. ;CALL:    MOVEI    T1,SCAN BLOCK
  3783. ;        LH(T1)=LENGTH IF .GT. 24
  3784. ;    MOVEI    T2,OPEN BLOCK (3 WORDS)
  3785. ;    MOVEI    T3,LOOKUP BLOCK (6 WORDS OR MORE)
  3786. ;        LH(T3)=LENGTH IF .GT. 6
  3787. ;    MOVEI    T4,PATH BLOCK (9 WORDS)
  3788. ;    PUSHJ    P,.STOPB
  3789. ;ERROR RETURN IF WILD-CARDS
  3790. ;SKIP RETURN IF SETUP OK
  3791. ;USES T1-4
  3792.  
  3793. TOPS10<
  3794. .STOPB:    $SAVE    <P1,P2,P3>        ; Save a few registers
  3795.     SKIPN    P3,.FDSTR(T1)        ;GET DEVICE
  3796.       MOVSI    P3,'DSK'        ;DEFAULT IF BLANK
  3797.     MOVEM    P3,1(T2)        ;STORE IN OPEN BLOCK
  3798.     MOVE    P1,.FDMOD(T1)        ;GET SWITCHES
  3799.     HRRZS    (T2)            ; Clear left half of first word
  3800.     SKIPE    P3,.FDNAM(T1)        ;IF NAME NOT BLANK,
  3801.     SETCM    P3,.FDNMM(T1)        ;GET NAME MASK
  3802.     JUMPN    P3,.POPJ##        ;ERROR IF WILD
  3803.     MOVE    P3,.FDNAM(T1)        ;GET NAME
  3804.     MOVEM    P3,.RBNAM(T3)        ;STORE IN LOOKUP BLOCK
  3805.     SKIPN    P3,.FXEXT(T1)        ;GET EXTENSION
  3806.       JRST    STOP.0            ; Ok, skip this
  3807.     AND    P3,.FDEXM(T1)        ; AND with the mask
  3808.     CAME    P3,.FDEXT(T1)        ; Still the same
  3809.       POPJ    P,            ; No, fail
  3810. STOP.0:    MOVEM    P3,.RBEXT(T3)        ;STORE IN LOOKUP BLOCK
  3811.     MOVEI    P3,0            ;CLEAR DIRECTORY
  3812.     MOVX    P1,FD.DIR        ;GET DIRECTORY BIT
  3813.     TDNN    P1,.FDMOD(T1)        ;SEE IF SET
  3814.     JRST    STOPND            ;NO--USE [-]
  3815.     SETCM    P3,.FDDIM(T1)        ;GET UFD MASK
  3816.     JUMPN    P3,.POPJ##        ;ERROR IF WILD
  3817.     MOVE    P3,.FDPPN(T1)        ;GET UFD
  3818.     TLNN    P3,-1            ;SEE IF PROJECT
  3819.     HLL    P3,.MYPPN        ;NO--USE LOGGED IN NUMBER
  3820.     TRNN    P3,-1            ;SEE IF PROGRAMMER
  3821.     HRR    P3,.MYPPN        ;NO--USE LOGGED IN NUMBER
  3822.     MOVEM    P3,.FDPPN(T1)        ;STORE FOR ERROR MESSAGES
  3823.     SKIPN    .FDPAT(T1)        ;SEE IF SFDS
  3824.     JRST    STOPND            ;NO--GO STORE AND RETURN
  3825.     SETZM    (T4)            ;CLEAR PATH
  3826.     HRLZI    P1,(T4)            ; ..
  3827.     HRRI    P1,1(T4)        ; ..
  3828.     BLT    P1,.PTMAX-1(T4)        ; ..
  3829.     MOVEM    P3,.PTPPN(T4)        ;STORE UFD
  3830.     MOVEI    P1,.FDPAT(T1)        ;POINT TO ARGUMENT SFD
  3831.     MOVSI    P2,-D$MSFD+1        ;COUNT SFDS
  3832.     HRRI    P2,(T4)            ;INDICATE START OF SFD BLOCK
  3833. STOPNS:    SKIPN    P3,(P1)            ;SEE IF DONE
  3834.     JRST    STOPNT            ;YES--FINISH UP
  3835.     MOVEM    P3,.PTPPN+1(P2)     ;NO--STORE IN PATH
  3836.     SETCM    P3,.FDD2M(P1)        ;GET MASK
  3837.     JUMPN    P3,.POPJ##        ;ERROR IF WILD
  3838.     AOJ    P1,            ; Advane to the next
  3839.     AOBJN    P2,STOPNS        ;LOOP UNTIL DONE
  3840. STOPNT:    MOVEI    P3,(T4)            ;INDICATE SFD
  3841. STOPND:    MOVEM    P3,.RBPPN(T3)        ;SET INTO LOOKUP
  3842.     JRST    .POPJ1##        ;SKIP RETURN
  3843. >; End of TOPS10 conditional
  3844.     SUBTTL    File processing -- FILE%CLOSE
  3845.  
  3846. ;+
  3847. ;.hl1 FILE%CLOSE
  3848. ;This routine will close the file that is currently open.
  3849. ;-
  3850.  
  3851. BLSRTN(FILE%CLOSE,<ABTFLG>)
  3852.     $SAVE    <TF,S2>            ; Save a few registers
  3853.     MOVE    S2,ABTFLG        ; Get the abort flag
  3854.     MOVEI    S1,FIL            ; Get the channel
  3855.     TXNN    S2,BLSTRU        ; Want to punt file?
  3856.      JRST    FILCL2            ; No, go close it
  3857.     RESDV.    S1,            ; Kill the channel
  3858.      JFCL                ; Ignore error
  3859.     JRST    FILCL3            ; Go return buffer space
  3860.  
  3861. ; Here if we want to close the file normally
  3862.  
  3863. FILCL2:    RELEASE    FIL,            ; Release the file channel (OK if already RESDV.'ed)
  3864.  
  3865. FILCL3:    MOVE    S1,FBFSIZ        ; Get the size of the buffers
  3866.     MOVE    S2,FBFADR        ; Get the address of them
  3867.     $CALL    M%RMEM            ; Return the memory to the OTS
  3868.     BLSRET    NORMAL            ; Give a good return
  3869.     SUBTTL    File processing -- NEXT%FILE
  3870.  
  3871. ;+
  3872. ;.hl1 NEXT%FILE
  3873. ;This routine will advance to the wild card file.
  3874. ;-
  3875.  
  3876. BLSRTN(NEXT%FILE)
  3877.     $SAVE    <S2,TF>            ; Save some registers
  3878.     $SAVE    <T1,T2,T3,T4>        ; That will be used
  3879.     $SAVE    <P1>            ; Save the flag
  3880.     SETO    P1,            ; Flag from here
  3881.     PJRST    OPNREA            ; Open attempting to read the next file
  3882.     SUBTTL    File processing -- GET%FILE - Get a byte
  3883.  
  3884. ;+
  3885. ;.hl1 GET%FILE(Character)
  3886. ;This routine will input a character from the file.  It will then store
  3887. ;the character in the address that is passed to it.
  3888. ;.literal
  3889. ;
  3890. ; Usage:
  3891. ;    GET%FILE (Character);
  3892. ;
  3893. ;.end literal
  3894. ;-
  3895.  
  3896. BLSRTN(GET%FILE,<CHARACTER>)
  3897. TOPS10<
  3898.  
  3899. GETFI2:    SOSGE    BH+.BFCNT        ; Decrement the count
  3900.       JRST    GETFI0            ; Need a new buffer
  3901.     ILDB    S1,BH+.BFPTR        ; Get a character
  3902.     MOVEM    S1,@CHARACTER        ; Store the character
  3903.     MOVE    S1,CURFTP        ; Get the file type
  3904.     CAXE    S1,$FBS36        ;[127][136] Is this 36 bit?
  3905.      BLSRET    NORMAL            ; Give a good return
  3906.     MOVE    S1,BH+.BFPTR        ; Get the buffer pointer
  3907.     TXNE    S1,<FLD(76,BP.POS)>    ; Is this the end?
  3908.      BLSRET    NORMAL            ; No, just return
  3909.     MOVE    S1,@BH+.BFPTR        ; Get the full work
  3910.     TRNN    S1,1            ; LSA bit on?
  3911.      BLSRET    NORMAL            ; No, just return
  3912.     MOVX    S1,200            ; Turn on the high order bit
  3913.     IORM    S1,@CHARACTER        ; . . .
  3914.     BLSRET    NORMAL            ; And return to the caller
  3915.  
  3916. ; Here to get a new buffer
  3917.  
  3918. GETFI0:    IN    FIL,            ; Get the next buffer
  3919.       JRST    GETFI2            ; Loop
  3920.     GETSTS    FIL,S1            ; Get the status
  3921.     TXNN    S1,IO.EOF        ; End of file?
  3922.       JRST    GETFI1            ; No, an error
  3923.     BLSRET    EOF            ; Yes, return end of file
  3924.  
  3925. GETFI1:    KERERR    (<Input error, status = ^O60/S1/>)
  3926.     BLSRET    RMS32            ; Close enough
  3927.  
  3928. >; End of TOPS10 conditional
  3929.     SUBTTL    File processing -- PUT%FILE - Store a byte
  3930.  
  3931. ;+
  3932. ;.hl1 PUT%FILE(Character)
  3933. ;This routine will store a character into the file.  It will then
  3934. ;return to the caller.
  3935. ;.literal
  3936. ;
  3937. ; Usage:
  3938. ;    PUT%FILE(Character);
  3939. ;
  3940. ;.end literal
  3941. ;-
  3942.  
  3943. BLSRTN(PUT%FILE,<CHARACTER>)
  3944.     $SAVE    <S2>            ; Save a register
  3945. TOPS10<
  3946. PUTFI1:    SOSGE    BH+.BFCNT        ; Decrement the count
  3947.       JRST    PUTFI0            ; Need to dump the buffer
  3948.     MOVE    S1,CHARACTER        ; Get the character
  3949.     IDPB    S1,BH+.BFPTR        ; Store the character
  3950.     MOVE    S2,FILTYP        ; Get the file type
  3951.     CAXN    S2,$FBS36        ;[127][136] 36 bit?
  3952.      TRNN    S1,200            ;[136] Yes, is the high order bit on?
  3953.       BLSRET NORMAL            ; No, Give a good return
  3954.     MOVX    S2,<FLD(76,BP.POS)>    ; Is this word aligned?
  3955.     TDNE    S2,BH+.BFPTR        ; . . .
  3956.      BLSRET    NORMAL            ; No, just return
  3957.     MOVEI    S1,1            ; Yes, light the LSA bit
  3958.     IORM    S1,@BH+.BFPTR        ; in the output
  3959.     BLSRET    NORMAL            ; Just return
  3960.  
  3961. ; Here to dump the buffer into the file.
  3962.  
  3963. PUTFI0:    OUT    FIL,            ; Dump the buffer
  3964.       JRST    PUTFI1            ; Adjust the buffer header
  3965.     GETSTS    FIL,S1            ; Get the status, it failed
  3966.     KERERR    (<Output error, status = ^O60/S1/>)
  3967.     BLSRET    RMS32            ; Close enough
  3968.     SUBTTL    Support routines -- PRSFIL - Parse a file specification
  3969.  
  3970. ;+
  3971. ;.hl1 PRSFIL
  3972. ;This routine will parse a file specification.  Is assumes that the file
  3973. ;specification is in the following format:
  3974. ;.literal
  3975. ;
  3976. ;    Device:File.Extension[Path]
  3977. ;
  3978. ;.en literal
  3979. ;This routine will accept wild cards in the file names, extensions and the
  3980. ;path specification.
  3981. ;.literal
  3982. ;
  3983. ; Usage:
  3984. ;    S1/ Byte pointer to the string
  3985. ;    S2/ Address to store the information in
  3986. ;    $CALL    PRSFIL
  3987. ;    (Return)
  3988. ;
  3989. ; On a true return:
  3990. ;    - The file specification parsed correctly
  3991. ;
  3992. ; On a false return:
  3993. ;    - Invalid file specification
  3994. ;
  3995. ;.end literal
  3996. ;-
  3997.  
  3998. TOPS10<
  3999. PRSFIL::$SAVE    <P1,P2>            ; Save two registers
  4000.     DMOVE    P1,S1            ; Copy the arguments
  4001.  
  4002.     MOVX    T1,.FDNAT        ; Get the type
  4003.     STORE    T1,.FDLEN(P2),FD.TYP    ; Store this
  4004.     MOVX    T1,.FDSIZ        ; Get the size
  4005.     STORE    T1,.FDLEN(P2),FD.LEN    ; Store this too
  4006.  
  4007.     $CALL    PRSWS$            ; Parse a sixbit item (with wilds)
  4008.     CAIE    S1,":"            ; Device delimiter?
  4009.       JRST    [MOVX    T3,<SIXBIT /DSK/>    ; Use disk
  4010.         MOVEM    T3,.FDSTR(P2)        ; Store it
  4011.         JRST    PRSF.5]            ; Continue processing
  4012.     MOVEM    T1,.FDSTR(P2)        ; Store the device name
  4013. PRSF.1:    $CALL    PRSWS$            ; Input the file name
  4014. PRSF.5:    CAIE    S1,.CHLAB        ; Start of directory?
  4015.      CAIN    S1,"["            ; Normal start of directory?
  4016.       JUMPE    T1,PRSF.4        ; Yes, go handle it if nothing before it
  4017.     MOVEM    T1,.FDNAM(P2)        ; Store the name
  4018.     MOVEM    T2,.FDNMM(P2)        ; And the mask
  4019.     JUMPE    S1,.RETT        ; End of the spec?
  4020.     CAIN    S1,"["            ; Is this a path?
  4021.       JRST    PRSF.4            ; Yes, go get it
  4022.     CAIE    S1,"."            ; Correct delimiter?
  4023.      JRST    PRSF.6            ; No, check for semi-colon (Files-11)
  4024.     $CALL    PRSWS$            ; No, get the extension
  4025.     ANDX    T1,LHMASK        ; Keep only three characters
  4026.     MOVEM    T1,.FDEXT(P2)        ; Store the extension
  4027.     MOVEM    T2,.FDEXM(P2)        ; Store the mask also
  4028.     JUMPE    S1,.RETT        ; End of the spec?
  4029.     CAIE    S1,.CHLAB        ; Also allow angle brackets (in case of dumb terminal)
  4030.      CAIN    S1,"["            ; Start of the path?
  4031.       JRST    PRSD.0            ; Yes, go handle it
  4032.  
  4033.     CAIE    S1,"."            ; Have another dot (TOPS-20)
  4034. PRSF.6:     CAIN    S1,";"            ; Or semi-colon (Files-11)?
  4035.       $RETT                ; Yes, return
  4036.     $RETF                ; No, bad file spec
  4037.  
  4038. ; Here if we have a directory before the file name
  4039.  
  4040. PRSF.4:    PUSHJ    P,PRSD.0        ; Get the directory
  4041.      $RETIF                ; If bad, just give up now
  4042.     JUMPE    S1,.RETT        ; If all done, just return
  4043.     JRST    PRSF.1            ; Otherwise, try again for file name
  4044.  
  4045. ; Here to parse the path specification.
  4046. ; The open bracket has already been read
  4047. ;
  4048. ; Usage:
  4049. ;    S1/ Byte pointer to text
  4050. ;    S2/ Address of FD
  4051. ;    $CALL    PRSDIR
  4052. ;
  4053. ; or
  4054. ;
  4055. ;    P1/ byte pointer to text
  4056. ;    P2/ Address of FD
  4057. ;    $CALL    PRSD.0
  4058. ;
  4059.  
  4060. PRSDIR::$SAVE    <P1,P2>            ; Save two registers
  4061.     DMOVE    P1,S1            ; Copy the arguments
  4062.     $CALL    INPCH$            ; Get a character
  4063.     CAIE    S1,"["            ; Open bracket?
  4064.      CAIN    S1,.CHLAB        ;  Other type?
  4065.       JRST    PRSD.0            ; Good bracket
  4066.        $RETF            ; Error return
  4067. PRSD.0:    MOVX    S2,FD.DIR        ; Get the directory specified bit
  4068.     TDNE    S2,.FDMOM(P2)        ; Directory given yet?
  4069.      TDNN    S2,.FDMOD(P2)        ;  .  .  .
  4070.       JRST    .+2            ; No, all is fine
  4071.        $RETF            ; Yes, punt
  4072.     IORM    S2,.FDMOD(P2)        ; Flag it
  4073.     IORM    S2,.FDMOM(P2)        ; . . .
  4074.     $CALL    PRSOC$            ; Input the programmer number
  4075.     TXNE    T1,LHMASK        ; Anything in the left half?
  4076.      JRST    PRSD.1            ; See if "[-]"
  4077.     HRLM    T1,.FDPPN(P2)        ; Store the directory
  4078.     HRLM    T2,.FDDIM(P2)        ; Store the mask too
  4079.     CAIE    S1,","            ; Good delimiter?
  4080.      $RETF                ; No, bad file spec
  4081.     $CALL    PRSOC$            ; Get the programmer number
  4082.     TXNE    T1,LHMASK        ; Is it valid?
  4083.      $RETF                ; No, very bad
  4084.     HRRM    T1,.FDPPN(P2)        ; Store the programmer number
  4085.     HRRM    T2,.FDDIM(P2)        ; And the mask
  4086.     JUMPE    S1,.RETT        ; If nothing else, just return
  4087.     CAIE    S1,.CHRAB        ; Allow angle bracket end
  4088.      CAIN    S1,"]"            ; Valid end?
  4089.       $RETT                ; Yes, all done with directory
  4090.     CAIE    S1,","            ; SFDs coming?
  4091.      $RETF                ; No, Give a failure return
  4092.  
  4093. ; Here to loop for all the Sub file directories
  4094.  
  4095.     $SAVE    <P2>            ; Save the pointer here
  4096.     HRLI    P2,-5            ; Make the AOBJN pointer
  4097.     ADDI    P2,.FDPAT        ; Point to the first SFD
  4098.  
  4099. PRSD.2:    $CALL    PRSWS$            ; Parse the SFD name
  4100.     MOVEM    T1,(P2)            ; Store the SFD name
  4101.     MOVEM    T2,.FDD2M(P2)        ; Store the mask also
  4102.     CAIE    S1,","            ; Delimited by a comma?
  4103.       JRST    PRSD.3            ; No, Try for other items
  4104.     AOBJN    P2,PRSD.2        ; Loop for all items
  4105.     $RETF                ; Too many SFDs
  4106.  
  4107. ; Here to check for default directory given by the user.
  4108.  
  4109. PRSD.1:    CAIE    S1,"-"            ; Use default?
  4110.       $RETF                ; No, error
  4111.     MOVX    S2,FD.DFX        ; Use default
  4112.     IORM    S2,.FDMOD(P2)        ; Light it
  4113.     IORM    S2,.FDMOD(P2)        ; . . .
  4114.     $CALL    INPCH$            ; Get the next character
  4115.  
  4116. PRSD.3:    JUMPE    S1,.RETT        ; If finished, just return
  4117.     CAIE    S1,"]"            ; Valid end?
  4118.      CAIN    S1,.CHRAB        ; . . .
  4119.       $RETT                ; Give a good return
  4120.     $RETF                ; No, Give a failure return
  4121. >; End of TOPS10 conditional
  4122.     SUBTTL    Support routines -- PRSSX$ - Parse a sixbit field
  4123.  
  4124. ;+
  4125. ;.hl1 PRSSX$
  4126. ;This routine will arse a non:wild sixbit field.  It will return the value
  4127. ;in T1.
  4128. ;.literal
  4129. ;
  4130. ; Usage:
  4131. ;    P1/ Byte pointer
  4132. ;    $CALL    PRSSX$
  4133. ;    (Return)
  4134. ;
  4135. ; On return:
  4136. ;    S1/ Delimiter character
  4137. ;    T1/ Sixbit token
  4138. ;
  4139. ;.end literal
  4140. ;-
  4141.  
  4142. TOPS10<
  4143. PRSSX$:    SETZ    T1,            ; Clear the destination
  4144.     MOVE    S2,[POINT 6,T1]        ; Gget the byte pointer
  4145.  
  4146. PRSS.0:    $CALL    INPCH$            ; Input a character
  4147.     $CALL    CHKAL$            ; Check to see if alphanumeric
  4148.     $RETIF                ; Return if it is not
  4149.     SUBI    S1,"A"-'A'        ; Convert to sixbit
  4150.     TRNN    T1,77            ; Finished?
  4151.      IDPB    S1,S2            ; No, Store the character
  4152.     JRST    PRSS.0            ; Loop for more
  4153. >; End of TOPS10 conditional
  4154.     SUBTTL    Support routines -- PRSWS$ - Parse a wild sixbit field
  4155.  
  4156. ;+
  4157. ;.hl1 PRSWS$
  4158. ;This routine will parse a wild sixbit field.  It will only accept
  4159. ;the following types of wild cards:
  4160. ;.literal
  4161. ;    *    - All wild
  4162. ;    xxx*    - Remainder of the field wild
  4163. ;    XXX???    - Same as above
  4164. ;    XXX%%%    - Same as above
  4165. ;    XXX%XX    - Single wild character
  4166. ;    XXX?XX    - Same as above
  4167. ;
  4168. ; Usage:
  4169. ;    P1/ Byte pointer to the string to parse
  4170. ;    $CALL    PRSWS$
  4171. ;    (Return)
  4172. ;
  4173. ; On return:
  4174. ;    S1/ Delimiter character
  4175. ;    T1/ Sixbit token
  4176. ;    T2/ Mask for the item
  4177. ;
  4178. ;.end literal
  4179. ;-
  4180.  
  4181. TOPS10<
  4182. PRSWS$:    SETZ    T1,            ; Clear where we are storing them
  4183.     SETO    T2,            ; Assume not wild
  4184.     MOVE    T3,[POINT 6,T1]        ; Byte pointer to the name
  4185.     MOVE    T4,[POINT 6,T2]        ; And to the mask
  4186.  
  4187. PRSW.0:    $CALL    INPCH$            ; Input the first character
  4188.     $CALL    CHKAL$            ; Check to see if alphanumeric
  4189.      JUMPF    PRSW.1            ; See if a wild card
  4190.     MOVX    S2,-1            ; Get the mask to store
  4191. PRSW.3:    SUBI    S1,"A"-'A'        ; Convert to sixbit
  4192.     TRNE    T1,77            ; Finished?
  4193.       JRST    PRSW.0            ; Yes, loop eating characters
  4194.     IDPB    S1,T3            ; Store the character
  4195.     IDPB    S2,T4            ; Store the mask
  4196.     JRST    PRSW.0            ; Loop back for more characters
  4197.  
  4198. ; Here if the character is not an alphanumeric.  Check for single character
  4199. ; wild cards and the remainder of the word wildcards
  4200.  
  4201.  
  4202. PRSW.1:    CAIE    S1,"?"            ; Is it valid single character
  4203.      CAIN    S1,"%"            ;  wild card?
  4204.       SKIPA                ; Yes, Keep going
  4205.     JRST    PRSW.2            ; No, Try for full word
  4206.     SETZ    S2,            ; Clear the mask
  4207.     JRST    PRSW.3            ; Store the byte
  4208.  
  4209. ; Here if we are to check to see if the remainder of thw word is to be wild
  4210.  
  4211. PRSW.2:    CAIE    S1,"*"            ; Remainder wild?
  4212.      JRST    PRSW.5            ; Go skip bad characters
  4213.     MOVEI    S1,'*'            ; Make it a sixbit *
  4214.     TXNE    T3,BP.POS        ; Filled?
  4215.      IDPB    S1,T3            ; No, Store the wild character
  4216.     SETZ    S1,            ; Clear the character
  4217.     TXNE    T4,BP.POS        ; Done?
  4218. PRSW.4:     IDPB    S1,T4            ; No, clear the mask character
  4219.     TXNE    T4,BP.POS        ; Done yet?
  4220.      JRST    PRSW.4            ; No, keep clearing things
  4221.     $CALL    INPCH$            ; Get the next character
  4222.                     ; And eat any extra characters
  4223.  
  4224. ; Here for a character which is not a valid part of a sixbit thing.
  4225. ;We will skip any characters which are not break characters for some field
  4226. ;of the filename.
  4227.  
  4228. PRSW.5:    JUMPE    S1,.RETT        ; If null, all done
  4229.     CAIE    S1,"["            ; Open bracket?
  4230.      CAIN    S1,"]"            ; Or close?
  4231.       $RETT                ; Yes, just return
  4232.     CAIE    S1,"."            ; Start of extension?
  4233.      CAIN    S1,","            ; Or directory element delimeter?
  4234.       $RETT                ; Yes, good break character
  4235.     CAIN    S1,":"            ; End of device name?
  4236.      $RETT                ; Yes, return now
  4237.     JRST    PRSW.0            ; And try again
  4238. >; End of TOPS10 conditional
  4239.     SUBTTL    Support routines -- CHKAL$ - Check for alphanumeric
  4240.  
  4241. ;+
  4242. ;.hl1 CHKAL$
  4243. ;This routine will check to see if the character specified is an alphanumeric
  4244. ;character.
  4245. ;.literal
  4246. ;
  4247. ; Usage:
  4248. ;    S1/ Character to check
  4249. ;    $CALL    CHKAL$
  4250. ;    (Return)
  4251. ;
  4252. ; On a true return:
  4253. ;    S1/ Upper case A to Z or 0 to 9.
  4254. ;
  4255. ; On a false return:
  4256. ;    S1/ Non-alphanumeric character
  4257. ;
  4258. ;.end literal
  4259. ;-
  4260.  
  4261. TOPS10<
  4262. CHKAL$:    CAIL    S1,"0"            ; Numeric?
  4263.      CAILE    S1,"9"            ; . . .
  4264.       SKIPA                ; No, Continue
  4265.     $RETT                ; Yes, Give a true return
  4266.  
  4267.     CAIL    S1,"A"            ; Upper case?
  4268.      CAILE    S1,"Z"            ; . . .
  4269.       SKIPA                ; No, Continue
  4270.     $RETT                ; Yes, Give a good return
  4271.  
  4272.     CAIL    S1,"a"            ; Lower case?
  4273.      CAILE    S1,"z"            ; . . .
  4274.       $RETF                ; No, Give a failure return
  4275.     MOVEI    S1,"A"-"a"(S1)        ; Convert to upper case
  4276.     $RETT                ; Give a good return
  4277. >; End of TOPS10 conditional
  4278.     SUBTTL    Support routines -- PRSOC$ - Parse a wild octal number
  4279.  
  4280. ;+
  4281. ;.hl1 PRSOC$
  4282. ;This routine will parse a wild octal number.  It will accept either
  4283. ;question mark (?) or percent sign (%) as the single wild card characters.
  4284. ;.literal
  4285. ;
  4286. ; Usage:
  4287. ;    P1/ Byte pointer
  4288. ;    $CALL    PRSOC$
  4289. ;    (Return)
  4290. ;
  4291. ; On return:
  4292. ;    T1/ Number (Right half only)
  4293. ;    T2/ Mask
  4294. ;
  4295. ;.end literal
  4296. ;-
  4297.  
  4298. TOPS10<
  4299. PRSOC$:    SETZB    T1,T2            ; Clear the number and the mask
  4300.     $CALL    INPCH$            ; Get the first character
  4301.     CAIN    S1,"*"            ; Full wild-card?
  4302.      $RETT                ; Yes, all done
  4303.     SOJA    T2,PRSO.3        ; No, go check other possibilities
  4304.  
  4305. PRSO.0:    $CALL    INPCH$            ; Get a character
  4306. PRSO.3:    CAIL    S1,"0"            ; Within range?
  4307.      CAILE    S1,"7"            ; . . .
  4308.       JRST    PRSO.1            ; No, check for wilds
  4309.     MOVX    S2,7            ; Flag not wild
  4310.  
  4311. PRSO.2:    LSH    T1,3            ; Move this over a digit
  4312.     LSH    T2,3            ; And the mask
  4313.     ADDI    T1,-"0"(S1)        ; Fill in this character
  4314.     TDO    T2,S2            ; Get the mask item
  4315.     JRST    PRSO.0            ; Loop for all the digits
  4316.  
  4317. PRSO.1:    CAIE    S1,"?"            ; Question mark?
  4318.      CAIN    S1,"%"            ; Or a percent?
  4319.       SKIPA                ; Yes, Continue
  4320.     $RETT                ; No, Return to the user
  4321.  
  4322.     SETZ    S2,            ; Clear the mask item
  4323.     MOVEI    S1,"0"            ; Use a zero
  4324.     JRST    PRSO.2            ; Loop all digits
  4325. >; End of TOPS10 conditional
  4326.     SUBTTL    Support routines -- INPCH$ - Input a character
  4327.  
  4328. ;+
  4329. ;.hl1 INPCH$
  4330. ;This routine will input a single character.  It will cause any extranous
  4331. ;bits to be remoted.  It will return the character in S1.
  4332. ;.literal
  4333. ;
  4334. ; Usage:
  4335. ;    P1/ Byte pointer
  4336. ;    $CALL    INPCH$
  4337. ;    (Return)
  4338. ;
  4339. ; On a true return:
  4340. ;    S1/ Character input
  4341. ;
  4342. ; On a false return:
  4343. ;    S1/ Null
  4344. ;
  4345. ;.end literal
  4346. ;-
  4347.  
  4348. TOPS10<
  4349. INPCH$:    ILDB    S1,P1            ; Get a character
  4350.     ANDX    S1,177            ; Clear the junk
  4351.     JUMPE    S1,.RETF        ; Return if this is zero
  4352.     $RETT                ; Give a good return
  4353. >; End of TOPS10 conditional
  4354.     SUBTTL    Packet count processing -- XFR%STATUS
  4355.  
  4356. ;+
  4357. ;.hl1 XFR%STATUS
  4358. ;This routine will handle the status that must be displayed on the user
  4359. ;terminal for the udpated counts of the packets and NAKs.
  4360. ;.LITERAL
  4361. ;
  4362. ; Usage:
  4363. ;    XFR_STATUS (Type, Sub-type);
  4364. ;
  4365. ;.end literal
  4366. ;.ls
  4367. ;.LE;Type - "S" or "R" for either Send or Receive.
  4368. ;.LE;Sub-type - "P" or "N" for either packet or NAK.
  4369. ;.els
  4370. ;-
  4371.  
  4372. BLSRTN(XFR%STATUS,<SUBTYPE,TYPE>)
  4373.     $SAVE    <TF,S1,S2>        ; Save a few registers
  4374.     $SAVE    <T1,T2,T3,T4>        ; . . .
  4375.     $CALL    T$LOCAL            ; Is this a local terminal?
  4376.       $RETIT            ; No, just skip this
  4377.  
  4378.     MOVE    TF,TY%PKT##        ; Want to type the packet information?
  4379.     TXNN    TF,BLSTRU        ; Want type out?
  4380.      $RETT                ; No, all done
  4381.  
  4382.     MOVE    T1,SUBTYPE        ; Get the sub type
  4383.     MOVEI    S1,0            ; Assume send packet
  4384.     CAIN    T1,"N"            ; Is this a NAK?
  4385.      MOVEI    S1,1            ; Yes, use NAK offset
  4386.     MOVE    T1,TYPE            ; Get the type now
  4387.     CAIN    T1,"R"            ; Is this receive
  4388.       MOVEI    S1,2(S1)        ; Yes, add in the other offset
  4389.     $TEXT    (,< ^T/PKTTXT(S1)/^D/@PKTCNT(S1)/^A>)
  4390.     $RET                ; Just return to the caller
  4391.  
  4392. DEFINE    PKTITM,<
  4393. PKT    S,SND%COUNT##
  4394. PKT    SN,SMSG%NAK##
  4395. PKT    R,RCV%COUNT##
  4396. PKT    RN,RMSG%NAK##
  4397. >; End of PKTITM
  4398.  
  4399. DEFINE    PKT(A,B)<ASCII /A/>
  4400. PKTTXT:    PKTITM
  4401. DEFINE    PKT(A,B)<EXP    B>
  4402. PKTCNT:    PKTITM
  4403.     SUBTTL    Terminal processing -- Message routines -- Initialization
  4404.  
  4405. ;+
  4406. ;.hl1 INITRM
  4407. ;This routine will initialize the terminal processing.  It will get the
  4408. ;line number for the command terminal.
  4409. ;.literal
  4410. ;
  4411. ; Usage:
  4412. ;    $CALL    INITRM
  4413. ;    (Return)
  4414. ;
  4415. ;
  4416. ; On a true return:
  4417. ;    - Terminal line number set up
  4418. ;
  4419. ;.end literal
  4420. ;-
  4421.  
  4422. INITRM:    MOVX    S2,JI.TNO        ; Get terminal number
  4423.     SETO    S1,            ;  for this job
  4424.     $CALL    I%JINF            ; Get it
  4425. TOPS20<
  4426.     MOVEM    S2,XFRTRM+$TTLIN    ; Store the line to use
  4427.     MOVEM    S2,MYTERM+$TTLIN    ; Store here also
  4428. >; End of TOPS20 conditional
  4429. TOPS10<
  4430.     PUSH    P,S2            ; Save this
  4431.     $TEXT    (<-1,,.TEMP>,<TTY^O/S2/^0>) ; Get the text
  4432.     HRROI    S1,.TEMP        ; Point to the location
  4433.     $CALL    S%SIXB            ; Convert to sixbit
  4434.     MOVEM    S2,MYTERM+$TTDEV    ; Store here
  4435.     MOVEM    S2,XFRTRM+$TTDEV    ; And also here
  4436.     POP    P,S2            ; Restore S2
  4437.     ADDI    S2,.UXTRM        ; Convert to a UDX
  4438.     GTNTN.    S2,            ; Get the node and line number
  4439.      SUBI    S2,.UXTRM        ; Can only fail because no network support
  4440.     HRRZM    S2,XFRTRM+$TTLIN    ; Store the line number
  4441.     HLRZM    S2,XFRTRM+$TTNOD    ; Store the node number
  4442.     HRRZM    S2,MYTERM+$TTLIN    ; Store the line number
  4443.     HLRZM    S2,MYTERM+$TTNOD    ; Store the node number
  4444.  
  4445.     MOVX    S1,%CNTIC        ; Get the number of jiffies per second
  4446.     GETTAB    S1,            ; From the monitor
  4447.       MOVX    S1,^D60            ; Assume 60
  4448.     MOVEM    S1,JIFSEC        ; Store for later use
  4449.  
  4450. ; Now check if we have a logical device KERMIT:.  If we do, that is our default
  4451. ;transfer device.
  4452.  
  4453.     MOVX    S1,<SIXBIT |KERMIT|>    ; Get the name
  4454.     DEVNAM    S1,            ; Check if it exists
  4455.      JRST    INIT.1            ; No, leave things as they are
  4456.     MOVE    S2,S1            ; Get a copy
  4457.     DEVCHR    S2,            ; Make sure it is a terminal
  4458.     TXNN    S2,DV.TTY        ; Is it?
  4459.      JRST    [$KERR (Device KERMIT: is not a terminal, using TTY: instead)
  4460.         JRST    INIT.1]        ; Just continue using console
  4461.     MOVEM    S1,XFRTRM+$TTDEV    ; And also here
  4462.     IONDX.    S1,            ; Get the UDX for the terminal
  4463.      JRST    INIT.1            ; Should never fail, since DEVCHR worked
  4464.     GTNTN.    S1,            ; Get the node and line number
  4465.      SUBI    S1,.UXTRM        ; Can only fail because no network support
  4466.     HRRZM    S1,XFRTRM+$TTLIN    ; Store the line number
  4467.     HLRZM    S1,XFRTRM+$TTNOD    ; Store the node number
  4468. INIT.1:
  4469. >; End of TOPS10 conditional
  4470.  
  4471.     SETZM    LCLECH            ; Default is no local echo
  4472.     MOVX    S1,$XXDEF        ;[127] Get default for XON-XOFF
  4473.     MOVEM    S1,XXPMOD        ;[127] and store it
  4474.     $RETT                ; Return to the caller
  4475.     SUBTTL    Terminal processing -- Message routines -- Open the terminal
  4476.  
  4477. ;+
  4478. ;.hl1 OPNTRM
  4479. ;This routine will open the terminal that has been sepecified or the
  4480. ;the command terminal if none has been specified.
  4481. ;.literal
  4482. ;
  4483. ; Usage:
  4484. ;    $CALL    OPNTRM
  4485. ;    (Return)
  4486. ;
  4487. ; On a true return:
  4488. ;    - Terminal open
  4489. ;
  4490. ; On a false return:
  4491. ;    - Terminal not open, error message issued.
  4492. ;
  4493. ;.end literal
  4494. ;-
  4495.  
  4496. OPNTRM:
  4497. TOPS10<
  4498.     $SAVE    <P1>            ; Save P1
  4499.     MOVEI    P1,XFRTRM        ; Point to the transfer terminal info
  4500.     CLOSE    TTY,            ; Just close incase it was open
  4501.                     ; (KLUDGE, since we can not get the
  4502.                     ;  terminal number GLXLIB is using
  4503.                     ;  and we should process commands after
  4504.                     ;  a send/receive)
  4505.     MOVE    S1,P1            ; Get the address
  4506.     $CALL    T$OPEN            ; Open the terminal
  4507.     $RETIF                ; Return if that failed
  4508.  
  4509.     MOVE    S1,RCV%EOL##        ; Get the end of line character
  4510.     MOVE    S2,S1            ; Get a copy
  4511.     LSH    S2,^D9            ; Up nine bits
  4512.     TRO    S1,^O200(S2)        ; Break even if parity on
  4513.     MOVE    S2,P1            ; Get the address of the control block
  4514.     $CALL    T$SBRK            ; Set the break set
  4515.  
  4516.     MOVX    T1,BLSTRU        ; Assume it is
  4517.     MOVE    S1,$TTLIN(P1)        ; Get this terminal line number
  4518.     MOVE    S2,$TTNOD(P1)        ; Get the node number
  4519.     CAMN    S1,MYTERM+$TTLIN    ; Is this the same?
  4520.      CAME    S2,MYTERM+$TTNOD    ; . . .
  4521.       MOVX    T1,BLSFAL        ; No, false
  4522.     MOVEM    T1,CONNECT%FLAG##    ; Store the flag
  4523.  
  4524. ; Now clear the terminal input buffer.  This will allow us to dump any NAKs
  4525. ; that were sent by the remote server into the bit bucket and not confuse
  4526. ; the protocol.
  4527.  
  4528.     MOVX    T1,.TOCIB        ; Clear the input buffer
  4529.     MOVE    T2,$TTUDX(P1)        ; Get the UDX
  4530.     MOVX    S1,[XWD 2,T1]        ; Point to the argument
  4531.     TRMOP.    S1,            ; Clear the input buffer
  4532.       JFCL                ; Don't care
  4533.  
  4534. ; Now open any debugging log file
  4535.  
  4536.     MOVE    T1,DBGLOG+$LGFLG    ; Get flags for debug file
  4537.     TXNN    T1,LG$SET        ; Check if file is set
  4538.      $RETT                ; No, nothing to open
  4539.     MOVX    S1,FOB.MZ        ; Get length of FOB
  4540.     MOVEI    S2,DBGLOG+$LGFOB    ; Point at FOB
  4541.     TXNE    T1,LG$APP        ; Want to append to file?
  4542.      $CALL    F%AOPN            ; Yes, do it
  4543.     TXON    T1,LG$APP        ; Next time we will want to append
  4544.      $CALL    F%OOPN            ; Even if we created file this time
  4545.     MOVEM    S1,DBGLOG+$LGIFN    ; Save the IFN
  4546.     TXO    T1,LG$OPN        ; Flag file is open
  4547.     MOVEM    T1,DBGLOG+$LGFLG    ; Save new flags
  4548.     $RETIT                ; If we got the file open, continue
  4549.     $KERR    (<Cannot open debugging log file ^F/DBGLOG+$LGFD/ - ^E/S1/>)
  4550.     SETZM    DBGLOG+$LGFLG        ; Ignore log file from now on
  4551.     $RETT                ; Give a good return
  4552.  
  4553. ; Here to reset the terminal for commands (KLUDGE for GLXLIB)
  4554.  
  4555. OCTERM:    MOVX    S1,1B0!1B1        ;[136] Open controlling terminal in image mode
  4556.     PJRST    K%OPEN##        ;[136] and go re-open the terminal
  4557. ;[136];    $RETT                ;[135] Skip this for now. It appears
  4558. ;[136];                    ;[135] that GLXLIB has been fixed.
  4559.     MOVX    T1,IO.SYN!.IOASC!IO.SUP    ; Get the mode
  4560.     MOVE    T2,$TTDEV+MYTERM    ; Get my terminal name
  4561.     SETZ    T3,            ; Clear this
  4562.     OPEN    TTY,T1            ; Open the terminal
  4563.       JFCL                ; Don't care
  4564.     $RETT                ; Give a good return
  4565. >; End of TOPS10 conditional
  4566.     SUBTTL    Terminal processing -- Message routines -- Close the terminal
  4567.  
  4568. ;+
  4569. ;.hl1 CLSTRM
  4570. ;This routine will close the terminal that has been opened by OPNTRM.
  4571. ;.literal
  4572. ;
  4573. ; Usage:
  4574. ;    $CALL    CLSTRM
  4575. ;    (Return)
  4576. ;
  4577. ;.end literal
  4578. ;-
  4579.  
  4580. CLSTRM:    MOVEI    S1,XFRTRM        ; Point to the transfer terminal info
  4581.     $CALL    T$CLOS            ; Close the terminal
  4582.     MOVX    S1,BLSFAL        ; Get the false value
  4583.     EXCH    S1,CONNECT%FLAG##    ; Store it
  4584.  
  4585. TOPS10<
  4586.     CAIN    S1,BLSTRU        ; Was it true?
  4587.      $CALL    OCTERM            ; Open the command terminal again
  4588. >; End of TOPS10 conditional
  4589. ;
  4590. ; Close the debugging log (if any)
  4591.  
  4592.     MOVE    T1,DBGLOG+$LGFLG    ; Get the flags
  4593.     TXZN    T1,LG$OPN        ; File open?
  4594.      $RETT                ; No, just return
  4595.     MOVEM    T1,DBGLOG+$LGFLG    ; Save new flags
  4596.     MOVE    S1,DBGLOG+$LGIFN    ; Yes, get the IFN
  4597.     $CALL    F%REL            ; Close the file
  4598.     $RETT                ; And return
  4599.     SUBTTL    Terminal processing -- Message routines -- Send a message
  4600.  
  4601. ;+
  4602. ;.hl1 SEND
  4603. ;This routine will send a message to the remote Kermit.  It is called with
  4604. ;the address of the message and the length of it.
  4605. ;.literal
  4606. ;
  4607. ; Usage:
  4608. ;    SEND(Address, Length);
  4609. ;
  4610. ;.end literal
  4611. ;-
  4612.  
  4613. BLSRTN(SEND,<MSGLEN,MSGADR>)
  4614.     $SAVE    <TF,S2,T1,T2>        ; Save some registers
  4615.  
  4616. ;[112] First clear the input buffer to dump any junk which showed up since
  4617. ;[112] we last received a message.
  4618.  
  4619.     MOVX    T1,.TOCIB        ;[112] Clear input buffer function
  4620.     MOVE    T2,XFRTRM+$TTUDX    ;[112] Get the UDX for the transfer terminal
  4621.     MOVE    S1,[XWD 2,T1]        ;[112] Point at arguments
  4622.     TRMOP.    S1,            ;[112] Clear the buffer
  4623.      CLRBFI                ;[112] Assume using console terminal
  4624.     MOVE    T1,MSGADR        ; Get the address of the message
  4625.     HRLI    T1,(POINT 8)        ; Point to it
  4626.     MOVE    T2,MSGLEN        ; Get a copy of the message length
  4627.  
  4628. SEND0:    SOJL    T2,SEND1        ; Finished?
  4629.     ILDB    S1,T1            ; No, get a character
  4630.     XMOVEI    S2,XFRTRM        ; Point to the information block
  4631.     $CALL    T$COUT            ; Output the character
  4632.     JUMPT    SEND0            ; True return, try for the next character
  4633.  
  4634. SEND2:    MOVE    S2,$TTIOS+XFRTRM    ; Get the status
  4635.     TXNE    S2,IO.ERR        ; Any errors?
  4636.       JRST    SEND4            ; Yes, handle it
  4637.     SETZ    S2,            ; Clear this
  4638.     HIBER    S2,            ; Wait until done
  4639.       JFCL                ; Don't care
  4640.     JRST    SEND2            ; Try again
  4641.  
  4642. SEND1:    XMOVEI    S2,XFRTRM        ; Point to the block
  4643.     $CALL    T$DMPO            ; Dump the character output buffer
  4644.     JUMPT    [BLSRET NORMAL]        ; Give a good return
  4645.  
  4646.     MOVE    S2,$TTIOS+XFRTRM    ; Get the IO status
  4647.     TXNN    S2,IO.ERR        ; Any errors?
  4648.       JRST    [SETZ    S2,            ; No, just sleep a little
  4649.         HIBER    S2,            ; . . .
  4650.           JFCL                ; Don't care about errors
  4651.         JRST    SEND1]            ; Try again
  4652.  
  4653. ; Here if there was an error
  4654.  
  4655. SEND4:    KERERR    (<Output error, status ^O60/S2/>)
  4656.     BLSRET    SNDERR            ; Return the error
  4657.     SUBTTL    Terminal processing -- Message routines -- Wait for turnaround
  4658.  
  4659. ;+
  4660. ;.hl1 IBM%WAIT
  4661. ; This routine will wait for the turnaround character from the line.
  4662. ;.literal
  4663. ;
  4664. ; Usage:
  4665. ;    STATUS = IBM_WAIT();
  4666. ;
  4667. ;.end literal
  4668. ;-
  4669.  
  4670.     BLSRTN(IBM%WAIT)
  4671.     $SAVE    <TF,S2>            ; Save the temps
  4672. IBMW.0:    XMOVEI    S2,XFRTRM        ; Point to the argument block
  4673.     $CALL    T$CIN            ; Attempt to read a character
  4674.     JUMPT    IBMW.1            ; If we got a character, check it out
  4675.     $CALL    RECEIE            ; Check out possible error
  4676.     TXNN    S1,BLSTRU        ; Still ok?
  4677.      JRST    [CAXN    S1,TIMEOUT    ; No, time out?
  4678.           MOVX    S1,NORMAL    ; Yes, pretend all ok
  4679.         $RET]            ; And return
  4680. IBMW.1:    ANDX    S1,177            ; Strip parity bit
  4681.     CAME    S1,IBM%CHAR##        ; This the turnaround character?
  4682.      JRST    IBMW.0            ; No, try again
  4683.  
  4684.     BLSRET    NORMAL            ; Give good return
  4685.     SUBTTL    Terminal processing -- Message routines -- Receive a message
  4686.  
  4687. ;+
  4688. ;.hl1 RECEIVE
  4689. ;This routine will receive a message from the remote Kermit.  This routine
  4690. ;will time out if the message is not received in the correct number of
  4691. ;seconds.
  4692. ;.literal
  4693. ;
  4694. ; Usage:
  4695. ;    RECEIVE(Address, Length);
  4696. ;
  4697. ;.end literal
  4698. ;-
  4699.  
  4700. BLSRTN(RECEIVE,<MSGLEN,MSGADR>)
  4701.     $SAVE    <TF,S2>
  4702.     $SAVE    <T1,T2,T3,T4>        ; Save a few registers
  4703. TOPS10<
  4704.     $CALL    SETTMR            ; Set the timer
  4705.  
  4706. RECEI0:    SETZM    @MSGLEN            ; Clear the count of characters
  4707.     MOVE    T1,MSGADR        ; Get the address to store into
  4708.     HRLI    T1,(POINT 8)        ; Build a byte pointer to it
  4709.     $CALL    RECSUB            ; Get a character
  4710.      $RETIF                ; Give up if failed
  4711.     ANDI    S1,^O177        ; Strip parity bit (if still there)
  4712.     MOVE    S2,S1            ; Get a copy of the character
  4713.     CAMN    S2,RCV%SOH##        ; Start of header character?
  4714.      JRST    RECEI1            ; Yes, go store it
  4715.     CAIE    S2,.CHCNC        ; Control-C?
  4716.      JRST    RECEI0            ; Not a character we are interested in,
  4717.  
  4718. RECEIC:    $CALL    RECSUB            ; Get a character
  4719.      $RETIF                ; Give up on failure
  4720.     ANDI    S1,^O177        ; Strip the parity bit
  4721.     MOVE    S2,S1            ; Get a copy
  4722.     CAMN    S2,RCV%SOH##        ; Start of packet?
  4723.      JRST    RECEI1            ; Yes, go read the packet
  4724.     CAIE    S2,.CHCNC        ; Control-C?
  4725.      JRST    RECEI0            ; No, just eat it
  4726.     BLSRET    ABORTED            ; Yes, give up
  4727.  
  4728.  
  4729. RECEI1:    IDPB    S1,T1            ; Store the character
  4730.     AOS    S1,@MSGLEN        ; Increment the count
  4731.     CAIL    S1,MAX%MSG##        ; Fill entire buffer?
  4732.      JRST    RECEIN            ; Yes, give good return
  4733.     CAIN    S2,.CHCNC        ; Control-C?
  4734.      JRST    RECEIC            ; Yes, go see if we get a second
  4735.     CAME    S2,RCV%EOL        ; End of line character?
  4736.      JRST    RECEI2            ; No, get another character
  4737.  
  4738. ; Here to give "normal" return
  4739.  
  4740. RECEIN:    $CALL    CHKKBD            ; Check for keyboard input first
  4741.     BLSRET    NORMAL            ; Then return normal
  4742.  
  4743. RECEI2:    $CALL    RECSUB            ; Get a character
  4744.     $RETIF                ; Just pass back errors
  4745.  
  4746.     MOVE    S2,S1            ; Get copy of character
  4747.     ANDI    S2,^O177        ; Strip parity bit
  4748.     CAME    S2,RCV%SOH##        ; Start of header again?
  4749.      JRST    RECEI1            ; No, go store character
  4750.  
  4751. ; Here if we got a second start of header.  Restart the message
  4752.  
  4753. RECEI3:    SETZM    @MSGLEN            ; Clear the length
  4754.     MOVE    T1,MSGADR        ; Get the address to store into
  4755.     HRLI    T1,(POINT 8)        ; Build a byte pointer to it
  4756.     JRST    RECEI1            ; Go store the SOH
  4757.  
  4758. ; Here if there are not more characters in the input buffer
  4759.  
  4760. RECEIE:    MOVE    S1,XFRTRM+$TTIOS    ; Get the IO status
  4761.     TXNN    S1,IO.ERR        ; Any errors?
  4762.       JRST    RECEIT            ; No, ASYNC blocking
  4763.     KERERR    (<Receive error, status ^O60/S1/>)
  4764.     BLSRET    RECERR            ; Return the value
  4765.  
  4766. ; Here if we are waiting for the input.  TOPS-10 timer processing
  4767.  
  4768. RECEIT:    $CALL    CHKKBD            ; Check for keyboard input
  4769.     SKIPN    SEND%TIMEOUT##        ; Any timeout?
  4770.      JUMPT    [BLSRET TIMEOUT]    ; No, pretend we just timed out
  4771.     MOVX    T3,%CNSUP        ; Get the system uptime
  4772.     GETTAB    T3,            ; . . . .
  4773.       JFCL                ; Failed?
  4774.     CAML    T3,TIMLIM        ; Output of time?
  4775.      BLSRET    TIMEOUT            ; Yes, time out
  4776.     SUB    T3,TIMLIM        ; Get the amount to hibernate
  4777.     IMULX    T3,-^D1000        ; Convert to milliseconds
  4778.     IDIV    T3,JIFSEC        ; . . .
  4779.     CAXLE    T3,^D1000        ; Never wait more than a second
  4780.       MOVX    T3,^D1000        ; (in case monitor screws up)
  4781.     TXO    T3,HB.RIO!HB.RTC!HB.RWJ    ; Wake when I/O done
  4782.     HIBER    T3,            ; Go away
  4783.       JFCL                ; Don't care
  4784.     BLSRET    NORMAL            ; Return OK
  4785.  
  4786.  
  4787. ; Subroutine to get a character and handle timing
  4788.  
  4789. RECSUB:    XMOVEI    S2,XFRTRM        ; Point to the argument block
  4790.     $CALL    T$CIN            ; Attempt to read a character
  4791.     JUMPF    RECS.1            ; If error, go check it out
  4792.     MOVE    S2,PARITY%TYPE##    ; Get the type
  4793.     CAIE    S2,PR%NONE##        ; No parity?
  4794.      ANDI    S1,^O177        ; No, strip parity bit
  4795.     $RET                ; Pass back true return
  4796.  
  4797. RECS.1:    $CALL    RECEIE            ; Check out error
  4798.     TXNN    S1,BLSTRU        ; Some type of error?
  4799.      $RET                ; Yes, give up (passing back failure)
  4800.     JRST    RECSUB            ; Try again
  4801.     SUBTTL    Terminal processing -- Message routines -- Check for keyboard input
  4802.  
  4803. ;+
  4804. ;.HL1 CHKKBD
  4805. ; This routine will check to see if the user has typed an interesting character
  4806. ;on the keyboard (assuming we still have one).
  4807. ; This allows for aborting the current file or an entire stream.
  4808. ;.literal
  4809. ;
  4810. ; Usage:
  4811. ;    $CALL    CHKKBD
  4812. ;
  4813. ; On true return:
  4814. ;    Some interesting character seen.
  4815. ;
  4816. ; On a false return:
  4817. ;    Nothing of interest seen.
  4818. ;
  4819. ;.end literal
  4820. ;-
  4821.  
  4822. CHKKBD:    MOVX    S2,BLSTRU        ; Get the flag value
  4823.     TDNE    S2,CONNECT%FLAG##    ; Check if connected
  4824.      $RETF                ; Yes, no keyboard to poll
  4825. CHKKB1:    INCHRS    S1            ; No, get a character from the keyboard
  4826.      $RETF                ; Nothing there
  4827.     CAXE    S1,.CHCRT        ; Carriage return?
  4828.      CAXN    S1,.CHCNA        ; Control-A?
  4829.       JRST    CHKKB2            ; Yes, go set flag and give correct return
  4830.     CAXN    S1,.CHCND        ; Control-D?
  4831.      XORM    S2,DEBUG%FLAG##        ; Yes, toggle debugging
  4832.     CAXE    S1,.CHCNX        ; Control-X?
  4833.      CAXN    S1,.CHCNZ        ; or control-Z?
  4834.       JRST    .+2            ; Yes, set correct flag
  4835.        JRST    CHKKB1            ; No, check if more there
  4836. CHKKB2:    CAXN    S1,.CHCNX        ; Control-X?
  4837.      MOVEM    S2,ABT%CUR%FILE##    ; Yes, abort current file
  4838.     CAXN    S1,.CHCNZ        ; No, control-Z?
  4839.      MOVEM    S2,ABT%ALL%FILE##    ; Yes, abort entire stream
  4840.     CAXN    S1,.CHCNA        ; Control-A?
  4841.      MOVEM    S2,TYP%STS%FLAG##    ; Flag that user wants some info
  4842.     CAXN    S1,.CHCND        ; Control-D?
  4843.      XORM    S2,DEBUG%FLAG##        ; Yes, toggle debugging
  4844.     CAXN    S1,.CHCRT        ; Carriage return?
  4845.      SETOM    TIMLIM            ; Yes, force immediate timeout
  4846.     INCHRS    S1            ; Any more characters?
  4847.      $RETT                ; No, return but remember we had something
  4848.     JRST    CHKKB2            ; Yes, go check if interesting
  4849.  
  4850.     SUBTTL    Terminal processing -- Message routines -- Set time out timer
  4851.  
  4852. ;+
  4853. ;.hl1 SETTMR
  4854. ;This routine will set the time out timer for inputting and outputting a
  4855. ;message.  It will be called by the RECEIVE and SEND routines.
  4856. ;.literal
  4857. ;
  4858. ; Usage:
  4859. ;    $CALL    SETTMR
  4860. ;    (Return)
  4861. ;
  4862. ; On return:
  4863. ;    TIMLIM set up
  4864. ;
  4865. ;.end literal
  4866. ;-
  4867.  
  4868. TOPS10<
  4869. SETTMR:    SKIPN    SEND%TIMEOUT##        ; Have a value?
  4870.       JRST    [MOVX    S1,.INFIN        ; No, use infinity
  4871.         MOVEM    S1,TIMLIM        ; Store the time limit
  4872.         $RET]                ; Return to the caller
  4873.     MOVX    S1,%CNSUP        ; Get the current uptime
  4874.     GETTAB    S1,            ; From the system
  4875.       JFCL                ; Don't care
  4876.     MOVEM    S1,TIMLIM        ; Store this
  4877.     MOVE    S1,SEND%TIMEOUT##    ; Get the time out again
  4878.     IMUL    S1,JIFSEC        ; Mul by jiffies per second
  4879.     ADDM    S1,TIMLIM        ; Update for the delta
  4880.     $RET                ; Return to the caller
  4881. >; End of TOPS10 conditional
  4882.     SUBTTL    Terminal processing -- General -- Determine using local line
  4883.  
  4884. ;+
  4885. ;.hl1 T$LOCAL
  4886. ;This routine will determine if we are using a local line or not.  It
  4887. ;will return TRUE if the line in XFRTRM is the same as MYTERM.
  4888. ;.literal
  4889. ;
  4890. ; Usage:
  4891. ;    $CALL    T$LOCAL
  4892. ;    (Return)
  4893. ;
  4894. ; Return true:
  4895. ;    MYTERM == XFRTRM
  4896. ;
  4897. ; Return false:
  4898. ;    MYTERM <> XFRTRM
  4899. ;
  4900. ;.end literal
  4901. ;-
  4902.  
  4903. T$LOCAL:
  4904.     MOVE    S1,$TTLIN+XFRTRM    ; Get this terminal line number
  4905.     MOVE    S2,$TTNOD+XFRTRM    ; Get the node number
  4906.     CAMN    S1,MYTERM+$TTLIN    ; Is this the same?
  4907.      CAME    S2,MYTERM+$TTNOD    ; . . .
  4908.       $RETF                ; Not the same
  4909.     $RETT                ; Same
  4910.     SUBTTL    Terminal processing -- General -- Open a terminal
  4911.  
  4912. ;+
  4913. ;.hl1 T$OPEN
  4914. ;This routine will open a terminal for input and output.  It is called with
  4915. ;the address of the terminal information block.  It will store the address
  4916. ;and size of the buffers, the channel number and device name into the
  4917. ;information block.
  4918. ;.literal
  4919. ;
  4920. ; Usage:
  4921. ;    XMOVEI    S1,Terminal information block
  4922. ;    $CALL    T$OPEN
  4923. ;    (Return)
  4924. ;
  4925. ; On a true return:
  4926. ;    - Terminal is open
  4927. ;
  4928. ; On a false return:
  4929. ;    - Terminal failed to open
  4930. ;
  4931. ;.end literal
  4932. ;-
  4933.  
  4934. TOPS10<
  4935. T$OPEN:    $SAVE    <P1,P2,P3,P4>        ; Save a registers
  4936.     MOVE    P1,S1            ; Copy the argument
  4937.     $CALL    T$CONN            ; Connect the terminal
  4938.     MOVEM    S1,$TTDEV(P1)        ; Store the device name
  4939.     MOVEM    S1,FLP+.FODEV        ; Store the name
  4940.     IONDX.    S1,            ; Get the UDX also
  4941.      SETO    S1,            ; Pretend it is us
  4942.     MOVEM    S1,$TTUDX(P1)        ; Remember the UDX
  4943.     MOVX    S1,.IOPIM!IO.SUP!UU.AIO    ; Get the mode and other information
  4944.     MOVEM    S1,FLP+.FOIOS        ; Store the status information
  4945.     HRLI    S1,$TTOBH(P1)        ; Get the output buffer header
  4946.     HRRI    S1,$TTIBH(P1)        ; Get the input buffer header
  4947.     MOVEM    S1,FLP+.FOBRH        ; Store them
  4948. ;[134]    MOVX    S1,-1            ; Assume defaults
  4949. ;[134]    MOVEM    S1,FLP+.FONBF        ; Store the number of buffers
  4950.     SETZM    FLP+.FOFNC        ; Clear this
  4951.     MOVX    S1,.FORED        ; Claim reading
  4952.     STORE    S1,FLP+.FOFNC,FO.FNC    ; Store the function
  4953.     MOVX    S1,FO.ASC        ; Assign a channel
  4954.     IORM    S1,FLP+.FOFNC        ; Turn this on
  4955.     MOVEI    S1,FLP+.FOIOS        ; Point to the block
  4956.     DEVSIZ    S1,            ; Get the size of the buffers
  4957.      JRST    [$KERR(<DEVSIZ UUO failure (^D/S1/)>)
  4958.         $RETF]            ; Return to the caller
  4959.     MOVEI    S2,MAX%MSG##/4+1 ;[134]    ; Get maximum message size
  4960.     PUSH    P,S2+1        ; [134]
  4961.     IDIVI    S2,-3(S1)    ; [134]    ; Compute no of buffers (3 word header)
  4962.     POP    P,S2+1        ; [134]
  4963.     ADDI    S2,1        ; [134]    ; Result was truncated, add a buffer
  4964.     HRL    S2,S2        ; [134]    ; Set up for both input and output
  4965.     MOVEM    S2,FLP+.FONBF    ; [134]    ; Store the number of buffers
  4966.     MOVEI    S1,(S1)            ; Get the size
  4967.     IMULI    S1,(S2)            ; Compute the total size
  4968.     LSH    S1,1            ; Double it (input and output)
  4969.     MOVEM    S1,$TTBSZ(P1)        ; Store the number of words
  4970.     $CALL    M%GMEM            ; Allocate the memory
  4971.     $RETIF                ; Failed?
  4972.     MOVEM    S2,$TTBAD(P1)        ; Store the buffer address
  4973.     EXCH    S2,.JBFF        ; Exchange with .JBFF
  4974.     MOVX    S1,<XWD .FONBF+1,FLP>    ; Point to the argument block
  4975.     FILOP.    S1,            ; Open terminal, allocate buffers
  4976.       JRST    OPEN.0            ; Failed, restore and get out
  4977.     MOVEM    S2,.JBFF        ; Store .JBFF back
  4978.     LOAD    S1,FLP+.FOFNC,FO.CHN    ; Get the channel assigned
  4979.     MOVEM    S1,$TTCHN(P1)        ; Store it
  4980.  
  4981. ; Remember any parameters we need to change, then change them
  4982.  
  4983.     MOVX    P2,.TOPAG        ; Get the TT PAGE (on/off) setting
  4984.     MOVE    P3,$TTUDX(P1)        ; Get the UDX
  4985.     MOVX    S1,<XWD 2,P2>        ; Point at the block
  4986.     TRMOP.    S1,            ; And get the bit
  4987.      SETZ    S1,            ; Must not know about it
  4988.     MOVEM    S1,$TTPAG(P1)        ; Save the bit setting
  4989.     SETOM    TRMOPN            ; Transfer terminal is now open
  4990. ;[133]    MOVE    S1,IBM%FLAG##        ; IBM mode?
  4991. ;[133]    TXNN    S1,BLSTRU        ;  .  .  .
  4992. ;[133]     $RETT                ; No, all done
  4993.     MOVE    S1,IBM%CHAR##        ; Yes, get the character
  4994.     CAXL    S1,.CHNUL        ;[133] Is it a character?
  4995.      JRST    .+2            ; Yes, need to clear TTY PAGE
  4996.       $RETT                ; No, leave things alone
  4997.     MOVX    S1,<XWD 3,P2>        ; Get the pointer
  4998.     ADDX    P2,.TOSET        ; Change to set function
  4999.     MOVEI    P4,1B35            ; Turn page on
  5000.     TRMOP.    S1,            ; Do it
  5001.      JFCL                ; Ignore error
  5002.     $RETT                ; Give a good return
  5003.  
  5004.  
  5005. ; Here if the FILOP. failed to open the terminal.
  5006.  
  5007. OPEN.0:    MOVEM    S2,.JBFF        ; Store .JBFF back
  5008.     $KERR    (<Terminal open failure ^T/FILERR##(S1)/>)
  5009.     SETZB    S1,S2            ; Clear these
  5010.     EXCH    S1,$TTBSZ(P1)        ; Get the size and clear entry
  5011.     EXCH    S2,$TTBAD(P1)        ; Get the address and clear it
  5012.     $CALL    M%RMEM            ; Return the memory
  5013.     $RETF                ; Return to the caller
  5014. >; End of TOPS10 conditional
  5015. SUBTTL    Terminal processing -- General -- T$CLOS - Close the terminal channel
  5016.  
  5017. ;+
  5018. ;.hl1 T$CLOS
  5019. ;This routine will close the terminal channel and return the buffers
  5020. ;associated with the terminal.
  5021. ;.literal
  5022. ;
  5023. ; Usage:
  5024. ;    XMOVEI    S1,Terminal information block
  5025. ;    $CALL    T$CLOSE
  5026. ;    (Return)
  5027. ;
  5028. ; On return:
  5029. ;    Terminal channel closed and the buffers returned.
  5030. ;
  5031. ;.end literal
  5032. ;-
  5033.  
  5034. T$CLOS:    $SAVE    <P1,P2,P3,P4>        ; Save P1
  5035.     SETZM    TRMOPN            ; Transfer terminal now closed
  5036.     MOVE    P1,S1            ; Copy the argument into here
  5037.  
  5038. ; First reset the parameters correctly
  5039.  
  5040.     MOVX    P2,.TOSET+.TOPAG    ; Reset TTY PAGE correctly
  5041.     MOVE    P3,$TTUDX(P1)        ;  .  .  .
  5042.     MOVE    P4,$TTPAG(P1)        ;  .  .  .
  5043.     MOVX    S1,<XWD 3,P2>        ; Point at block
  5044.     TRMOP.    S1,            ; And set bit back the way we found it
  5045.      JFCL                ; We tried
  5046.     SETZ    S2,            ; Clear this word
  5047.     MOVE    S1,$TTCHN(P1)        ; Get the channel number
  5048.     STORE    S1,S2,FO.CHN        ; Store the channel number
  5049.     MOVX    S1,.FOREL        ; Get the function
  5050.     STORE    S1,S2,FO.FNC        ; Store the function
  5051.     MOVX    S1,<XWD 1,S2>        ; Point to the argument block
  5052.     FILOP.    S1,            ; Release the channel
  5053.       JFCL                ; Don't care
  5054.     MOVE    S1,$TTBSZ(P1)        ; Get the number of words
  5055.     MOVE    S2,$TTBAD(P1)        ; Get the address
  5056.     $CALL    M%RMEM            ; Return the memory
  5057.     $RETF                ; Return if that fails
  5058.     $RETT                ; Give a good return
  5059.     SUBTTL    Terminal processing -- General -- Input a character
  5060.  
  5061. ;+
  5062. ;.hl1 T$CIN
  5063. ;This routine will input a character given the terminal information
  5064. ;block address.  This routine assumes that the terminal has been opened.
  5065. ;.literal
  5066. ;
  5067. ; Usage:
  5068. ;    XMOVEI    S2,Terminal info block
  5069. ;    $CALL    T$CIN
  5070. ;    (Return)
  5071. ;
  5072. ; On a true return:
  5073. ;    S1/ Character
  5074. ;
  5075. ; On a false return:
  5076. ;    $TTIOS word of terminal block contains the status
  5077. ;
  5078. ;.end literal
  5079. ;-
  5080.  
  5081. T$CIN:    SOSGE    $TTIBH+.BFCNT(S2)        ; Decrement the character count
  5082.       JRST    CIN.0            ; Get a buffer
  5083.     ILDB    S1,$TTIBH+.BFPTR(S2)    ; Read one character
  5084.     $RETT                ; And return it
  5085.  
  5086. ; Here to get the next buffer from the terminal
  5087.  
  5088. CIN.0:    SETZ    TF,            ; Clear a registers
  5089.     MOVX    S1,.FOINP        ; Get the FILOP. function
  5090.     STORE    S1,TF,FO.FNC        ; Store the function
  5091.     MOVE    S1,$TTCHN(S2)        ; Get the channel
  5092.     STORE    S1,TF,FO.CHN        ; Store the channel
  5093.     MOVX    S1,<XWD 1,TF>        ; Get the argument pointer
  5094.     FILOP.    S1,            ; Attempt to read characters
  5095.       TRNA                ; Failed, store status
  5096.     JRST    T$CIN            ; Loop to get the characters
  5097.  
  5098. ; Here if the FILOP. failed, store the status and give a fail return
  5099.  
  5100.     MOVEM    S1,$TTIOS(S2)        ; Store the status
  5101.     $RETF                ; And fail
  5102.     SUBTTL    Terminal processing -- General -- Output a character
  5103.  
  5104. ;+
  5105. ;.hl1 T$COUT
  5106. ;This routine will output a character given the character and the terminal
  5107. ;information block.
  5108. ;.literal
  5109. ;
  5110. ; Usage:
  5111. ;    MOVEI    S1,Character
  5112. ;    XMOVEI    S2,Terminal information block
  5113. ;    $CALL    T$COUT
  5114. ;    (Return)
  5115. ;
  5116. ; On a true return:
  5117. ;    - Character stuffed in the buffer
  5118. ;
  5119. ; On a false return:
  5120. ;    - Problems outputting the character.
  5121. ;
  5122. ;.end literal
  5123. ;-
  5124.  
  5125. T$COUT:    SOSGE    $TTOBH+.BFCNT(S2)    ; Decrement the count
  5126.       JRST    COUT.0            ; Output the buffer
  5127.     IDPB    S1,$TTOBH+.BFPTR(S2)    ; Store the character
  5128.     $RETT                ; Give a good return
  5129.  
  5130. COUT.0:    $CALL    T$DMPO            ; Output the buffer
  5131.     JUMPT    T$COUT            ; Try again
  5132.     $RET                ; Pass back the error
  5133.  
  5134. T$DMPO:    $SAVE    <S1,S2>            ; Save two registers
  5135.     SETZ    S1,            ; Clear this
  5136.     MOVE    TF,$TTCHN(S2)        ; Get the channel
  5137.     STORE    TF,S1,FO.CHN        ; Store it
  5138.     MOVX    TF,.FOOUT        ; Get the function
  5139.     STORE    TF,S1,FO.FNC        ; Store it
  5140.     MOVX    TF,<XWD 1,S1>        ; Point to the argument block
  5141.     FILOP.    TF,            ; Output the information
  5142.       SKIPA                ; Failed, store the status and return
  5143.     $RETT                ; Give a good return
  5144.     MOVEM    TF,$TTIOS(S2)        ; Store the status
  5145.     $RETF                ; Give a failure return
  5146.     SUBTTL    Terminal processing -- General -- Output a character for CONNECT
  5147.  
  5148. ;+
  5149. ;.hl1 T$CCOT
  5150. ;This routine will output a character given the character and the terminal
  5151. ;information block. It will send only the single character using
  5152. ;a TRMOP.
  5153. ;.literal
  5154. ;
  5155. ; Usage:
  5156. ;    MOVEI    S1,Character
  5157. ;    XMOVEI    S2,Terminal information block
  5158. ;    $CALL    T$CCOT
  5159. ;    (Return)
  5160. ;
  5161. ; On a true return:
  5162. ;    - Character stuffed in the buffer
  5163. ;
  5164. ; On a false return:
  5165. ;    - Problems outputting the character.
  5166. ;
  5167. ;.end literal
  5168. ;-
  5169.  
  5170. T$CCOT:    $SAVE    <P1,P2,P3>        ; Save some registers
  5171.     MOVE    P2,$TTUDX(S2)        ; Get the terminal UDX
  5172.     MOVX    P1,.TOOIC        ; Output an image character
  5173.     MOVE    P3,S1            ; And the character
  5174.     MOVE    S1,[XWD 3,P1]        ; Get the argument pointer
  5175.     TRMOP.    S1,            ; Send the character
  5176.      JRST    [MOVE    S1,P3        ; Couldn't, get the character back
  5177.         PJRST    T$COUT]        ; And try the other way
  5178.     MOVE    S1,P3            ; Get the character back
  5179.     $RETT                ; And return
  5180.     SUBTTL    Terminal processing -- General -- Connect a terminal line
  5181.  
  5182. ;+
  5183. ;.hl1 T$CONN
  5184. ;This routine will connect a terminal to the system.  This is a TOPS-10
  5185. ;only routine
  5186. ;.literal
  5187. ;
  5188. ; Usage:
  5189. ;    MOVEI    S1,Terminal information block
  5190. ;    $CALL    T$CONN
  5191. ;    (Return)
  5192. ;
  5193. ; On return:
  5194. ;    S1/ Terminal name in sixbit
  5195. ;
  5196. ;.end literal
  5197. ;-
  5198.  
  5199. TOPS10<
  5200. T$CONN:    $SAVE    <P1>            ; Save this registers
  5201.     MOVE    P1,S1            ; Copy the address
  5202.     MOVX    S1,<XWD .NDTCN,T1>    ; Point to the argument block
  5203.     MOVX    T1,2            ; Number of words
  5204.     MOVE    T2,$TTLIN(P1)        ; Get the line number
  5205.     HRL    T2,$TTNOD(P1)        ; Get the node number
  5206.     NODE.    S1,            ; Connect the terminal
  5207.      JRST    .+2            ; Not a network system
  5208.     $RET                ; Return to the caller
  5209.     CAXE    S1,<<XWD .NDTCN,T1>>    ; Non-network system?
  5210.      JRST    TCON.E            ; No, some other error
  5211.     MOVE    S1,$TTLIN(P1)        ; Get the line number
  5212.     ADDX    S1,.UXTRM        ; Convert to UDX
  5213.     DEVNAM    S1,            ; Convert to terminal name
  5214.      SETO    S1,            ; Not a device?
  5215. TCON.E:    $RET                ; Return
  5216. >; End of TOPS10 conditional
  5217.     SUBTTL    Terminal processing -- General -- Set PIM break set
  5218.  
  5219. ;+
  5220. ;.hl1 T$SBRK
  5221. ;This routine will set the PIM mode break set.  It will be called with
  5222. ;the character to use and the address of the terminal control block.
  5223. ;.literal
  5224. ;
  5225. ; Usage:
  5226. ;    MOVEI    S1,<BYTE(9)0,0,Character,second character>
  5227. ;    XMOVE    S2,Terminal control block
  5228. ;    $CALL    T$SBRK
  5229. ;    (Return)
  5230. ;
  5231. ; On a true return;
  5232. ;    - Mask set
  5233. ;
  5234. ; On a false return:
  5235. ;    - It failed.
  5236. ;
  5237. ;.end literal
  5238. ;-
  5239.  
  5240. TOPS10<
  5241. T$SBRK:    $SAVE    <P1,P2,P3>        ; Save a few registers
  5242.     MOVE    P2,$TTUDX(S2)        ; Get the terminal UDX
  5243.     HRLZ    P3,S1            ; Copy the character
  5244.     JUMPE    P3,.+2            ; If no desired break char, break on all
  5245.      TXO    P3,<BYTE (9)0,0,.CHCNC,.CHCNC!^O200> ; Otherwise, also break on Ctl-C
  5246. ;[133]    MOVE    S1,IBM%FLAG##        ; Check if we are talking to IBM
  5247.     MOVE    S1,IBM%CHAR##        ;[133] See if we are talkng to IBM
  5248.     CAXGE    S1,.CHNUL        ;[133] Are we?
  5249.      TDZA    S1,S1            ; No, no additional break char
  5250.     LSH    S1,^D9            ; Position to correct place
  5251.     JUMPE    P3,.+2            ; If already breaking on all, stay that way
  5252.      TRO    P3,(S1)            ; Turn it on
  5253.     MOVX    P1,.TOSET+.TOPBS    ; Get the function
  5254.     MOVX    S1,<XWD 3,P1>        ; Point to the argument block
  5255.     TRMOP.    S1,            ; Do the function
  5256.       $RETF                ; Pass back the error
  5257.     $RETT                ; Give a good return
  5258. >; End of TOPS10 conditional
  5259.     SUBTTL    Terminal processing -- Text output -- TERM%DUMP & DBG%DUMP
  5260.  
  5261. ;+
  5262. ;.HL1 TERM%DUMP
  5263. ;This routine will dump the terminal buffer that the BLISS routines have been
  5264. ;keepng on the user's terminal.
  5265. ;.hl1 DBG%DUMP
  5266. ; This routine will dump the buffer onto either the terminal or into
  5267. ;the debugging file.
  5268. ;-
  5269.  
  5270. BLSRTN(TERM%DUMP,<COUNT,BUFFER>)
  5271.     $SAVE    <TF,S1>            ; Save TF and S1
  5272.     MOVX    S1,BLSTRU        ; Determine if connected
  5273.     TDNN    S1,CONNECT%FLAG##    ; Are we?
  5274.      $TEXT    (,<^T/@BUFFER/^A>)    ; No, type it
  5275.     $RET                ; And return
  5276.  
  5277.  
  5278. BLSRTN(DBG%DUMP,<COUNT,BUFFER>)
  5279.     $SAVE    <TF,S1,S2>        ; Save a few registers
  5280.     MOVX    S2,LG$OPN        ; Is the debugging log open?
  5281.     TDNE    S2,DBGLOG+$LGFLG    ;  .  .  .
  5282.      JRST    TRMD.1            ; Yes, just dump the buffer
  5283.     MOVE    S2,CONNECT%FLAG##    ; Get the flag
  5284.     TXNN    S2,BLSTRU        ; Communicating on controlling term?
  5285.      $TEXT    (,<^T/@BUFFER/^A>)    ; No, we can type on it
  5286.     $RET                ; And return
  5287.  
  5288. ; Here to output the text to the debugging file
  5289.  
  5290. TRMD.1:    MOVE    S1,DBGLOG+$LGIFN    ; Get the IFN
  5291.     MOVE    S2,BUFFER        ; Get the address of the buffer
  5292.     HRL    S2,COUNT        ; And the count
  5293.     $CALL    F%OBUF            ; Output the buffer
  5294.     $RETIT                ; If no error, return
  5295.  
  5296.     MOVE    S1,DBGLOG+$LGIFN    ; Get the IFN back
  5297.     MOVX    S2,LG$OPN        ; Get the open flag
  5298.     ANDCAM    S2,DBGLOG+$LGFLG    ; Flag file not open anymore
  5299.     PJRST    F%REL            ; Try to keep what we wrote already
  5300.     SUBTTL    Error processing -- .KERERR - Handle KERMIT-10 errors
  5301.  
  5302. ;+
  5303. ;.hl1 _.KERERR
  5304. ;This routine is called by the KERERR macro.  It is used to pass error
  5305. ;text to the remote KERMIT.
  5306. ;-
  5307.  
  5308. .KERERR::
  5309.     HRRZ    TF,@(P)            ; Get the address of the text
  5310.     MOVEM    TF,.TEMP        ; Save it here
  5311.     $SAVE    <TF,S1,S2>        ; Save a few registers
  5312.     $SAVE    <T1,T2,T3,T4>        ; And a few more
  5313.     $TEXT    (<-1,,MSGTXT>,<?Kermit-10 ^I/@.TEMP/^0>) ; Type the text
  5314.     JRST    KRERR            ; Join the common code
  5315.     SUBTTL    Error processing -- KRM%ERROR - Handle the KERMSG errors
  5316.  
  5317. ;+
  5318. ;.hl1 KRM%ERROR
  5319. ;This routine will handle the errors that KERMSG will generate.
  5320. ;-
  5321.  
  5322. BLSRTN(KRM%ERROR,<ERRTYP>)
  5323.     $SAVE    <TF,S2>            ; Save a few registers
  5324.     $SAVE    <T1,T2,T3,T4>        ; And a few more
  5325.     MOVE    S1,ERRTYP        ; Get the error type
  5326.     MOVSI    S2,-ERRLEN        ; Get the size of the table
  5327.  
  5328. KRMER0:    CAME    S1,ERRTBL(S2)        ; Is this the error?
  5329.     AOBJN    S2,.-1            ; Look until we find it
  5330.     $TEXT    (<-1,,MSGTXT>,<?Kermit-10 ^T/@ERRTXT(S2)/^0>) ; Write the text
  5331.  
  5332. ; Here to count the characters and call the BLISS routine to write the
  5333. ; error packet to the remote
  5334.  
  5335. KRERR:    SKIPN    TRMOPN            ; Transfer terminal open?
  5336.      JRST    [$TEXT    (,<^T/MSGTXT/>)    ; No, just type the error message
  5337.         BLSRET    ABORTED]    ; And punt
  5338.     MOVE    S1,[POINT 7,MSGTXT]    ; Point to the text
  5339.     SETZ    S2,            ; Clear the counter
  5340.  
  5341. KRERR0:    ILDB    T1,S1            ; Get a character
  5342.     JUMPE    T1,KRERR1        ; Finished?
  5343.     AOJA    S2,KRERR0        ; No, count it up and loop
  5344.  
  5345. KRERR1:    PUSH    P,S2            ; Push this on the stack
  5346.     XMOVEI    S1,MSGTXT        ; Point to the text
  5347.     PUSH    P,S1            ; Save this on the stack too
  5348.     PUSHJ    P,SND%ERROR##        ; Send the error message
  5349.     ADJSP    P,-2            ; Remove the information
  5350.     BLSRET    NORMAL            ; Give a normal return for now
  5351.  
  5352. ; BLISS error text
  5353.  
  5354. DEFINE    KER(TYPE,VALUE,TEXT)<EXP VALUE>
  5355.  
  5356. ERRTBL:    KERRORS
  5357.  ERRLEN==.-ERRTBL
  5358.  
  5359. DEFINE    KER(TYPE,VALUE,TEXT)<EXP [ASCIZ |Text|]>
  5360.  
  5361. ERRTXT:    KERRORS
  5362.     EXP    [ASCIZ |Unknown error code|]
  5363.     SUBTTL    CRC calculation routine
  5364.  
  5365. ;+
  5366. ;.hl1 CRC calculation
  5367. ; This routine will calculate the CRC for a string.  It will use
  5368. ;the CRC-CCITT polynomial.
  5369. ;.lit
  5370. ;
  5371. ; Usage:
  5372. ;    CRC = CRCCLC(.Address, .Length)
  5373. ;
  5374. ;.end lit
  5375. ;-
  5376.  
  5377. BLSRTN(CRCCLC,<LEN,BYTEPTR>)        ; Define the routine
  5378.     $SAVE    <T1,T2,T3,T4>        ; Save T1-T4
  5379.  
  5380. ; AC usage:
  5381. ;    S1/ Accumulated CRC
  5382. ;    T4/ Remaining length
  5383. ;    T3/ Byte pointer to string
  5384. ;    T2/ temp
  5385. ;    T1/ temp
  5386.  
  5387.     SETZ    S1,            ; Initial CRC is 0
  5388.     MOVE    T4,LEN            ; Get the length
  5389.     MOVE    T3,BYTEPTR        ; And the address
  5390.  
  5391. CRCC.1:    ILDB    T1,T3            ; Get a character
  5392.     XORI    T1,(S1)            ; Add in with current CRC
  5393.     LDB    T2,[POINT 4,T1,31]    ; Get high 4 bits
  5394.     ANDI    T1,^O17            ; And low 4 bits
  5395.     MOVE    T1,CRCTB2(T1)        ; Get low portion of CRC factor
  5396.     XOR    T1,CRCTAB(T2)        ; Plus high portion
  5397.     LSH    S1,-^D8            ; Shift off a byte from previous CRC
  5398.     XOR    S1,T1            ; Add in new value
  5399.     SOJG    T4,CRCC.1        ; Loop for all characters
  5400.  
  5401.     $RET                ; Return (value already in S1)
  5402.  
  5403.  
  5404. ; Data tables for CRC-CCITT generation
  5405.  
  5406. CRCTAB:    OCT    0
  5407.     OCT    10201
  5408.     OCT    20402
  5409.     OCT    30603
  5410.     OCT    41004
  5411.     OCT    51205
  5412.     OCT    61406
  5413.     OCT    71607
  5414.     OCT    102010
  5415.     OCT    112211
  5416.     OCT    122412
  5417.     OCT    132613
  5418.     OCT    143014
  5419.     OCT    153215
  5420.     OCT    163416
  5421.     OCT    173617
  5422.  
  5423. CRCTB2:    OCT    0
  5424.     OCT    10611
  5425.     OCT    21422
  5426.     OCT    31233
  5427.     OCT    43044
  5428.     OCT    53655
  5429.     OCT    62466
  5430.     OCT    72277
  5431.     OCT    106110
  5432.     OCT    116701
  5433.     OCT    127532
  5434.     OCT    137323
  5435.     OCT    145154
  5436.     OCT    155745
  5437.     OCT    164576
  5438.     OCT    174367
  5439.     SUBTTL    Data area
  5440.  
  5441.     RELOC                ; To the low segment
  5442.  
  5443. PDL:    BLOCK    PDLLEN            ; Stack
  5444. TOPS10<
  5445. CCLOFS:    BLOCK    1            ; CCL offset
  5446. >; End of TOPS10 conditional
  5447.  
  5448. LOWBEG:!
  5449. HSTNOD::BLOCK    1            ; Host node number
  5450. HSTITX::BLOCK    1            ; Host node ITEXT string
  5451. XITFLG:    BLOCK    1            ; Exit flag
  5452. PRTARG:    BLOCK    2            ; Saved parser information
  5453. PRBLK:    BLOCK    PAR.SZ            ; Parser interface block
  5454. PROMPT:    BLOCK    D$PSIZ            ; User prompt
  5455. TXIBLK:    BLOCK    .RDRTY+1        ; TEXTI block
  5456. ANSBUF:    BLOCK    ANSLEN            ; Answer buffer
  5457. PRMPTB:    BLOCK    ANSLEN            ; Prompt buffer
  5458. TOPS10<
  5459. LOGDIN::BLOCK    1            ;[125] Flag if we are logged in
  5460. MONBLK:    BLOCK    PAR.SZ            ; Monitor command block
  5461. TMPBP:    BLOCK    1            ; Byte pointer for building .TMP file name
  5462. TMPSIZ:    BLOCK    1            ; TMP file size
  5463. TMPADR:    BLOCK    1            ; Address of TMP pointer
  5464. CCLIFN:    BLOCK    1            ; CCL file IFN
  5465. .MYPPN:    BLOCK    1            ; My ppn
  5466. >; End of TOPS10 conditional
  5467.  
  5468. INIIFN:    BLOCK    1            ; KERMIT.INI IFN
  5469.  
  5470. ; LOCAL command processing storage
  5471.  
  5472. LCLSTR:    BLOCK    1            ; Address of string to type
  5473. LCLSIZ:    BLOCK    1            ; Size of string
  5474. LCLRTN:    BLOCK    1            ; Address of get a char routine
  5475. LCLCHR:    BLOCK    1            ; Location to fetch character into
  5476.  
  5477. ; Terminal I/O information
  5478.  
  5479. TOPS10<
  5480. TIMLIM:    BLOCK    1            ; Time out time
  5481. JIFSEC::BLOCK    1            ; Number of jiffies per second
  5482. >; End of TOPS10 conditional
  5483. TRMOPN:    BLOCK    1            ; Transfer terminal open
  5484.  
  5485. ESCAPE:    BLOCK    1            ; CONNECT escape character
  5486. ESCTXT:    BLOCK    1            ; Escape character in ASCII
  5487.  
  5488. LCLECH:    BLOCK    1            ; Local echo flag
  5489.  
  5490. XXPMOD:    BLOCK    1            ;[127] XON-XOFF-processing
  5491. XFRTRM:    BLOCK    $TTSIZ            ; Transfer terminal information
  5492. MYTERM:    BLOCK    $TTSIZ            ; My terminal information
  5493.  
  5494. ; File I/O information
  5495.  
  5496. FILTYP:    BLOCK    1            ; Type of file being read/written
  5497. CURFTP:    BLOCK    1            ; File byte size for currently read file
  5498. FILPTR:    BLOCK    1            ; Location containing a byte pointer to store FILE%NAME
  5499. TOPS10<
  5500. USRFIL:    BLOCK    1            ; Non-zero if user supply spec
  5501. USRFX:    BLOCK    .FDSIZ            ; Length of the file spec area
  5502. FX:    BLOCK    .FDSIZ            ; File specification length
  5503. BH:    BLOCK    3            ; Buffer header
  5504. FBFADR:    BLOCK    1            ; Address of the file buffers
  5505. FBFSIZ:    BLOCK    1            ; Size of the file buffers
  5506. WLDPTR:    BLOCK    1            ; Pointer used by .LKWLD
  5507. FLP::    BLOCK    .FOMAX            ; FILOP. block
  5508. ELB::    BLOCK    .RBMAX            ; Enter/Lookup block
  5509. PTH::    BLOCK    .PTMAX            ; Path block
  5510. FPTH::    BLOCK    .PTMAX            ; File found in path
  5511.  
  5512. ; LOKWLD interface
  5513.  
  5514. WLD:    BLOCK    $LKLEN            ; Length of block
  5515. >; End of TOPS10 conditional
  5516.  
  5517. ; Random information and storage
  5518.  
  5519. .TEMP:    BLOCK    10            ; Temp storage for strings
  5520.  
  5521. MSGTXT:    BLOCK    50            ; Area for 250 character of message
  5522. LOWEND:!
  5523.  
  5524. LOWSIZ==.-LOWBEG
  5525.  
  5526.     RELOC                ; Back to the high segment
  5527. PHABEG:    PHASE    LOWEND
  5528.  
  5529. LOWPHA:!
  5530.  
  5531. IB:    $BUILD    IB.SZ
  5532.      $SET    IB.FLG,,IT.OCT!IB.NPF
  5533.      $SET    IB.PRG,,%%.MOD
  5534.     $EOB
  5535.  
  5536. HLPFD:    $BUILD    FDMSIZ
  5537.      $SET    .FDLEN,FD.LEN,FDMSIZ    ; Size of the block
  5538.      $SET    .FDLEN,FD.TYP,.FDNAT    ; Native file specification
  5539.      $SET    .FDSTR,,<SIXBIT /HLP/>    ; HLP:
  5540.      $SET    .FDNAM,,%%.MOD        ; KERMIT
  5541.      $SET    .FDEXT,,<SIXBIT /HLP/>    ; .HLP
  5542.     $EOB
  5543.  
  5544. CCLFD:    $BUILD    FDMSIZ            ; Minimum size FD
  5545.      $SET    .FDLEN,FD.LEN,FDMSIZ    ; Size of the FDB
  5546.      $SET    .FDLEN,FD.TYP,.FDNAT    ; Native spec
  5547.      $SET    .FDSTR,,<SIXBIT |DSK|>    ; Device is DSK
  5548.      $SET    .FDEXT,,<SIXBIT |TMP|>    ; Extension
  5549.     $EOB                ; End of block
  5550.  
  5551. CCLFOB:    $BUILD    FOB.MZ            ; Build an FOB
  5552.      $SET    FOB.FD,,CCLFD        ; Address of FD
  5553.      $SET    FOB.CW,FB.BSZ,7        ; Byte size
  5554.     $EOB                ; End of block
  5555.  
  5556. ; FD for KERMIT.INI
  5557.  
  5558. INIFD:    $BUILD    FDMSIZ            ; Minimum size FD
  5559.      $SET    .FDLEN,FD.LEN,FDMSIZ    ; Size
  5560.      $SET    .FDLEN,FD.TYP,.FDNAT    ; Native FD
  5561. TOPS10<
  5562.      $SET    .FDSTR,,<SIXBIT |DSK|>    ; Device is DSK
  5563.      $SET    .FDNAM,,<SIXBIT |KERMIT|>    ; Name is KERMIT
  5564.      $SET    .FDEXT,,<SIXBIT |INI|>    ; .INI
  5565. >; End of TOPS10 conditional
  5566. TOPS20<
  5567.      $SET    .FDSTG,,<ASCIZ |DSK:KERMIT.INI|>
  5568. >; End of TOPS20 conditional
  5569.     $EOB                ; End of block
  5570.  
  5571.  
  5572. ; Blocks for log files
  5573.  
  5574.     DEFINE LGBLK(NAM)<
  5575. NAM'LOG:
  5576.     $BUILD    $LGSIZ            ; Build an LG block
  5577.      $SET    $LGFLG,,0        ; No flags (file no set)
  5578.      $SET    $LGFOB+FOB.CW,FB.BSZ,7    ; Byte size
  5579.      $SET    $LGFOB+FOB.FD,,NAM'LOG+$LGFD ; Address of FD
  5580.     $EOB                ; End of block
  5581. > ; End of LGBLK macro definition
  5582.  
  5583. ; Now expand the macro for each type of log file
  5584.  
  5585.     LGBLK(DBG)            ; Debugging log file
  5586.     LGBLK(SES)            ; Session log file
  5587.     LGBLK(TRN)            ; Transaction log file
  5588.  
  5589.  
  5590. ; FOB for debugging file
  5591.  
  5592. DBFFOB:    $BUILD    FOB.MZ            ; Build an FOB
  5593.      $SET    FOB.CW,FB.BSZ,7        ; Byte size
  5594.     $EOB                ; End of block
  5595.  
  5596.  
  5597. ;[107] Macro name table for DEFINE/SET
  5598.  
  5599. DFNTAB:    XWD    0,D$MAXD        ;[107] Current number, maximum
  5600.     BLOCK    D$MAXD            ;[107] Leave the space
  5601.  
  5602. PHALEN==.-LOWEND
  5603.  
  5604. PHAEND:    DEPHASE
  5605.  
  5606.     RELOC                ; Back to the low segment
  5607.     BLOCK    PHALEN            ; Allocate the phased space
  5608.     RELOC                ; Back to the high segment
  5609.     SUBTTL    End of Kermit
  5610.  
  5611. TOPS20<    END    <3,,KERMIT>>
  5612. TOPS10<    END    KERMIT>