home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / hp3000 / hp3000.c < prev    next >
C/C++ Source or Header  |  2020-01-01  |  188KB  |  5,789 lines
  1. #define LISTING  1
  2. #if LISTING
  3. #pragma LIST ON
  4. #else
  5. #pragma LIST OFF
  6. #endif
  7.  
  8. #pragma   LINES 68
  9. #pragma   WIDTH 132
  10. #pragma   TITLE         "KERMIT (R) FILE TRANSFER"
  11. #pragma   SUBTITLE      "GLOBAL DECLARATIONS"
  12. #pragma   LIST OFF
  13. #include <stdio.h>
  14. #include <string.h>
  15. #include <time.h>
  16. #include <ctype.h>
  17. #include <stdlib.h>
  18. #include <mpe.h>
  19.  
  20. #if LISTING
  21. #pragma LIST ON
  22. #else
  23. #pragma LIST OFF
  24. #endif
  25.  
  26. #define    VERS   "GMI'S HP 3000 C KERMIT.  VERSION:  12 JULY 1994"
  27. #pragma    VERSIONID  VERS
  28.  
  29. /* Suggested compile options:   INFO="+L -Aa -C"    */
  30. /* RL=LIBCINIT.LIB.SYS required as part of the LINK */
  31.  
  32. #define    begin {
  33. #define    end   }
  34. #define    then
  35. #define    procedure
  36. #define    subroutine
  37. #define    logical       unsigned short
  38.  
  39. #pragma    intrinsic     FOPEN
  40. #pragma    intrinsic     FCLOSE
  41. #pragma    intrinsic     FSETMODE
  42. #pragma    intrinsic     FREAD
  43. #pragma    intrinsic     FWRITE
  44. #pragma    intrinsic     FCONTROL
  45. #pragma    intrinsic     FGETINFO
  46. #pragma    intrinsic     PRINT, FCHECK          /* For debugging only */
  47. #pragma    intrinsic     PRINTFILEINFO PRINT_FILE_INFO  /* ditto */
  48. #pragma    intrinsic     BINARY
  49. #pragma    intrinsic     DBINARY
  50. #pragma    intrinsic     ASCII
  51. #pragma    intrinsic     DASCII
  52. #pragma    intrinsic     WHO
  53. #pragma    intrinsic     CLOCK
  54. #pragma    intrinsic     JOBINFO
  55. #pragma    intrinsic     HPCICOMMAND
  56. #pragma    intrinsic     XCONTRAP
  57. #pragma    intrinsic     RESETCONTROL
  58. #pragma    intrinsic     QUIT
  59. #pragma    intrinsic     ABORTSESS
  60. #pragma    intrinsic     GETJCW
  61. #pragma    intrinsic     PUTJCW
  62.  
  63. /* *************************************************************** */
  64. /*                                                                 */
  65. /*     Version 1.0 : Ed Eldridge                                   */
  66. /*                   Polaris, Inc.                                 */
  67. /*                   1400 Wilson Blvd                              */
  68. /*                     suite 1100                                  */
  69. /*                   Arlington, Virginia   22209                   */
  70. /*                   (703) 527-7333                                */
  71. /*                                                                 */
  72. /*     Version 2.0 : Tony Appelget                                 */
  73. /*                   General Mills, Inc.                           */
  74. /*                   P.O. Box 1113                                 */
  75. /*                   Minneapolis, MN 55440                         */
  76. /*                   (612) 540-7703                                */
  77. /*                                                                 */
  78. /*     C-Language :  Tony Appelget                                 */
  79. /*                   General Mills, Inc.                           */
  80. /*                   P.O. Box 1113                                 */
  81. /*                   Minneapolis, MN 55440                         */
  82. /*                   (612) 540-7703                                */
  83. /*                                                                 */
  84. /*    * * * * * * * * * * * * * * * * * * * * * * * * * * * * *    */
  85. /*                                                                 */
  86. /*        I have left General Mills, and will no longer be able    */
  87. /*        to maintain the HP3000 Kermits unless, by chance or good */
  88. /*        fortune, I wind up in another HP3000 shop.  I will be    */
  89. /*        available to answer questions on a call-at-your-own risk */
  90. /*        basis.  My home phone is (612) 559-3764.                 */
  91. /*                                        Tony Appelget            */
  92. /*                                        13 July 1994             */
  93. /*                                                                 */
  94. /*    * * * * * * * * * * * * * * * * * * * * * * * * * * * * *    */
  95. /*                                                                 */
  96. /*                                                                 */
  97. /* *************************************************************** */
  98. /*  Originally written in SPL and reworked considerably in that    */
  99. /*  language.  Translated to C.  This was a rooky's first effort   */
  100. /*  at a large scale program in a new (for him) language.  To ease */
  101. /*  the transition from SPL (and PASCAL and Unisys ALGOL) certain  */
  102. /*  features of those languages were DEFINEd, such as `begin' and  */
  103. /*  `end' for `{' and `}', `procedure' and `subroutine' for the    */
  104. /*  functions, etc.  MPE I/O continues to be used, since it is     */
  105. /*  native to the machine and much, much easier to get along with  */
  106. /*  than C's I/O.                                                  */
  107.  
  108. /*  All the functionality of the SPL program were retained and     */
  109. /*  appears to be functional.  One very tenuous, or perhaps wispy, */
  110. /*  problem has appeared on rare occasions.  The first attempt at  */
  111. /*  a transfer in SERVER mode goes out to lunch.  Any attempt to   */
  112. /*  log the problem results in flawless operation (sigh).  Help    */
  113. /*  with this problem or identification of other problems would be */
  114. /*  appreciated.                                                   */
  115. /*                                             Tony Appelget       */
  116. /*                                             June 1993           */
  117.  
  118. #define   DBUF_WORDSIZE   1024
  119. #define   DBUF_BYTESIZE   DBUF_WORDSIZE*2
  120. #define   LBUF_WORDSIZE   1024
  121. #define   LBUF_BYTESIZE   LBUF_WORDSIZE*2
  122. #define   MAX_RCV_SIZE    94
  123. #define   MAX_LONGPACK_SIZE 2047
  124. #define   DFLT_MAXTRY   10   /* Normal retry count */
  125. #define   DFLT_TO       10   /* Normal timeout */
  126. #define   FAST_MAXTRY   5
  127. #define   FAST_TO       2
  128.  
  129. #define   CR     0xD  /* %15 */
  130. #define   LF     0xA  /* %12 */
  131. #define   XON    0X11 /* %21 */
  132. #define   EOT    0x4  /*  %4 */
  133. #define   SP     0x20 /* %40 */
  134. #define   HTAB   0x9  /* %11 */
  135. #define A_DEL    0x7f /* %177 */
  136. #define   true   -1
  137. #define   false  0
  138.  
  139. /* Configurable Parameters */
  140.  
  141. #define  P_Q_8       0x26  /* %46   Prefered 8 Bit Quote */
  142. #define  P_RPT_CHR   0x7E  /* %176  Prefered Repeat Prefix */
  143.  
  144. #define  LONGP_F     14:15:1
  145. #define  WINDOWS_F   13:15:1
  146. #define  ATTRS_F     12:15:1
  147.  
  148.  
  149. int     USE_DC1    = true,
  150.         QUOTE_8    = false,
  151.         USE_REPEAT = false,
  152.         EXP_TABS   = false,
  153.         IMAGE      = false;
  154.  
  155. int     PAUSE_CNT     = 0,
  156.         YOUR_PAD      = 0,
  157.         YOUR_PAD_COUNT = 0,
  158.         MAX_SND_SIZE   = MAX_RCV_SIZE,
  159.         MAX_SND_DATA   = MAX_RCV_SIZE,
  160.         LONGPACK_SIZE  = 0,
  161.         YOUR_EOL       = CR,
  162.         MY_EOL         = CR,
  163.         MY_Q_CTL       = 0x23,  /* %43, */
  164.         YOUR_Q_CTL     = 0x23,  /* %43, */
  165.         Q_8            = P_Q_8,
  166.         RPT_CHR        = P_RPT_CHR,
  167.         YOUR_TO        = 10,
  168.         MAXTRY         = DFLT_MAXTRY;
  169.  
  170. unsigned short
  171.         MY_TO          = DFLT_TO;
  172.  
  173. char    MY_CAPS,
  174.         YOUR_CAPS;
  175.  
  176.        /*FOR USER INPUT SCANNER*/
  177.        /* FIRST WORD OF USER COMMAND STUFF */
  178. #define  NULLV          0
  179.  
  180. #define  TAKEV          1
  181. #define  TAKESZ         4
  182. #define  TAKESZSZ       7
  183.  
  184. #define  SENDV          2
  185. #define  SENDSZ         4
  186. #define  SENDSZSZ       7
  187.  
  188. #define  RECEIVEV       3
  189. #define  RECEIVESZ      7
  190. #define  RECEIVESZSZ   10
  191.  
  192. #define  SERVEV         4
  193. #define  SERVESZ        6
  194. #define  SERVESZSZ      9
  195.  
  196. #define  SETV           5
  197. #define  SETSZ          3
  198. #define  SETSZSZ        6
  199.  
  200. #define  EXITV          6
  201. #define  EXITSZ         4
  202. #define  EXITSZSZ       7
  203.  
  204. #define  QUITV          6
  205. #define  QUITSZ         4
  206. #define  QUITSZSZ       7
  207.  
  208. #define  DIRV           7
  209. #define  DIRSZ          3
  210. #define  DIRSZSZ        6
  211.  
  212. #define  SPACEV         8
  213. #define  SPACESZ        5
  214. #define  SPACESZSZ      8
  215.  
  216. #define  DELETEV        9
  217. #define  DELETESZ       6
  218. #define  DELETESZSZ     9
  219.  
  220. #define  TYPEV         10
  221. #define  TYPESZ         4
  222. #define  TYPESZSZ       7
  223.  
  224. #define  VERIFYV       11
  225. #define  VERIFYSZ       6
  226. #define  VERIFYSZSZ     9
  227.  
  228. #define  STATUSV       11
  229. #define  STATUSSZ       6
  230. #define  STATUSSZSZ     9
  231.  
  232.        /* SECOND WORD OF USER COMMAND STUFF */
  233.  
  234. #define  DEBUGV        20
  235. #define  DEBUGSZ        5
  236. #define  DEBUGSZSZ      8
  237.  
  238. #define  DELAYV        21
  239. #define  DELAYSZ        5
  240. #define  DELAYSZSZ      8
  241.  
  242. #define  LINEV         22
  243. #define  LINESZ         4
  244. #define  LINESZSZ       7
  245.  
  246. #define  SENDV_1       23
  247.  
  248. #define  SPEEDV        24
  249. #define  SPEEDSZ        5
  250. #define  SPEEDSZSZ      8
  251.  
  252. #define  HANDSHAKEV    25
  253. #define  HANDSHAKESZ    9
  254. #define  HANDSHAKESZSZ 12
  255.  
  256. #define  RECEIVEV_1    26
  257.  
  258. #define  LOGV          27
  259. #define  LOGSZ          3
  260. #define  LOGSZSZ        6
  261.  
  262. #define  SOHV          28
  263. #define  SOHSZ          3
  264. #define  SOHSZSZ        6
  265.  
  266. #define  FASTV         29
  267. #define  FASTSZ         4
  268. #define  FASTSZSZ       7
  269.  
  270.        /* THIRD WORD OF USER COMMAND STUFF */
  271.  
  272. #define  PAUSEV        30
  273. #define  PAUSESZ        5
  274. #define  PAUSESZSZ      8
  275.  
  276. #define  BINARYV       31
  277. #define  BINARYSZ       6
  278. #define  BINARYSZSZ     9
  279.  
  280. #define  DEVICEV       32
  281. #define  DEVICESZ       6
  282. #define  DEVICESZSZ     9
  283.  
  284. #define  FCODEV        33
  285. #define  FCODESZ        5
  286. #define  FCODESZSZ      8
  287.  
  288. #define  RECLENV       34
  289. #define  RECLENSZ       6
  290. #define  RECLENSZSZ     9
  291.  
  292. #define  BLOCKFV       35
  293. #define  BLOCKFSZ       6
  294. #define  BLOCKFSZSZ     9
  295.  
  296. #define  FIXRECV       36
  297. #define  FIXRECSZ       6
  298. #define  FIXRECSZSZ     9
  299.  
  300. #define  MAXRECV       37
  301. #define  MAXRECSZ       6
  302. #define  MAXRECSZSZ     9
  303.  
  304. #define  MAXEXTV       38
  305. #define  MAXEXTSZ       6
  306. #define  MAXEXTSZSZ     9
  307.  
  308. #define  SAVESPV       39
  309. #define  SAVESPSZ       6
  310. #define  SAVESPSZSZ     9
  311.  
  312. #define  PROGV         40
  313. #define  PROGSZ         4
  314. #define  PROGSZSZ       7
  315.  
  316. #define  BIN128V       41
  317. #define  BIN128SZ       6
  318. #define  BIN128SZSZ     9
  319.  
  320. #define  TEXTV         42
  321. #define  TEXTSZ         4
  322. #define  TEXTSZSZ       7
  323.  
  324. #define  TXT80V        43
  325. #define  TXT80SZ        5
  326. #define  TXT80SZSZ      8
  327.  
  328. #define  EXPTABV       44
  329. #define  EXPTABSZ       6
  330. #define  EXPTABSZSZ     9
  331.  
  332. #define  PURGEV        45
  333. #define  PURGESZ        5
  334. #define  PURGESZSZ      8
  335.  
  336. #define  AUTOV         50
  337. #define  AUTOSZ         4
  338. #define  AUTOSZSZ       7
  339.  
  340.        /* FOURTH WORD OF USER COMMAND STUFF */
  341.  
  342. #define  ONV           51
  343. #define  ONSZ           2
  344. #define  ONSZSZ         5
  345.  
  346. #define  OFFV          52
  347. #define  OFFSZ          3
  348. #define  OFFSZSZ        6
  349.  
  350. #define  NONEV         53
  351. #define  NONESZ         4
  352. #define  NONESZSZ       7
  353.  
  354. #define  XONV          54
  355. #define  XONSZ          3
  356. #define  XONSZSZ        6
  357.  
  358. #define  XON2V         55
  359. #define  XON2SZ         4
  360. #define  XON2SZSZ       7
  361.  
  362. #define  YESV          56
  363. #define  YESSZ          3
  364. #define  YESSZSZ        6
  365.  
  366.        /* QUESTION MARK ANYWHERE FOR HELP */
  367.  
  368. #define  QMARKV        60
  369. #define  QMARKSZ        1
  370. #define  QMARKSZSZ      4
  371.  
  372. #define  NUMBERV       61
  373. #define  NOMORE    NUTTIN
  374.  
  375. char     RESWDS[] =
  376.      { TAKESZSZ,      TAKESZ,      'T','A','K','E',         TAKEV,
  377.        SERVESZSZ,     SERVESZ,     'S','E','R','V','E','R', SERVEV,
  378.        SENDSZSZ,      SENDSZ,      'S','E','N','D',         SENDV,
  379.        RECEIVESZSZ,   RECEIVESZ,   'R','E','C','E','I','V','E',
  380.                                                             RECEIVEV,
  381.        SETSZSZ,       SETSZ,       'S','E','T',             SETV,
  382.        EXITSZSZ,      EXITSZ,      'E','X','I','T',         EXITV,
  383.        QUITSZSZ,      QUITSZ,      'Q','U','I','T',         EXITV,
  384.        DIRSZSZ,       DIRSZ,       'D','I','R',             DIRV,
  385.        SPACESZSZ,     SPACESZ,     'S','P','A','C','E',     SPACEV,
  386.        DELETESZSZ,    DELETESZ,    'D','E','L','E','T','E', DELETEV,
  387.        TYPESZSZ,      TYPESZ,      'T','Y','P','E',         TYPEV,
  388.        VERIFYSZSZ,    VERIFYSZ,    'V','E','R','I','F','Y', VERIFYV,
  389.        STATUSSZSZ,    STATUSSZ,    'S','T','A','T','U','S', STATUSV,
  390.  
  391.        DEBUGSZSZ,     DEBUGSZ,     'D','E','B','U','G',     DEBUGV,
  392.        LOGSZSZ,       LOGSZ,       'L','O','G',             LOGV,
  393.        HANDSHAKESZSZ, HANDSHAKESZ, 'H','A','N','D','S','H','A','K','E',
  394.                                                             HANDSHAKEV,
  395.        LINESZSZ,      LINESZ,      'L','I','N','E',         LINEV,
  396.        SPEEDSZSZ,     SPEEDSZ,     'S','P','E','E','D',     SPEEDV,
  397.        DELAYSZSZ,     DELAYSZ,     'D','E','L','A','Y',     DELAYV,
  398.        SOHSZSZ,       SOHSZ,       'S','O','H',             SOHV,
  399.        SENDSZSZ,      SENDSZ,      'S','E','N','D',         SENDV_1,
  400.        RECEIVESZSZ,   RECEIVESZ,   'R','E','C','E','I','V','E',
  401.                                                             RECEIVEV_1,
  402.        FASTSZSZ,      FASTSZ,      'F','A','S','T',         FASTV,
  403.  
  404.        PAUSESZSZ,     PAUSESZ,     'P','A','U','S','E',     PAUSEV,
  405.        BINARYSZSZ,    BINARYSZ,    'B','I','N','A','R','Y', BINARYV,
  406.        DEVICESZSZ,    DEVICESZ,    'D','E','V','I','C','E', DEVICEV,
  407.        FCODESZSZ,     FCODESZ,     'F','C','O','D','E',     FCODEV,
  408.        RECLENSZSZ,    RECLENSZ,    'R','E','C','L','E','N', RECLENV,
  409.        BLOCKFSZSZ,    BLOCKFSZ,    'B','L','O','C','K','F', BLOCKFV,
  410.        FIXRECSZSZ,    FIXRECSZ,    'F','I','X','R','E','C', FIXRECV,
  411.        MAXRECSZSZ,    MAXRECSZ,    'M','A','X','R','E','C', MAXRECV,
  412.        MAXEXTSZSZ,    MAXEXTSZ,    'M','A','X','E','X','T', MAXEXTV,
  413.        SAVESPSZSZ,    SAVESPSZ,    'S','A','V','E','S','P', SAVESPV,
  414.        PROGSZSZ,      PROGSZ,      'P','R','O','G',         PROGV,
  415.        BIN128SZSZ,    BIN128SZ,    'B','I','N','1','2','8', BIN128V,
  416.        TEXTSZSZ,      TEXTSZ,      'T','E','X','T',         TEXTV,
  417.        TXT80SZSZ,     TXT80SZ,     'T','X','T','8','0',     TXT80V,
  418.        EXPTABSZSZ,    EXPTABSZ,    'E','X','P','T','A','B', EXPTABV,
  419.        PURGESZSZ,     PURGESZ,     'P','U','R','G','E',     PURGEV,
  420.        AUTOSZSZ,      AUTOSZ,      'A','U','T','O',         AUTOV,
  421.  
  422.        ONSZSZ,        ONSZ,        'O','N',                 ONV,
  423.        OFFSZSZ,       OFFSZ,       'O','F','F',             OFFV,
  424.        NONESZSZ,      NONESZ,      'N','O','N','E',         NONEV,
  425.        XONSZSZ,       XONSZ,       'X','O','N',             XONV,
  426.        XON2SZSZ,      XON2SZ,      'X','O','N','2',         XON2V,
  427.        YESSZSZ,       YESSZ,       'Y','E','S',             YESV,
  428.        QMARKSZSZ,     QMARKSZ,     '?',                     QMARKV,
  429.        0, 0, 0, 0 };
  430. /* *************************************************************** */
  431. /*                                                                 */
  432. /*     Parameters that are changed via the SET command             */
  433. /*                                                                 */
  434. /* *************************************************************** */
  435.  
  436. int            RCV_BINARY = false,     /* Binary if true         */
  437.                RCV_FIXREC = true,      /* Fixed records if true  */
  438.                RCV_SAVESP = true,      /* Release unused space   */
  439.                IMPATIENT  = false;     /* Short timeouts         */
  440.  
  441. int            RCV_FCODE  = 0,         /* File code              */
  442.                RCV_RECLEN = -80,       /* Record Length          */
  443.                RCV_BLOCKF = 16,        /* Blocking Factor        */
  444.                RCV_MAXEXT = 32;        /* Max Extents            */
  445.  
  446. int            RCV_MAXREC = 5000;     /* Max Records            */
  447.  
  448. char           RCV_DEV[]  =           /* Device Type            */
  449.                                 "DISC            ";
  450.  
  451. int            SND_BINARY = 0;         /* Send Mode: 0 = Auto    */
  452.                                         /*            1 = Binary  */
  453.                                         /*            2 = ASCII   */
  454.  
  455. short int      HNDSHK  = 1,             /* Handshake: 0 = None    */
  456.                                         /*            1 = XON     */
  457.                                         /*            2 = XON2    */
  458.                DEBUG_MODE = 0,          /* Debug Mode             */
  459.                TSPEED = 0,              /* Line Speed (CPS)       */
  460.                LDEV_LINE = 0;           /* Line LDEV              */
  461.  
  462. char           SOH         = '\x01',    /* Begin-packet character */
  463.                MY_BLK_CK   = '3',
  464.                YOUR_BLK_CK = '3';
  465.  
  466. int            MIN_SIZE[60];            /* Used by input scanner to
  467.                                             ensure unique abbreviated
  468.                                             keywords              */
  469.  
  470. /* *************************************************************** */
  471.  
  472.  
  473. /* Buffers and etc. */
  474.  
  475.  
  476. int            LNUM   = 0, /* Line File number     */
  477.                CINUM  = 0, /* CI Input             */
  478.                CONUM  = 0, /* CI Output            */
  479.                LOGNUM = 0, /* Log Output           */
  480.                DNUM   = 0, /* Disc file number     */
  481.                TAKENUM= 0, /* TAKE File Number     */
  482.                KT_NUM = 0; /* Temp for LISTFs, etc */
  483.  
  484.      char           DBUF[DBUF_BYTESIZE],
  485.                     LBUF[LBUF_BYTESIZE];
  486.  
  487.      int            DBUFCNT,   /* Disc buffer byte count */
  488.                     DBUF_RMAX, /* Receive Max Buf size   */
  489.                     DBUFINX,   /* Disc buffer index */
  490.                     LBUFCNT;   /* Line buffer count */
  491.  
  492.      char           PDATA[MAX_LONGPACK_SIZE];  /* Outgoing pkt data */
  493.      int            PDATACNT;
  494.  
  495.      char           RP_DATA[MAX_LONGPACK_SIZE]; /* Rcv (data) buf*/
  496.      char           RP; /* Response type */
  497.      int            RP_LEN,  /* Length of response data */
  498.                     RP_NUM;  /* Packet number of response */
  499.  
  500.      char           PBUF[80];
  501.      int            PLEN;
  502.  
  503.      char           L_FNAME[38],  /* Local file name  */
  504.                     R_FNAME[38],  /* Remote file name */
  505.                     LOGNAME[38];  /* Current log file name */
  506.  
  507.      int            L_FNAME_LEN,  /* Length of Name    */
  508.                     R_FNAME_LEN,  /* Length of Name    */
  509.                     LOGNAME_LEN;  /* Length of log file name */
  510.  
  511. /*  Keyboard input & scanner stuff */
  512.      char           IB[80];
  513.      int            ILEN;          /* Length of Current IB */
  514.      char           CPARM[80]  ;   /* Current Parameter */
  515.  
  516.      char           ITEMPTR,       /* Points to found item */
  517.                     *IB_PTR;        /* Moves along input line */
  518.  
  519.      int            CPLEN,         /* Length of CPARM      */
  520.                     CPVAL,         /* Numeric value found  */
  521.                     ITEM,          /* Index of CPARM  word */
  522.                     IBX;
  523.  
  524. /* Misc */
  525.  
  526.      char           STATE,  /* Current state */
  527.                     Q8_IND; /* Receive Q8 flag */
  528.  
  529.      int            N = 0,  /* Current packet number */
  530.                     NUMTRY,  /* Current "try" number  */
  531.                     OLDTRY;  /* Previous "try" number */
  532.  
  533.      char           KT_NAME[32];  /* Temp file name */
  534.  
  535.      int            KTN_LEN;        /* Length of KT_NAME */
  536.  
  537.      int            HAVE_KTEMP,     /* True if temp file exists */
  538.                     DBUF_WRITTEN=false, /* Prevent LF from forcing
  539.                                             disc write after write
  540.                                             from full buffer */
  541.                     CTLY = false;  /* True if CONTROL-Y        */
  542.      char           MYSELF[8];
  543.  
  544.      short          ERROR,              /* For HPCICOMMAND int */
  545.                     PARM;               /*      ditto      */
  546.  
  547.      #define        NO_VISIBLE_MSG 2    /*      ditto      */
  548.  
  549.      char           KERM_JCW[] = "KRMJCW00  ";
  550.  
  551.      unsigned short MY_JCW_VAL;
  552.      short          JCW_ERR;
  553.  
  554. #    define         IDLING    0
  555. #    define         SENDING   1
  556. #    define         RECVING   2
  557. #    define         SEND_OK   16+SENDING
  558. #    define         RECV_OK   16+RECVING
  559. #    define         SEND_NG   256+SENDING
  560. #    define         RECV_NG   256+RECVING
  561.  
  562. /* #    define IN      0                */
  563. /* #    define OUT     1                */
  564. /* #    define IO      2                */
  565.  
  566. #define E_ST   if (LOGNUM != 0) then begin strcpy(PBUF,
  567. #define E_EN   ); FWRITE(LOGNUM,PBUF,-strlen(PBUF),0); end
  568.  
  569. #define M_ST   strcpy(PBUF,
  570. #define M_EN   ); FWRITE(CONUM, PBUF, -strlen(PBUF), 0)
  571.  
  572. #define FLUSH_DBUF  begin FWRITE(DNUM,DBUF,-DBUFINX,0); DBUFINX = 0; end
  573. #define KTEMP_NAME  "KMTTEMP"
  574. #define RPACK_PACK  1
  575. #define SPACK_PACK  2
  576.  
  577. /* ************************************************************** */
  578.      int            TAKE_VAL;
  579.  
  580.      unsigned short TTYPE = 13,     /* Terminal type */
  581.                     LDEV_CI = 0,    /* Command ldev */
  582.                     ORGL_TTYPE,     /* Orig TTYPE   */
  583.                     ORGL_TISPEED,   /* Orig I speed */
  584.                     ORGL_TOSPEED,   /* Orig O speed */
  585.                     ORGL_ECHO,      /* 0=off, 1=on  */
  586.                     DFLT_TTYPE;     /* 10=HPPA, 13=Classic machines */
  587.  
  588.      int            I_DELAY = 10;   /* Initial Pause Duration */
  589.  
  590. /* ************************************************************** */
  591.  
  592. #pragma   SUBTITLE      "LOW LEVEL FUNCTIONS"
  593. #pragma   PAGE
  594. char TOCHAR(CHR)
  595. char        CHR ;
  596. begin
  597.        return (CHR+SP);
  598. end
  599.  
  600. /* ************************************************************** */
  601.  
  602. int UNCHAR(CHR)
  603. char       CHR ;
  604. begin
  605.        return (CHR-SP);
  606. end
  607.  
  608. /* ************************************************************** */
  609.  
  610. int CTL(CHR)
  611. int     CHR ;
  612. begin
  613.      return (CHR ^ 0x40);
  614. end
  615.  
  616. /* ************************************************************** */
  617.  
  618. int NPNO(PNO)
  619. int      PNO ;
  620. begin
  621.      return ((PNO + 1) % 64);
  622. end
  623.  
  624. /* *************************************************************** */
  625.  
  626. int PPNO(PNO)
  627. int      PNO ;
  628. begin
  629.      if (PNO == 0) then
  630.           return (63);
  631.      else
  632.           return (PNO - 1);
  633. end
  634.  
  635. /* *************************************************************** */
  636.  
  637. void CONTROLY(void)
  638. begin
  639.  
  640.      CTLY = true;
  641.      RESETCONTROL();
  642.      return;
  643.  
  644. end
  645. /* *************************************************************** */
  646. #pragma   SUBTITLE      "CALCULATE_CRC - Three-byte checksum" */
  647. #pragma   PAGE
  648. int CALCULATE_CRC(PKT, LEN)
  649. int                    LEN;
  650. char              PKT[];
  651. begin
  652.  
  653.   /* Copied from the IBM-PC CRC calulator in module MSSCOM.ASM   */
  654.   /* and modified for better efficiency in this environment.  AX */
  655.   /* and DX were the original PC registers and the nomenclature  */
  656.   /* was retained for want of better identifiers.                */
  657.  
  658.      register struct INT16
  659.           {  unsigned char UPPER_BYTE :8;
  660.              unsigned char LOWER_BYTE :8;
  661.           };
  662.      register union /* EQUIV_A */ /* COULD THIS BE SIMPLIFIED? */
  663.           { struct INT16 AX;
  664.             unsigned short A;
  665.           } ACC;
  666.      register union /* EQUIV_D */
  667.           { struct INT16 DX;
  668.             unsigned short D;
  669.           } DATA;
  670.  
  671.      int I = 1;
  672.  
  673.       DATA.D = 0;
  674.       do begin
  675.           ACC.AX.UPPER_BYTE = PKT[I];
  676.           DATA.DX.LOWER_BYTE = DATA.DX.LOWER_BYTE ^ ACC.AX.UPPER_BYTE;
  677.           ACC.AX.UPPER_BYTE =
  678.                          (DATA.DX.LOWER_BYTE<<4) ^ DATA.DX.LOWER_BYTE;
  679.           ACC.AX.LOWER_BYTE = 0;
  680.           DATA.D = ACC.A | DATA.DX.UPPER_BYTE;
  681.           ACC.A = (ACC.A)>>4;
  682.           DATA.DX.LOWER_BYTE = DATA.DX.LOWER_BYTE ^ ACC.AX.UPPER_BYTE;
  683.           DATA.D = DATA.D ^ (ACC.A>>1);
  684.      end
  685.      while (( I++ ) < LEN);
  686.  
  687.      return DATA.D;
  688.  
  689. end
  690.  
  691. #pragma   SUBTITLE      "Write packets to log file"
  692. #pragma   PAGE
  693. procedure WRITE_LOG(PACKET, LEN, WHO)
  694. int                         LEN, WHO;
  695. char                PACKET[];
  696. begin
  697.      struct CLOCK_DESC
  698.      { unsigned char HH :8;
  699.        unsigned char MM :8;
  700.        unsigned char SS :8;
  701.        unsigned char TT :8;
  702.      };
  703.  
  704.      union PAIRED
  705.      { struct CLOCK_DESC NOW;
  706.        long int TDUM;
  707.      } TIME_STUFF;
  708.  
  709.      char      *PB;
  710.      int       PB_L;          /* So we don't clobber global PLEN */
  711.      char      PBUF[80];      /* So we don't clobber global PBUF */
  712.  
  713.      if (WHO==RPACK_PACK)
  714.           strcpy(PBUF, "RPACK: ");
  715.      else
  716.      if (WHO==SPACK_PACK)
  717.           strcpy(PBUF, "SPACK: ");
  718.      else
  719.           strcpy(PBUF, "?????? ");
  720.      PB_L = strlen(PBUF);
  721.      TIME_STUFF.TDUM = CLOCK();
  722.      PB_L = PB_L+ASCII(TIME_STUFF.NOW.HH, 10, PBUF+PB_L);
  723.      PBUF[PB_L++] = ':';
  724.      PB_L = PB_L+ASCII(TIME_STUFF.NOW.MM, 10, PBUF+PB_L);
  725.      PBUF[PB_L++] = ':';
  726.      PB_L = PB_L+ASCII(TIME_STUFF.NOW.SS, 10, PBUF+PB_L);
  727.      PBUF[PB_L++] = '.';
  728.      PB_L = PB_L+ASCII(TIME_STUFF.NOW.TT, 10, PBUF+PB_L);
  729.      strcpy(PBUF+PB_L, "  (");
  730.      PB_L = strlen(PBUF);
  731.      PB_L = PB_L+ASCII(LEN, 10, PBUF+PB_L);
  732.      PBUF[PB_L++] = ')';
  733.      FWRITE(LOGNUM, PBUF, -(PB_L), 0);
  734.  
  735.      strcpy(PBUF,"       ");
  736.      PB = PACKET;
  737.  
  738.      while (LEN > 72)
  739.      begin
  740.           strncpy(PBUF+7, PB, 72);
  741.           FWRITE(LOGNUM, PBUF, -79, 0);
  742.           PB = PB+72;
  743.           LEN = LEN-72;
  744.      end;
  745.  
  746.      if (LEN > 0)  then
  747.      begin
  748.           strncpy(PBUF+7, PB, LEN);
  749.           FWRITE(LOGNUM, PBUF, -(LEN+7), 0);
  750.      end;
  751.  
  752. end
  753.  
  754. #pragma   SUBTITLE      "SPACK - Send A Packet"
  755. #pragma   PAGE
  756.      subroutine REGULAR_PACK(LBUF, DATA, LEN, NUM, TYP, OX)
  757.      char                   LBUF[],DATA[],         TYP;
  758.  
  759.      int                                 LEN, NUM,     *OX;
  760.  
  761.      begin
  762.           int IX,
  763.               INX,
  764.               CHKSUM=0;
  765.  
  766.           #define XCK(CHR) {CHKSUM=CHKSUM+CHR; LBUF[INX]=CHR; INX++;}
  767.  
  768.           LBUF[0] = SOH;                /* Start with SOH */
  769.           INX = 1;
  770.           if ((STATE == 'S') |          /* Then length    */
  771.               (STATE == 'R') |
  772.               (YOUR_BLK_CK == '1'))  then
  773.           XCK(TOCHAR(LEN+3))
  774.                else
  775.           XCK(TOCHAR(LEN+5));
  776.           XCK(TOCHAR(NUM));             /* Block number   */
  777.           XCK(TYP);                     /* Block type     */
  778.  
  779.           if (LEN != 0) then            /* Data if needed */
  780.                for (IX=0; IX<LEN; ++IX)
  781.                     XCK(DATA[IX]);
  782.  
  783.           if ((STATE == 'S') |
  784.               (STATE == 'R') |
  785.               (YOUR_BLK_CK == '1'))  then
  786.           begin                 /*  Kermit primative checksum  */
  787.                CHKSUM = (CHKSUM) % 256;
  788.                CHKSUM = ((CHKSUM)/64 + (CHKSUM)%64)%64;
  789.                LBUF[INX] = TOCHAR(CHKSUM);  /* Insert checksum */
  790.                INX++;
  791.           end
  792.                else
  793.           begin                         /*  Fancy 3-byte CRC  */
  794.                CHKSUM = CALCULATE_CRC(LBUF, INX-1);
  795.                LBUF[INX] = TOCHAR(CHKSUM/4096);            /* Byte 1 */
  796.                LBUF[INX=INX+1] = TOCHAR((CHKSUM%4096)/64); /* Byte 2 */
  797.                LBUF[INX=INX+1] = TOCHAR(CHKSUM%64);        /* Byte 3 */
  798.                INX = INX + 1;
  799.           end;
  800.      *OX = INX;
  801.      #undef XCK
  802.      end
  803.  
  804. #pragma   SUBTITLE      "BUILD A LONG PACKET"
  805. #pragma   PAGE
  806.      subroutine LONG_PACK(LBUF, DATA, LEN, NUM, TYP, OX)
  807.      char   LBUF[],
  808.             DATA[];
  809.  
  810.      int    LEN,
  811.             NUM,
  812.             TYP,
  813.             *OX;
  814.  
  815.      begin
  816.           int   IX,
  817.                 INX = 1;
  818.  
  819.           register int   CHKSUM=0;
  820.  
  821.           #define   XCK(CHR) {LBUF[INX]=CHR; CHKSUM=CHKSUM+CHR; INX++;}
  822.  
  823.           LBUF[0] = SOH;
  824.           XCK(TOCHAR(0));           /*Length=0 says long data packet*/
  825.           XCK(TOCHAR(NUM));         /*Packet number*/
  826.           XCK(TYP);                 /*Should be 'D' only*/
  827.           IX = LEN + (YOUR_BLK_CK-'0');
  828.           XCK(TOCHAR(IX / 95));     /*Length, most  significant part*/
  829.           XCK(TOCHAR(IX % 95));     /*Length, least significant part*/
  830.           CHKSUM = CHKSUM%256;
  831.           XCK(TOCHAR( ((CHKSUM/64)+(CHKSUM%64) )%64 ));    /*HDR BCC*/
  832.           if (YOUR_BLK_CK == '1')  then
  833.           begin
  834.                for (IX=0;  IX<LEN;  ++IX)
  835.                     XCK(DATA[IX]);
  836.                CHKSUM = (CHKSUM/64+CHKSUM%64)%64;
  837.                LBUF[INX] = TOCHAR( CHKSUM );
  838.           end
  839.                else
  840.           begin                         /*  Fancy 3-byte CRC  */
  841.                strncpy(LBUF+INX, DATA, LEN);
  842.                INX = INX+LEN;
  843.                CHKSUM = CALCULATE_CRC(LBUF, INX-1);
  844.                LBUF[INX] = TOCHAR(CHKSUM/4096);            /* Byte 1 */
  845.                LBUF[INX=INX+1] = TOCHAR((CHKSUM%4096)/64); /* Byte 2 */
  846.                LBUF[INX=INX+1] = TOCHAR(CHKSUM%64);        /* Byte 3 */
  847.           end;
  848.  
  849.           *OX = INX+1;
  850.      #undef XCK
  851.      end
  852.  
  853. #pragma   SUBTITLE      "SPACK - Send a packet"
  854. #pragma   PAGE
  855. procedure SPACK(TYP,NUM,LEN,DATA)
  856. char            TYP;
  857. int                 NUM,LEN;
  858. char                        DATA[];
  859. begin
  860.  
  861.      logical   R_ERROR = false;
  862.  
  863.      int       OX = 1;
  864.  
  865.      float     P_INT;
  866.  
  867.      if ((LEN > MAX_SND_DATA) & (TYP == 'D')) then
  868.           LONG_PACK(LBUF, DATA, LEN, NUM, TYP, &OX);
  869.      else
  870.           REGULAR_PACK(LBUF, DATA, LEN, NUM, TYP, &OX);
  871.  
  872.      if ((DEBUG_MODE > 0) && (LOGNUM != 0)) then
  873.      begin
  874.           WRITE_LOG(LBUF, OX, SPACK_PACK);
  875.      end;
  876.  
  877.      LBUF[OX] = YOUR_EOL;               /* Set end of line char */
  878.      OX = OX + 1;
  879.  
  880.      if (PAUSE_CNT != 0) then
  881.      begin
  882.           P_INT = PAUSE_CNT/10.;
  883.           PAUSE(&P_INT);                /* Pause for turnaround */
  884.      end;
  885.  
  886.      FWRITE(LNUM,LBUF,-OX,0xD0);        /* Write the block */
  887.      if (ccode() != CCE)  then
  888.      if ((DEBUG_MODE != 0) && (LOGNUM != 0))
  889.      begin
  890.           FCHECK(LNUM, &R_ERROR);
  891.           strcpy(PBUF, "WRITE ERROR ");
  892.           PLEN=strlen(PBUF);
  893.           PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN);
  894.           WRITE_LOG(PBUF, PLEN, SPACK_PACK);
  895.      end;
  896.  
  897. end
  898.  
  899. #pragma   SUBTITLE      "RPACK - Receive Packet"
  900. #pragma   PAGE
  901. logical RPACK(TYP,LEN,NUM,DATA)
  902. char          *TYP             ;
  903. int              *LEN,*NUM     ;
  904. char                      DATA[] ;
  905. begin
  906.  
  907.      int            IX,              /* General Index       */
  908.                     PACKLEN;         /* Packet length       */
  909.  
  910.      unsigned short R_ERROR = false,   /* Error Flag */
  911.                     RCHKSUM,           /* Received checksum */
  912.                     DONE = false;      /* Done Flag  */
  913.  
  914.      register unsigned short  CCHKSUM; /* Calculated checksum */
  915.  
  916.      char          *PACKET;
  917.  
  918.      LBUF[0] = 0;
  919.      strncat(LBUF+1, LBUF, LBUF_BYTESIZE-1);    /* Zero out buffer */
  920.  
  921.      FCONTROL(LNUM,04,&MY_TO);  /* Set timeout interval */
  922.  
  923.      LBUFCNT = FREAD(LNUM,LBUF,-LBUF_BYTESIZE); /* Read buffer */
  924.  
  925.      if ( ccode() != CCE )then
  926.      begin                              /* Timeout */
  927.           FCHECK(LNUM, &R_ERROR);
  928.  
  929.           if (LOGNUM != 0) then
  930.           begin
  931.                strcpy(PBUF, "RPACK: FSERROR ");
  932.                PLEN=strlen(PBUF);
  933.                PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN);
  934.                FWRITE(LOGNUM, PBUF, -PLEN, 0);
  935.           end;
  936.           R_ERROR=1;
  937.      end
  938.           else
  939.      begin                              /* Have a packet */
  940.  
  941.           if ( (DEBUG_MODE > 0) & (LOGNUM != 0) ) then
  942.           begin
  943.                WRITE_LOG(LBUF, LBUFCNT, RPACK_PACK);
  944.           end;
  945.  
  946.           IX = 0;
  947.           while ( !(DONE | R_ERROR) )
  948.           begin                         /* Look for SOH */
  949.                if (LBUF[IX] == SOH) then
  950.                begin
  951.                     DONE = true;
  952.                end
  953.                     else
  954.                begin
  955.                     IX = IX + 1;
  956.                     if (IX > (LBUFCNT - 4)) then
  957.                     begin               /* SOH not found */
  958.                          R_ERROR = 3;
  959.                          E_ST "RPACK - SOH not found" E_EN;
  960.                     end;                /* No SOH */
  961.                end;               /* Not SOH */
  962.           end;              /* while */
  963.      end;            /* Have a packet */
  964.  
  965.  
  966.      if (R_ERROR!=0) then
  967.      begin
  968.           return( R_ERROR );
  969.      end;
  970.  
  971.      /* Something in the buffer that starts with SOH. */
  972.      /* Let's see if everything else looks good.      */
  973.  
  974.      PACKET = &LBUF[IX];                /* Address packet */
  975.  
  976.      PACKLEN = UNCHAR(PACKET[1]);
  977.      if (PACKLEN > 0)  then
  978.      begin                              /* Regular packets */
  979.           PACKLEN = PACKLEN+2;
  980.           if ( (IX + PACKLEN > LBUFCNT) |
  981.                (PACKLEN > MAX_RCV_SIZE + 2) |
  982.                (PACKLEN < 5) ) then
  983.           begin                         /* Length is not reasonable */
  984.                R_ERROR = 5;
  985.                E_ST "RPACK - Invalid length" E_EN;
  986.           end
  987.                else
  988.           begin                         /* Length OK */
  989.  
  990.                if ( (STATE == 'S')  |
  991.                     (STATE == 'R')  |
  992.                     (YOUR_BLK_CK == '1') )  then
  993.                begin                    /* Kermit primative checksum */
  994.                     CCHKSUM = 0;
  995.                     for (IX = PACKLEN-2; IX > 0; --IX)
  996.                          CCHKSUM = CCHKSUM + PACKET[IX];
  997.  
  998.                     CCHKSUM = CCHKSUM % 256; /* LOW 8 BITS ONLY */
  999.                     CCHKSUM = (CCHKSUM/64 + CCHKSUM%64)%64;
  1000.                     CCHKSUM = TOCHAR(CCHKSUM);
  1001.  
  1002.                     RCHKSUM = PACKET[PACKLEN-1];
  1003.                end
  1004.                     else
  1005.                begin
  1006.                     CCHKSUM = CALCULATE_CRC(PACKET, PACKLEN-4);
  1007.  
  1008.                     RCHKSUM = UNCHAR(PACKET[PACKLEN-1])      /*(10:6)*/
  1009.                             + UNCHAR(PACKET[PACKLEN-2])*64   /*(4:6)*/
  1010.                             + UNCHAR(PACKET[PACKLEN-3])*4096;/*(0:4)*/
  1011.  
  1012.                     PACKLEN = PACKLEN-2;
  1013.                end;
  1014.  
  1015.               if (CCHKSUM != RCHKSUM) then
  1016.               begin                     /* Bad checksum */
  1017.                     R_ERROR = 7;
  1018.                     E_ST "RPACK - CHKSUM Error" E_EN;
  1019.               end;
  1020.           end;
  1021.      end
  1022.           else
  1023.      begin                              /* Long packets */
  1024.           PACKLEN = 95*UNCHAR(PACKET[4]) + UNCHAR(PACKET[5]);
  1025.  
  1026.           if ( (PACKLEN > LBUFCNT)  |
  1027.                (PACKLEN > LONGPACK_SIZE+10) )  then
  1028.           begin
  1029.                R_ERROR = 5;
  1030.                E_ST "RPACK - Invalid longpack length" E_EN;
  1031.           end
  1032.                else
  1033.           begin
  1034.                if (PACKET[3] != 'D')  then
  1035.                begin
  1036.                     R_ERROR = 9;
  1037.                     E_ST "RPACK - Longpack not data" E_EN;
  1038.                end
  1039.                     else
  1040.                begin                    /* Calculate header checksum */
  1041.                     CCHKSUM = 0;
  1042.                     for (IX = 1; IX <= 5;  ++IX)
  1043.                          CCHKSUM = CCHKSUM + PACKET[IX];
  1044.                     CCHKSUM = CCHKSUM % 256;
  1045.  
  1046.  
  1047.                     if ( (CCHKSUM/64+CCHKSUM%64)%64
  1048.                               != UNCHAR(PACKET[6]) )  then
  1049.                     begin
  1050.                          R_ERROR = 7;
  1051.                          E_ST "RPACK - Header checksum error" E_EN;
  1052.                     end
  1053.                          else
  1054.                     begin
  1055.                          if (YOUR_BLK_CK == '1')  then
  1056.                          begin
  1057.                               for (IX = 6; IX < PACKLEN-2+7; ++IX)
  1058.                                   CCHKSUM = CCHKSUM+PACKET[IX];
  1059.                               CCHKSUM =
  1060.                                  (CCHKSUM/64+CCHKSUM%64)%64;
  1061.  
  1062.                               RCHKSUM = UNCHAR(PACKET[PACKLEN-1+7]);
  1063.                          end
  1064.                               else
  1065.                          begin
  1066.                               CCHKSUM =
  1067.                                    CALCULATE_CRC(PACKET, PACKLEN-4+7);
  1068.  
  1069.                               RCHKSUM =
  1070.                                    UNCHAR(PACKET[PACKLEN-1+7])
  1071.                                  + UNCHAR(PACKET[PACKLEN-2+7])*64
  1072.                                  + UNCHAR(PACKET[PACKLEN-3+7])*4096;
  1073.  
  1074.                          /*    PACKLEN = PACKLEN-2;  */
  1075.                          end;
  1076.  
  1077.                          if (CCHKSUM != RCHKSUM)  then
  1078.                          begin
  1079.                               R_ERROR = 7;
  1080.                               E_ST
  1081.                                   "RPACK - Longpack checksum error"
  1082.                               E_EN;
  1083.                          end;
  1084.                     end;
  1085.                end;
  1086.           end;
  1087.      end;
  1088.  
  1089.      if ( R_ERROR==0 ) then
  1090.      begin                      /* Packet OK, return the needed info */
  1091.           *TYP = PACKET[3];
  1092.           *NUM = UNCHAR(PACKET[2]);
  1093.           if (UNCHAR( PACKET[1] )  !=  0) then
  1094.             strncpy(DATA, PACKET+4, (*LEN=PACKLEN-5));
  1095.                else
  1096.             strncpy(DATA, PACKET+7, (*LEN=PACKLEN-(YOUR_BLK_CK-'0')));
  1097.      end;
  1098.      return( R_ERROR );
  1099. end
  1100.  
  1101. #pragma   SUBTITLE      "BUFILL - Fill Transmit Buffer"
  1102. #pragma   PAGE
  1103.      logical subroutine GETCHAR(CHR, CNT, STAT)
  1104.      char                      *CHR            ;
  1105.      unsigned short                  CNT       ;
  1106.      int                                  *STAT;
  1107.           begin
  1108.  
  1109.           /*  Extract a char from the buffer and do not increment */
  1110.           /*  the index.  False is returned if EOF or some error  */
  1111.           /*  condition occurs (STAT is set accordingly).         */
  1112.           /*                                                      */
  1113.           /*  If the buffer index (DBUFINX) is equal to the count */
  1114.           /*  (DBUFCNT) the buffer is empty. If in binary mode,   */
  1115.           /*  we simply get another record. Otherwise (ASCII)     */
  1116.           /*  we return EOL. In this case DBUFINX will equal      */
  1117.           /*  DBUFCNT + 1 the next time thru.                     */
  1118.  
  1119.           logical   GETCHARSTATUS = true;
  1120.  
  1121.           if ( !(DBUFINX < DBUFCNT) ) then
  1122.           begin                         /* No data in buffer */
  1123.                if (IMAGE | (DBUFINX > DBUFCNT)) then
  1124.                begin                    /* Fill up the buffer */
  1125.                     DBUFCNT = FREAD(DNUM,DBUF,-DBUF_BYTESIZE);
  1126.                     if ( ccode()==CCL ) then
  1127.                     begin               /* Read error */
  1128.                          *STAT = -1;
  1129.                          E_ST "BUFILL - Disc read error" E_EN;
  1130.                          GETCHARSTATUS = false;
  1131.                     end
  1132.                          else
  1133.                     if ( ccode()==CCG ) then
  1134.                     begin               /*  End of file */
  1135.                          GETCHARSTATUS = false;
  1136.                          if (CNT == 0) then *STAT = 1;
  1137.                     end
  1138.                          else
  1139.                     begin               /* Read went OK */
  1140.  
  1141.                          if ( !IMAGE ) then
  1142.                          begin          /* Suppress trailing blanks */
  1143.                               DBUFINX = DBUFCNT -1;
  1144.                               while ( (DBUFINX > 0) &
  1145.                                       (DBUF[DBUFINX] == ' ') )
  1146.                               begin
  1147.                                    DBUFINX = DBUFINX - 1;
  1148.                               end;
  1149.                               DBUFCNT = DBUFINX + 1;
  1150.                          end;
  1151.  
  1152.                          DBUFINX = 0;
  1153. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  1154. /*                                                                 */
  1155. /*     WARNING: Zero length binary records will not be handled     */
  1156. /*              properly.                                          */
  1157. /*                                                                 */
  1158. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  1159.                          if (DBUFCNT > 0) then
  1160.                               *CHR = DBUF[0];
  1161.                          else
  1162.                               *CHR = CR;
  1163.                     end;
  1164.                end
  1165.                     else
  1166.                begin            /* Return EOL */
  1167.                     *CHR = CR;
  1168.                end;
  1169.           end                   /* No data in buffer */
  1170.                else
  1171.           begin
  1172.                *CHR = DBUF[DBUFINX];
  1173.           end;
  1174.           return GETCHARSTATUS;
  1175.      end
  1176.  
  1177. #pragma   SUBTITLE      "BUFILL - Fill transmit buffer"
  1178. #pragma   PAGE
  1179. procedure BUFILL(DATA,CNT,STAT)
  1180. char             DATA[]        ;
  1181. int                  *CNT,*STAT;
  1182. begin
  1183.  
  1184.      logical        DONE = false;
  1185.  
  1186.      struct CHAR_DESC
  1187.      { unsigned char HI_BIT  :1;
  1188.        unsigned char LO_BITS :7;
  1189.      };
  1190.  
  1191.      union   /* THIS IS AN UNNECESSARY COMPLICATION */
  1192.      { struct CHAR_DESC CHAR;
  1193.        unsigned char T;
  1194.      }BYTE;
  1195.  
  1196.      register unsigned char T7;
  1197.  
  1198.      unsigned short INCLEN,
  1199.                     RPT_CNT,
  1200.                     IX,
  1201.                     CLEFT,
  1202.                     BUF_MAX,
  1203.                     COUNT;
  1204.  
  1205.  
  1206.      logical        TRY_REPEAT;
  1207.  
  1208.      char           INCBUF[6];   /* Intermediate Char Buf */
  1209.  
  1210.      #define        PUTCHR(CHR) { INCBUF[INCLEN] = CHR; INCLEN++;}
  1211.  
  1212.      COUNT = 0;
  1213.      *STAT = 0;
  1214.      if (LONGPACK_SIZE > MAX_SND_DATA)  then
  1215.           BUF_MAX = LONGPACK_SIZE;
  1216.      else
  1217.           BUF_MAX = MAX_SND_DATA;
  1218.      CLEFT = BUF_MAX;                   /* Compute room */
  1219.      while ( !DONE )
  1220.      begin
  1221.           DONE = !GETCHAR(&BYTE.T, COUNT, STAT);
  1222.           if ( !DONE ) then
  1223.           begin
  1224.                /* Transfer the character to an intermediate buffer */
  1225.                /* (INCBUF). If a multi-character sequence is       */
  1226.                /* generated, it is placed in INCBUF in reverse     */
  1227.                /* order. The sequence is re-inverted later.        */
  1228.  
  1229.                T7 = BYTE.CHAR.LO_BITS;      /* Get low seven bits */
  1230.  
  1231.                INCLEN = 0;
  1232.                TRY_REPEAT = USE_REPEAT;
  1233.                if ( (T7 == CR) & (!IMAGE) ) then
  1234.                begin            /* Generate end-of-line sequence */
  1235.                     TRY_REPEAT = false;
  1236.                     PUTCHR(CTL(LF));
  1237.                     PUTCHR(MY_Q_CTL);
  1238.                     PUTCHR(CTL(CR));
  1239.                     PUTCHR(MY_Q_CTL);
  1240.                end
  1241.                     else
  1242.                begin
  1243.                     if ( (T7 < SP) | (T7 == A_DEL) ) then
  1244.                     begin                       /* Control char */
  1245.                          if (QUOTE_8) then
  1246.                               PUTCHR(CTL(T7))
  1247.                          else
  1248.                               PUTCHR(CTL(BYTE.T));
  1249.                          PUTCHR(MY_Q_CTL);
  1250.                     end
  1251.                          else
  1252.                     if ( (T7 == MY_Q_CTL)  |
  1253.                          (QUOTE_8 & (T7 == Q_8))  |
  1254.                          (USE_REPEAT & (T7 == RPT_CHR)) )    then
  1255.                     begin               /* Quote a not-control char */
  1256.                          if (QUOTE_8) then
  1257.                               PUTCHR(T7)
  1258.                          else
  1259.                               PUTCHR(BYTE.T);
  1260.                          PUTCHR(MY_Q_CTL);
  1261.                     end
  1262.                          else
  1263.                     begin                       /* Regular char */
  1264.                          if (QUOTE_8) then
  1265.                               PUTCHR(T7)
  1266.                          else
  1267.                               PUTCHR(BYTE.T);
  1268.                     end;
  1269.  
  1270.                     if ( (QUOTE_8) & (BYTE.T != T7) ) then
  1271.                          PUTCHR(Q_8);
  1272.                end;
  1273.  
  1274.                /* The single char sequence has been generated. */
  1275.                /* Continue if it will fit in the buffer.       */
  1276.  
  1277.                if (INCLEN > CLEFT) then
  1278.                begin                            /* It won't fit */
  1279.                     DONE = true;
  1280.                end
  1281.                     else
  1282.                begin                            /* Accepted */
  1283.                     DBUFINX = DBUFINX +1;
  1284.                     if ( TRY_REPEAT & (CLEFT - INCLEN >= 2) ) then
  1285.                     begin
  1286.  
  1287.                          /* OK, now we do repeat processing. */
  1288.                          /* Count the adjacent occurences.   */
  1289.  
  1290.                          IX = DBUFINX;
  1291.                          while ( (IX < DBUFCNT) &
  1292.                                  (DBUF[IX] == BYTE.T) )
  1293.                          begin
  1294.                               IX = IX +1;
  1295.                          end;
  1296.  
  1297.                          RPT_CNT = IX - DBUFINX + 1;
  1298.                          if (RPT_CNT > 94) then
  1299.                               RPT_CNT = 94;
  1300.  
  1301.                          /* Use the repeat count only if it */
  1302.                          /* saves space in the buffer.      */
  1303.  
  1304.                          if ( (INCLEN+2) < (INCLEN*RPT_CNT) ) then
  1305.                          begin                  /* Use repeat */
  1306.                               PUTCHR(TOCHAR(RPT_CNT));
  1307.                               PUTCHR(RPT_CHR);
  1308.                               DBUFINX = DBUFINX + RPT_CNT - 1;
  1309.                          end;
  1310.                     end;
  1311.  
  1312.                     /* Transfer to the buffer */
  1313.  
  1314.                     while (INCLEN > 0)
  1315.                     begin
  1316.                          INCLEN = INCLEN - 1;
  1317.                          DATA[COUNT] = INCBUF[INCLEN];
  1318.                          COUNT = COUNT + 1;
  1319.                     end;
  1320.  
  1321.                     CLEFT = BUF_MAX - COUNT;
  1322.                     if (CLEFT <= 0) then DONE = true;
  1323.                end;
  1324.           end;
  1325.      end;
  1326.      *CNT = COUNT;
  1327. end
  1328.  
  1329. #pragma   SUBTITLE      "BUFEMP - Empty Received Buffer"
  1330. #pragma   page
  1331. procedure BUFEMP(DATA,CNT)
  1332. char             DATA[]   ;
  1333. int                   CNT ;
  1334. begin
  1335.  
  1336.      struct CHAR_DESC
  1337.      { unsigned char HI_BIT  :1;
  1338.        unsigned char LO_BITS :7;
  1339.      };
  1340.  
  1341.      union    /* THIS IS AN UNNECESSARY COMPLICATION */
  1342.      { struct CHAR_DESC CHAR;
  1343.        unsigned char T8;
  1344.      }BYTE;
  1345.  
  1346.      register unsigned char   T7,
  1347.                               T;
  1348.  
  1349.      unsigned short I = 0,
  1350.                     RPT_CNT,
  1351.                     T_HI;
  1352.  
  1353.      #define   NCHAR  { T = BYTE.T8 = DATA[I++]; \
  1354.                         T7 = BYTE.CHAR.LO_BITS;  \
  1355.                        }
  1356.  
  1357.      while (I < CNT)
  1358.      begin
  1359.           T_HI = 0;             /* Hold high bit here if quote 8 */
  1360.  
  1361.           RPT_CNT = 1;
  1362.  
  1363.           NCHAR;
  1364.           if ( USE_REPEAT & (T7 == RPT_CHR) ) then
  1365.           begin                         /* Process repeat */
  1366.                NCHAR;
  1367.                RPT_CNT = UNCHAR(T7);
  1368.                NCHAR;
  1369.           end;
  1370.  
  1371.           if ( QUOTE_8 && (T7 == Q_8) ) then
  1372.           begin
  1373.                T_HI = 128;
  1374.                NCHAR;
  1375.           end;
  1376.  
  1377.           if (T7 == YOUR_Q_CTL) then
  1378.           begin
  1379.                NCHAR;
  1380.                if ( (T7 >= 0x3F) && (T7 <= 0x5F) ) then
  1381.                     T = BYTE.T8 = CTL(T);
  1382.                     T7 = BYTE.CHAR.LO_BITS;
  1383.           end;
  1384.  
  1385.           if (QUOTE_8) then
  1386.                T = T_HI + T7;           /* Got the real character */
  1387.  
  1388.           if ( (!IMAGE) & (T7 == CR) ) then
  1389.                RPT_CNT = 0;             /* Throw away CR */
  1390.  
  1391.           if (EXP_TABS && (T7==HTAB) )  then
  1392.           begin
  1393.                RPT_CNT=8*RPT_CNT - (DBUFINX%8); /* NEEDS WORK */
  1394.                T=' ';
  1395.           end;
  1396.  
  1397.           /* Transfer to disc buffer */
  1398.  
  1399.           while (RPT_CNT > 0)
  1400.           begin
  1401.                RPT_CNT = RPT_CNT - 1;
  1402.                if ( (!IMAGE) & (T7 == LF) ) then
  1403.                begin
  1404.                     if (DBUF_WRITTEN) then
  1405.                     begin
  1406.                          DBUF_WRITTEN = false;
  1407.                          if (DBUFINX > 0) then
  1408.                               FLUSH_DBUF;
  1409.                     end
  1410.                          else
  1411.                     FLUSH_DBUF;
  1412.                end
  1413.                     else
  1414.                begin
  1415.                     DBUF[DBUFINX] = T;
  1416.                     DBUFINX = DBUFINX + 1;
  1417.                     if (DBUFINX >= DBUF_RMAX) then
  1418.                     begin
  1419.                          FLUSH_DBUF;
  1420.                          DBUF_WRITTEN = true;
  1421.                     end;
  1422.                end;
  1423.           end;
  1424.      end;
  1425. #    undef NCHAR
  1426. end
  1427. #pragma   SUBTITLE      "CBUFXLT - Translate Command Buffer"
  1428. #pragma   PAGE
  1429. logical procedure CBUFXLT(IDATA,ICNT,ODATA,OCNT,OMAX)
  1430. char                      IDATA[],   ODATA[]         ;
  1431. int                             ICNT,     *OCNT,OMAX ;
  1432. begin
  1433.  
  1434.      int            I = 0,
  1435.                     RPT_CNT,
  1436.                     COUNT = 0;
  1437.  
  1438.      unsigned char  T,
  1439.                     T_HI,
  1440.                     T7;
  1441.  
  1442.      logical        CBUFSTATUS;
  1443. #    define         NCHAR { T = IDATA[I]; T7 = T%128; I++; }
  1444.  
  1445.      COUNT = 0;
  1446.      CBUFSTATUS = true;
  1447.  
  1448.      while (I < ICNT)
  1449.      begin
  1450.           T_HI = 0;             /* Hold high bit here if quote 8 */
  1451.  
  1452.           RPT_CNT = 1;
  1453.  
  1454.           NCHAR;
  1455.           if ( USE_REPEAT & (T7 == RPT_CHR) ) then
  1456.           begin                 /* Process repeat */
  1457.                NCHAR;
  1458.                RPT_CNT = UNCHAR(T7);
  1459.                NCHAR;
  1460.           end;
  1461.  
  1462.           if (QUOTE_8 & (T7 == Q_8) ) then
  1463.           begin
  1464.                T_HI = 128;
  1465.                NCHAR;
  1466.           end;
  1467.  
  1468.           if (T7 == YOUR_Q_CTL) then
  1469.           begin
  1470.                NCHAR;
  1471.                if ( (T7 >= 0x3F) & (T7 <= 0x5F) ) then
  1472.                     T = CTL(T);
  1473.                T7 = T%128;
  1474.           end;
  1475.  
  1476.           if (QUOTE_8) then
  1477.                T = T_HI + T7;           /* Got the real character */
  1478.  
  1479.  
  1480.           /* Transfer to output buffer */
  1481.  
  1482.           while (RPT_CNT > 0)
  1483.           begin
  1484.                RPT_CNT = RPT_CNT - 1;
  1485.                ODATA[COUNT] = T;
  1486.                COUNT = COUNT + 1;
  1487.                if (COUNT >= OMAX) then
  1488.                begin
  1489.                     I = 0;
  1490.                     CBUFSTATUS = false;
  1491.                end;
  1492.           end;
  1493.      end;
  1494.      *OCNT = COUNT;
  1495.      return CBUFSTATUS;
  1496. end
  1497. #pragma   SUBTITLE      "UNQFNAME - Check For Unique File Name"
  1498. #pragma   PAGE
  1499. logical procedure UNQFNAME(FNAME,LEN)
  1500. int                              LEN ;
  1501. char                       FNAME[]   ;
  1502. begin
  1503.  
  1504.      char         BA_TEMP[38];
  1505.  
  1506.      short        I_ERR,
  1507.                   I_PARM;
  1508.  
  1509.      strcpy(BA_TEMP, "listf ");
  1510.      strncat(BA_TEMP+6, FNAME, LEN);
  1511.      strcat(BA_TEMP+6+LEN, ";$NULL");
  1512.      BA_TEMP[strlen(BA_TEMP)] = CR;
  1513.      HPCICOMMAND(BA_TEMP, &I_ERR, &I_PARM, NO_VISIBLE_MSG);
  1514.      return(I_ERR == 907);
  1515. end
  1516.  
  1517. #pragma   SUBTITLE      "MAKE_U_FNAME - Make a Unique File Name"
  1518. #pragma   PAGE
  1519. logical procedure MAKE_U_FNAME(FNAME,LEN)
  1520. char                           FNAME[]   ;
  1521. int                                 *LEN ;
  1522. begin
  1523.  
  1524.      int            FIX,   /* From Index  */
  1525.                     TIX,   /* To Index    */
  1526.                     BLEN;  /* Base Length */
  1527.  
  1528.      logical        ALPH,  /* Char Alpha  */
  1529.                     NUM,   /* Char is Num */
  1530.                     DONE,  /* Loop Flag   */
  1531.                     FNAMESTATUS;
  1532.  
  1533.      unsigned char  ITEMP; /* Scratch     */
  1534.  
  1535.      FIX = 0;
  1536.      TIX = 0;
  1537.      BLEN = *LEN;
  1538.  
  1539.      while (FIX < BLEN)
  1540.      begin
  1541.           ITEMP = FNAME[FIX];
  1542.  
  1543.           if ( (ITEMP >= 'a') &
  1544.                (ITEMP <= 'z') ) then ITEMP = ITEMP - ' ';
  1545.  
  1546.           ALPH = false;
  1547.           NUM = false;
  1548.  
  1549.           if ( (ITEMP >= 'A')  &
  1550.                (ITEMP <= 'Z') ) then ALPH = true;
  1551.                else
  1552.           if ( (ITEMP >= '0')  &
  1553.                (ITEMP <= '9') ) then NUM = true;
  1554.  
  1555.           if ( (ALPH & (TIX==0)) |
  1556.                ( (ALPH | NUM) & (TIX > 0) ) ) then
  1557.           begin
  1558.                FNAME[TIX] = ITEMP;
  1559.                TIX = TIX + 1;
  1560.           end;
  1561.  
  1562.           FIX = FIX + 1;
  1563.      end;
  1564.  
  1565.      BLEN = TIX;
  1566.  
  1567.      /*------------------------------------------------*/
  1568.      /* File name now in native format. Adjust length. */
  1569.      /*------------------------------------------------*/
  1570.  
  1571.      if (BLEN > 8) then BLEN = 8;    /* Truncate */
  1572.           else
  1573.      if (BLEN == 0) then
  1574.      begin                      /* Nothing left, use default */
  1575.           strcpy(FNAME, "KMT ");
  1576.           BLEN = 3;
  1577.      end;
  1578.  
  1579.      /*----------------------------------------*/
  1580.      /* File name is now OK , check uniqueness */
  1581.      /*----------------------------------------*/
  1582.  
  1583.      if (UNQFNAME(FNAME,BLEN)) then
  1584.      begin              /* OK, we're done */
  1585.           FNAMESTATUS = true;
  1586.           *LEN = BLEN;
  1587.      end
  1588.           else
  1589.      begin
  1590.           /* ----------------------------------------------*/
  1591.           /* Append two numeric chars (00-99) to the name. */
  1592.           /*-----------------------------------------------*/
  1593.  
  1594.           if (BLEN>6) then
  1595.                BLEN = 6;
  1596.  
  1597.           ITEMP = 1;
  1598.           DONE = false;
  1599.           while ( (ITEMP < 99) & !DONE )
  1600.           begin
  1601.                FNAME[BLEN] = (ITEMP/10) + '0';
  1602.                FNAME[BLEN+1] = (ITEMP%10) + '0';
  1603.                *LEN = BLEN + 2;
  1604.                if (UNQFNAME(FNAME,*LEN)) then
  1605.                     DONE = true;
  1606.                else
  1607.                     ITEMP = ITEMP + 1;
  1608.           end;
  1609.  
  1610.           FNAMESTATUS = (!DONE);
  1611.      end;
  1612.      return FNAMESTATUS;
  1613. end
  1614.  
  1615. #pragma   SUBTITLE      "P_EPACK Print Error (E) Packet Data"
  1616. #pragma   PAGE
  1617. procedure P_EPACK(DATA,LEN)
  1618. int                    LEN ;
  1619. char              DATA[]   ;
  1620. begin
  1621.  
  1622.      if (LOGNUM != 0) then
  1623.           FWRITE(LOGNUM,DATA,-LEN,0);
  1624. end
  1625.  
  1626. #pragma   SUBTITLE      "SBREAK - Send Break"
  1627. #pragma   PAGE
  1628. char procedure SBREAK()
  1629. begin
  1630.  
  1631.      char      SBREAKSTATUS;
  1632.  
  1633.      SBREAKSTATUS = STATE;      /* Default is no change */
  1634.      NUMTRY = NUMTRY + 1;
  1635.      if (NUMTRY > MAXTRY) then
  1636.      begin
  1637.           E_ST "SBREAK - Max retrys exceeded " E_EN;
  1638.           SBREAKSTATUS = 'A';
  1639.      end
  1640.           else
  1641.      begin
  1642.           SPACK('B', N, 0, RP_DATA);
  1643.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 )  then
  1644.           begin
  1645.                if (RP == 'Y') then
  1646.                begin
  1647.                     if (RP_NUM == N) then
  1648.                     begin
  1649.                          NUMTRY = 0;
  1650.                          N = NPNO(N);
  1651.                          SBREAKSTATUS = 'C';
  1652.                     end;
  1653.                end
  1654.                     else
  1655.                if (RP == 'E') then
  1656.                begin
  1657.                     E_ST "SBREAK - E packet recieved" E_EN;
  1658.                     P_EPACK(RP_DATA,RP_LEN);
  1659.                     SBREAKSTATUS = 'A';
  1660.                end
  1661.                     else
  1662.                if (RP != 'N') then
  1663.                begin
  1664.                     E_ST "SBREAK - Unknown packet type" E_EN;
  1665.                     SBREAKSTATUS = 'A';
  1666.                end;
  1667.           end;
  1668.      end;
  1669.      return SBREAKSTATUS;
  1670. end
  1671. #pragma   SUBTITLE      "SPAR - Set Up Send SI Parameters"
  1672. #pragma   PAGE
  1673. subroutine SPAR(DATA,LEN)
  1674. char            DATA[]   ;
  1675. int                 *LEN ;
  1676. begin
  1677.      DATA[0] = TOCHAR(MAX_RCV_SIZE); /* Biggest to send me      */
  1678.      DATA[1] = TOCHAR(MY_TO);        /* When to time me out     */
  1679.      DATA[2] = TOCHAR(0);            /* How many pads I need    */
  1680.      DATA[3] = CTL(0);               /* Pad char to use for me  */
  1681.      DATA[4] = TOCHAR(CR);           /* End-of-line char for me */
  1682.      DATA[5] = MY_Q_CTL;             /* Control quote I send    */
  1683.      DATA[6] = P_Q_8;                /* Prefered 8 bit quote    */
  1684.      DATA[7] = MY_BLK_CK;            /* 3-char CRC default      */
  1685.      DATA[8] = P_RPT_CHR;            /* Prefered repeat prefix  */
  1686.      DATA[9] = TOCHAR(MY_CAPS);      /* Extended capabilities   */
  1687.      DATA[10]= TOCHAR(0);            /* Windowing (none here)   */
  1688.      DATA[11]= TOCHAR(LONGPACK_SIZE / 95);   /* MAXL1           */
  1689.      DATA[12]= TOCHAR(LONGPACK_SIZE % 95);   /* MAXL2           */
  1690.      *LEN = 13;
  1691. end
  1692.  
  1693. #pragma   SUBTITLE      "RPAR - Set Up Send RI Parameters"
  1694. #pragma   PAGE
  1695. subroutine RPAR(DATA,LEN)
  1696. int                  LEN ;
  1697. char            DATA[]   ;
  1698. begin
  1699.      int       TEMP;
  1700.  
  1701.      MAX_SND_SIZE = UNCHAR(DATA[0]);  /* Max send size          */
  1702. /*  !  MAX_SND_DATA = MAX_SND_SIZE -3;   Max send data size     */
  1703.      YOUR_TO = UNCHAR(DATA[1]);       /* When I time you out    */
  1704.      YOUR_PAD_COUNT = UNCHAR(DATA[2]);/* Number of pads to send */
  1705.      YOUR_PAD = CTL(DATA[3]);         /* Your Pad char          */
  1706.      YOUR_EOL = UNCHAR(DATA[4]);      /* Your end-of-line       */
  1707.      YOUR_Q_CTL = DATA[5];            /* Your control quote     */
  1708.  
  1709.      QUOTE_8 = false;
  1710.      if (LEN > 6) then
  1711.      begin
  1712.           if ( (DATA[6] == 'Y') | (DATA[6] == P_Q_8) ) then
  1713.           begin
  1714.                Q_8 = P_Q_8;
  1715.                QUOTE_8 = true;
  1716.           end;
  1717.      end;
  1718.  
  1719.      if (LEN > 7)  then
  1720.      YOUR_BLK_CK = DATA[7];
  1721.           else
  1722.      YOUR_BLK_CK = '1';  /* No block check -> one-byte check */
  1723.  
  1724.      if ( (LEN > 8) & (DATA[8] == P_RPT_CHR) ) then
  1725.      begin
  1726.           RPT_CHR = P_RPT_CHR;
  1727.           USE_REPEAT = true;          /* OK for repeat prefix   */
  1728.      end
  1729.           else
  1730.      begin
  1731.           USE_REPEAT = false;         /* No repeat processing   */
  1732.      end;
  1733.  
  1734.      if (LEN >= 12)  then
  1735.      begin     /* Other side agrees to long packets, maybe */
  1736.           YOUR_CAPS = ( UNCHAR(DATA[9]) && (MY_CAPS) );
  1737.           /* Windowing, DATA[10], is unsupported in this prog */
  1738.           TEMP = 95*UNCHAR(DATA[11]) + UNCHAR(DATA[12]);
  1739.           if (TEMP > MAX_SND_SIZE)  then
  1740.           begin
  1741.                if (TEMP < MAX_LONGPACK_SIZE)  then
  1742.                     LONGPACK_SIZE = TEMP-7-(YOUR_BLK_CK-'0');
  1743.                else
  1744.                     LONGPACK_SIZE = MAX_LONGPACK_SIZE;
  1745.           end
  1746.                else
  1747.           LONGPACK_SIZE = 0;
  1748.      end
  1749.           else
  1750.      LONGPACK_SIZE = 0;       /* Long packets disallowed */
  1751. end
  1752.  
  1753. #pragma   SUBTITLE      "SINIT - Perform Send Init"
  1754. #pragma   PAGE
  1755. char subroutine SINIT()
  1756. begin
  1757.  
  1758.      char      SINITSTATUS;
  1759.  
  1760.      SINITSTATUS = STATE;  /* Default to return current state */
  1761.      NUMTRY = NUMTRY + 1;
  1762.      if (NUMTRY > MAXTRY) then
  1763.      begin
  1764.           E_ST "SINIT - Max retrys exceeded" E_EN;
  1765.           SINITSTATUS = 'A';               /* Abort */
  1766.      end
  1767.           else
  1768.      begin
  1769.           SPAR(RP_DATA, &RP_LEN);          /* Set up SI data */
  1770.           N = 0;                           /* Start packets at zero */
  1771.           SPACK('S', N, RP_LEN, RP_DATA);  /* And send it    */
  1772.  
  1773.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then
  1774.           begin
  1775.                if (RP == 'Y') then
  1776.                begin
  1777.                     if (RP_NUM == N) then
  1778.                     begin                       /* Positive response */
  1779.                          RPAR(RP_DATA,RP_LEN);  /* Get parameters */
  1780.                          if ( (YOUR_BLK_CK != '1')  &
  1781.                               (YOUR_BLK_CK != '3') )  then
  1782.                          begin   /* Whatever that was, I can't do it */
  1783.                               MY_BLK_CK = '1';  /* Lets try again */
  1784.                               N = 0;
  1785.                               SINITSTATUS = 'S';
  1786.                          end
  1787.                               else
  1788.                          begin          /*  OK, let'stry it your way */
  1789.                               MY_BLK_CK = YOUR_BLK_CK;
  1790.                               MAX_SND_DATA = MAX_SND_SIZE -
  1791.                                              3-(YOUR_BLK_CK-'0');
  1792.                               NUMTRY = 0;
  1793.                               N = NPNO(N);
  1794.                               SINITSTATUS = 'F';
  1795.                          end;
  1796.                     end;
  1797.                end
  1798.                     else
  1799.                if (RP == 'E') then
  1800.                begin                    /* Error packet */
  1801.                     E_ST "SINIT - E packet recieved" E_EN;
  1802.                     P_EPACK(RP_DATA,RP_LEN);
  1803.                     SINITSTATUS = 'A';
  1804.                end;
  1805.           end;
  1806.      end;
  1807.      return SINITSTATUS;
  1808. end
  1809.  
  1810. #pragma   SUBTITLE      "SFILE - Send File Header"
  1811. #pragma   PAGE
  1812. char subroutine SFILE(SFNAME,SFNLEN)
  1813. char                  SFNAME[]      ;
  1814. int                          SFNLEN ;
  1815.  
  1816. begin
  1817.      int       SFILESTATUS,
  1818.                BFSTAT;
  1819.  
  1820.      SFILESTATUS = STATE;               /* Default to current state */
  1821.      NUMTRY = NUMTRY + 1;
  1822.      if (NUMTRY > MAXTRY) then
  1823.      begin
  1824.           E_ST "SFILE - Max retrys exceeded" E_EN;
  1825.           SFILESTATUS = 'A';                    /* Abort */
  1826.      end
  1827.           else
  1828.      begin
  1829.           if (SFNLEN == 0) then
  1830.                SPACK('X', N, 0, SFNAME);      /* Header only */
  1831.           else
  1832.                SPACK('F', N, SFNLEN, SFNAME); /* Normal file */
  1833.  
  1834.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 )then
  1835.           begin
  1836.                if (RP == 'Y') then
  1837.                begin
  1838.                     if (RP_NUM == N) then
  1839.                     begin
  1840.                          DBUFCNT = 0; /* Set disc buf empty */
  1841.                          DBUFINX = 1; /* Index=get next     */
  1842.  
  1843.                          BUFILL(PDATA,&PDATACNT,&BFSTAT);
  1844.                          if (BFSTAT == 0) then
  1845.                          begin
  1846.                               NUMTRY = 0;
  1847.                               N = NPNO(N);
  1848.                               SFILESTATUS = 'D';
  1849.                          end
  1850.                               else
  1851.                          begin
  1852.                               E_ST "SFILE - BUFILL error" E_EN;
  1853.                               N = NPNO(N);
  1854.                               SFILESTATUS = 'Z';
  1855.                          end;
  1856.                     end;
  1857.                end
  1858.                     else
  1859.                if (RP == 'E') then
  1860.                begin
  1861.                     P_EPACK(RP_DATA,RP_LEN);
  1862.                     SFILESTATUS = 'A';
  1863.                end
  1864.                     else
  1865.                if (RP != 'N') then
  1866.                begin
  1867.                     SFILESTATUS = 'A';
  1868.                     E_ST "SFILE - Unknown packet type" E_EN;
  1869.                end;
  1870.           end;
  1871.      end;
  1872.      return SFILESTATUS;
  1873. end
  1874.  
  1875. #pragma   SUBTITLE      "SDATA - Send Data Packet"
  1876. #pragma   PAGE
  1877. char subroutine SDATA()
  1878. begin
  1879.      char      SDATASTATUS;
  1880.      int       BFSTAT;
  1881.  
  1882.      SDATASTATUS = STATE; /* Default is return current state */
  1883.  
  1884.      NUMTRY = NUMTRY + 1;
  1885.      if (NUMTRY > MAXTRY) then
  1886.      begin
  1887.           SDATASTATUS = 'A';
  1888.           E_ST "SDATA - Retry count exceeded" E_EN;
  1889.      end
  1890.           else
  1891.      begin
  1892.           SPACK('D', N, PDATACNT, PDATA);
  1893.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then
  1894.           begin
  1895.                if (RP == 'Y') then
  1896.                begin
  1897.                     if (RP_NUM == N) then
  1898.                     begin
  1899.                          NUMTRY = 0;
  1900.                          N = NPNO(N);
  1901.                          BUFILL(PDATA,&PDATACNT,&BFSTAT);
  1902.                          if (BFSTAT != 0) then
  1903.                          begin
  1904.                               SDATASTATUS = 'Z';
  1905.                               FCLOSE(DNUM,0,0);
  1906.                               DNUM = 0;
  1907.                          end;
  1908.                     end;
  1909.                end
  1910.                     else
  1911.                if (RP == 'E') then
  1912.                begin
  1913.                     E_ST "SDATA - E packet recieved" E_EN;
  1914.                     P_EPACK(RP_DATA,RP_LEN);
  1915.                     SDATASTATUS = 'A';
  1916.                end
  1917.                     else
  1918.                if (RP != 'N') then
  1919.                begin
  1920.                     SDATASTATUS = 'A';
  1921.                     E_ST "SDATA - Unknown Packet Type" E_EN;
  1922.                end;
  1923.           end;
  1924.      end;
  1925.      return SDATASTATUS;
  1926. end
  1927.  
  1928. #pragma   SUBTITLE      "SEOF - Send EOF"
  1929. #pragma   PAGE
  1930. char subroutine SEOF()
  1931. begin
  1932.      char      SEOFSTATUS;
  1933.  
  1934.      SEOFSTATUS = STATE;
  1935.      NUMTRY = NUMTRY + 1;
  1936.      if (NUMTRY > MAXTRY) then
  1937.      begin
  1938.           E_ST "SEOF - Max retrys exceeded" E_EN;
  1939.           SEOFSTATUS = 'A';
  1940.      end
  1941.           else
  1942.      begin
  1943.           SPACK('Z', N, 0, RP_DATA);
  1944.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then
  1945.           begin
  1946.                if (RP == 'Y') then
  1947.                begin
  1948.                     if (RP_NUM == N) then
  1949.                     begin
  1950.                          NUMTRY = 0;
  1951.                          N = NPNO(N);
  1952.                          SEOFSTATUS = 'B';
  1953.                     end;
  1954.                end
  1955.                     else
  1956.                if (RP == 'E') then
  1957.                begin
  1958.                     E_ST "SEOF - E packet recieved" E_EN;
  1959.                     P_EPACK(RP_DATA,RP_LEN);
  1960.                     SEOFSTATUS = 'A';
  1961.                end
  1962.                     else
  1963.                if (RP != 'N') then
  1964.                begin
  1965.                     SEOFSTATUS = 'A';
  1966.                     E_ST "SEOF - Unknown packet type" E_EN;
  1967.                end;
  1968.           end;
  1969.      end;
  1970.      return SEOFSTATUS;
  1971. end
  1972.  
  1973. #pragma   SUBTITLE      "SENDSW - Packet Sender"
  1974. #pragma   PAGE
  1975. logical procedure SENDSW(SFNAME,SFNLEN)
  1976. char                     SFNAME[]      ;
  1977. int                             SFNLEN ;
  1978. begin
  1979.  
  1980.      logical        DONE = false,
  1981.                     FOPT,
  1982.                     SENDSWSTATUS;
  1983.  
  1984.      char           FORMALDESIG[30];
  1985.  
  1986. /* Send Switch (Main Code) */
  1987.  
  1988.      MY_JCW_VAL = SENDING;
  1989.      PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  1990.      if  (IMPATIENT)  then
  1991.      begin
  1992.           MY_TO = FAST_TO;
  1993.           MAXTRY = FAST_MAXTRY;
  1994.      end
  1995.           else
  1996.      begin
  1997.           MY_TO = DFLT_TO;
  1998.           MAXTRY = DFLT_MAXTRY;
  1999.      end;
  2000.  
  2001.      NUMTRY = 0;
  2002.      if (SFNLEN <= 0)  then
  2003.      begin
  2004.           STATE = 'S';          /* Normal file send */
  2005.           SFNLEN = -SFNLEN;     /* Make positive again */
  2006.      end
  2007.      else
  2008.           STATE = 'F';          /* Sending text, skip SI */
  2009.  
  2010.      if (SND_BINARY == 1) then
  2011.      begin                      /* Always binary */
  2012.           IMAGE = true;
  2013.      end
  2014.           else
  2015.      if (SND_BINARY == 2) then
  2016.      begin                      /* Always ASCII */
  2017.           IMAGE = false;
  2018.      end
  2019.           else
  2020.      begin                      /* Auto, check file */
  2021.           FGETINFO(DNUM,FORMALDESIG,&FOPT);
  2022.           if ( (FOPT & 0x4) != 0 ) then
  2023.                IMAGE = false;
  2024.           else
  2025.                IMAGE = true;
  2026.      end;
  2027.  
  2028.      while ( !(DONE | CTLY) )
  2029.      begin
  2030.           if (STATE == 'S') then STATE = SINIT();
  2031.                else
  2032.           if (STATE == 'F') then STATE = SFILE(SFNAME,SFNLEN);
  2033.                else
  2034.           if (STATE == 'D') then STATE = SDATA();
  2035.                else
  2036.           if (STATE == 'Z') then STATE = SEOF();
  2037.                else
  2038.           if (STATE == 'B') then
  2039.           begin
  2040.                STATE = 'C';
  2041.                DONE = true;
  2042.           end
  2043.                else
  2044.           begin
  2045.                DONE = true;
  2046.           end;
  2047.      end;
  2048.  
  2049.      if (DNUM != 0) then
  2050.      begin
  2051.           FCLOSE(DNUM,0,0);
  2052.           DNUM = 0;
  2053.      end;
  2054.      if (STATE == 'C') then
  2055.      begin
  2056.           MY_JCW_VAL = SEND_OK;
  2057.           SENDSWSTATUS = true;
  2058.      end
  2059.           else
  2060.      begin
  2061.           MY_JCW_VAL = SEND_NG;
  2062.           SENDSWSTATUS = false;
  2063.      end;
  2064.      return SENDSWSTATUS;
  2065. end
  2066.  
  2067. #pragma   SUBTITLE      "R_RPAR - Receive Read RI Parms"
  2068. #pragma   PAGE
  2069. procedure R_RPAR(DATA,LEN)
  2070. int                   LEN ;
  2071. char             DATA[]   ;
  2072. begin
  2073.      int       TEMP;
  2074.  
  2075.      MAX_SND_SIZE = UNCHAR(DATA[0]);   /* Max send size          */
  2076.      MAX_SND_DATA = MAX_SND_SIZE -3;   /* Max send data size     */
  2077.      YOUR_TO = UNCHAR(DATA[1]);        /* When I time you out    */
  2078.      YOUR_PAD_COUNT = UNCHAR(DATA[2]); /* Number of pads to send */
  2079.      YOUR_PAD = CTL(DATA[3]);          /* Your Pad char          */
  2080.      YOUR_EOL = UNCHAR(DATA[4]);       /* Your end-of-line       */
  2081.      YOUR_Q_CTL = DATA[5];             /* Your control quote     */
  2082.      if ( (LEN > 6) & (DATA[6] == 'Y') )  then
  2083.      begin                             /* I specify the quote    */
  2084.           Q8_IND = 'Y';
  2085.           QUOTE_8 = true;
  2086.      end
  2087.           else
  2088.      if ( (LEN > 6) & (DATA[6] != 'N') ) then
  2089.      begin                      /* Quote specified for me */
  2090.           Q_8 = DATA[6];
  2091.           Q8_IND = ' ';
  2092.           QUOTE_8 = true;
  2093.      end
  2094.           else
  2095.      begin                      /* No 8 bit quoting */
  2096.           QUOTE_8 = false;
  2097.      end;
  2098.  
  2099.      if (LEN > 7)  then
  2100.      begin
  2101.           YOUR_BLK_CK = DATA[7];
  2102.           if ( (YOUR_BLK_CK == '1') |
  2103.                (YOUR_BLK_CK == '3') )  then
  2104.           MY_BLK_CK = YOUR_BLK_CK;         /* Will do it your way */
  2105.                else
  2106.           MY_BLK_CK = YOUR_BLK_CK = '1';   /* The old way */
  2107.      end
  2108.           else
  2109.      MY_BLK_CK = YOUR_BLK_CK = '1';       /* No blk ck -> one-byte ck */
  2110.  
  2111.      if ( (LEN > 8) & (DATA[8] != ' ') ) then
  2112.      begin
  2113.           RPT_CHR = DATA[8];
  2114.           USE_REPEAT = true;
  2115.      end
  2116.           else
  2117.      begin
  2118.           USE_REPEAT = false;
  2119.      end;
  2120.      if (LEN > 12)  then          /* Extended packet stuff */
  2121.      begin
  2122.           YOUR_CAPS = UNCHAR(DATA[9]) & MY_CAPS;
  2123.  
  2124.           /* Windowing, DATA(10), is unsupported herein */
  2125.  
  2126.           TEMP = UNCHAR(DATA[11])*95 + UNCHAR(DATA[12]);
  2127.           if (TEMP > MAX_LONGPACK_SIZE)  then
  2128.                TEMP = MAX_LONGPACK_SIZE;
  2129.           LONGPACK_SIZE = TEMP-7-(YOUR_BLK_CK-'1');
  2130.      end
  2131.           else
  2132.      LONGPACK_SIZE = MAX_SND_SIZE-6;
  2133. end
  2134.  
  2135. #pragma   SUBTITLE      "R_SPAR - Set up SEND Parameters"
  2136. #pragma   PAGE
  2137. procedure R_SPAR(DATA,LEN)
  2138. char             DATA[]   ;
  2139. int                  *LEN ;
  2140. begin
  2141.      DATA[0] = TOCHAR(MAX_RCV_SIZE   /* Biggest to send me      */
  2142.                 + 1 - (MY_BLK_CK-'0'));
  2143.      DATA[1] = TOCHAR(MY_TO);        /* When to time me out     */
  2144.      DATA[2] = TOCHAR(0);            /* How many pads I need    */
  2145.      DATA[3] = CTL(0);               /* Pad char to use for me  */
  2146.      DATA[4] = TOCHAR(CR);           /* End-of-line char for me */
  2147.      DATA[5] = MY_Q_CTL;             /* Control quote I send    */
  2148.      if (QUOTE_8) then
  2149.      begin
  2150.           if (Q8_IND == 'Y') then
  2151.           begin                 /* I specify the char */
  2152.                Q_8 = P_Q_8;
  2153.                DATA[6] = P_Q_8;
  2154.           end
  2155.                else
  2156.           begin                 /* Already specified */
  2157.                DATA[6] = 'Y';
  2158.           end;
  2159.      end
  2160.           else
  2161.      begin
  2162.           DATA[6] = 'N';        /* No 8 bit quoting */
  2163.      end;
  2164.  
  2165.      DATA[7] = MY_BLK_CK;
  2166.  
  2167.      if (USE_REPEAT) then
  2168.           DATA[8] = RPT_CHR;
  2169.      else
  2170.           DATA[8] = ' ';
  2171.  
  2172.      DATA[9] = TOCHAR(YOUR_CAPS);    /* We negotiated this  */
  2173.  
  2174.      DATA[10] = TOCHAR(0);           /* We don't do windows */
  2175.  
  2176.      DATA[11] = TOCHAR( (LONGPACK_SIZE / 95) );   /* MAXL1 */
  2177.      DATA[12] = TOCHAR( (LONGPACK_SIZE % 95) );   /* MAXL2 */
  2178.  
  2179.      *LEN = 13;
  2180. end
  2181.  
  2182. #pragma   SUBTITLE      "RINIT - Recieve Initialization"
  2183. #pragma   PAGE
  2184. char subroutine RINIT()
  2185. begin
  2186.  
  2187.      int       R_ERROR,
  2188.                RINITSTATUS;
  2189.  
  2190.      RINITSTATUS = STATE;
  2191.      NUMTRY = NUMTRY + 1;
  2192.      if (NUMTRY > MAXTRY) then
  2193.      begin
  2194.           E_ST "RINIT - Retry count exceeded" E_EN;
  2195.           RINITSTATUS = 'A';
  2196.      end
  2197.           else
  2198.      begin
  2199.           R_ERROR = RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA);
  2200.           if (R_ERROR == 0)  then
  2201.           begin
  2202.                if (RP == 'S') then
  2203.                begin
  2204.                     R_RPAR(RP_DATA,RP_LEN);         /* Read the others*/
  2205.                     R_SPAR(RP_DATA,&RP_LEN);         /* Generate ours */
  2206.                     SPACK('Y', N, RP_LEN, RP_DATA);  /* Send it       */
  2207.  
  2208.                     OLDTRY = NUMTRY;    /* Save trys */
  2209.                     NUMTRY = 0;
  2210.                     N = NPNO(RP_NUM);   /* Syncronize */
  2211.                     RINITSTATUS = 'F';  /* Switch to F mode */
  2212.                end
  2213.                     else
  2214.                if (RP == 'E') then
  2215.                begin
  2216.                     E_ST "RINIT - E packet recieved" E_EN;
  2217.                     P_EPACK(RP_DATA,RP_LEN);
  2218.                     RINITSTATUS = 'A';
  2219.                end
  2220.                     else
  2221.                if (RP == 'N') then
  2222.                begin
  2223.                     E_ST "RINIT - NAK packet recieved" E_EN;
  2224.                     P_EPACK(RP_DATA,RP_LEN);
  2225.                end
  2226.                     else
  2227.                begin
  2228.                     E_ST "RINIT - Unexpected packet type" E_EN;
  2229.                     RINITSTATUS = 'A';
  2230.                end;
  2231.           end
  2232.                else
  2233.           begin
  2234.                if (R_ERROR != 3) then   /*no SOH found*/
  2235.                     SPACK('N', N, 0, RP_DATA);
  2236.           end;
  2237.      end;
  2238.      return RINITSTATUS;
  2239. end
  2240.  
  2241. #pragma   SUBTITLE      "RFILE - Recieve a File Header"
  2242. #pragma   PAGE
  2243. char subroutine RFILE()
  2244. begin
  2245.  
  2246.      char      FNAME[30],
  2247.                RFILESTATUS;
  2248.  
  2249.      int       FN_LEN,
  2250.                FOPT;
  2251.  
  2252.      #define   FN_MAX  35
  2253.  
  2254.      RFILESTATUS = STATE;
  2255.      NUMTRY = NUMTRY + 1;
  2256.      if (NUMTRY > MAXTRY) then
  2257.      begin
  2258.           E_ST "RFILE - Retry count exceeded" E_EN;
  2259.           RFILESTATUS = 'A';
  2260.      end
  2261.           else
  2262.      begin
  2263.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then
  2264.           begin                         /* Got a packet*/
  2265.                if (RP == 'S') then
  2266.                begin            /* Still in SI, perhaps ACK lost*/
  2267.                     OLDTRY = OLDTRY + 1;
  2268.                     if (OLDTRY > MAXTRY) then
  2269.                     begin
  2270.                          E_ST "RFILE - Pretry (S) exceeded" E_EN;
  2271.                          RFILESTATUS = 'A';
  2272.                     end
  2273.                          else
  2274.                     if (RP_NUM != PPNO(N)) then
  2275.                     begin               /* Number must match */
  2276.                          E_ST "RFILE - N mismatch on S packet" E_EN;
  2277.                          RFILESTATUS = 'A';
  2278.                     end
  2279.                          else
  2280.                     begin               /* OK, re-ACK the packet */
  2281.                          R_SPAR(RP_DATA,&RP_LEN);
  2282.                          SPACK('Y', RP_NUM, RP_LEN, RP_DATA);
  2283.                          NUMTRY = 0;
  2284.                     end;
  2285.                end
  2286.                     else
  2287.                if (RP == 'Z') then
  2288.                begin            /* End of file, previous packet (?) */
  2289.                     OLDTRY = OLDTRY + 1;
  2290.                     if (OLDTRY > MAXTRY) then
  2291.                     begin
  2292.                          E_ST "RFILE - Pretry (Z) exceeded" E_EN;
  2293.                          RFILESTATUS = 'A';
  2294.                     end
  2295.                          else
  2296.                     if (RP_NUM != PPNO(N)) then
  2297.                     begin               /* N must match */
  2298.                          E_ST "RFILE - N mismatch on Z packet" E_EN;
  2299.                          RFILESTATUS = 'A';
  2300.                     end
  2301.                          else
  2302.                     begin               /* OK, re-ACK the packet */
  2303.                          SPACK('Y', RP_NUM, 0, RP_DATA);
  2304.                          NUMTRY = 0;
  2305.                     end;
  2306.                end
  2307.                     else
  2308.                if (RP == 'F') then
  2309.                begin /* File header (what we expect) */
  2310.                     if (RP_NUM != N) then
  2311.                     begin               /* Oops */
  2312.                          E_ST "RFILE - N mismatch" E_EN;
  2313.                          RFILESTATUS = 'A';
  2314.                     end
  2315.                          else
  2316.                     begin               /* OK, Open the file */
  2317.  
  2318.                          if (L_FNAME_LEN != 0) then
  2319.                          begin
  2320.                               strncpy(FNAME, L_FNAME, L_FNAME_LEN);
  2321.                               FN_LEN = L_FNAME_LEN;
  2322.                          end
  2323.                               else
  2324.                          begin
  2325.                               CBUFXLT(RP_DATA,RP_LEN,
  2326.                                         FNAME,&FN_LEN,FN_MAX);
  2327.  
  2328.                               if ( !UNQFNAME(FNAME,FN_LEN) ) then
  2329.                               begin
  2330.                                    MAKE_U_FNAME(FNAME,&FN_LEN);
  2331.                               end;
  2332.                          end;
  2333.  
  2334.                          FNAME[FN_LEN] = ' ';
  2335.  
  2336.                          if (RCV_BINARY) then
  2337.                          begin          /* Binary mode */
  2338.                               IMAGE = true;
  2339.                               FOPT = 0;
  2340.                          end
  2341.                               else
  2342.                          begin          /* ASCII mode */
  2343.                               IMAGE = false;
  2344.                               FOPT = 4;
  2345.                          end;
  2346.  
  2347.                          if ( !RCV_FIXREC ) then
  2348.                               FOPT = FOPT + 0x40; /* set variable */
  2349.  
  2350.                          if (RCV_RECLEN < 0) then
  2351.                               DBUF_RMAX = -RCV_RECLEN;
  2352.                          else
  2353.                               DBUF_RMAX = RCV_RECLEN * 2;
  2354.  
  2355.                          begin
  2356.                               DNUM = FOPEN(FNAME,FOPT,1,
  2357.                                             RCV_RECLEN,
  2358.                                             RCV_DEV,0,0,
  2359.                                             RCV_BLOCKF,0,
  2360.                                             RCV_MAXREC,
  2361.                                             RCV_MAXEXT,1,
  2362.                                             RCV_FCODE);
  2363.  
  2364.                               if (DNUM == 0) then
  2365.                               begin     /* Can't open file */
  2366.                                    E_ST "RFILE - Can't open file" E_EN;
  2367.                                    RFILESTATUS = 'A';
  2368.                               end
  2369.                                    else
  2370.                               begin     /* OK */
  2371.                                    strcpy(RP_DATA, FNAME);
  2372.                                    RP_LEN = FN_LEN;
  2373.                                    SPACK('Y', N, RP_LEN, RP_DATA);
  2374.                                    OLDTRY = NUMTRY;
  2375.                                    NUMTRY = 0;
  2376.                                    N = NPNO(N);
  2377.                                    RFILESTATUS = 'D';
  2378.                                    DBUFCNT = 0;
  2379.                                    DBUFINX = 0;
  2380.                               end;
  2381.                          end;
  2382.                     end;
  2383.                end
  2384.                     else
  2385.                if (RP == 'B') then
  2386.                begin            /* Break transmission */
  2387.                     if (RP_NUM != N) then
  2388.                     begin       /* Oops */
  2389.                          E_ST "RFILE - (B) N mismatch" E_EN;
  2390.                          RFILESTATUS = 'A';
  2391.                     end
  2392.                          else
  2393.                     begin
  2394.                          SPACK('Y', N, 0, RP_DATA);
  2395.                          RFILESTATUS = 'C';
  2396.                     end;
  2397.                end
  2398.                     else
  2399.                if (RP == 'E') then
  2400.                begin
  2401.                     E_ST "RFILE - E packet recieved" E_EN;
  2402.                     P_EPACK(RP_DATA,RP_LEN);
  2403.                     RFILESTATUS = 'A';
  2404.                end
  2405.                     else
  2406.                begin
  2407.                     E_ST "RFILE - Unknown packet type" E_EN;
  2408.                     RFILESTATUS = 'A';
  2409.                end;
  2410.           end                   /* Got a packet */
  2411.                else
  2412.           begin
  2413.                SPACK('N', N, 0, RP_DATA);  /* No (readable) packet */
  2414.           end;
  2415.      end;
  2416.      return RFILESTATUS;
  2417.      #undef FN_MAX
  2418. end
  2419.  
  2420. #pragma   SUBTITLE      "RDATA - Recieve Data"
  2421. #pragma   PAGE
  2422. char subroutine RDATA()
  2423. begin
  2424.  
  2425.      char      RDATASTATUS;
  2426.  
  2427.      RDATASTATUS = STATE;
  2428.      NUMTRY = NUMTRY + 1;
  2429.      if (NUMTRY > MAXTRY) then
  2430.      begin
  2431.           E_ST "RDATA - Retry count exceeded" E_EN;
  2432.           RDATASTATUS = 'A';
  2433.      end
  2434.           else
  2435.      begin
  2436.           MY_TO = 5 + LONGPACK_SIZE/TSPEED;     /* Rcv timeout */
  2437.           if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then
  2438.           begin
  2439.                if (RP == 'D') then
  2440.                begin            /* Good, what we expect */
  2441.                     if (RP_NUM != N) then
  2442.                     begin       /* Oops, not this packet */
  2443.                          OLDTRY = OLDTRY + 1;
  2444.                          if (OLDTRY > MAXTRY) then
  2445.                          begin
  2446.                               E_ST "RDATA - Pretry exceeded" E_EN;
  2447.                               RDATASTATUS = 'A';
  2448.                          end
  2449.                               else
  2450.                          if (RP_NUM == PPNO(N)) then
  2451.                          begin          /* Already have this one */
  2452.                               SPACK('Y', RP_NUM, 0, RP_DATA);/*Re-ACK*/
  2453.                               NUMTRY = 0;
  2454.                          end
  2455.                               else
  2456.                          begin
  2457.                               E_ST "RDATA - N (D) mismatch" E_EN;
  2458.                               RDATASTATUS = 'A';
  2459.                          end;
  2460.                     end         /* Wrong packet */
  2461.                          else
  2462.                     begin       /* Got the one we want */
  2463.                          BUFEMP(RP_DATA,RP_LEN);  /* Process */
  2464.                          SPACK('Y', N, 0, RP_DATA);  /* and ACK */
  2465.                          OLDTRY = NUMTRY;
  2466.                          NUMTRY = 0;
  2467.                          N = NPNO(N);
  2468.                     end;
  2469.                end              /* RP = 'D' */
  2470.                     else
  2471.                if (RP == 'F') then
  2472.                begin            /* File header */
  2473.                     OLDTRY = OLDTRY + 1;
  2474.                     if (OLDTRY > MAXTRY) then
  2475.                     begin
  2476.                          E_ST "RDATA - Pretry (F) exceeded" E_EN;
  2477.                          RDATASTATUS = 'A';
  2478.                     end
  2479.                          else
  2480.                     if (RP_NUM != PPNO(N)) then
  2481.                     begin       /* Oops */
  2482.                          E_ST "RDATA - N (F) mismatch" E_EN;
  2483.                          RDATASTATUS = 'A';
  2484.                     end
  2485.                          else
  2486.                     begin       /* OK */
  2487.                          SPACK('Y', RP_NUM, 0, RP_DATA); /* ReACK */
  2488.                          NUMTRY = 0;
  2489.                     end;
  2490.                end              /* RP = 'F' */
  2491.                     else
  2492.                if (RP == 'Z') then
  2493.                begin            /* End of File */
  2494.                     if (RP_NUM != N) then
  2495.                     begin
  2496.                          E_ST "RDATA - N (Z) mismatch" E_EN;
  2497.                          RDATASTATUS = 'A';
  2498.                     end
  2499.                          else
  2500.                     begin
  2501.                          if (DBUFINX > 0) then
  2502.                               FLUSH_DBUF;
  2503.  
  2504.                          if (RCV_SAVESP) then
  2505.                               FCLOSE(DNUM,0x9,0);
  2506.                          else
  2507.                               FCLOSE(DNUM,1,0);
  2508.  
  2509.                          DNUM = 0;
  2510.                          SPACK('Y', N, 0, RP_DATA); /* ACK */
  2511.                          L_FNAME_LEN = 0;
  2512.                          N = NPNO(N);
  2513.                          RDATASTATUS = 'F';
  2514.                     end;
  2515.                end      /* RP = 'Z' */
  2516.                     else
  2517.                if (RP == 'E') then
  2518.                begin
  2519.                     E_ST "RDATA - E packet recieved" E_EN;
  2520.                     P_EPACK(RP_DATA,RP_LEN);
  2521.                     RDATASTATUS = 'A';
  2522.                end
  2523.                     else
  2524.                begin
  2525.                     E_ST "RDATA - Unknown packet type" E_EN;
  2526.                     RDATASTATUS = 'A';
  2527.                end;
  2528.           end   /* Got packet */
  2529.                else
  2530.           begin
  2531.                SPACK('N', N, 0, RP_DATA);  /* NAK */
  2532.           end;
  2533.      end;
  2534.      return RDATASTATUS;
  2535. end
  2536.  
  2537. #pragma   SUBTITLE      "RECSW - Receive Switch (Definitions)"
  2538. #pragma   PAGE
  2539. logical procedure RECSW(SERVE)
  2540. logical                 SERVE ;
  2541. begin
  2542.  
  2543.      logical        DONE = false,
  2544.                     RECSWSTATUS,
  2545.                     R_ERROR;
  2546.  
  2547.      int            FOPT,    /* File Options (calculated) */
  2548.                     FN_LEN;  /* File Name Length          */
  2549.  
  2550.      #define        FN_MAX  35  /* Max File Name Length */
  2551.  
  2552.      char           FNAME[FN_MAX];
  2553.  
  2554. /*  "RECSW - Main Code" */
  2555.  
  2556.      MY_JCW_VAL = RECVING;
  2557.      PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  2558.      if (IMPATIENT)  then
  2559.      begin
  2560.           MY_TO = FAST_TO;
  2561.           MAXTRY = FAST_MAXTRY;
  2562.      end
  2563.           else
  2564.      begin
  2565.           MY_TO = DFLT_TO;
  2566.           MAXTRY = DFLT_MAXTRY;
  2567.      end;
  2568.  
  2569.      if ( !SERVE ) then
  2570.      begin
  2571.           STATE = 'R';
  2572.           N = 0;
  2573.           NUMTRY = 0;
  2574.      end
  2575.           else
  2576.      begin
  2577.           STATE = 'F';
  2578.      end;
  2579.  
  2580.      while ( !(DONE || CTLY) )
  2581.      begin
  2582.           if (STATE == 'R') then STATE = RINIT();
  2583.                else
  2584.           if (STATE == 'F') then STATE = RFILE();
  2585.                else
  2586.           if (STATE == 'D') then STATE = RDATA();
  2587.                else
  2588.           if (STATE == 'C') then
  2589.           begin
  2590.                DONE = true;
  2591.                RECSWSTATUS = true;
  2592.           end
  2593.                else
  2594.           if (STATE == 'A') then
  2595.           begin
  2596.                DONE = true;
  2597.                RECSWSTATUS = false;
  2598.           end;
  2599.      end;
  2600.  
  2601.      if (DNUM != 0) then
  2602.      begin
  2603.           FCLOSE(DNUM,0,0);
  2604.           DNUM = 0;
  2605.      end;
  2606.      if (STATE == 'C') then
  2607.           MY_JCW_VAL = RECV_OK;
  2608.      else
  2609.           MY_JCW_VAL = RECV_NG;
  2610.      MY_TO = DFLT_TO;
  2611.  
  2612.      return RECSWSTATUS;
  2613. end
  2614.  
  2615. #pragma   SUBTITLE      "TYPESW - Type a file on the terminal"
  2616. #pragma   PAGE
  2617. logical procedure TYPESW()
  2618. begin
  2619.      logical   DONE = false;
  2620.  
  2621.      DNUM = FOPEN(L_FNAME, 5, 0);
  2622.      if (DNUM == 0) then
  2623.      begin
  2624.           M_ST "File open failure" M_EN;
  2625.           return false;
  2626.      end;
  2627.  
  2628.      while ( !(DONE | CTLY) )
  2629.      begin
  2630.           DBUFCNT = FREAD(DNUM, DBUF, -DBUF_BYTESIZE);
  2631.           if (DBUFCNT == 0)  then
  2632.           begin         /* No data read.  Assume EOF */
  2633.                DONE = true;
  2634.           end
  2635.                else
  2636.                FWRITE(CONUM, DBUF, -DBUFCNT, 0);
  2637.      end;
  2638.      FCLOSE(DNUM, 0, 0);
  2639.      DNUM = 0;
  2640.      if (CTLY) then
  2641.           return false;
  2642.      else
  2643.           return true;
  2644. end
  2645.  
  2646. #pragma   SUBTITLE      "OPEN_LINE - Open Communications Line"
  2647. #pragma   PAGE
  2648. logical procedure OPEN_LINE()
  2649. begin
  2650.  
  2651.      logical        R_ERROR = false,
  2652.                     TEMP;
  2653.  
  2654.      int            DEV_L;
  2655.  
  2656.      char           A_DEV[12],
  2657.                     NONAME[3] = "   ";
  2658.  
  2659.      if (LNUM == 0) then
  2660.      begin                              /* Line not open */
  2661.           if (LDEV_LINE == 0) then
  2662.           begin
  2663.                E_ST "Line not specified or defaultable" E_EN;
  2664.                R_ERROR = true;
  2665.           end
  2666.                else
  2667.           begin
  2668.                strcpy(PBUF, "SETMSG OFF");
  2669.                PLEN = strlen(PBUF);
  2670.                PBUF[PLEN] = CR;
  2671.                HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  2672.  
  2673.                strcpy(A_DEV, "000 ");
  2674.                ASCII(LDEV_LINE, -10, A_DEV+2);
  2675.  
  2676.                LNUM = FOPEN(NONAME, 0, 0x4, LBUF_WORDSIZE, A_DEV);
  2677.                if (LNUM==0) then if ( LOGNUM!=0) then
  2678.                     begin
  2679.                          FCHECK(LNUM, &R_ERROR);
  2680.                          strcpy(PBUF, "OPEN_LINE:  FOPEN ERROR ");
  2681.                          PLEN = strlen(PBUF);
  2682.                          PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN);
  2683.                          FWRITE(LOGNUM, PBUF, -PLEN, 0);
  2684.                          R_ERROR=true;
  2685.                     end;
  2686.                if (LNUM == 0) then
  2687.                begin
  2688.                     E_ST "FOPEN error on communications port" E_EN;
  2689.                     R_ERROR = true;
  2690.                end
  2691.                     else
  2692.                begin            /* Set up the line */
  2693.                     if (HNDSHK == 0) then
  2694.                          TTYPE = 18;
  2695.                     else
  2696.                          TTYPE = DFLT_TTYPE;
  2697.  
  2698.  /* Some of the following FCONTROLs don't do anything and, if probed
  2699.     via ccode(), return an error.  This is a fruitfull area for future
  2700.     cleanup.
  2701.  */
  2702.                     FCONTROL(LNUM,39,&ORGL_TTYPE);
  2703.                     FCONTROL(LNUM,38,&TTYPE);
  2704.  
  2705.                     FCONTROL(LNUM,13,&ORGL_ECHO);
  2706.  
  2707.                     if (TSPEED != 0) then
  2708.                     begin
  2709.                          ORGL_TISPEED = TSPEED;
  2710.                          FCONTROL(LNUM,10,&ORGL_TISPEED);
  2711.                          ORGL_TOSPEED = TSPEED;
  2712.                          FCONTROL(LNUM,11,&ORGL_TOSPEED);
  2713.                     end
  2714.                          else
  2715.                     FCONTROL(LNUM,40,&TSPEED); /* Get speed */
  2716.  
  2717.                     FSETMODE(LNUM,4);           /* Inhibit LF */
  2718.  
  2719.                     if (HNDSHK == 2) then
  2720.                     begin           /* Set XON as termination char */
  2721.                          TEMP = XON;
  2722.                          FCONTROL(LNUM,25,&TEMP);
  2723.                     end;
  2724.  
  2725.  
  2726. /*                    TEMP = MY_EOL+(256*CTL('Y'));
  2727.                     FCONTROL(LNUM, 41, &TEMP); Almost transparent rx*/
  2728.  
  2729.  
  2730.                     if ( (LDEV_CI == LDEV_LINE) &
  2731.                          (LOGNUM == CONUM) )     then LOGNUM = 0;
  2732.                end;
  2733.           end;
  2734.      end;
  2735.  
  2736.      return (!R_ERROR);
  2737. end
  2738.  
  2739. #pragma   SUBTITLE      "SHUT_LINE - Close Communications Line"
  2740. #pragma   PAGE
  2741. procedure SHUT_LINE()
  2742. begin
  2743.  
  2744.      unsigned short TEMP;
  2745.  
  2746.      if (LNUM != 0) then
  2747.      begin                      /* Line is open */
  2748.           FSETMODE(LNUM,0);     /* Turn on linefeed */
  2749.  
  2750.           if (ORGL_TTYPE != TTYPE) then
  2751.                FCONTROL(LNUM,38,&ORGL_TTYPE);
  2752.  
  2753.           if (TSPEED != 0) then
  2754.           begin
  2755.                if (ORGL_TISPEED != TSPEED) then
  2756.                begin
  2757.                     TEMP = ORGL_TISPEED;
  2758.                     FCONTROL(LNUM,10,&TEMP);
  2759.                end;
  2760.                if (ORGL_TOSPEED != TSPEED) then
  2761.                begin
  2762.                     TEMP = ORGL_TOSPEED;
  2763.                     FCONTROL(LNUM,11,&TEMP);
  2764.                end;
  2765.           end;
  2766.  
  2767.           if (ORGL_ECHO == 0) then
  2768.                FCONTROL(LNUM,12,&TEMP);
  2769.  
  2770.           if (HNDSHK == 2) then
  2771.           begin
  2772.                TEMP = 0;
  2773.                FCONTROL(LNUM,25,&TEMP);
  2774.           end;
  2775.  
  2776.  
  2777.           FCLOSE(LNUM,0,0);
  2778.           LNUM = 0;
  2779.  
  2780.           if (LOGNUM == 0)  then LOGNUM = CONUM;
  2781.  
  2782.           strcpy(PBUF, "SETMSG ON");
  2783.           PLEN = strlen(PBUF);
  2784.           PBUF[PLEN] = CR;
  2785.           HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  2786.      end;
  2787. end
  2788.  
  2789. #pragma   SUBTITLE      "Temporary File Allocation/Deletion"
  2790. #pragma   PAGE
  2791. procedure KILL_KTEMP()
  2792. begin
  2793.      int        TNUM=0, /* Temp file number */
  2794.                 X;      /* Temp variable    */
  2795.  
  2796.      char       TBUF[80];
  2797.  
  2798.      strcpy(TBUF, "RESET ");
  2799.      strcat(TBUF, KTEMP_NAME);        /* Reset file equate */
  2800.      X = strlen(TBUF);
  2801.      TBUF[X] = CR;
  2802.      HPCICOMMAND(TBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  2803.  
  2804.      strcpy(TBUF, KTEMP_NAME);
  2805.      X = strlen(TBUF);
  2806.      TBUF[X] = ' ';
  2807.  
  2808.      TNUM = FOPEN(TBUF,7,4);            /* Try to open it */
  2809.      if (TNUM != 0) then
  2810.           FCLOSE(TNUM,4,0);             /* Kill it */
  2811.      HAVE_KTEMP = false;
  2812. end
  2813.  
  2814. procedure GET_KTEMP()
  2815. begin
  2816.      int       TNUM,  /* Temp file number */
  2817.                X;     /* Temp variable    */
  2818.  
  2819.      char      TBUF[80];
  2820.  
  2821.      KILL_KTEMP(); /* Delete any old one */
  2822.      TNUM = FOPEN(KT_NAME,4,4,-80,0,0,0,16,0,2048); /* Open new */
  2823.      if (TNUM != 0) then
  2824.      begin
  2825.           FCLOSE(TNUM,2,0); /* Save as temporary */
  2826.           if (ccode() == CCE) then
  2827.           begin
  2828.                strcpy(TBUF, "FILE ");
  2829.                strcat(TBUF, KTEMP_NAME);
  2830.                strcat(TBUF, ",OLDTEMP");
  2831.                X = strlen(TBUF);
  2832.                TBUF[X] = CR;
  2833.                HPCICOMMAND(TBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  2834.                if (ERROR == 0) then
  2835.                     HAVE_KTEMP = true;
  2836.           end;
  2837.      end;
  2838. end
  2839. #pragma   SUBTITLE      "HOST_COMMAND - Process an HP 3000 Command"
  2840. #pragma   PAGE
  2841. procedure HOST_COMMAND(CMD,CMD_LEN,LONG_REPLY)
  2842. char                   CMD[]                  ;
  2843. int                        CMD_LEN            ;
  2844. logical                            LONG_REPLY ;
  2845. begin
  2846.  
  2847.      char           CMD_BUF[80];
  2848.  
  2849.      logical        CMD_ERR = false;
  2850.  
  2851.      short          CI_ERNO,
  2852.                     CI_PARM,
  2853.                     CMD_BUF_LEN;
  2854.  
  2855.      strncpy(CMD_BUF, CMD, CMD_LEN);
  2856.      if (LONG_REPLY) then
  2857.      begin
  2858.           GET_KTEMP();
  2859.           if ( !HAVE_KTEMP ) then
  2860.           begin
  2861.                strcpy(CMD_BUF, "HOST_CMD Unable to allocate temp file");
  2862.                CMD_BUF_LEN = strlen(CMD_BUF);
  2863.                SPACK('E', N, CMD_BUF_LEN, CMD_BUF);
  2864.                CMD_ERR = true;
  2865.           end;
  2866.      end;
  2867.  
  2868.      if ( !CMD_ERR ) then
  2869.      begin
  2870.           CMD_BUF[CMD_LEN] = CR;
  2871.           HPCICOMMAND(CMD_BUF, &CI_ERNO, &CI_PARM, NO_VISIBLE_MSG);
  2872.           if (CI_ERNO != 0) then
  2873.           begin                         /* Command Interpreter error */
  2874.                strcpy(CMD_BUF, "Command Error, CIERROR = ");
  2875.                CMD_BUF_LEN = strlen(CMD_BUF);
  2876.                CMD_BUF_LEN = CMD_BUF_LEN
  2877.                                +ASCII(CI_ERNO, 10, CMD_BUF+CMD_BUF_LEN);
  2878.                SPACK('E', N, CMD_BUF_LEN, CMD_BUF);
  2879.                CMD_ERR = true;
  2880.           end
  2881.                else
  2882.           begin                         /* Command OK  */
  2883.                if (LONG_REPLY) then
  2884.                begin
  2885.                     DNUM = FOPEN(KT_NAME,6,0);
  2886.                     if (DNUM == 0) then
  2887.                     begin               /* Temp file open error */
  2888.                          strcpy(CMD_BUF, "Temp file open failure");
  2889.                          CMD_BUF_LEN = strlen(CMD_BUF);
  2890.                          SPACK('E', N, CMD_BUF_LEN, CMD_BUF);
  2891.                          CMD_ERR = true;
  2892.                     end
  2893.                          else
  2894.                     begin
  2895.                          SENDSW(CMD_BUF,0);
  2896.                          STATE = SBREAK();
  2897.                     end;
  2898.                end
  2899.                     else
  2900.                begin            /* Short reply */
  2901.                     SPACK('Y', N, 0, CMD_BUF);
  2902.                end;
  2903.           end;
  2904.      end;
  2905. end
  2906. #pragma   SUBTITLE "KERMIT_HPCICOMMAND - Process Generic KERMIT Command"
  2907. #pragma   PAGE
  2908. procedure KERMIT_HPCICOMMAND(KCMD,KCMD_LEN)
  2909. char                     KCMD[]        ;
  2910. int                           KCMD_LEN ;
  2911. begin
  2912.  
  2913.      char           KC_BUF[80];
  2914.  
  2915.      int            INTRINSIC_STATUS[6];
  2916.  
  2917.      short          KC_LEN,
  2918.                     ERR,
  2919.                     X;
  2920.  
  2921.      int            SESSION = 0;
  2922.  
  2923.      float          WRITE_FINISH = 2.0;
  2924.  
  2925.      if ( (KCMD[0]=='D') & (KCMD_LEN>0) ) then
  2926.      begin                      /* Directory Command */
  2927.           strcpy(KC_BUF, "LISTF ");
  2928.           KC_LEN = strlen(KC_BUF);
  2929.  
  2930.           if (KCMD_LEN > 2) then
  2931.           begin                         /* Check for filespec */
  2932.                X = UNCHAR(KCMD[1]);
  2933.                if ( (X>0) & (X<=(KCMD_LEN-2)) ) then
  2934.                begin                    /* Use filespec */
  2935.                     strncat(KC_BUF,  KCMD+2, X);
  2936.                     KC_LEN = KC_LEN + X;
  2937.                end;
  2938.           end;
  2939.  
  2940.           strcat(KC_BUF, ",2;*");
  2941.           strcat(KC_BUF, KTEMP_NAME);
  2942.           KC_LEN = strlen(KC_BUF);
  2943.           HOST_COMMAND(KC_BUF, KC_LEN, true, NO_VISIBLE_MSG);
  2944.      end
  2945.  
  2946.           else
  2947.      if ( (KCMD[0] == 'U') & (KCMD_LEN > 0) ) then
  2948.      begin                              /* File space usage */
  2949.           strcpy(KC_BUF, "REPORT ");
  2950.           KC_LEN = strlen(KC_BUF);
  2951.  
  2952.           if (KCMD_LEN > 2) then
  2953.           begin                         /* Check for groupspec */
  2954.                X = UNCHAR(KCMD[1]);
  2955.                if ( (X > 0) & (X <= (KCMD_LEN -2)) ) then
  2956.                begin                    /* Use groupspec */
  2957.                     strncat(KC_BUF, KCMD+2, X);
  2958.                     KC_LEN = KC_LEN + X;
  2959.                end;
  2960.           end;
  2961.  
  2962.           strcat(KC_BUF, ",*");
  2963.           strcat(KC_BUF, KTEMP_NAME);
  2964.           KC_LEN = strlen(KC_BUF);
  2965.  
  2966.           HOST_COMMAND(KC_BUF, KC_LEN, true, NO_VISIBLE_MSG);
  2967.      end
  2968.  
  2969.           else
  2970.      if ( (KCMD[0]=='E') & (KCMD_LEN>0) ) then
  2971.      begin                              /* Erase (delete) command */
  2972.           strcpy(KC_BUF, "PURGE ");
  2973.           KC_LEN = strlen(KC_BUF);
  2974.  
  2975.           if (KCMD_LEN > 2) then
  2976.           begin
  2977.                X = UNCHAR(KCMD[1]);
  2978.           end
  2979.                else
  2980.           begin
  2981.                X = 0;
  2982.           end;
  2983.  
  2984.           if ( (X < 1) | (X > (KCMD_LEN-2)) ) then
  2985.           begin
  2986.                strcpy(KC_BUF, "Filespec missing or invalid");
  2987.                KC_LEN = strlen(KC_BUF);
  2988.                SPACK('E', N, KC_LEN, KC_BUF);
  2989.           end
  2990.                else
  2991.           begin
  2992.                strncat(KC_BUF, KCMD+2, X);
  2993.                KC_LEN = KC_LEN + X;
  2994.                HOST_COMMAND(KC_BUF, KC_LEN, false, NO_VISIBLE_MSG);
  2995.           end;
  2996.      end
  2997.  
  2998.           else
  2999.      if ( (KCMD[0]=='T') & (KCMD_LEN>0) ) then
  3000.      begin                              /* Type Command */
  3001.           if (KCMD_LEN > 1) then
  3002.           begin
  3003.                X = UNCHAR(KCMD[1]);
  3004.           end
  3005.                else
  3006.           begin
  3007.                X = 0;
  3008.           end;
  3009.  
  3010.           if ( (X < 1) | (X > (KCMD_LEN -2)) ) then
  3011.           begin
  3012.                strcpy(KC_BUF, "Filespec missing or invalid");
  3013.                KC_LEN = strlen(KC_BUF);
  3014.                SPACK('E', N, KC_LEN, KC_BUF);
  3015.           end
  3016.                else
  3017.           begin
  3018.                strncpy(KC_BUF, &KCMD[2], X);
  3019.                KC_BUF[X] = ' ';
  3020.  
  3021.                begin
  3022.                     DNUM = FOPEN(KC_BUF,5,0);
  3023.                     if (DNUM == 0) then
  3024.                     begin
  3025.                          strcpy(KC_BUF, "File open error");
  3026.                          KC_LEN = strlen(KC_BUF);
  3027.                          SPACK('E', N, KC_LEN, KC_BUF);
  3028.                     end
  3029.                          else
  3030.                     begin
  3031.                          SENDSW(KC_BUF,0);
  3032.                          STATE = SBREAK();
  3033.                     end;
  3034.                end;
  3035.           end;
  3036.      end
  3037.  
  3038.           else
  3039.      if (KCMD[0] == 'L')  then
  3040.      begin                              /* Bye command */
  3041.           JOBINFO(1, &SESSION, INTRINSIC_STATUS,
  3042.                   15, &SESSION, &ERR);
  3043.           if ( INTRINSIC_STATUS[0] != 0 ) then
  3044.           begin
  3045.                strcpy(PBUF, "Can't 'BYE'. JOBINFO status=");
  3046.                PLEN = strlen(PBUF);
  3047.                PLEN = PLEN+ASCII(INTRINSIC_STATUS[0], 10, PBUF+PLEN);
  3048.                SPACK('E', N, PLEN, PBUF);
  3049.           end
  3050.                else
  3051.           begin
  3052.                strcpy(PBUF, "Kermit session aborted by user");
  3053.                PLEN=strlen(PBUF);
  3054.                SPACK('Y', N, PLEN, PBUF);
  3055.                if (LOGNUM!=0)  then  FCLOSE(LOGNUM, 0x9, 0);
  3056.                if (HAVE_KTEMP)  then  KILL_KTEMP();
  3057.                PAUSE(&WRITE_FINISH);            /* FWRITE in SPACK */
  3058.                ABORTSESS(1, SESSION, INTRINSIC_STATUS);
  3059.           end;
  3060.      end
  3061.           else
  3062.      begin
  3063.           strcpy(KC_BUF, "Unimplementented Server Command");
  3064.           KC_LEN = strlen(KC_BUF);
  3065.           SPACK('E', N, KC_LEN, KC_BUF);
  3066.      end;
  3067. end
  3068. #pragma   SUBTITLE      "DIRSEARCH - Locate Candidates for Send"
  3069. #pragma   page
  3070.      logical subroutine DIRSEARCH(SEARCHED)
  3071.      unsigned short              *SEARCHED ;
  3072.      begin
  3073.           logical      DIRSEARCHSTATUS;
  3074.  
  3075.           DIRSEARCHSTATUS = false;  /* Prepare for the worst */
  3076.           if ( *SEARCHED==0 ) then
  3077.           begin
  3078.                GET_KTEMP();
  3079.                if ( !HAVE_KTEMP ) then
  3080.                begin
  3081.                     strcpy( PBUF, "DIR Unable to allocate temp file");
  3082.                     PLEN = strlen(PBUF);
  3083.                     SPACK('E', N, PLEN, PBUF);
  3084.                     return DIRSEARCHSTATUS;
  3085.                end;
  3086.                strcpy(PBUF, "LISTF ");
  3087.                strncat(PBUF, L_FNAME, L_FNAME_LEN);
  3088.                strcat(PBUF, "; *");
  3089.                strncat(PBUF, KTEMP_NAME, KTN_LEN);
  3090.                PBUF[strlen(PBUF)] = CR;
  3091.                HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  3092.                if (ERROR != 0) then
  3093.                begin
  3094.                     strcpy(PBUF, "Directory search failed. Error=");
  3095.                     PLEN = strlen(PBUF);
  3096.                     PLEN = PLEN+ ASCII(ERROR, 10, PBUF+PLEN);
  3097.                     SPACK('E', N, PLEN, PBUF);
  3098.                     return DIRSEARCHSTATUS;
  3099.                end;
  3100.  
  3101.                KT_NUM = FOPEN(KT_NAME, 6, 0);
  3102.                if (KT_NUM == 0) then
  3103.                begin
  3104.                     strcpy(PBUF, "Temp file open failure");
  3105.                     PLEN = strlen(PBUF);
  3106.                     SPACK('E', N, PLEN, PBUF);
  3107.                     return DIRSEARCHSTATUS;
  3108.                end;
  3109.  
  3110.                FREAD(KT_NUM, PBUF, -80); /*Hopefully skip over junk */
  3111.                FREAD(KT_NUM, PBUF, -80);
  3112.                FREAD(KT_NUM, PBUF, -80);
  3113.                *SEARCHED = 1;
  3114.           end;
  3115.  
  3116.           strcpy(PBUF, "                    ");
  3117.           if ( (FREAD(KT_NUM, PBUF, -80) <= 1) |
  3118.                !isalnum(PBUF[0]) ) then
  3119.           begin
  3120.                *SEARCHED = 0;
  3121.                FCLOSE(KT_NUM, 4, 0);  /* Purge */
  3122.                KT_NUM = 0;
  3123.                KILL_KTEMP();
  3124.                STATE = SBREAK();
  3125.                return DIRSEARCHSTATUS;
  3126.           end;
  3127.  
  3128.           /* If we survived all of that, we will return one file name */
  3129.  
  3130.           L_FNAME_LEN = 0;
  3131.           while ( isalnum(PBUF[L_FNAME_LEN]) )
  3132.           begin
  3133.                L_FNAME[L_FNAME_LEN] = PBUF[L_FNAME_LEN];
  3134.                L_FNAME_LEN++;
  3135.           end;
  3136.           L_FNAME[L_FNAME_LEN] = ' ';
  3137.           if (*SEARCHED==1)  then
  3138.           begin
  3139.                *SEARCHED = 2;
  3140.                L_FNAME_LEN = -L_FNAME_LEN;
  3141.           end;
  3142.           DIRSEARCHSTATUS = true;
  3143.           return DIRSEARCHSTATUS;
  3144.      end
  3145. #pragma   SUBTITLE      "SPLIT_CBUF - Separate File Names"
  3146. #pragma   page
  3147.      subroutine  SPLIT_CBUF(BUF, LEN)  /* Handle the case where we   */
  3148.      int                         LEN;  /* have local and remote file */
  3149.      char                   BUF[];     /* names specified in a remote*/
  3150.                                        /* GET request.               */
  3151.      begin
  3152.           int       IX = 0;
  3153.           while (BUF[IX] == ' ') IX++;
  3154.  
  3155.           L_FNAME_LEN = 0;
  3156.  
  3157.           while ( (BUF[IX] !=' ')  &  (IX < LEN) )
  3158.           begin
  3159.                L_FNAME[L_FNAME_LEN] = BUF[IX];
  3160.                L_FNAME_LEN = L_FNAME_LEN+1;
  3161.                IX++;
  3162.           end;
  3163.           L_FNAME[L_FNAME_LEN] = ' ';
  3164.  
  3165.           R_FNAME_LEN = 0;
  3166.  
  3167.           while ( (BUF[IX] == ' ')  &  (IX < LEN) ) IX++;
  3168.  
  3169.           while ( (BUF[IX] != ' ')  &  (IX < LEN) )
  3170.           begin
  3171.                R_FNAME[R_FNAME_LEN] = BUF[IX];
  3172.                R_FNAME_LEN = R_FNAME_LEN+1;
  3173.                IX++;
  3174.           end;
  3175.           R_FNAME[R_FNAME_LEN] = ' ';
  3176.           R_FNAME_LEN = -R_FNAME_LEN;
  3177.      end
  3178.  
  3179. #pragma   SUBTITLE      "SERVER - Driver for Server Mode"
  3180. #pragma   PAGE
  3181. procedure SERVER()
  3182. begin
  3183.  
  3184. #    define         CB_MAX  80     /* Max command size -1 */
  3185.  
  3186.      char           CBUF[CB_MAX];  /* Command Buffer */
  3187.  
  3188.      logical        DONE = false,
  3189.                     SEARCHED = 0;
  3190.  
  3191.      int            CB_CNT,  /* Command size */
  3192.                     IX;
  3193.  
  3194.      /* Set default conditions */
  3195.  
  3196.      MAX_SND_SIZE = 80;
  3197.      MAX_SND_DATA = 77;
  3198.      YOUR_PAD_COUNT = 0;
  3199.      YOUR_PAD = 0;
  3200.      YOUR_EOL = CR;
  3201.      YOUR_Q_CTL = 0x23;
  3202.      QUOTE_8 = false;
  3203.      USE_REPEAT = false;
  3204.  
  3205.      while ( !(DONE | CTLY) )
  3206.           begin
  3207.           N = 0;
  3208.           NUMTRY = 0;
  3209.           STATE = 'S';
  3210.  
  3211.           if ( (RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0) |
  3212.                (RP_NUM == 0) ) then
  3213.           begin
  3214.                MY_JCW_VAL = IDLING;
  3215.                PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  3216.                if (RP == 'I') then
  3217.                begin /* Exchange Parameters */
  3218.                     R_RPAR(RP_DATA,RP_LEN);
  3219.                     R_SPAR(RP_DATA,&RP_LEN);
  3220.                     SPACK('Y', N, RP_LEN, RP_DATA);
  3221.                     OLDTRY = NUMTRY;
  3222.                     NUMTRY = 0;
  3223.                     N = NPNO(RP_NUM);
  3224.                end
  3225.                     else
  3226.                if (RP == 'S') then
  3227.                begin /* Other side is sending */
  3228.                     R_RPAR(RP_DATA,RP_LEN);
  3229.                     R_SPAR(RP_DATA,&RP_LEN);
  3230.                     SPACK('Y', N, RP_LEN, RP_DATA);
  3231.                     OLDTRY = NUMTRY;
  3232.                     NUMTRY = 0;
  3233.                     N = NPNO(RP_NUM);
  3234.                     RECSW(true);
  3235.                     PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  3236.                end
  3237.                     else
  3238.                if (RP == 'R') then
  3239.                begin /* Other side wants us to send */
  3240.  
  3241.                     CBUFXLT(RP_DATA,RP_LEN,CBUF,&CB_CNT,CB_MAX);
  3242.                     SPLIT_CBUF(CBUF, CB_CNT);
  3243.                     while ( DIRSEARCH(&SEARCHED) )
  3244.                     begin
  3245.                          DNUM = FOPEN(L_FNAME,5,0);
  3246.                          if (DNUM == 0) then
  3247.                          begin  /* File open error */
  3248.                               strcpy(RP_DATA, "File open error - ");
  3249.                               strncat(RP_DATA, L_FNAME, L_FNAME_LEN);
  3250.                               SPACK('E', N, strlen(RP_DATA), RP_DATA);
  3251.                          MY_JCW_VAL = SEND_NG;
  3252.                          end
  3253.                               else
  3254.                          if (R_FNAME_LEN == 0)  then
  3255.                          begin
  3256.                               SENDSW(L_FNAME, L_FNAME_LEN);
  3257.                               L_FNAME_LEN = 0;
  3258.                          end
  3259.                               else
  3260.                          begin
  3261.                               SENDSW(R_FNAME, R_FNAME_LEN);
  3262.                               R_FNAME_LEN = 0;
  3263.                          end;
  3264.                     end;
  3265.                     PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  3266.                end
  3267.                     else
  3268.                if (RP == 'G') then
  3269.                begin /* KERMIT Command */
  3270.                     if ( (RP_DATA[0] == 'F') & (RP_LEN == 1) ) then
  3271.                     begin
  3272.                          SPACK('Y', N, 0, RP_DATA);
  3273.                          DONE = true;
  3274.                     end
  3275.                          else
  3276.                     begin
  3277.                          if ( CBUFXLT(RP_DATA,RP_LEN,
  3278.                                     CBUF,&CB_CNT,CB_MAX) ) then
  3279.                          begin
  3280.                               KERMIT_HPCICOMMAND(CBUF, CB_CNT,
  3281.                                                  NO_VISIBLE_MSG);
  3282.                          end
  3283.                               else
  3284.                          begin
  3285.                               strcpy(CBUF,  "Command too big");
  3286.                               CB_CNT = strlen(CBUF);
  3287.                               SPACK('E', N, CB_CNT, CBUF);
  3288.                          end;
  3289.                     end;
  3290.                end
  3291.                     else
  3292.                begin
  3293.                     SPACK('N', N, 0, RP_DATA);
  3294.                end;
  3295.           end
  3296.                else
  3297.           begin
  3298.                SPACK('N', N, 0, RP_DATA);
  3299.           end;
  3300.      end;
  3301. end
  3302.  
  3303. #pragma   SUBTITLE      "VERIFY - List assorted attributes"
  3304. #pragma   PAGE
  3305. procedure VERIFY()
  3306. begin
  3307.      static    char     BLANKS[] =
  3308.                "                                                  ";
  3309.      char      *P,
  3310.                NUMBER[10];
  3311. #    define    SAY      {strcat(P,      /* Better than M_ST */
  3312. #    define    ENDSAY            ); }   /* Better than M_EN */
  3313.  
  3314. #    define    SAYNUM    {PLEN = ASCII(
  3315. #    define    DECIMAL    , 10, NUMBER); strncat(P, NUMBER, PLEN); }
  3316.  
  3317. #    define    SPIT      SPIT1 SPIT2 SPIT3
  3318. #    define    SPIT1     {PLEN = strlen(P);
  3319. #    define    SPIT2     FWRITE(CONUM, PBUF, -PLEN, 0);
  3320. #    define    SPIT3     strcpy(PBUF, BLANKS); strcpy(P, ""); }
  3321.  
  3322. #    define    MIDLINE   strncat(P, BLANKS, 30-strlen(P))
  3323.  
  3324. #    define    SAYBOOL(TRUTH) BOO1(TRUTH)  BOO2
  3325. #    define    BOO1(TRUTH)    if (TRUTH)
  3326. #    define    BOO2             SAY "ON" ENDSAY else SAY "OFF" ENDSAY
  3327.  
  3328.      P = PBUF;
  3329.      SAY  BLANKS  ENDSAY;
  3330.      SPIT;
  3331.      SAY "RECEIVE parameters" ENDSAY;
  3332.      MIDLINE;
  3333.      SAY "Other parameters"   ENDSAY;
  3334.      SPIT;
  3335.  
  3336.      SAY "   BINARY:       " ENDSAY;
  3337.      SAYBOOL(RCV_BINARY);
  3338.      MIDLINE;
  3339.      SAY "   SEND BINARY:  " ENDSAY;
  3340.      switch(SND_BINARY)
  3341.      begin
  3342.           case 0:  begin SAY "Auto"   ENDSAY;  break; end;
  3343.           case 1:  begin SAY "Binary" ENDSAY;  break; end;
  3344.           case 2:  begin SAY "ASCII"  ENDSAY;  break; end;
  3345.      end;
  3346.      SPIT;
  3347.  
  3348.      SAY "   FIXREC:       " ENDSAY;
  3349.      SAYBOOL(RCV_FIXREC);
  3350.      MIDLINE;
  3351.      SAY "   SEND PAUSE:   " ENDSAY;
  3352.      SAYNUM PAUSE_CNT        DECIMAL;
  3353.      SPIT;
  3354.  
  3355.      SAY "   SAVESP:       " ENDSAY;
  3356.      SAYBOOL(RCV_SAVESP);
  3357.      MIDLINE;
  3358.      SAY "   DELAY:        " ENDSAY;
  3359.      SAYNUM I_DELAY          DECIMAL;
  3360.      SPIT;
  3361.  
  3362.      SAY "   FCODE:        " ENDSAY;
  3363.      SAYNUM RCV_FCODE        DECIMAL;
  3364.      MIDLINE;
  3365.      SAY "   HANDSHAKE:    " ENDSAY;
  3366.      switch (HNDSHK)
  3367.      begin
  3368.           case 0:  begin SAY "None" ENDSAY;  break; end;
  3369.           case 1:  begin SAY "XON"  ENDSAY;  break; end;
  3370.           case 2:  begin SAY "XON2" ENDSAY;  break; end;
  3371.      end;
  3372.      SPIT;
  3373.  
  3374.      SAY "   RECLEN:       " ENDSAY;
  3375.      SAYNUM RCV_RECLEN       DECIMAL;
  3376.      MIDLINE;
  3377.      SAY "   DEBUG:        " ENDSAY;
  3378.      SAYNUM DEBUG_MODE       DECIMAL;
  3379.      SPIT;
  3380.  
  3381.      SAY "   BLOCKF:       " ENDSAY;
  3382.      SAYNUM RCV_BLOCKF       DECIMAL;
  3383.      MIDLINE;
  3384.      SAY "   LOG:          " ENDSAY;
  3385.      if ( (LOGNUM > 0)  &  (LOGNUM != CONUM) )  then
  3386.      begin
  3387.           SAY "TRUE (" ENDSAY;
  3388.           SAY LOGNAME ENDSAY;
  3389.           SAY ")" ENDSAY;
  3390.      end
  3391.           else
  3392.           SAY "FALSE" ENDSAY;
  3393.  
  3394.      SPIT;
  3395.      SAY "   MAXEXT:       " ENDSAY;
  3396.      SAYNUM RCV_MAXEXT       DECIMAL;
  3397.      MIDLINE;
  3398.      SAY "   LINE LDEV:    " ENDSAY;
  3399.      SAYNUM LDEV_LINE        DECIMAL;
  3400.      SPIT;
  3401.  
  3402.      SAY "   MAXREC:       " ENDSAY;
  3403.      PLEN = DASCII(RCV_MAXREC, 10, NUMBER); strncat(P, NUMBER, PLEN);
  3404.      MIDLINE;
  3405.      SAY "   LINE SPEED:   " ENDSAY;
  3406.      SAYNUM TSPEED           DECIMAL;
  3407.      SPIT;
  3408.  
  3409.      SAY "   DEVICE:       " ENDSAY;
  3410.      strncat(P, RCV_DEV, 4);
  3411.      MIDLINE;
  3412.      SAY "   SOH:          " ENDSAY;
  3413.      SAYNUM SOH              DECIMAL;
  3414.      SPIT;
  3415.  
  3416.      SAY "   EXPTAB:       " ENDSAY;
  3417.      SAYBOOL(EXP_TABS);
  3418.      SPIT;
  3419.  
  3420. end
  3421.  
  3422. #pragma   SUBTITLE      "KINIT - Perform KERMIT Initialization"
  3423. #pragma   PAGE
  3424. logical procedure KINIT()
  3425. begin
  3426.  
  3427.      logical        R_ERROR = false;
  3428.  
  3429.      unsigned short J_MODE,
  3430.                     J_LDEV,
  3431.                     F_LDEV;
  3432.  
  3433.      char           TEST_CMD[20];
  3434.  
  3435.      int            T = 0;
  3436.  
  3437.      char           STDIN[]   = "$STDIN ",
  3438.                     STDLIST[] = "$STDLIST ";
  3439.  
  3440.      unsigned short DUM16;
  3441.      int            DUM32;
  3442.      char           DUMARY[20];
  3443.  
  3444.      LNUM = 0;
  3445.  
  3446.      CINUM = FOPEN(STDIN , 0x2C, 0);
  3447.      CONUM = FOPEN(STDLIST , 0x10C, 0);
  3448.  
  3449.      /*  LOGNUM := CONUM; Equates to non-STDLIST cause confusion  */
  3450.  
  3451.      if ( (CINUM != 0) & (CONUM != 0) ) then
  3452.      begin
  3453.           M_ST    VERS    M_EN;   /* Output current version #  */
  3454.           M_ST   "    "   M_EN;
  3455.  
  3456.           XCONTRAP( (int)CONTROLY, &DUM32 );
  3457.  
  3458.           strcpy(KT_NAME, KTEMP_NAME);
  3459.           KTN_LEN = strlen(KT_NAME);
  3460.           KT_NAME[KTN_LEN] = ' ';
  3461.  
  3462.           LDEV_CI = 0;
  3463.           LDEV_LINE = 0;
  3464.  
  3465.           WHO(&J_MODE, &DUM32, &DUM32, MYSELF,
  3466.               DUMARY, DUMARY, DUMARY, &J_LDEV);
  3467.  
  3468.           if ( (J_MODE % 16) / 4 == 1 )then  /* .(12:2) */
  3469.           begin                         /* Session */
  3470.                LDEV_LINE = J_LDEV;      /* Default COM to session dev */
  3471.                                         /* Get CI ldev */
  3472.                FGETINFO(CINUM, DUMARY, &DUM16, &DUM16,
  3473.                         &DUM16, &DUM16, &F_LDEV);
  3474.                if (F_LDEV == J_LDEV) then
  3475.                begin            /* Command input uses session device */
  3476.                     LDEV_CI = J_LDEV;
  3477.                end
  3478.                     else
  3479.                begin
  3480.                                         /* Get CO ldev */
  3481.                     FGETINFO(CONUM, DUMARY, &DUM16, &DUM16,
  3482.                              &DUM16 ,&DUM16, &F_LDEV);
  3483.                     if (F_LDEV == J_LDEV) then
  3484.                          LDEV_CI = J_LDEV;   /* CO uses session ldev */
  3485.                end;
  3486.           end;
  3487.           for (T=0; T<60; T++) MIN_SIZE[T]=32767;
  3488.           MIN_SIZE[DELETEV]   = 2;  MIN_SIZE[DIRV]       = 2;
  3489.           MIN_SIZE[EXITV]     = 1;  MIN_SIZE[NULLV]      = 1;
  3490.           MIN_SIZE[RECEIVEV]  = 1;  MIN_SIZE[SENDV]      = 3;
  3491.           MIN_SIZE[SERVEV]    = 3;  MIN_SIZE[SETV]       = 3;
  3492.           MIN_SIZE[SPACEV]    = 2;  MIN_SIZE[STATUSV]    = 2;
  3493.           MIN_SIZE[TAKEV]     = 2;  MIN_SIZE[TYPEV]      = 2;
  3494.           MIN_SIZE[VERIFYV]   = 1;
  3495.  
  3496.           MIN_SIZE[DEBUGV]    = 3;  MIN_SIZE[DELAYV]     = 3;
  3497.           MIN_SIZE[HANDSHAKEV]= 1;  MIN_SIZE[LINEV]      = 2;
  3498.           MIN_SIZE[LOGV]      = 2;  MIN_SIZE[SENDV_1]    = 3;
  3499.           MIN_SIZE[SPEEDV]    = 2;  MIN_SIZE[SOHV]       = 2;
  3500.           MIN_SIZE[RECEIVEV_1]= 1;
  3501.  
  3502.           MIN_SIZE[AUTOV]     = 1;  MIN_SIZE[BIN128V]    = 4;
  3503.           MIN_SIZE[BINARYV]   = 4;  MIN_SIZE[BLOCKFV]    = 2;
  3504.           MIN_SIZE[DEVICEV]   = 1;  MIN_SIZE[FIXRECV]    = 2;
  3505.           MIN_SIZE[FCODEV]    = 2;  MIN_SIZE[MAXRECV]    = 4;
  3506.           MIN_SIZE[MAXEXTV]   = 4;  MIN_SIZE[PAUSEV]     = 2;
  3507.           MIN_SIZE[PROGV]     = 2;  MIN_SIZE[RECLENV]    = 1;
  3508.           MIN_SIZE[SAVESPV]   = 1;  MIN_SIZE[TEXTV]      = 2;
  3509.           MIN_SIZE[TXT80V]    = 2;  MIN_SIZE[EXPTABV]    = 1;
  3510.           MIN_SIZE[FASTV]     = 2;
  3511.  
  3512.           MIN_SIZE[NONEV]     = 1;  MIN_SIZE[OFFV]       = 2;
  3513.           MIN_SIZE[ONV]       = 2;  MIN_SIZE[XONV]       = 3;
  3514.           MIN_SIZE[XON2V]     = 4;  MIN_SIZE[YESV]       = 1;
  3515.         MY_CAPS = 2;/*  0 CAT
  3516.                       1 (LONGP_F) CAT
  3517.                       0 (WINDOWS_F) CAT
  3518.                       0 (ATTRS_F);  */
  3519.           strcpy(TEST_CMD, "SETVAR NOTHING 0");
  3520.           TEST_CMD[strlen(TEST_CMD)] = 0x0D;
  3521.           HPCICOMMAND(TEST_CMD, &ERROR, &PARM, NO_VISIBLE_MSG);
  3522.           if (ccode() == CCE)  then
  3523.                DFLT_TTYPE = 10;        /* HPPA machines */
  3524.           else
  3525.                DFLT_TTYPE = 13;       /* Classic machines */
  3526.  
  3527.      end
  3528.           else
  3529.      begin
  3530.           R_ERROR = true;
  3531.      end;
  3532.  
  3533.      if (TAKE_VAL > 0) then
  3534.      begin
  3535.           strcpy(PBUF, "F599KM00 ");
  3536.           PLEN = strlen(PBUF);
  3537.           ASCII(TAKE_VAL, -10, PBUF+(PLEN-2));
  3538.           TAKENUM = FOPEN(PBUF, 0x5, 0x400);
  3539.           if (TAKENUM == 0) then
  3540.           begin
  3541.                strcat(PBUF, "take file open error");
  3542.                PLEN = strlen(PBUF);
  3543.                FWRITE(CONUM, PBUF, -PLEN, 0);
  3544.           end;
  3545.      end;
  3546.  
  3547.      LONGPACK_SIZE = MAX_LONGPACK_SIZE-10;
  3548.  
  3549.      return !R_ERROR;
  3550.  
  3551. end
  3552. #pragma   SUBTITLE      "HELP - User Help Function"
  3553. #pragma   PAGE
  3554. procedure HELP(ITEM, LEVEL, RCVCASE)
  3555. int            ITEM, LEVEL, RCVCASE;
  3556.  
  3557. /* WARNING* No check is made for missing params!!!!!!!!!!!!*/
  3558. begin
  3559.  
  3560.      M_ST " " M_EN;
  3561.      switch (ITEM)
  3562.      begin
  3563.  
  3564.           /* HPCICOMMANDS IN GENERAL */
  3565.         case 0:
  3566.           begin
  3567.  
  3568.                M_ST "Commands:" M_EN;
  3569.                M_ST " " M_EN;
  3570.                M_ST "     TAKE"      M_EN;
  3571.                M_ST "     SERVE"     M_EN;
  3572.                M_ST "     SEND"      M_EN;
  3573.                M_ST "     RECEIVE"   M_EN;
  3574.                M_ST "     SET"       M_EN;
  3575.                M_ST "     VERIFY"    M_EN;
  3576.                M_ST "     DIR"       M_EN;
  3577.                M_ST "     SPACE"     M_EN;
  3578.                M_ST "     DELETE"    M_EN;
  3579.                M_ST "     TYPE"      M_EN;
  3580.                M_ST "     EXIT"      M_EN;
  3581.                break;
  3582.           end;
  3583.  
  3584.           /* TAKE */
  3585.         case TAKEV:
  3586.           begin
  3587.             M_ST "Syntax:  TAKE filespec" M_EN;
  3588.             M_ST " " M_EN;
  3589.             M_ST
  3590.               "The TAKE command causes subsequent commands to be"
  3591.             M_EN;
  3592.              M_ST
  3593.                "taken from the specified file until EOF is reached."
  3594.              M_EN;
  3595.              M_ST
  3596.                "If a subsequent TAKE is encountered within the original"
  3597.              M_EN;
  3598.              M_ST
  3599.                "TAKE file, the first file is closed and execution"
  3600.              M_EN;
  3601.              M_ST
  3602.                "continues with the second.  This means that if a"
  3603.               M_EN;
  3604.              M_ST
  3605.                "TAKE appears within a TAKE file, commands that follow"
  3606.              M_EN;
  3607.              M_ST
  3608.                "it (in the original TAKE file) will be ignored."
  3609.              M_EN;
  3610.              break;
  3611.           end;
  3612.  
  3613.           /* SEND */
  3614.  
  3615.         case SENDV:
  3616.           begin
  3617.              M_ST  "Syntax:  SEND filespec1 [filespec2]" M_EN;
  3618.              M_ST " " M_EN;
  3619.              M_ST
  3620.                "This command causes a file (indicated by filespec1)"
  3621.              M_EN;
  3622.              M_ST
  3623.                "to be sent from the HP to the local KERMIT.  Wildcard"
  3624.              M_EN;
  3625.              M_ST
  3626.                "characters are not permitted.  If filespec2 is speci-"
  3627.              M_EN;
  3628.              M_ST
  3629.                "fied, the file will be sent with that name."
  3630.              M_EN;
  3631.              break;
  3632.           end;
  3633.  
  3634.           /* RECEIVE */
  3635.         case RECEIVEV:
  3636.           begin
  3637.              M_ST "Syntax:  RECEIVE filespec" M_EN;
  3638.              M_ST " " M_EN;
  3639.              M_ST
  3640.                "The RECEIVE command causes HP KERMIT to enter receive"
  3641.              M_EN;
  3642.              M_ST
  3643.                "mode and wait for the local kermit to start sending"
  3644.              M_EN;
  3645.              M_ST
  3646.                "a file.  Filespec must be specified.  The file will be"
  3647.              M_EN;
  3648.              M_ST
  3649.                "stored under that name."
  3650.              M_EN;
  3651.              break;
  3652.           end;
  3653.  
  3654.           /* SERVE */
  3655.         case SERVEV:
  3656.           begin
  3657.              M_ST "Syntax:  SERVE" M_EN;
  3658.              M_ST " " M_EN;
  3659.              M_ST
  3660.              "The SERVE command causes HP 3000 KERMIT to go into"
  3661.              M_EN;
  3662.              M_ST
  3663.                "server mode.  Once in server mode, the only way back"
  3664.              M_EN;
  3665.              M_ST
  3666.                "to command mode is the Control-Y trap."
  3667.              M_EN;
  3668.              M_ST " " M_EN;
  3669.              M_ST
  3670.                "In addition to the standard KERMIT transactions for"
  3671.              M_EN;
  3672.              M_ST
  3673.                "file transfer, the following server functions are"
  3674.              M_EN;
  3675.              M_ST
  3676.                "supported:"
  3677.              M_EN;
  3678.              M_ST " " M_EN;
  3679.              M_ST
  3680.                "FUNCTION             PROBABLE SYNTAX"
  3681.              M_EN;
  3682.              M_ST
  3683.                "                     (If available on local KERMIT)"
  3684.              M_EN;
  3685.              M_ST
  3686.                "-------------------  -------------------------------"
  3687.              M_EN;
  3688.              M_ST " " M_EN;
  3689.              M_ST
  3690.                "Finish serving       FINISH"
  3691.              M_EN;
  3692.              M_ST
  3693.                "Type a file          REMOTE TYPE filespec"
  3694.              M_EN;
  3695.              M_ST
  3696.                "Directory Listing    REMOTE DIRECTORY [filespec]"
  3697.              M_EN;
  3698.              M_ST
  3699.                "File Space Listing   REMOTE SPACE [filespec]"
  3700.              M_EN;
  3701.              M_ST
  3702.                "Delete a file        REMOTE DELETE filespec"
  3703.              M_EN;
  3704.              M_ST " " M_EN;
  3705.              M_ST
  3706.                "Wildcard file specification may be used only for the"
  3707.              M_EN;
  3708.              M_ST
  3709.                "DIRECTORY and SPACE transactions.  Wildcard specifi-"
  3710.              M_EN;
  3711.              M_ST
  3712.                "cations are in the native HP 3000 format.  To produce"
  3713.              M_EN;
  3714.              M_ST
  3715.                "a DIRECTORY listing of all files starting with FOO use:"
  3716.              M_EN;
  3717.              M_ST  " " M_EN;
  3718.              M_ST
  3719.                "             REMOTE DIRECTORY FOO@"
  3720.              M_EN;
  3721.              break;
  3722.           end;
  3723.  
  3724.           /* SET */
  3725.         case SETV:
  3726.           begin
  3727.                switch (LEVEL)
  3728.                begin
  3729.  
  3730.                   /* SET HPCICOMMANDS IN GNERAL */
  3731.                 case DEBUGV-1:
  3732.                   begin
  3733.                      M_ST "SET items:" M_EN;
  3734.                      M_ST " " M_EN;
  3735.                      M_ST "  SET DEBUG"  M_EN;
  3736.                      M_ST "  SET DELAY"  M_EN;
  3737.                      M_ST "  SET LINE"   M_EN;
  3738.                      M_ST "  SET SEND"   M_EN;
  3739.                      M_ST "  SET SPEED"  M_EN;
  3740.                      M_ST "  SET HANDSHAKE"  M_EN;
  3741.                      M_ST "  SET RECEIVE"    M_EN;
  3742.                      M_ST "  SET LOG"    M_EN;
  3743.                      M_ST "  SET SOH"    M_EN;
  3744.                      M_ST "  SET FAST"   M_EN;
  3745.                      M_ST " "        M_EN;
  3746.                      M_ST "type 'SET item ?' for explanation" M_EN;
  3747.                      break;
  3748.                 end;
  3749.  
  3750.                /* SET DEBUG */
  3751.  
  3752.              case DEBUGV:
  3753.                begin
  3754.                     M_ST
  3755.                      "Syntax:  SET DEBUG number"
  3756.                     M_EN;
  3757.                     M_ST " " M_EN;
  3758.                     M_ST
  3759.                      "This sets the debug level to the indicated"
  3760.                     M_EN;
  3761.                     M_ST
  3762.                      "number.  Currently, only one level exists."
  3763.                     M_EN;
  3764.                     M_ST
  3765.                      "This level is enabled by setting the number to"
  3766.                     M_EN;
  3767.                     M_ST
  3768.                      "any non-negative, non-zero number.  If DEBUG is"
  3769.                     M_EN;
  3770.                     M_ST
  3771.                      "enabled, packets sent and received are written"
  3772.                     M_EN;
  3773.                     M_ST
  3774.                      "to the LOG file."
  3775.                     M_EN;
  3776.                     break;
  3777.                end;
  3778.  
  3779.                /* SET DELAY */
  3780.  
  3781.              case DELAYV:
  3782.                begin
  3783.                     M_ST "Syntax:  SET DELAY number" M_EN;
  3784.                     M_ST " " M_EN;
  3785.                     M_ST
  3786.                      "Causes a pause for the indicated number of"
  3787.                     M_EN;
  3788.                     M_ST
  3789.                      "seconds prior to starting a SEND command.  This"
  3790.                     M_EN;
  3791.                     M_ST
  3792.                      "is to allow the user to escape back to the local"
  3793.                     M_EN;
  3794.                     M_ST
  3795.                      "KERMIT and enter a RECEIVE command."
  3796.                     M_EN;
  3797.                     break;
  3798.                end;
  3799.  
  3800.                /* SET LINE */
  3801.  
  3802.              case LINEV:
  3803.                begin
  3804.                     M_ST "Syntax:  SET LINE ldev" M_EN;
  3805.                     M_ST " " M_EN;
  3806.                     M_ST
  3807.                      "This causes the indicated ldev (logical device"
  3808.                     M_EN;
  3809.                     M_ST
  3810.                      "number) to be used for communications purposes."
  3811.                     M_EN;
  3812.                     break;
  3813.                end;
  3814.  
  3815.                /* SET SEND */
  3816.  
  3817.              case SENDV_1:
  3818.                begin
  3819.                     M_ST "                 { PAUSE 1/10 secs}" M_EN;
  3820.                     M_ST "                 {                }" M_EN;
  3821.                     M_ST "Syntax: SET SEND {       { ON   } }" M_EN;
  3822.                     M_ST "                 { BINARY{ OFF  } }" M_EN;
  3823.                     M_ST "                 {       { AUTO } }" M_EN;
  3824.                     M_ST " " M_EN;
  3825.                     M_ST
  3826.                      "This parameter is used to alter the default"
  3827.                     M_EN;
  3828.                     M_ST
  3829.                      "conditions relating to how files are sent."
  3830.                     M_EN;
  3831.                     break;
  3832.                end;
  3833.  
  3834.                /* SET SPEED */
  3835.  
  3836.                begin
  3837.                     M_ST "Syntax:  SET SPEED speed" M_EN;
  3838.                     M_ST " " M_EN;
  3839.                     M_ST
  3840.                      "Sets the communications speed to the indicated"
  3841.                     M_EN;
  3842.                     M_ST
  3843.                      "number of characters per second.  Supported"
  3844.                     M_EN;
  3845.                     M_ST
  3846.                      "speeds are: 30, 60, 120, 480, 960, and 1920."
  3847.                     M_EN;
  3848.                     M_ST
  3849.                      "Note that external devices may limit the speed "
  3850.                     M_EN;
  3851.                     M_ST
  3852.                      "to lower rates."
  3853.                     M_EN;
  3854.                     break;
  3855.                end;
  3856.  
  3857.                /* SET HANDSHAKE */
  3858.  
  3859.              case HANDSHAKEV:
  3860.                begin
  3861.                     M_ST "Syntax:  SET HANDSHAKE option" M_EN;
  3862.                     M_ST " " M_EN;
  3863.                     M_ST
  3864.                      "This specifies any handshaking that is to be"
  3865.                     M_EN;
  3866.                     M_ST
  3867.                      "done on the communications line.  Options are:"
  3868.                     M_EN;
  3869.                     M_ST " " M_EN;
  3870.                     M_ST
  3871.                      "XON  Generate an XON character prior to each"
  3872.                     M_EN;
  3873.                     M_ST
  3874.                      "read.  This is the default mode and is needed"
  3875.                     M_EN;
  3876.                     M_ST
  3877.                      "in most cases since the HP will lose any"
  3878.                     M_EN;
  3879.                     M_ST
  3880.                      "characters that are transmitted when no read is"
  3881.                     M_EN;
  3882.                     M_ST
  3883.                      "posted.  The local KERMIT must be capable of"
  3884.                     M_EN;
  3885.                     M_ST
  3886.                      "waiting for an XON character before issuing a"
  3887.                     M_EN;
  3888.                     M_ST
  3889.                      "a write to the communications line."
  3890.                     M_EN;
  3891.                     M_ST " " M_EN;
  3892.                     M_ST
  3893.                      "NONE  Generate no special characters prior to a"
  3894.                     M_EN;
  3895.                     M_ST
  3896.                      "read."
  3897.                     M_EN;
  3898.                     M_ST " " M_EN;
  3899.                     M_ST
  3900.                      "XON2 Same as XON except in both directions."
  3901.                     M_EN;
  3902.                     M_ST
  3903.                      "This sets the read termination character to XON"
  3904.                     M_EN;
  3905.                     M_ST
  3906.                      "in an attempt to synchronize with another KERMIT"
  3907.                     M_EN;
  3908.                     M_ST
  3909.                      "having similar limitations."
  3910.                     M_EN;
  3911.                     break;
  3912.                end;
  3913.  
  3914.                /* SET RECEIVE */
  3915.  
  3916.              case RECEIVEV_1:
  3917.              begin
  3918.                switch (RCVCASE)
  3919.                begin
  3920.  
  3921.                     /* General stuff */
  3922.  
  3923.                   case BINARYV-1:
  3924.                     begin
  3925.                     M_ST
  3926.                      "The SET RECEIVE parameter is used to alter the"
  3927.                     M_EN;
  3928.                     M_ST
  3929.                      "default conditions regarding file reception."
  3930.                     M_EN;
  3931.                     M_ST
  3932.                      "The various options are:"
  3933.                     M_EN;
  3934.                     M_ST " " M_EN;
  3935.                     M_ST "     SET RECEIVE DEVICE" M_EN;
  3936.                     M_ST "     SET RECEIVE FCODE"  M_EN;
  3937.                     M_ST "     SET RECEIVE BINARY" M_EN;
  3938.                     M_ST "     SET RECEIVE RECLEN" M_EN;
  3939.                     M_ST "     SET RECEIVE FIXREC" M_EN;
  3940.                     M_ST "     SET RECEIVE BLOCKF" M_EN;
  3941.                     M_ST "     SET RECEIVE MAXREC" M_EN;
  3942.                     M_ST "     SET RECEIVE MAXEXT" M_EN;
  3943.                     M_ST "     SET RECEIVE SAVESP" M_EN;
  3944.                     M_ST "     SET RECEIVE PROG"   M_EN;
  3945.                     M_ST "     SET RECEIVE TEXT"   M_EN;
  3946.                     M_ST "     SET RECEIVE TXT80"  M_EN;
  3947.                     M_ST "     SET RECEIVE BIN128" M_EN;
  3948.                     M_ST "     SET RECEIVE EXPTAB" M_EN;
  3949.                     break;
  3950.                     end;
  3951.  
  3952.                     /* SET RECEIVE BINARY */
  3953.  
  3954.                   case BINARYV:
  3955.                     begin
  3956.                     M_ST
  3957.                      "Syntax:  SET RECEIVE BINARY { ON  }"
  3958.                     M_EN;
  3959.                     M_ST
  3960.                      "                            { OFF }"
  3961.                     M_EN;
  3962.                     M_ST " " M_EN;
  3963.                     M_ST
  3964.                      "BINARY tells how to store received files on the"
  3965.                     M_EN;
  3966.                     M_ST
  3967.                      "3000."
  3968.                     M_EN;
  3969.                     M_ST "       ON  Store files as binary." M_EN;
  3970.                     M_ST "       OFF Store files as ASCII." M_EN;
  3971.                     break;
  3972.                     end;
  3973.  
  3974.                     /* SET RECEIVE DEVICE */
  3975.  
  3976.                   case DEVICEV:
  3977.                     begin
  3978.                     M_ST
  3979.                      "Syntax:  SET RECEIVE DEVICE [ dev ]"
  3980.                     M_EN;
  3981.                     M_ST " " M_EN;
  3982.                     M_ST
  3983.                      "DEVICE specifies the device class for received"
  3984.                     M_EN;
  3985.                     M_ST
  3986.                      "files.  Default is DISC.  This command can be"
  3987.                     M_EN;
  3988.                     M_ST
  3989.                      "used to send files directly to the system line"
  3990.                     M_EN;
  3991.                     M_ST "printer." M_EN;
  3992.                     M_ST " " M_EN;
  3993.                     break;
  3994.                     end;
  3995.  
  3996.                     /* SET RECEIVE FCODE */
  3997.  
  3998.                   case FCODEV:
  3999.                     begin
  4000.                     M_ST
  4001.                      "Syntax:  SET RECEIVE FCODE n"
  4002.                     M_EN;
  4003.                     M_ST " " M_EN;
  4004.                     M_ST
  4005.                      "FCODE specifies the file code for received files."
  4006.                     M_EN;
  4007.                     break;
  4008.                     end;
  4009.  
  4010.                     /* SET RECEIVE RECLEN */
  4011.  
  4012.                   case RECLENV:
  4013.                     begin
  4014.                     M_ST
  4015.                      "Syntax:  SET RECEIVE RECLEN [-]n"
  4016.                     M_EN;
  4017.                     M_ST " " M_EN;
  4018.                     M_ST
  4019.                      "RECLEN specifies the maximum record length (n)"
  4020.                     M_EN;
  4021.                     M_ST
  4022.                      "for a received file.  As with other HP file "
  4023.                     M_EN;
  4024.                     M_ST
  4025.                      "system commands, n is assumed to be words if"
  4026.                     M_EN;
  4027.                     M_ST
  4028.                      "positive and bytes if negative"
  4029.                     M_EN;
  4030.                     break;
  4031.                     end;
  4032.  
  4033.                     /* SET RECEIVE BLOCKF */
  4034.  
  4035.                   case BLOCKFV:
  4036.                     begin
  4037.                     M_ST
  4038.                      "Syntax:  SET RECEIVE BLOCKF n"
  4039.                     M_EN;
  4040.                     M_ST " " M_EN;
  4041.                     M_ST
  4042.                      "BLOCKF specifies the blocking factor for received"
  4043.                     M_EN;
  4044.                     M_ST
  4045.                      "files.  If n is 0, the file system will calculate"
  4046.                     M_EN;
  4047.                     M_ST
  4048.                      "a blocking factor automatically and usually "
  4049.                      "unsatisfactorily."
  4050.                     M_EN;
  4051.                     break;
  4052.                     end;
  4053.  
  4054.                     /* SET RECEIVE FIXREC */
  4055.  
  4056.                   case FIXRECV:
  4057.                     begin
  4058.                     M_ST
  4059.                      "Syntax:  SET RECEIVE FIXREC { ON  }"
  4060.                     M_EN;
  4061.                     M_ST
  4062.                      "                            { OFF }"
  4063.                     M_EN;
  4064.                     M_ST " " M_EN;
  4065.                     M_ST
  4066.                      "FIXREC is used to identify fixed or variable"
  4067.                     M_EN;
  4068.                     M_ST
  4069.                      "length records.  Options are:"
  4070.                     M_EN;
  4071.                     M_ST "       ON   Use fixed length records." M_EN;
  4072.                     M_ST "       OFF  Use variable length records."M_EN;
  4073.                     break;
  4074.                     end;
  4075.  
  4076.                     /* SET RECEIVE MAXREC */
  4077.  
  4078.                   case MAXRECV:
  4079.                     begin
  4080.                     M_ST
  4081.                      "Syntax:  SET RECEIVE MAXREC n"
  4082.                     M_EN;
  4083.                     M_ST " " M_EN;
  4084.                     M_ST
  4085.                      "MAXREC specifies the maximum number of records"
  4086.                     M_EN;
  4087.                     M_ST
  4088.                      "that can be stored in a received file."
  4089.                     M_EN;
  4090.                     break;
  4091.                     end;
  4092.  
  4093.                     /* SET RECEIVE MAXEXT */
  4094.  
  4095.                   case MAXEXTV:
  4096.                     begin
  4097.                     M_ST
  4098.                      "Syntax:  SET RECEIVE MAXEXT n"
  4099.                     M_EN;
  4100.                     M_ST " " M_EN;
  4101.                     M_ST
  4102.                      "MAXEXT specifies the maximum number of extents"
  4103.                     M_EN;
  4104.                     M_ST
  4105.                      "for a received file.  This number (n) must be in"
  4106.                     M_EN;
  4107.                     M_ST
  4108.                      "the range 1 ... 32."
  4109.                     M_EN;
  4110.                     break;
  4111.                     end;
  4112.  
  4113.                     /* SET RECEIVE SAVESP */
  4114.  
  4115.                   case SAVESPV:
  4116.                     begin
  4117.                     M_ST
  4118.                      "Syntax:  SET RECEIVE SAVESP { ON  }"
  4119.                     M_EN;
  4120.                     M_ST
  4121.                      "                            { OFF }"
  4122.                     M_EN;
  4123.                     M_ST " " M_EN;
  4124.                     M_ST
  4125.                      "SAVESP specifies if unused file space at the end"
  4126.                     M_EN;
  4127.                     M_ST
  4128.                      "of the file is to be returned to the operating"
  4129.                     M_EN;
  4130.                     M_ST
  4131.                      "system.  Options are:"
  4132.                     M_EN;
  4133.                     M_ST "       ON   Return unused apace" M_EN;
  4134.                     M_ST "       OFF  Do not return unused space"M_EN;
  4135.                     break;
  4136.                     end;
  4137.  
  4138.                     /* SET RECEIVE PROG */
  4139.  
  4140.                   case PROGV:
  4141.                     begin
  4142.                     M_ST
  4143.                      "Syntax:  SET RECEIVE PROG"
  4144.                     M_EN;
  4145.                     M_ST " " M_EN;
  4146.                     M_ST
  4147.                      "PROG will set all of the other parameters needed"
  4148.                     M_EN;
  4149.                     M_ST
  4150.                      "to receive an HP 3000 program (executable) file."
  4151.                     M_EN;
  4152.                     M_ST
  4153.                      "It is equivalent to:"
  4154.                     M_EN;
  4155.                     M_ST "   SET RECEIVE BINARY ON" M_EN;
  4156.                     M_ST "   SET RECEIVE FIXREC ON" M_EN;
  4157.                     M_ST "   SET RECEIVE FCODE 1029" M_EN;
  4158.                     M_ST "   SET RECEIVE RECLEN 128" M_EN;
  4159.                     M_ST "   SET RECEIVE BLOCKF 1" M_EN;
  4160.                     M_ST "   SET RECEIVE MAXEXT 1" M_EN;
  4161.                     break;
  4162.                     end;
  4163.  
  4164.                     /* SET RECEIVE BIN128 */
  4165.  
  4166.                   case BIN128V:
  4167.                     begin
  4168.                     M_ST
  4169.                      "Syntax:  SET RECEIVE BIN128"
  4170.                     M_EN;
  4171.                     M_ST " " M_EN;
  4172.                     M_ST
  4173.                      "BIN128 sets up the needed parameters for recei-"
  4174.                     M_EN;
  4175.                     M_ST
  4176.                      "ving a binary file in the ""normal"" HP repre-"
  4177.                     M_EN;
  4178.                     M_ST
  4179.                      "sentation.  It is equivalent to:"
  4180.                     M_EN;
  4181.                     M_ST "   SET RECEIVE BINARY ON" M_EN;
  4182.                     M_ST "   SET RECEIVE FIXREC OFF" M_EN;
  4183.                     M_ST "   SET RECEIVE FCODE 0" M_EN;
  4184.                     M_ST "   SET RECEIVE RECLEN 128" M_EN;
  4185.                     M_ST "   SET RECEIVE BLOCKF 0" M_EN;
  4186.                     break;
  4187.                     end;
  4188.  
  4189.                     /* SET RECEIVE TEXT */
  4190.  
  4191.                   case TEXTV:
  4192.                     begin
  4193.                     M_ST
  4194.                      "Syntax:  SET RECEIVE TEXT"
  4195.                     M_EN;
  4196.                     M_ST " " M_EN;
  4197.                     M_ST
  4198.                      "TEXT sets up the needed parameters for receiving"
  4199.                     M_EN;
  4200.                     M_ST
  4201.                      """generic"" text files.  It is equivalent to:"
  4202.                     M_EN;
  4203.                     M_ST "   SET RECEIVE BINARY OFF" M_EN;
  4204.                     M_ST "   SET RECEIVE FIXREC OFF" M_EN;
  4205.                     M_ST "   SET RECEIVE FCODE 0" M_EN;
  4206.                     M_ST "   SET RECEIVE RECLEN -254" M_EN;
  4207.                     M_ST "   SET RECEIVE BLOCKF 0" M_EN;
  4208.                     break;
  4209.                     end;
  4210.  
  4211.                     /* SET RECEIVE TXT80 */
  4212.  
  4213.                   case TXT80V:
  4214.                     begin
  4215.                     M_ST
  4216.                      "Syntax:  SET RECEIVE TXT80"
  4217.                     M_EN;
  4218.                     M_ST " " M_EN;
  4219.                     M_ST
  4220.                      "TXT80 sets up the needed parameters for recei-"
  4221.                     M_EN;
  4222.                     M_ST
  4223.                      "ving 80 character text files in the manner that"
  4224.                     M_EN;
  4225.                     M_ST
  4226.                      "is most convenient for the typical text editor"
  4227.                     M_EN;
  4228.                     M_ST
  4229.                      "on the HP.  It is equivalent to:"
  4230.                     M_EN;
  4231.                     M_ST "   SET RECEIVE BINARY OFF" M_EN;
  4232.                     M_ST "   SET RECEIVE FIXREC ON" M_EN;
  4233.                     M_ST "   SET RECEIVE FCODE 0" M_EN;
  4234.                     M_ST "   SET RECEIVE RECLEN -80" M_EN;
  4235.                     M_ST "   SET RECEIVE BLOCKF 16" M_EN;
  4236.                     break;
  4237.                     end;
  4238.  
  4239.                     /* SET RECEIVE EXPTAB */
  4240.  
  4241.                   case EXPTABV:
  4242.                     begin
  4243.                     M_ST
  4244.                      "Syntax:  SET RECEIVE EXPTAB { ON  }"
  4245.                     M_EN;
  4246.                     M_ST
  4247.                      "                            { OFF }"
  4248.                     M_EN;
  4249.                     M_ST " " M_EN;
  4250.                     M_ST
  4251.                      "EXPTAB expands horizontal tabs found in the"
  4252.                     M_EN;
  4253.                     M_ST
  4254.                      "data.  Tab stops are assumed to be at columns"
  4255.                     M_EN;
  4256.                     M_ST
  4257.                      "1, 9, 17, 25, etc."
  4258.                     M_EN;
  4259.                     break;
  4260.                     end;
  4261.                  break;
  4262.                end;   /* case SET RECEIVE */
  4263.               break;
  4264.              end;
  4265.  
  4266.                /* SET LOG */
  4267.  
  4268.              case LOGV:
  4269.                begin
  4270.                     M_ST
  4271.                      "Syntax:  SET LOG { [ filespec ] }"
  4272.                     M_EN;
  4273.                     M_ST
  4274.                      "                 { PURGE        }"
  4275.                     M_EN;
  4276.                     M_ST " " M_EN;
  4277.                     M_ST
  4278.                      "This command sets the LOG file to the indicated"
  4279.                     M_EN;
  4280.                     M_ST
  4281.                      "filespec.  Error and DEBUG messages (if enabled)"
  4282.                     M_EN;
  4283.                     M_ST
  4284.                      "are written to the LOG file (see SET DEBUG)."
  4285.                     M_EN;
  4286.                     M_ST
  4287.                      "If filespec is not specified, the current LOG"
  4288.                     M_EN;
  4289.                     M_ST
  4290.                      "file, if open, is closed.  If PURGE is specified,"
  4291.                     M_EN;
  4292.                      M_ST
  4293.                       "the file is closed and purged."
  4294.                      M_EN;
  4295.                      break;
  4296.                end;
  4297.  
  4298.                /* SET SOH */
  4299.  
  4300.              case SOHV:
  4301.                begin
  4302.                     M_ST "Syntax:  SET SOH [%]n" M_EN;
  4303.                     M_ST " " M_EN;
  4304.                     M_ST
  4305.                      "This option sets the value of the start-of-header"
  4306.                     M_EN;
  4307.                     M_ST
  4308.                      "character used to begin each packet.  If the %-"
  4309.                     M_EN;
  4310.                     M_ST
  4311.                      "sign is used, n is assumed to be octal.  Other-"
  4312.                     M_EN;
  4313.                     M_ST
  4314.                      "wise n is assumed to be decimal.  Default value"
  4315.                     M_EN;
  4316.                     M_ST
  4317.                      "for SOH is 1."
  4318.                     M_EN;
  4319.                     break;
  4320.                end;
  4321.  
  4322.                /* SET FAST */
  4323.  
  4324.              case FASTV:
  4325.                begin
  4326.                     M_ST "Syntax:  SET FAST {ON }" M_EN;
  4327.                     M_ST "                  {OFF}" M_EN;
  4328.                     M_ST " " M_EN;
  4329.                     M_ST
  4330.                      "FAST ON shortens both the number of timeouts "
  4331.                     M_EN;
  4332.                     M_ST
  4333.                      "and the timeout time for receiving packets. "
  4334.                     M_EN;
  4335.                     M_ST
  4336.                      "It is intended primarily for machine-to-machine"
  4337.                     M_EN;
  4338.                     M_ST
  4339.                      "RECEIVES by this Kermit when there are also a"
  4340.                     M_EN;
  4341.                     M_ST
  4342.                      "number of files stacked up to be transmitted by"
  4343.                     M_EN;
  4344.                     M_ST
  4345.                      "this Kermit.  The timing out may be too fast for"
  4346.                     M_EN;
  4347.                     M_ST
  4348.                      "a human sitting at a PC Keyboard, and should "
  4349.                     M_EN;
  4350.                     M_ST
  4351.                      "probably not be used in that case."
  4352.                     M_EN;
  4353.                     break;
  4354.                end;
  4355.  
  4356.                  break;
  4357.                end;
  4358.              break;
  4359.             end;  /* SET (LEVEL) case */
  4360.  
  4361.           /* EXIT */
  4362.  
  4363.         case EXITV:
  4364.           begin
  4365.                M_ST "Syntax:  {EXIT}" M_EN;
  4366.                M_ST "         {QUIT}" M_EN;
  4367.                M_ST " " M_EN;
  4368.                M_ST
  4369.                  "This command causes the HP KERMIT process to"
  4370.                M_EN;
  4371.                M_ST
  4372.                  "terminate in an orderly manner."
  4373.                M_EN;
  4374.                break;
  4375.           end;
  4376.  
  4377.           /* DIR */
  4378.  
  4379.         case DIRV:
  4380.           begin
  4381.                M_ST "Syntax:  DIR [filespec]" M_EN;
  4382.                M_ST " " M_EN;
  4383.                M_ST
  4384.                 "This command searches the disc directory for the"
  4385.                M_EN;
  4386.                M_ST
  4387.                 "indicated filespec, if any.  Wildcard characters"
  4388.                M_EN;
  4389.                M_ST
  4390.                 "may be used."
  4391.                M_EN;
  4392.                break;
  4393.           end;
  4394.  
  4395.           /* SPACE */
  4396.  
  4397.         case SPACEV:
  4398.           begin
  4399.                M_ST "Syntax:  SPACE [groupspec]" M_EN;
  4400.                M_ST " " M_EN;
  4401.                M_ST
  4402.                 "This command reports the amount of in-use and"
  4403.                M_EN;
  4404.                M_ST
  4405.                 "available disc for the user's account and group."
  4406.                M_EN;
  4407.                M_ST
  4408.                 "(Groupspec may not be valid if the logon user does"
  4409.                M_EN;
  4410.                M_ST
  4411.                 "not have account manager capability.)"
  4412.                M_EN;
  4413.                break;
  4414.           end;
  4415.  
  4416.           /* DELETE */
  4417.  
  4418.         case DELETEV:
  4419.           begin
  4420.                M_ST "Syntax:  DELETE filespec" M_EN;
  4421.                M_ST " " M_EN;
  4422.                M_ST
  4423.                 "This command causes the indicated filespec to be"
  4424.                M_EN;
  4425.                M_ST
  4426.                 "removed from disc."
  4427.                M_EN;
  4428.                break;
  4429.           end;
  4430.  
  4431.           /* TYPE */
  4432.  
  4433.  
  4434.         case TYPEV:
  4435.           begin
  4436.                M_ST "Syntax:  TYPE filespec" M_EN;
  4437.                M_ST " " M_EN;
  4438.                M_ST "TYPE lists a file on your terminal." M_EN;
  4439.                break;
  4440.           end;
  4441.  
  4442.           /* STATUS */
  4443.  
  4444.         case STATUSV:
  4445.           begin
  4446.                M_ST "Syntax:  { STATUS }" M_EN;
  4447.                M_ST "         { VERIFY }" M_EN;
  4448.                M_ST " " M_EN;
  4449.                M_ST
  4450.                 "STATUS provides a listing of the current file and"
  4451.                M_EN;
  4452.                M_ST
  4453.                 "transmission attributes."
  4454.                M_EN;
  4455.                break;
  4456.           end;
  4457.  
  4458.      end; /* ITEM case */
  4459.      M_ST " " M_EN;
  4460.      IB[ILEN-1] = ' ';   /*Hopefully wipe out question mark*/
  4461.      FWRITE(CONUM, IB, -ILEN, 0xD0);
  4462. end
  4463.  
  4464. #pragma   SUBTITLE      "SEARCH - Command table lookup"
  4465. #pragma   PAGE
  4466. procedure SEARCH(TARGET, LENGTH, DICT, DEFN, START)
  4467. int                      LENGTH,             START;
  4468. char             TARGET[],       DICT[],
  4469.                                       *DEFN       ;
  4470. begin
  4471.  
  4472.      int       I;
  4473.  
  4474.      char      *P;
  4475.  
  4476.      I = 0;
  4477.      P = DICT;
  4478.      while ( *( P+(*P)-1 ) < START )  P = P +  *P;
  4479.      while ( *P != 0 )
  4480.      begin
  4481.           I = I+1;
  4482.           if (LENGTH <=  *(P+1) ) then
  4483.                if ( strncmp(TARGET, P+2, LENGTH) == 0) then
  4484.                     if ( LENGTH >= MIN_SIZE[*(P+(*P)-1)] ) then
  4485.                     begin
  4486.                          *DEFN = *(P + (*P)-1);
  4487.                          return I;
  4488.                     end;
  4489.           P = P + *P;
  4490.      end;
  4491.      return 0;
  4492. end
  4493.  
  4494. #pragma   SUBTITLE      "READ_USER - Read from keyboard or TAKE file"
  4495. #pragma   page
  4496.      subroutine READ_USER(PROMPT)
  4497.      logical              PROMPT;
  4498.      begin
  4499.           int  DUM32;
  4500.  
  4501.           IBX = 0; /* Index to zero */
  4502.           begin    /* Not initial command */
  4503.  
  4504.                if (CTLY) then
  4505.                begin
  4506.                     M_ST "           " M_EN;
  4507.                     M_ST "<CONTROL-Y>" M_EN;
  4508.                     M_ST "           " M_EN;
  4509.                     if (TAKENUM != 0) then
  4510.                     begin
  4511.                          FCLOSE(TAKENUM,0,0);
  4512.                          TAKENUM = 0;
  4513.                     end;
  4514.  
  4515.                     CTLY = false;
  4516.  
  4517.                end;
  4518.  
  4519.                if (TAKENUM != 0) then
  4520.                begin /* Open TAKE file */
  4521.                     ILEN = FREAD(TAKENUM,IB,-72);
  4522.                     if (ccode()==CCG) then
  4523.                     begin               /* End of file */
  4524.                          FCLOSE(TAKENUM,0,0);
  4525.                          TAKENUM = 0;
  4526.                     end
  4527.                          else
  4528.                     if (ccode()==CCL) then
  4529.                     begin               /* Some other error */
  4530.                          M_ST "Read error on TAKE file" M_EN;
  4531.                          FCLOSE(TAKENUM,0,0);
  4532.                          TAKENUM = 0;
  4533.                     end;
  4534.                end;
  4535.  
  4536.                if (TAKENUM == 0) then
  4537.                do begin
  4538.                     if (PROMPT) then
  4539.                     begin
  4540.                          strcpy(PBUF, "KERMIT3000>");
  4541.                          FWRITE(CONUM,PBUF,-strlen(PBUF), 0xD0);
  4542.                     end;
  4543.                     ILEN = FREAD(CINUM,IB,-80);
  4544.                     if (ccode() != CCE) then
  4545.                     begin
  4546.                          strcpy(IB, "EXIT");
  4547.                          ILEN = 4;
  4548.                     end;
  4549.                end
  4550.                while ( !(ILEN > 0 | !(PROMPT) ) );
  4551.           end;
  4552.           IB_PTR = IB;
  4553.           IB[ILEN] = '^';  /* Stopper */
  4554.           MY_JCW_VAL = IDLING;
  4555.      end
  4556. #pragma   SUBTITLE      "SCANIT - Command scanner"
  4557. #pragma   PAGE
  4558.      subroutine SCANIT(START)
  4559.      int               START;
  4560.      begin
  4561.           ITEM = NULLV;  /* Default return */
  4562.           CPLEN = 0;
  4563.           while (*IB_PTR == ' ')  IB_PTR++; /* Skip blanks  */
  4564.           if (*IB_PTR == '^') then              /* End of input */
  4565.           begin
  4566.                return;
  4567.           end;
  4568.  
  4569.           if ( (*IB_PTR>='A' & *IB_PTR<='z')  |  *IB_PTR == '@' )  then
  4570.           begin
  4571.                do begin
  4572.                     if ( *IB_PTR>='a' & *IB_PTR<='z' )  then
  4573.                     CPARM[CPLEN] = *IB_PTR-' ';    /* Upshift */
  4574.                          else
  4575.                     CPARM[CPLEN] = *IB_PTR;
  4576.                     IB_PTR++;    /* Points after moved entity */
  4577.                     CPLEN++;
  4578.                end
  4579.                while ( (*IB_PTR != ' ') & (*IB_PTR != '^') );
  4580.                if ( SEARCH(CPARM, CPLEN, RESWDS, &ITEMPTR, START)>0 )
  4581.                  then ITEM = ITEMPTR;
  4582.                return;
  4583.           end;
  4584.  
  4585.           if ('0' <= *IB_PTR & *IB_PTR <= '9'
  4586.            | *IB_PTR == '-'  |  *IB_PTR == '%')  then
  4587.           begin    /* It looks numeric.  Will know for sure later. */
  4588.                if (*IB_PTR == '-'  |  *IB_PTR == '%')  then
  4589.                begin
  4590.                     CPARM[CPLEN] = *IB_PTR;
  4591.                     CPLEN++;
  4592.                     IB_PTR++;
  4593.                end;
  4594.                if ( !('0' <= *IB_PTR & *IB_PTR <= '9') ) then
  4595.                begin
  4596.                     return;
  4597.                end;
  4598.                while ('0' <= *IB_PTR & *IB_PTR<= '9')
  4599.                begin
  4600.                     CPARM[CPLEN] = *IB_PTR;
  4601.                     CPLEN++;
  4602.                     IB_PTR++;
  4603.                end;
  4604.                CPVAL = BINARY(CPARM, CPLEN);
  4605.                if (ccode()==CCE)  then  /* If this is bad then */
  4606.                     ITEM = NUMBERV;     /* move numeric is bad */
  4607.                return;
  4608.           end;
  4609.  
  4610.           if (*IB_PTR == '?') then
  4611.           begin
  4612.                ITEM = QMARKV;
  4613.                IB_PTR++;
  4614.                return;
  4615.           end;
  4616.  
  4617.           /* At this point the item found is not alphanumeric,    */
  4618.           /* numeric (including optional minus sign), or question */
  4619.           /* mark. Pass it back for the command processor to work */
  4620.           /* with.                                                */
  4621.  
  4622.           while (*IB_PTR != ' '  &  *IB_PTR != '^')
  4623.           begin
  4624.                CPARM[PLEN] = *IB_PTR;
  4625.                CPLEN++;
  4626.                IB_PTR++;
  4627.           end;
  4628.  
  4629. /*        del;   ?????        Cut back stack */
  4630.      end
  4631. #pragma   SUBTITLE      "CMDINT - Command Interpreter"
  4632. #pragma   PAGE
  4633. procedure CMDINT(ICMD,ICLEN)
  4634. int                   ICLEN ;
  4635. char             ICMD[]     ;
  4636. begin
  4637.  
  4638.  
  4639.      int            IBYTE,         /* Current Character    */
  4640.                     X;             /* Temp Variable        */
  4641.  
  4642.      int            D_X;           /* Temp Double          */
  4643.  
  4644.      logical        DONE = false,  /* Done Flag */
  4645.                     XFROK;         /* Xfer OK flag */
  4646.  
  4647.      float          P_INT,         /* PAUSE Interval*/
  4648.                     BRIEFLY = 1.0; /* Give HPCICOMMAND some time */
  4649.  
  4650. /*   label          TAKE_EXIT,
  4651.                     SEND_EXIT,
  4652.                     RECEIVE_EXIT,
  4653.                     SERVE_EXIT,
  4654.                     SET_EXIT;        */
  4655.  
  4656.  
  4657.      while ( !DONE )
  4658.      begin
  4659.           if (ICLEN != 0) then
  4660.           begin
  4661.                strncpy(IB, ICMD, ICLEN);
  4662.                IB[ILEN=ICLEN] = '^';
  4663.                IB_PTR = IB;
  4664.                ICLEN = 0;
  4665.           end
  4666.                else
  4667.           READ_USER(true);
  4668.  
  4669.           SCANIT(NULLV);
  4670.           if (TAKEV <= ITEM & ITEM <= VERIFYV) then
  4671.           switch (ITEM)
  4672.           begin
  4673.           /* TAKE */
  4674.         case TAKEV:
  4675.           begin
  4676.                SCANIT(QMARKV);
  4677.                while (ITEM == QMARKV)
  4678.                begin
  4679.                     HELP(TAKEV);
  4680.                     READ_USER(false);
  4681.                     SCANIT(QMARKV);
  4682.                     if (CTLY) then
  4683.                          goto TAKE_EXIT;
  4684.                end;
  4685.                if (ITEM != NULLV) then  /* No reserved words allowed */
  4686.                begin
  4687.                     M_ST "Cannot use reserved word for filespec." M_EN;
  4688.                     goto TAKE_EXIT;
  4689.                end;
  4690.                CPARM[CPLEN] = ' ';
  4691.                if (TAKENUM != 0) then
  4692.                begin
  4693.                     FCLOSE(TAKENUM,0,0);
  4694.                     TAKENUM = 0;
  4695.                end;
  4696.                TAKENUM = FOPEN(CPARM,0x5,0x400);
  4697.                if (TAKENUM == 0) then
  4698.                begin
  4699.                     M_ST "take error" M_EN;
  4700.                end;
  4701.           TAKE_EXIT:
  4702.                break;
  4703.           end;
  4704.  
  4705.           /* SEND */
  4706.  
  4707.         case SENDV:
  4708.           begin
  4709.                SCANIT(QMARKV); /* get local file name */
  4710.                while (ITEM == QMARKV)
  4711.                begin
  4712.                     HELP(SENDV);
  4713.                     READ_USER(false);
  4714.                     SCANIT(QMARKV);
  4715.                     if (CTLY) then
  4716.                          goto SEND_EXIT;
  4717.                end;
  4718.  
  4719.                MY_JCW_VAL = SEND_NG;  /* pessimism */
  4720.  
  4721.                while (CPLEN == 0)
  4722.                begin
  4723.                     strcpy(PBUF, "HP3000 file name?");
  4724.                     FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0);
  4725.                     READ_USER(false);
  4726.                     SCANIT(QMARKV);
  4727.                     if (CTLY) then
  4728.                          goto SEND_EXIT;
  4729.                end;
  4730.                strcpy(L_FNAME, CPARM);
  4731.                L_FNAME[CPLEN] = ' ';
  4732.                L_FNAME_LEN = CPLEN;
  4733.  
  4734.                DNUM = FOPEN(L_FNAME,5,0);
  4735.                if (DNUM == 0) then
  4736.                begin
  4737.                     M_ST "File open error" M_EN;
  4738.                end
  4739.                     else
  4740.                begin
  4741.                     SCANIT(QMARKV);
  4742.                     if (CPLEN != 0) then
  4743.                     begin
  4744.                          strcpy(R_FNAME, CPARM);
  4745.                     end;
  4746.                     R_FNAME_LEN = CPLEN;
  4747.  
  4748.                     if ( !OPEN_LINE() ) then
  4749.                     begin
  4750.                          M_ST "Line open failure" M_EN;
  4751.                     end
  4752.                          else
  4753.                     begin
  4754.                          M_ST
  4755.                            "Escape back to your local KERMIT "
  4756.                            "and enter the RECEIVE command"
  4757.                          M_EN;
  4758.  
  4759.                          if (I_DELAY > 0) then
  4760.                          begin
  4761.                               P_INT = I_DELAY;
  4762.                               PAUSE(&P_INT);
  4763.                          end;
  4764.  
  4765.                          if (R_FNAME_LEN != 0) then
  4766.                               XFROK = SENDSW(R_FNAME,
  4767.                                               -R_FNAME_LEN);
  4768.                          else
  4769.                               XFROK = SENDSW(L_FNAME,
  4770.                                               -L_FNAME_LEN);
  4771.  
  4772.                          STATE = SBREAK();
  4773.                          if (LDEV_CI == LDEV_LINE) then
  4774.                               SHUT_LINE();  /* Echo on, etc. */
  4775.  
  4776.                          if ( !XFROK ) then
  4777.                          begin
  4778.                               M_ST "SEND failure" M_EN;
  4779.                          end
  4780.                               else
  4781.                          begin
  4782.                               M_ST "SEND completed" M_EN;
  4783.                          end;
  4784.                     end;
  4785.                end;
  4786.           SEND_EXIT:
  4787.                PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  4788.  
  4789.                L_FNAME_LEN = 0;
  4790.                break;
  4791.           end;
  4792.  
  4793.           /* RECEIVE */
  4794.  
  4795.         case RECEIVEV:
  4796.           begin
  4797.                SCANIT(QMARKV);
  4798.                while (ITEM == QMARKV)
  4799.                begin
  4800.                     HELP(RECEIVEV);
  4801.                     READ_USER(false);
  4802.                     SCANIT(QMARKV);
  4803.                     if (CTLY) then
  4804.                          goto RECEIVE_EXIT;
  4805.                end;
  4806.  
  4807.                MY_JCW_VAL = RECV_NG;  /* pessimism */
  4808.  
  4809.                while (CPLEN == 0)
  4810.                begin
  4811.                     strcpy(PBUF, "HP3000 file name?");
  4812.                     FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0);
  4813.                     READ_USER(false);
  4814.                     SCANIT(QMARKV);
  4815.                     if (CTLY) then
  4816.                          goto RECEIVE_EXIT;
  4817.                end;
  4818.                strncpy(L_FNAME, CPARM, CPLEN);
  4819.                L_FNAME_LEN = CPLEN;
  4820.  
  4821.                strcpy(PBUF, "listf ");
  4822.                strncat(PBUF, L_FNAME, L_FNAME_LEN);
  4823.                strcat(PBUF, ";$null");
  4824.                PBUF[strlen(PBUF)] = CR;
  4825.                HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  4826.                if (ERROR != 0) then;  /* Its not there. OK. */
  4827.                     else
  4828.                begin
  4829.                     strcpy(PBUF,
  4830.                            "File is already present.  "
  4831.                            "OK to remove? (Y/N)");
  4832.                     FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0);
  4833.                     READ_USER(false);
  4834.                     SCANIT(ONV);
  4835.                     if (ITEM==YESV) then
  4836.                     begin
  4837.                          L_FNAME[L_FNAME_LEN] = 0;
  4838.                          remove(L_FNAME);
  4839.                     end
  4840.                          else
  4841.                     begin
  4842.                          M_ST "RECEIVE attempt abandoned" M_EN;
  4843.                          goto RECEIVE_EXIT;
  4844.                     end;
  4845.                end;
  4846.  
  4847.  
  4848.                if ( !OPEN_LINE() ) then
  4849.                begin
  4850.                     M_ST "Line open error" M_EN;
  4851.                end
  4852.                     else
  4853.                begin
  4854.                     M_ST
  4855.                       "Escape back to your local KERMIT "
  4856.                       "and enter the SEND command"
  4857.                     M_EN;
  4858.  
  4859.                     XFROK = RECSW(false);
  4860.  
  4861.                     if (LDEV_CI == LDEV_LINE) then
  4862.                          SHUT_LINE();  /* Echo on, etc. */
  4863.  
  4864.                     if ( !XFROK ) then
  4865.                     begin
  4866.                          M_ST "RECEIVE error" M_EN;
  4867.                     end
  4868.                          else
  4869.                     begin
  4870.                          M_ST "RECEIVE complete" M_EN;
  4871.                     end;
  4872.                end;
  4873.           RECEIVE_EXIT:
  4874.           PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR);
  4875.  
  4876.           L_FNAME_LEN = 0;
  4877.           break;
  4878.           end;
  4879.  
  4880.           /* SERVE */
  4881.  
  4882.         case SERVEV:
  4883.           begin
  4884.                SCANIT(QMARKV);
  4885.                if (ITEM == QMARKV) then
  4886.                begin
  4887.                     HELP(SERVEV);
  4888.                     READ_USER(false);
  4889.                     if (CTLY) then
  4890.                          goto SERVE_EXIT;
  4891.                end;
  4892.                if ( !OPEN_LINE() ) then
  4893.                begin
  4894.                     M_ST "Line open failure" M_EN;
  4895.                end
  4896.                     else
  4897.                begin
  4898.                     M_ST
  4899.                       "Entering SERVER mode - "
  4900.                       "escape back to your local KERMIT"
  4901.                     M_EN;
  4902.                     SERVER();
  4903.  
  4904.                     if (LDEV_CI == LDEV_LINE) then SHUT_LINE();
  4905.  
  4906.               /*    DONE = !CTLY;    */
  4907.                end;
  4908.           SERVE_EXIT:
  4909.                break;
  4910.           end;
  4911.  
  4912.           /* SET */
  4913.  
  4914.         case SETV:
  4915.           begin
  4916.                SCANIT(DEBUGV);
  4917.                if (ITEM == QMARKV) then
  4918.                begin
  4919.                     HELP(SETV, DEBUGV-1);
  4920.                     READ_USER(false);
  4921.                     SCANIT(DEBUGV);
  4922.                     if (CTLY) then
  4923.                          goto SET_EXIT;
  4924.                end;
  4925.                if ( !(DEBUGV <= ITEM & ITEM <= FASTV) )  then
  4926.                begin
  4927.                     M_ST "set error" M_EN;
  4928.                end
  4929.                     else
  4930.                switch (ITEM)
  4931.                begin
  4932.  
  4933.                /* SET DEBUG */
  4934.  
  4935.              case DEBUGV:
  4936.                begin
  4937.                     SCANIT(QMARKV);
  4938.                     while (ITEM == QMARKV)
  4939.                     begin
  4940.                          HELP(SETV, DEBUGV);
  4941.                          READ_USER(false);
  4942.                          SCANIT(QMARKV);
  4943.                          if (CTLY) then
  4944.                               goto SET_EXIT;
  4945.                     end;
  4946.                     if (ITEM == NUMBERV) then
  4947.                          DEBUG_MODE = CPVAL;
  4948.                          else
  4949.                     begin
  4950.                          M_ST "set debug error" M_EN;
  4951.                     end;
  4952.                     break;
  4953.                end;
  4954.  
  4955.                /* SET DELAY */
  4956.  
  4957.              case DELAYV:
  4958.                begin
  4959.                     SCANIT(QMARKV);
  4960.                     while (ITEM == QMARKV)
  4961.                     begin
  4962.                          HELP(SETV, DELAYV);
  4963.                          READ_USER(false);
  4964.                          SCANIT(QMARKV);
  4965.                          if (CTLY) then
  4966.                               goto SET_EXIT;
  4967.                     end;
  4968.                     if (CPLEN == 0) then
  4969.                     begin
  4970.                          I_DELAY = 0;
  4971.                     end
  4972.                          else
  4973.                     begin
  4974.                          if (ITEM == NUMBERV) then
  4975.                               I_DELAY = CPVAL;
  4976.                               else
  4977.                          begin
  4978.                               M_ST "set delay error" M_EN;
  4979.                          end;
  4980.                     end;
  4981.                     break;
  4982.                end;
  4983.  
  4984.                /* SET LINE */
  4985.  
  4986.              case LINEV:
  4987.                begin
  4988.                     SCANIT(QMARKV);
  4989.                     while (ITEM == QMARKV)
  4990.                     begin
  4991.                          HELP(SETV, LINEV);
  4992.                          READ_USER(false);
  4993.                          SCANIT(QMARKV);
  4994.                          if (CTLY) then
  4995.                               goto SET_EXIT;
  4996.                     end;
  4997.                     if (CPLEN == 0) then
  4998.                     begin
  4999.                          LDEV_LINE = 0;
  5000.                          SHUT_LINE();
  5001.                     end
  5002.                          else
  5003.                     begin
  5004.                          if (ITEM != NUMBERV) then
  5005.                          begin
  5006.                               M_ST "set line error" M_EN;
  5007.                          end
  5008.                               else
  5009.                          begin
  5010.                               LDEV_LINE = CPVAL;
  5011.                               SHUT_LINE();
  5012.                          end;
  5013.                     end;
  5014.                     ASCII(LDEV_LINE,-10,KERM_JCW+7);
  5015.                     break;
  5016.                end;
  5017.  
  5018.                /* SET SEND */
  5019.  
  5020.              case SENDV_1:
  5021.                begin
  5022.                     SCANIT(PAUSEV);
  5023.                     while (ITEM == QMARKV)
  5024.                     begin
  5025.                          HELP(SETV, SENDV_1);
  5026.                          READ_USER(false);
  5027.                          SCANIT(PAUSEV);
  5028.                          if (CTLY) then
  5029.                               goto SET_EXIT;
  5030.                     end;
  5031.                     if (ITEM == PAUSEV) then
  5032.                     begin
  5033.                          SCANIT(QMARKV);
  5034.                          if (ITEM != NUMBERV) then
  5035.                          begin
  5036.                               M_ST "send pause error" M_EN;
  5037.                          end
  5038.                               else
  5039.                          PAUSE_CNT = CPVAL;
  5040.                     end
  5041.  
  5042.                          else
  5043.                     if (ITEM == BINARYV) then
  5044.                     begin
  5045.                          SCANIT(AUTOV);         /* POTENTIAL TROUBLE */
  5046.                          if (AUTOV <= ITEM & ITEM <= OFFV) then
  5047.                          SND_BINARY = ITEM-AUTOV;
  5048.                               else
  5049.                          begin
  5050.                               M_ST "set send binary error" M_EN;
  5051.                          end;
  5052.                     end
  5053.                          else
  5054.                     begin
  5055.                          M_ST "set send error" M_EN;
  5056.                     end
  5057.                     break;
  5058.                end;
  5059.  
  5060.                /* SET SPEED */
  5061.  
  5062.              case SPEEDV:
  5063.                begin
  5064.                     SCANIT(QMARKV);
  5065.                     while (ITEM == QMARKV)
  5066.                     begin
  5067.                          HELP(SETV, SPEEDV);
  5068.                          READ_USER(false);
  5069.                          SCANIT(QMARKV);
  5070.                          if (CTLY) then
  5071.                               goto SET_EXIT;
  5072.                     end;
  5073.                     X = CPVAL;
  5074.                     if( (X != 30)  & (X != 60)  & (X != 120) &
  5075.                         (X != 240) & (X != 480) & (X != 960) &
  5076.                         (X != 1920) )  then
  5077.                     begin
  5078.                          M_ST
  5079.                          "Invalid SPEED, use 30,60,120,240,480,960,1920"
  5080.                          M_EN;
  5081.                     end
  5082.                          else
  5083.                     TSPEED = X;
  5084.                     break;
  5085.                end;
  5086.  
  5087.                /* SET HANDSHAKE */
  5088.  
  5089.              case HANDSHAKEV:
  5090.                begin
  5091.                     SCANIT(ONV);
  5092.                     while (ITEM == QMARKV)
  5093.                     begin
  5094.                          HELP(SETV, HANDSHAKEV);
  5095.                          READ_USER(false);
  5096.                          SCANIT(ONV);
  5097.                          if (CTLY) then
  5098.                               goto SET_EXIT;
  5099.                     end;
  5100.                     if (NONEV <= ITEM & ITEM <= XON2V) then
  5101.                     HNDSHK = ITEM-NONEV;
  5102.                          else
  5103.                     begin
  5104.                          M_ST "set handshake error" M_EN;
  5105.                     end;
  5106.                     break;
  5107.                end;
  5108.  
  5109.                /* SET RECEIVE */
  5110.  
  5111.              case RECEIVEV_1:
  5112.                begin
  5113.                     SCANIT(PAUSEV);
  5114.                     while (ITEM == QMARKV)
  5115.                     begin
  5116.                          HELP(SETV, RECEIVEV_1, BINARYV-1);
  5117.                          READ_USER(false);
  5118.                          SCANIT(PAUSEV);
  5119.                          if (CTLY) then
  5120.                               goto SET_EXIT;
  5121.                     end;
  5122.                     if ( !(BINARYV <= ITEM & ITEM <= EXPTABV) ) then
  5123.                     begin
  5124.                          M_ST "set receive error" M_EN;
  5125.                     end
  5126.                          else
  5127.                 /*    case (ITEM-BINARYV of    */
  5128.                     switch (ITEM)
  5129.                     begin
  5130.  
  5131.                     /* SET RECEIVE BINARY */
  5132.  
  5133.                   case BINARYV:
  5134.                     begin
  5135.                          SCANIT(ONV);
  5136.                          while (ITEM == QMARKV)
  5137.                          begin
  5138.                               HELP(SETV, RECEIVEV_1, BINARYV);
  5139.                               READ_USER(false);
  5140.                               SCANIT(ONV);
  5141.                               if (CTLY) then
  5142.                                    goto SET_EXIT;
  5143.                          end;
  5144.                          if (ITEM == ONV  |  ITEM == OFFV) then
  5145.                          RCV_BINARY = (ITEM == ONV);
  5146.                               else
  5147.                          begin
  5148.                               M_ST "set receive binary error" M_EN;
  5149.                          end;
  5150.                          break;
  5151.                     end;
  5152.  
  5153.                     /* SET RECEIVE DEVICE */
  5154.  
  5155.                   case DEVICEV:
  5156.                     begin
  5157.                          SCANIT(QMARKV);
  5158.                          while (ITEM == QMARKV)
  5159.                          begin
  5160.                               HELP(SETV, RECEIVEV_1, DEVICEV);
  5161.                               READ_USER(false);
  5162.                               SCANIT(QMARKV);
  5163.                                    if (CTLY) then
  5164.                                         goto SET_EXIT;
  5165.                          end;
  5166.                          if (CPLEN != 0) then
  5167.                          begin
  5168.                               strcpy(RCV_DEV, CPARM);
  5169.                               RCV_DEV[CPLEN] = CR;
  5170.                          end
  5171.                               else
  5172.                          begin
  5173.                               strcpy(RCV_DEV, "DISC");
  5174.                               RCV_DEV[CPLEN] = CR;
  5175.                          end;
  5176.                          break;
  5177.                     end;
  5178.  
  5179.                     /* SET RECEIVE FCODE */
  5180.  
  5181.                   case FCODEV:
  5182.                     begin
  5183.                          SCANIT(QMARKV);
  5184.                          while (ITEM == QMARKV)
  5185.                          begin
  5186.                               HELP(SETV, RECEIVEV_1, FCODEV);
  5187.                               READ_USER(false);
  5188.                               SCANIT(QMARKV);
  5189.                               if (CTLY) then
  5190.                                    goto SET_EXIT;
  5191.                          end;
  5192.                          if (ITEM != NUMBERV) then
  5193.                          begin
  5194.                               M_ST "set receive fcode error" M_EN;
  5195.                          end
  5196.                               else
  5197.                          begin
  5198.                               RCV_FCODE = CPVAL;
  5199.                          end;
  5200.                          break;
  5201.                     end;
  5202.  
  5203.                     /* SET RECEIVE RECLEN */
  5204.  
  5205.                   case RECLENV:
  5206.                     begin
  5207.                          SCANIT(QMARKV);
  5208.                          while (ITEM == QMARKV)
  5209.                          begin
  5210.                               HELP(SETV, RECEIVEV_1, RECLENV);
  5211.                               READ_USER(false);
  5212.                               SCANIT(QMARKV);
  5213.                               if (CTLY) then
  5214.                                    goto SET_EXIT;
  5215.                          end;
  5216.                          if (ITEM != NUMBERV) then
  5217.                          begin
  5218.                               M_ST "set receive reclen error" M_EN;
  5219.                          end
  5220.                               else
  5221.                          if (CPVAL != 0) then
  5222.                          begin
  5223.                               RCV_RECLEN = CPVAL;
  5224.                          end
  5225.                               else
  5226.                          RCV_RECLEN = -254;
  5227.                          break;
  5228.                     end;
  5229.  
  5230.                     /* SET RECEIVE BLOCKF */
  5231.  
  5232.                   case BLOCKFV:
  5233.                     begin
  5234.                          SCANIT(QMARKV);
  5235.                          while (ITEM == QMARKV)
  5236.                          begin
  5237.                               HELP(SETV, RECEIVEV_1, BLOCKFV);
  5238.                               READ_USER(false);
  5239.                               SCANIT(QMARKV);
  5240.                               if (CTLY) then
  5241.                                    goto SET_EXIT;
  5242.                          end;
  5243.                          if (ITEM != NUMBERV) then
  5244.                          begin
  5245.                               M_ST "set receive blockf error" M_EN;
  5246.                          end
  5247.                               else
  5248.                          begin
  5249.                               RCV_BLOCKF = CPVAL;
  5250.                          end;
  5251.                          break;
  5252.                     end;
  5253.  
  5254.                     /* SET RECEIVE FIXREC */
  5255.  
  5256.                   case FIXRECV:
  5257.                     begin
  5258.                          SCANIT(ONV);
  5259.                          while (ITEM == QMARKV)
  5260.                          begin
  5261.                               HELP(SETV, RECEIVEV_1, FIXRECV);
  5262.                               READ_USER(false);
  5263.                               SCANIT(ONV);
  5264.                               if (CTLY) then
  5265.                                    goto SET_EXIT;
  5266.                          end;
  5267.                          if (ITEM == ONV  |  ITEM == OFFV) then
  5268.                          RCV_FIXREC = (ITEM==ONV);
  5269.                               else
  5270.                          begin
  5271.                               M_ST "set receive fixrec error" M_EN;
  5272.                          end;
  5273.                          break;
  5274.                     end;
  5275.  
  5276.                     /* SET RECEIVE MAXREC */
  5277.  
  5278.                   case MAXRECV:
  5279.                     begin
  5280.                          SCANIT(QMARKV);
  5281.                          while (ITEM == QMARKV)
  5282.                          begin
  5283.                               HELP(SETV, RECEIVEV_1, MAXRECV);
  5284.                               READ_USER(false);
  5285.                               SCANIT(QMARKV);
  5286.                               if (CTLY) then
  5287.                                    goto SET_EXIT;
  5288.                          end;
  5289.                          D_X = DBINARY(CPARM,CPLEN);
  5290.                          if (ccode() != CCE) then
  5291.                          begin
  5292.                               M_ST "set receive maxrec error" M_EN;
  5293.                          end
  5294.                               else
  5295.                          begin
  5296.                               RCV_MAXREC = D_X;
  5297.                          end;
  5298.                          break;
  5299.                     end;
  5300.  
  5301.                     /* SET RECEIVE MAXEXT */
  5302.  
  5303.                   case MAXEXTV:
  5304.                     begin
  5305.                          SCANIT(QMARKV);
  5306.                          while (ITEM == QMARKV)
  5307.                          begin
  5308.                               HELP(SETV, RECEIVEV_1, MAXEXTV);
  5309.                               READ_USER(false);
  5310.                               SCANIT(QMARKV);
  5311.                               if (CTLY) then
  5312.                                    goto SET_EXIT;
  5313.                          end;
  5314.                          if (ITEM != NUMBERV) then
  5315.                          begin
  5316.                               M_ST "set receive maxext error" M_EN;
  5317.                          end
  5318.                               else
  5319.                          begin
  5320.                               RCV_MAXEXT = CPVAL;
  5321.                          end;
  5322.                          break;
  5323.                     end;
  5324.  
  5325.                     /* SET RECEIVE SAVESP */
  5326.  
  5327.                   case SAVESPV:
  5328.                     begin
  5329.                          SCANIT(ONV);
  5330.                          while (ITEM == QMARKV)
  5331.                          begin
  5332.                               HELP(SETV, RECEIVEV_1, SAVESPV);
  5333.                               READ_USER(false);
  5334.                               SCANIT(ONV);
  5335.                               if (CTLY) then
  5336.                                    goto SET_EXIT;
  5337.                          end;
  5338.                          if (ITEM == ONV  |  ITEM == OFFV) then
  5339.                          RCV_SAVESP = (ITEM == ONV);
  5340.                               else
  5341.                          begin
  5342.                               M_ST "set receive savesp error" M_EN;
  5343.                          end;
  5344.                          break;
  5345.                     end;
  5346.  
  5347.                     /* SET RECEIVE PROG */
  5348.  
  5349.                   case PROGV:
  5350.                     begin
  5351.                          SCANIT(QMARKV);
  5352.                          while (ITEM == QMARKV)
  5353.                          begin
  5354.                               HELP(SETV, RECEIVEV_1, PROGV);
  5355.                               READ_USER(false);
  5356.                               SCANIT(QMARKV);
  5357.                               if (CTLY) then
  5358.                                    goto SET_EXIT;
  5359.                          end;
  5360.                          RCV_BINARY = true;
  5361.                          RCV_FIXREC = true;
  5362.                          RCV_FCODE  = 1029;
  5363.                          RCV_RECLEN = 128;
  5364.                          RCV_BLOCKF = 1;
  5365.                          RCV_MAXEXT = 1;
  5366.                          break;
  5367.                     end;
  5368.  
  5369.                     /* SET RECEIVE BIN128 */
  5370.  
  5371.                   case BIN128V:
  5372.                     begin
  5373.                          SCANIT(QMARKV);
  5374.                          while (ITEM == QMARKV)
  5375.                          begin
  5376.                               HELP(SETV, RECEIVEV_1, BIN128V);
  5377.                               READ_USER(false);
  5378.                               SCANIT(QMARKV);
  5379.                               if (CTLY) then
  5380.                                    goto SET_EXIT;
  5381.                          end;
  5382.                          RCV_BINARY = true;
  5383.                          RCV_FIXREC = false;
  5384.                          RCV_FCODE  = 0;
  5385.                          RCV_RECLEN = 128;
  5386.                          RCV_BLOCKF = 0;
  5387.                          break;
  5388.                     end;
  5389.  
  5390.                     /* SET RECEIVE TEXT */
  5391.  
  5392.                   case TEXTV:
  5393.                     begin
  5394.                          SCANIT(QMARKV);
  5395.                          while (ITEM == QMARKV)
  5396.                          begin
  5397.                               HELP(SETV, RECEIVEV_1, TEXTV);
  5398.                               READ_USER(false);
  5399.                               SCANIT(QMARKV);
  5400.                               if (CTLY) then
  5401.                                    goto SET_EXIT;
  5402.                          end;
  5403.                          RCV_BINARY = false;
  5404.                          RCV_FIXREC = false;
  5405.                          RCV_FCODE  = 0;
  5406.                          RCV_RECLEN = -254;
  5407.                          RCV_BLOCKF = 0;
  5408.                          break;
  5409.                     end;
  5410.  
  5411.                     /* SET RECEIVE TXT80 */
  5412.  
  5413.                   case TXT80V:
  5414.                     begin
  5415.                          SCANIT(QMARKV);
  5416.                          while (ITEM == QMARKV)
  5417.                          begin
  5418.                               HELP(SETV, RECEIVEV_1, TXT80V);
  5419.                               READ_USER(false);
  5420.                               SCANIT(QMARKV);
  5421.                               if (CTLY) then
  5422.                                    goto SET_EXIT;
  5423.                          end;
  5424.                          RCV_BINARY = false;
  5425.                          RCV_FIXREC = true;
  5426.                          RCV_FCODE  = 0;
  5427.                          RCV_RECLEN = -80;
  5428.                          RCV_BLOCKF = 16;
  5429.                          break;
  5430.                     end;
  5431.  
  5432.                     /* SET RECEIVE EXPTAB */
  5433.  
  5434.                   case EXPTABV:
  5435.                     begin
  5436.                          SCANIT(ONV);
  5437.                          while (ITEM == QMARKV)
  5438.                          begin
  5439.                               HELP(SETV, RECEIVEV_1, EXPTABV);
  5440.                               READ_USER(false);
  5441.                               SCANIT(ONV);
  5442.                               if (CTLY) then
  5443.                                    goto SET_EXIT;
  5444.                          end;
  5445.                          if (ITEM == ONV  |  ITEM == OFFV)  then
  5446.                               EXP_TABS = (ITEM == ONV);
  5447.                               else
  5448.                          begin
  5449.                               M_ST "set receive exptab error" M_EN;
  5450.                          end;
  5451.                          break;
  5452.                     end;
  5453.  
  5454.                     end;  /* SET RECEIVE cases */
  5455.                     break;
  5456.                end;
  5457.  
  5458.                /* SET LOG */
  5459.  
  5460.              case LOGV:
  5461.                begin
  5462.                     SCANIT(PAUSEV);
  5463.                     while (ITEM == QMARKV)
  5464.                     begin
  5465.                          HELP(SETV, LOGV);
  5466.                          READ_USER(false);
  5467.                          SCANIT(PAUSEV);
  5468.                          if (CTLY) then
  5469.                               goto SET_EXIT;
  5470.                     end;
  5471.                     if (LOGNUM != 0 & LOGNUM != CONUM) then
  5472.                     begin
  5473.                          if (ITEM == PURGEV)  then
  5474.                          begin
  5475.                               FCLOSE(LOGNUM,0x4,0);
  5476.                               CPLEN = 0;
  5477.                          end
  5478.                          else
  5479.                               FCLOSE(LOGNUM,0x9,0);
  5480.                          LOGNUM = 0;
  5481.                     end
  5482.                          else
  5483.                     if (ITEM == PURGEV)  then
  5484.                          CPLEN = 0;
  5485.  
  5486.                  /* SCANIT;  Was done above */
  5487.                     if (CPLEN == 0) then
  5488.                     begin
  5489.                          /* Take no action */
  5490.                     end
  5491.                          else
  5492.                     begin
  5493.                     strncpy(LOGNAME, CPARM, LOGNAME_LEN=CPLEN);
  5494.                     LOGNAME[LOGNAME_LEN+1] = 0;  /* For VERIFY */
  5495.                     strcpy(PBUF, "listf ");                    ;
  5496.                     strncat(PBUF, LOGNAME, LOGNAME_LEN);
  5497.                     strcat(PBUF, "; $null");
  5498.                     PBUF[strlen(PBUF)] = CR;
  5499.                     HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  5500.                     if (ERROR != 0) then;  /* Its not there.  OK.  */
  5501.                          else
  5502.                     begin
  5503.                          strcpy(PBUF, "File is already present.  "
  5504.                                       "Ok to remove? (Y/N)");
  5505.                          FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0);
  5506.                          READ_USER(false);
  5507.                          SCANIT(ONV);
  5508.                          if (ITEM == YESV) then
  5509.                          begin
  5510.                               LOGNAME[LOGNAME_LEN] = 0;
  5511.                               remove(LOGNAME);
  5512.                          end
  5513.                               else
  5514.                          begin
  5515.                               M_ST "SET LOG attempt abandoned" M_EN;
  5516.                               goto SET_EXIT;
  5517.                          end;
  5518.                     end;
  5519.                     LOGNAME[LOGNAME_LEN] = ' ';
  5520.                     LOGNUM = FOPEN(LOGNAME,0x4,0x1,64,
  5521.                                    0,0,0,2,0,10016);
  5522.                     if (LOGNUM == 0) then
  5523.                     begin
  5524.                          M_ST "File open error" M_EN;
  5525.                     end;
  5526.                     end;
  5527.                     break;
  5528.                end;
  5529.  
  5530.                     /* SET SOH */
  5531.  
  5532.                   case SOHV:
  5533.                     begin
  5534.                          SCANIT(QMARKV);
  5535.                          while (ITEM == QMARKV)
  5536.                          begin
  5537.                               HELP(SETV, SOHV);
  5538.                               READ_USER(false);
  5539.                               SCANIT(QMARKV);
  5540.                               if (CTLY) then
  5541.                                    goto SET_EXIT;
  5542.                          end;
  5543.                          if (ITEM == NUMBERV) then
  5544.                               SOH = CPVAL;
  5545.                               else
  5546.                          begin
  5547.                               M_ST "set soh error" M_EN;
  5548.                          end;
  5549.                          break;
  5550.                     end;
  5551.  
  5552.                     /* SET FAST */
  5553.  
  5554.                   case FASTV:
  5555.                     begin
  5556.                          SCANIT(ONV);
  5557.                          while (ITEM == QMARKV)
  5558.                          begin
  5559.                               HELP(SETV, FASTV);
  5560.                               READ_USER(false);
  5561.                               SCANIT(ONV);
  5562.                               if (CTLY) then
  5563.                                    goto SET_EXIT;
  5564.                          end;
  5565.                          if (ITEM == ONV  |  ITEM == OFFV) then
  5566.                          IMPATIENT = (ITEM==ONV);
  5567.                               else
  5568.                          begin
  5569.                               M_ST "set fast error" M_EN;
  5570.                          end;
  5571.                          break;
  5572.                     end;
  5573.                     break;
  5574.  
  5575.                end; /* SET cases */
  5576.  
  5577.           SET_EXIT:
  5578.           break;
  5579.           end;
  5580.  
  5581.           /* EXIT */
  5582.  
  5583.         case EXITV:
  5584.           begin
  5585.                SCANIT(QMARKV);
  5586.                while (ITEM == QMARKV)
  5587.                begin
  5588.                     HELP(EXITV);
  5589.                     READ_USER(false);
  5590.                     SCANIT(QMARKV);
  5591.                     if (CTLY) then
  5592.                        goto EXIT_EXIT;
  5593.                end;
  5594.                DONE = true;
  5595.           EXIT_EXIT:
  5596.                break;
  5597.           end;
  5598.  
  5599.           /* DIR */
  5600.  
  5601.         case DIRV:
  5602.           begin
  5603.                SCANIT(QMARKV);
  5604.                while (ITEM == QMARKV)
  5605.                begin
  5606.                     HELP(DIRV);
  5607.                     READ_USER(false);
  5608.                     SCANIT(QMARKV);
  5609.                     if (CTLY) then
  5610.                          goto DIR_EXIT;
  5611.                end;
  5612.                begin
  5613.                     strcpy(PBUF, "LISTF ");
  5614.                     strncat(PBUF, CPARM, CPLEN);
  5615.                     strcat(PBUF, ", 2");
  5616.                     PBUF[strlen(PBUF)] = CR;
  5617.                     HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  5618.                     if (ERROR > 0) then
  5619.                     begin
  5620.                          printf("CIerror %d \n", ERROR);
  5621.                     end;
  5622.                end;
  5623.           DIR_EXIT:
  5624.           break;
  5625.           end;
  5626.  
  5627.           /* SPACE */
  5628.  
  5629.         case SPACEV:
  5630.           begin
  5631.                SCANIT(QMARKV);
  5632.                while (ITEM == QMARKV)
  5633.                begin
  5634.                     HELP(SPACEV);
  5635.                     READ_USER(false);
  5636.                     SCANIT(QMARKV);
  5637.                     if (CTLY) then
  5638.                          goto SPACE_EXIT;
  5639.                end;
  5640.                begin
  5641.                     strcpy(PBUF, "REPORT ");
  5642.                     strncat(PBUF, CPARM, CPLEN);
  5643.                     PBUF[strlen(PBUF)] = CR;
  5644.                     HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG);
  5645.                     if (ERROR > 0) then
  5646.                     begin
  5647.                          printf("CIerror %d \n", ERROR);
  5648.                     end
  5649.                          else
  5650.                     begin
  5651.                          M_ST " " M_EN;  /* Cosmetic output */
  5652.                     end;
  5653.                end;
  5654.           SPACE_EXIT:
  5655.           break;
  5656.           end;
  5657.  
  5658.           /* DELETE */
  5659.  
  5660.         case DELETEV:
  5661.           begin
  5662.                SCANIT(QMARKV);
  5663.                while (ITEM == QMARKV)
  5664.                begin
  5665.                     HELP(DELETEV);
  5666.                     READ_USER(false);
  5667.                     SCANIT(QMARKV);
  5668.                     if (CTLY) then
  5669.                          goto DELETE_EXIT;
  5670.                end;
  5671.                if (CPLEN > 0) then
  5672.                begin
  5673.                     strncpy(PBUF, CPARM, CPLEN);
  5674.                     CPARM[CPLEN] = 0;
  5675.                     ERROR = remove(CPARM);
  5676.                     if (ERROR != 0) then
  5677.                     begin
  5678.                          printf("CIerror %d \n", ERROR);
  5679.                     end;
  5680.                     PAUSE(&BRIEFLY);  /* Let HPCICOMMAND finish */
  5681.                end
  5682.                     else
  5683.                begin
  5684.                     M_ST "Filespec missing or invalid" M_EN;
  5685.                end;
  5686.           DELETE_EXIT:
  5687.           break;
  5688.           end;
  5689.  
  5690.           /* TYPE */
  5691.  
  5692.         case TYPEV:
  5693.           begin
  5694.                SCANIT(QMARKV); /* get local file name */
  5695.                while (ITEM == QMARKV)
  5696.                begin
  5697.                     HELP(TYPEV);
  5698.                     READ_USER(false);
  5699.                     SCANIT(QMARKV);
  5700.                     if (CTLY) then
  5701.                          goto SEND_EXIT;
  5702.                end;
  5703.                while (CPLEN == 0)
  5704.                begin
  5705.                     strcpy(PBUF, "HP3000 file name?");
  5706.                     FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0);
  5707.                     READ_USER(false);
  5708.                     SCANIT(QMARKV);
  5709.                     if (CTLY) then
  5710.                          goto SEND_EXIT;
  5711.                end;
  5712.                strncpy(L_FNAME, CPARM, CPLEN);
  5713.                L_FNAME[CPLEN] = ' ';
  5714.                L_FNAME_LEN = CPLEN;
  5715.  
  5716.                M_ST " " M_EN;
  5717.                if ( TYPESW() ) then
  5718.                begin
  5719.                     M_ST " " M_EN;
  5720.                     M_ST "TYPE completed" M_EN;
  5721.                end
  5722.                     else
  5723.                begin
  5724.                     M_ST " " M_EN;
  5725.                     M_ST "TYPE failure" M_EN;
  5726.                end;
  5727.  
  5728.                L_FNAME_LEN = 0;
  5729.                break;
  5730.           end;
  5731.  
  5732.           /* VERIFY */
  5733.  
  5734.         case STATUSV:
  5735.           begin
  5736.                SCANIT(QMARKV);
  5737.                while (ITEM == QMARKV)
  5738.                begin
  5739.                     HELP(VERIFYV);
  5740.                     READ_USER(false);
  5741.                     SCANIT(QMARKV);
  5742.                     if (CTLY) then
  5743.                          goto VERIFY_EXIT;
  5744.                end;
  5745.                VERIFY();
  5746.           VERIFY_EXIT:
  5747.                break;
  5748.           end;
  5749.  
  5750.           end /* case */
  5751.                else
  5752.           if (ITEM == QMARKV) then
  5753.                HELP(NULLV);
  5754.  
  5755.                else
  5756.           begin
  5757.                M_ST "command error" M_EN;
  5758.           end;
  5759.      end;
  5760. end
  5761.  
  5762. #pragma   SUBTITLE      "Main program (for what its worth)"
  5763. #pragma   PAGE
  5764. main (ARGC, ARGV, envp, PARM_VAL, INFO_STR)
  5765. int   ARGC;
  5766. char       *ARGV[];              /* Individual groups in INFO */
  5767. char             *envp[];        /* Book sez do not reference
  5768.                                     this, period */
  5769. int                     PARM_VAL;
  5770. char                             *INFO_STR;
  5771.  
  5772. {
  5773.  
  5774.      if ((TAKE_VAL=PARM_VAL) == 0) then     /*Must be in outer block*/
  5775.           TAKE_VAL = GETJCW();              /*to work*/
  5776.      if ( !KINIT() ) then
  5777.      begin
  5778.           QUIT(7300+TAKE_VAL);
  5779.      end
  5780.           else
  5781.      begin
  5782.           CMDINT(INFO_STR, strlen(INFO_STR));
  5783.           SHUT_LINE();
  5784.           if (HAVE_KTEMP) then KILL_KTEMP();
  5785.           if (LOGNUM != 0) then
  5786.                FCLOSE(LOGNUM, 0x9, 0);
  5787.      end;
  5788. }
  5789.