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