home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / vmssys.bli < prev    next >
Text File  |  2020-01-01  |  21KB  |  830 lines
  1. MODULE KERSYS (IDENT = '3.3.113',
  2.     ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)
  3.         ) =
  4. BEGIN
  5.  
  6. !++
  7. ! FACILITY:
  8. !   KERMIT-32
  9. !
  10. ! ABSTRACT:
  11. !   KERMIT-32 is an implementation of the KERMIT protocal to allow the
  12. !   transfer of files from micro computers to the DECsystem-10, DECSYSTEM-20
  13. !   and now the VAX/VMS systems.
  14. !
  15. ! ENVIRONMENT:
  16. !   User mode
  17. !
  18. ! AUTHOR: Robert C. McQueen, Nick Bush, CREATION DATE: 24-January-1983
  19. !
  20. ! MODIFIED BY:
  21. !
  22. !--
  23.  
  24. %SBTTL 'Table of Contents'
  25. %SBTTL 'Revision History'
  26.  
  27. !++
  28. !
  29. ! 2.0.032    By: Nick Bush            On: 25-Feb-1984
  30. !        Add code for LOCAL and REMOTE commands.  These depend
  31. !        upon support in KERMSG and KERSYS.
  32. !
  33. ! 3.0.045    Start of version 3.
  34. !
  35. ! 3.1.057    By: Nick Bush                On: 21-Feb-1985
  36. !        Determine VMS version on startup and remember for later
  37. !        use.  Use it in KERSYS to determine whether we will need
  38. !        to force an end-of-file on the mailbox when the subprocess
  39. !        on the other end goes away.
  40. !
  41. ! 3.1.064    By: Nick Bush                On: 30-March-1985
  42. !        Fix LIB$SPAWN call to set SYS$INPUT for the subprocess
  43. !        to be NLA0: so that it doesn't try to input from the
  44. !        terminal.
  45. !
  46. ! 3.1.066    By: Nick Bush                On: 22-April-1985
  47. !        Don't use NLA0: as SYS$INPUT when spawning things under VMS 3.
  48. !
  49. ! Start of version 3.3
  50. !
  51. ! 3.3.101    By: Robert McQueen            On: 2-July-1986
  52. !        Change from $TRNLOG system service calls to LIB$SYS_TRNLOG
  53. !        library routine calls.
  54. !
  55. ! 3.3.108    By: Antonino N. Mione            On: 8-Sep-1986
  56. !        Make KERMIT-32 close the terminal (so the terminal
  57. !        parameters are appropriately reset) upon reciept of 
  58. !        a GENERIC LOGOUT packet.
  59. !
  60. ! 3.3.113    JHW0002        Jonathan Welch,        5-May-1988 11:48
  61. !        Modified SY_TIME to use $GETTIM as opposed to the LIB$timer
  62. !        routines (which broke when their method of calculating
  63. !        time differences changed in V4.4?).
  64. !
  65. !        Removed the call to LIB$INIT_TIMER in SY_INIT.
  66. !--
  67.  
  68. %SBTTL 'Include files'
  69. !
  70. ! INCLUDE FILES:
  71. !
  72.  
  73. LIBRARY 'SYS$LIBRARY:STARLET';
  74.  
  75. LIBRARY 'SYS$LIBRARY:TPAMAC';
  76.  
  77. REQUIRE 'KERCOM';                ! Common definitions
  78.  
  79. REQUIRE 'KERERR';                ! Error message symbol definitions
  80.  
  81. %SBTTL 'Storage -- Local'
  82. !
  83. ! OWN STORAGE:
  84. !
  85.  
  86. OWN
  87.     VMS_VERSION,                ! Major version number of VMS
  88.     ORG_DEFAULT_DIR_TEXT : VECTOR [MAX_FILE_NAME, BYTE],    ! Text of default dir
  89.     ORG_DEFAULT_DIR : BLOCK [8, BYTE],        ! Original default directory
  90.     ORG_DEFAULT_DEV_TEXT : VECTOR [MAX_FILE_NAME, BYTE],    ! Text of default device
  91.     ORG_DEFAULT_DEV : BLOCK [8, BYTE],        ! Descriptor for orginal default device
  92.     Subtrahend : VECTOR [2, LONG];        ! Constant to subtract from system time.
  93.  
  94. !<BLF/FORMAT>
  95. %SBTTL 'External routines'
  96. !
  97. ! EXTERNAL REFERENCES:
  98. !
  99.  
  100. EXTERNAL ROUTINE
  101. !
  102. ! Library routines
  103. !
  104.     LIB$EDIV : ADDRESSING_MODE (GENERAL),
  105.     LIB$SET_LOGICAL : ADDRESSING_MODE (GENERAL),
  106.     LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE,
  107.     LIB$SPAWN : ADDRESSING_MODE (GENERAL),
  108.     LIB$SUBX : ADDRESSING_MODE (GENERAL),
  109.     OTS$CVT_L_TZ : ADDRESSING_MODE (GENERAL) NOVALUE,
  110.     SYS$SETDDIR : ADDRESSING_MODE (GENERAL),
  111.     SYS$GETTIM : ADDRESSING_MODE (GENERAL),
  112. !
  113. ! KERTRM - Terminal handling routines
  114. !
  115.     TERM_CLOSE,                    ! Close terminal and restore characteristics
  116.  
  117. !
  118. ! KERTT - Text processing
  119. !
  120.     TT_INIT : NOVALUE,                ! Initialization routine
  121.     TT_TEXT : NOVALUE,                ! Output a text string
  122.     TT_NUMBER : NOVALUE,            ! Output a number
  123.     TT_CHAR : NOVALUE,                ! Output a single character
  124.     TT_OUTPUT : NOVALUE,            ! Routine to dump the current
  125.                             !  text line.
  126.     TT_CRLF : NOVALUE;                ! Output the line
  127.  
  128. %SBTTL 'External storage'
  129. !
  130. ! EXTERNAL Storage:
  131. !
  132.  
  133. EXTERNAL
  134. !
  135. ! KERMSG storage
  136. !
  137.     GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Data for generic command
  138.     GEN_1SIZE,                    ! Size of data in GEN_1DATA
  139.     GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Second argument for generic command
  140.     GEN_2SIZE,                    ! Size of data in GEN_2DATA
  141.     GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Third arg for generic command
  142.     GEN_3SIZE,                    ! Size of data in GEN_3DATA
  143. !
  144. ! Misc constants.
  145. !
  146.     FILE_SIZE,                    ! Number of characters in FILE_NAME
  147.     FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)];
  148.  
  149. %SBTTL 'SY_INIT - Initialize KERSYS'
  150.  
  151. GLOBAL ROUTINE SY_INIT : NOVALUE =
  152.  
  153. !++
  154. ! FUNCTIONAL DESCRIPTION:
  155. !
  156. ! This routine will initialize the module KERSYS.
  157. !
  158. ! CALLING SEQUENCE:
  159. !
  160. !    SY_INIT ();
  161. !
  162. ! INPUT PARAMETERS:
  163. !
  164. !    None.
  165. !
  166. ! IMPLICIT INPUTS:
  167. !
  168. !    None.
  169. !
  170. ! OUPTUT PARAMETERS:
  171. !
  172. !    None.
  173. !
  174. ! IMPLICIT OUTPUTS:
  175. !
  176. !    None.
  177. !
  178. ! COMPLETION CODES:
  179. !
  180. !    None.
  181. !
  182. ! SIDE EFFECTS:
  183. !
  184. !    KERSYS storage initialized
  185. !
  186. !--
  187.  
  188.     BEGIN
  189.  
  190.     LITERAL
  191.     SYI_EFN = 10;                ! EFN to use for $GETSYI
  192.  
  193.     LOCAL
  194.     VERSION_STRING : VECTOR [8, BYTE],  ! Return version string here
  195.     VERSION_LENGTH,                ! And length here
  196.     SYI_ITEM_LIST : BLOCK [16, BYTE],   ! Argument list for $GETSYI
  197.     LENGTH,                    ! Length of default dir returned
  198.     STATUS;
  199.  
  200.     EXTERNAL ROUTINE
  201.     LIB$SYS_TRNLOG : ADDRESSING_MODE(GENERAL);
  202.  
  203. !
  204. ! Set up arg list for $GETSYI
  205. !
  206.     SYI_ITEM_LIST [0, 0, 16, 0] = 8;    ! We expect an 8-byte string
  207.     SYI_ITEM_LIST [2, 0, 16, 0] = SYI$_VERSION; ! Want the VMS version
  208.     SYI_ITEM_LIST [4, 0, 32, 0] = VERSION_STRING; ! Put it here
  209.     SYI_ITEM_LIST [8, 0, 32, 0] = VERSION_LENGTH; ! Length goes here
  210.     SYI_ITEM_LIST [12, 0, 32, 0] = 0;    ! End the list
  211.     STATUS = $GETSYI (EFN=SYI_EFN, ITMLST=SYI_ITEM_LIST); ! Get the data
  212.     IF NOT .STATUS            ! If we can't get the version
  213.     THEN
  214.     VMS_VERSION = 0        ! Assume very old VMS?
  215.     ELSE
  216.     BEGIN
  217.     STATUS = $WAITFR (EFN=SYI_EFN);    ! Wait for completion
  218.     IF .STATUS            ! If we got it
  219.     THEN
  220.         BEGIN
  221.         IF .VERSION_STRING [0] GEQ %C'0' AND
  222.         .VERSION_STRING [0] LEQ %C'9'    ! If first character is numeric
  223.         THEN
  224.         VMS_VERSION = (.VERSION_STRING[0] - %C'0')*10    ! save first digit
  225.         ELSE
  226.         VMS_VERSION = 0;        ! No first digit, store 0
  227.         VMS_VERSION = .VMS_VERSION + .VERSION_STRING[1] - %C'0' ! Get rest of version
  228.         END
  229.     ELSE
  230.         VMS_VERSION = 0;        ! Can't get version?
  231.     END;
  232. !
  233. ! Set up original default directory
  234. !
  235.     ORG_DEFAULT_DIR [DSC$B_CLASS] = DSC$K_CLASS_S;
  236.     ORG_DEFAULT_DIR [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  237.     ORG_DEFAULT_DIR [DSC$W_LENGTH] = MAX_FILE_NAME;
  238.     ORG_DEFAULT_DIR [DSC$A_POINTER] = ORG_DEFAULT_DIR_TEXT;
  239.     STATUS = SYS$SETDDIR (0, LENGTH, ORG_DEFAULT_DIR);
  240.  
  241.     IF .STATUS THEN ORG_DEFAULT_DIR [DSC$W_LENGTH] = .LENGTH ELSE ORG_DEFAULT_DIR [DSC$W_LENGTH] = 0;
  242. !
  243. ! Get original default device
  244. !
  245.     ORG_DEFAULT_DEV [DSC$B_CLASS] = DSC$K_CLASS_S;
  246.     ORG_DEFAULT_DEV [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  247.     ORG_DEFAULT_DEV [DSC$W_LENGTH] = MAX_FILE_NAME;
  248.     ORG_DEFAULT_DEV [DSC$A_POINTER] = ORG_DEFAULT_DEV_TEXT;
  249.     STATUS = LIB$SYS_TRNLOG (%ASCID'SYS$DISK', LENGTH, ORG_DEFAULT_DEV);
  250.  
  251.     IF .STATUS EQL SS$_NOTRAN            ! No translation?
  252.     THEN
  253.     LENGTH = 0;                ! Yes, set the length to zero
  254.     IF .STATUS THEN ORG_DEFAULT_DEV [DSC$W_LENGTH] = .LENGTH ELSE ORG_DEFAULT_DEV [DSC$W_LENGTH] = 0;
  255.  
  256.     END;                    ! End of SY_INIT
  257.  
  258. %SBTTL 'SY_LOGOUT - delete the process.'
  259.  
  260. GLOBAL ROUTINE SY_LOGOUT : NOVALUE =
  261.  
  262. !++
  263. ! FUNCTIONAL DESCRIPTION:
  264. !
  265. !    This routine will delete this process.
  266. !
  267. ! CALLING SEQUENCE:
  268. !
  269. !    SY_LOGOUT ();
  270. !
  271. ! INPUT PARAMETERS:
  272. !
  273. !    None.
  274. !
  275. ! IMPLICIT INPUTS:
  276. !
  277. !    None.
  278. !
  279. ! OUTPUT PARAMETERS:
  280. !
  281. !    None.
  282. !
  283. ! IMPLICIT OUTPUTS:
  284. !
  285. !    None.
  286. !
  287. ! COMPLETION CODES:
  288. !
  289. !    None.
  290. !
  291. ! SIDE EFFECTS:
  292. !
  293. !    None.
  294. !
  295. !--
  296.  
  297.     BEGIN
  298.     TERM_CLOSE();                ![108] Close the terminal early
  299.     $DELPRC ();
  300.     END;                    ! End of SY_LOGOUT
  301.  
  302. %SBTTL 'SY_GENERIC - Perform a generic command'
  303.  
  304. GLOBAL ROUTINE SY_GENERIC (GCMD_TYPE, STRING_ADDRESS, STRING_LENGTH, GET_CHR_RTN) =
  305.  
  306. !++
  307. ! FUNCTIONAL DESCRIPTION:
  308. !
  309. ! This routine will perform a generic command.
  310. !
  311. ! CALLING SEQUENCE:
  312. !
  313. !    SY_GENERIC (GCMD_TYPE, STRING_ADDRESS, STRING_LENGTH, GET_CHR_RTN);
  314. !
  315. ! INPUT PARAMETERS:
  316. !
  317. !    GCMD_TYPE - GC_xxx value for command to be performed
  318. !    STRING_ADDRESS - Place to return address of string result
  319. !    STRING_LENGTH - Place to return length of string result
  320. !    GET_CHR_RTN - Place to return address of a get a character routine
  321. !
  322. ! IMPLICIT INPUTS:
  323. !
  324. !    None.
  325. !
  326. ! OUTPUT PARAMETERS:
  327. !
  328. !    Returns KER_xxx status
  329. !
  330. ! IMPLICIT OUTPUTS:
  331. !
  332. !    None.
  333. !
  334. ! COMPLETION CODES:
  335. !
  336. !    None.
  337. !
  338. ! SIDE EFFECTS:
  339. !
  340. !    None.
  341. !
  342. !--
  343.  
  344.     BEGIN
  345.  
  346.     LITERAL
  347.     MAX_CMD_LEN = 2*MAX_MSG,        ! Max command length
  348.     MAX_MBX_LEN = 20;            ! Max mailbox name length
  349.  
  350.     OWN
  351.     RSP_TEXT : VECTOR [MAX_CMD_LEN, BYTE],    ! Return text
  352.     RSP_LEN;                ! Length of return text
  353.  
  354.     LOCAL
  355.     STATUS,                    ! Status results
  356.     FLAGS,                    ! Flag word for LIB$SPAWN
  357.     OUR_PID,                ! Our PID value
  358.     ITMLST : VECTOR [4, LONG],        ! GETJPI argument
  359.     POINTER,                ! Character pointer
  360.     MBX_CHAN,                ! Channel for mail box
  361.     COMMAND_LENGTH,                ! Length of command string
  362.     COMMAND_DESC : BLOCK [8, BYTE],        ! Descriptor for command string
  363.     COMMAND_STR : VECTOR [MAX_CMD_LEN, BYTE],    ! Actual command string
  364.     MBX_DESC : BLOCK [8, BYTE],        ! Mailbox equivalence name
  365.     MBX_NAME : VECTOR [MAX_MBX_LEN, BYTE];    ! Storage for MBX name
  366.  
  367.     ROUTINE PROCESS_COMPLETION_AST (MBX_CHAN) =
  368. !
  369. ! This routine is called upon process completion (of the process we spawned
  370. ! to perform the command).  It will ensure that the mailbox gets an end-of-file.
  371. !
  372.     BEGIN
  373.     RETURN $QIO (CHAN = .MBX_CHAN, FUNC = IO$_WRITEOF);    ! Write the EOF
  374.     END;
  375.     ROUTINE CONCAT (SRC_ADR, SRC_LEN, DST_PTR, DST_LEN) : NOVALUE =
  376. !
  377. ! This routine is called to concatenate a string onto the current string
  378. !
  379.     BEGIN
  380.  
  381.     LOCAL
  382.         LENGTH;                ! Length we will actually move
  383.  
  384.     LENGTH = .SRC_LEN;            ! Get total length
  385.  
  386.     IF .LENGTH GTR MAX_CMD_LEN - ..DST_LEN THEN LENGTH = MAX_CMD_LEN - ..DST_LEN;
  387.  
  388.     CH$MOVE (.LENGTH, CH$PTR (.SRC_ADR), ..DST_PTR);
  389.     .DST_PTR = CH$PLUS (.LENGTH, ..DST_PTR);
  390.     .DST_LEN = ..DST_LEN + .LENGTH;        ! Update length
  391.     END;
  392. !
  393. ! Initialize the command descriptor
  394. !
  395.     COMMAND_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
  396.     COMMAND_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  397.     COMMAND_LENGTH = 0;                ! Nothing here yet
  398.     COMMAND_DESC [DSC$A_POINTER] = COMMAND_STR;    ! Point at string storage
  399.     POINTER = CH$PTR (COMMAND_STR);
  400. !
  401. ! Determine what to do with the command
  402. !
  403.  
  404.     CASE .GCMD_TYPE FROM GC_MIN TO GC_MAX OF
  405.     SET
  406.  
  407.     [GC_COPY] :
  408.         BEGIN
  409.  
  410.         EXTERNAL
  411.         GEN_COPY_CMD : BLOCK [8, BYTE];
  412.  
  413.         CONCAT (.GEN_COPY_CMD [DSC$A_POINTER], .GEN_COPY_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  414.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  415.         CONCAT (UPLIT (%ASCII' '), 1, POINTER, COMMAND_LENGTH);
  416.         CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH);
  417.         END;
  418.  
  419.     [GC_CONNECT] :
  420.         BEGIN
  421.  
  422.         LOCAL
  423.         LENGTH,
  424.         DIR_FAB : $FAB_DECL,        ! FAB for $PARSE
  425.         DIR_NAM : $NAM_DECL,        ! NAM for $PARSE
  426.         EXP_STR : VECTOR [NAM$C_MAXRSS, BYTE],    ! Expanded file spec
  427.         DEV_DESC : BLOCK [8, BYTE],    ! Descriptor for device name
  428.         DIR_DESC : BLOCK [8, BYTE];
  429.  
  430.         DIR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
  431.         DIR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  432.         DEV_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
  433.         DEV_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  434.  
  435.         IF .GEN_1SIZE GTR 0
  436.         THEN
  437.         BEGIN
  438.         $FAB_INIT (FAB = DIR_FAB, FOP = NAM, NAM = DIR_NAM, FNA = GEN_1DATA, FNS = .GEN_1SIZE);
  439.         $NAM_INIT (NAM = DIR_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS);
  440.         STATUS = $PARSE (FAB = DIR_FAB);
  441.  
  442.         IF NOT .STATUS
  443.         THEN
  444.             BEGIN
  445.             LIB$SIGNAL (.STATUS);
  446.             RETURN .STATUS;
  447.             END;
  448.  
  449.         IF .DIR_NAM [NAM$B_NODE] GTR 0
  450.         THEN
  451.             BEGIN
  452.             DEV_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_NODE];
  453.             DEV_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_NODE] + .DIR_NAM [NAM$B_DEV];
  454.             END
  455.         ELSE
  456.             BEGIN
  457.             DEV_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_DEV];
  458.             DEV_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_DEV];
  459.             END;
  460.  
  461.         DIR_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_DIR];
  462.         DIR_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_DIR];
  463.         END
  464.         ELSE
  465.         BEGIN
  466.         DIR_DESC [DSC$W_LENGTH] = .ORG_DEFAULT_DIR [DSC$W_LENGTH];
  467.         DIR_DESC [DSC$A_POINTER] = .ORG_DEFAULT_DIR [DSC$A_POINTER];
  468.         DEV_DESC [DSC$W_LENGTH] = .ORG_DEFAULT_DEV [DSC$W_LENGTH];
  469.         DEV_DESC [DSC$A_POINTER] = .ORG_DEFAULT_DEV [DSC$A_POINTER];
  470.         END;
  471.  
  472.         STATUS = LIB$SET_LOGICAL (%ASCID'SYS$DISK', DEV_DESC);
  473.  
  474.         IF NOT .STATUS
  475.         THEN
  476.         BEGIN
  477.         LIB$SIGNAL (.STATUS);
  478.         RETURN .STATUS;
  479.         END;
  480.  
  481.         STATUS = SYS$SETDDIR (DIR_DESC, 0, 0);
  482.  
  483.         IF NOT .STATUS
  484.         THEN
  485.         BEGIN
  486.         LIB$SIGNAL (.STATUS);
  487.         RETURN .STATUS;
  488.         END;
  489.  
  490.         DIR_DESC [DSC$A_POINTER] = GEN_1DATA;
  491.         DIR_DESC [DSC$W_LENGTH] = MAX_MSG;
  492.         STATUS = SYS$SETDDIR (0, DIR_DESC [DSC$W_LENGTH], DIR_DESC);
  493.  
  494.         IF NOT .STATUS
  495.         THEN
  496.         BEGIN
  497.         LIB$SIGNAL (.STATUS);
  498.         RETURN .STATUS;
  499.         END;
  500.  
  501.         POINTER = CH$PTR (RSP_TEXT);
  502.         RSP_LEN = 0;
  503.         CONCAT (UPLIT (%ASCII'Default directory set to '), 25, POINTER, RSP_LEN);
  504.         CONCAT (.DEV_DESC [DSC$A_POINTER], .DEV_DESC [DSC$W_LENGTH], POINTER, RSP_LEN);
  505.         CONCAT (.DIR_DESC [DSC$A_POINTER], .DIR_DESC [DSC$W_LENGTH], POINTER, RSP_LEN);
  506.         .STRING_ADDRESS = RSP_TEXT;
  507.         .STRING_LENGTH = .RSP_LEN;
  508.         RETURN KER_NORMAL;
  509.         END;
  510.  
  511.     [GC_DELETE] :
  512.         BEGIN
  513.  
  514.         EXTERNAL
  515.         GEN_DELETE_CMD : BLOCK [8, BYTE];
  516.  
  517.         CONCAT (.GEN_DELETE_CMD [DSC$A_POINTER], .GEN_DELETE_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  518.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  519.         END;
  520.  
  521.     [GC_DIRECTORY] :
  522.         BEGIN
  523.  
  524.         EXTERNAL
  525.         GEN_DIR_CMD : BLOCK [8, BYTE];
  526.  
  527.         CONCAT (.GEN_DIR_CMD [DSC$A_POINTER], .GEN_DIR_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  528.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  529.         END;
  530.  
  531.     [GC_DISK_USAGE] :
  532.         BEGIN
  533.  
  534.         EXTERNAL
  535.         GEN_USG_CMD : BLOCK [8, BYTE],    ! Command without arg
  536.         GEN_USG_ARG_CMD : BLOCK [8, BYTE];    ! Command with arg
  537.  
  538.         IF .GEN_1SIZE LEQ 0
  539.         THEN
  540.         BEGIN
  541.         CONCAT (.GEN_USG_CMD [DSC$A_POINTER], .GEN_USG_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  542.         END
  543.         ELSE
  544.         BEGIN
  545.         CONCAT (.GEN_USG_ARG_CMD [DSC$A_POINTER], .GEN_USG_ARG_CMD [DSC$W_LENGTH], POINTER,
  546.             COMMAND_LENGTH);
  547.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  548.         END;
  549.  
  550.         END;
  551.  
  552.     [GC_HELP] :
  553.         BEGIN
  554.  
  555.         EXTERNAL
  556.         GEN_HELP_TEXT : BLOCK [8, BYTE];
  557.  
  558.         .STRING_ADDRESS = .GEN_HELP_TEXT [DSC$A_POINTER];
  559.         .STRING_LENGTH = .GEN_HELP_TEXT [DSC$W_LENGTH];
  560.         RETURN KER_NORMAL;
  561.         END;
  562.  
  563.     [GC_RENAME] :
  564.         BEGIN
  565.  
  566.         EXTERNAL
  567.         GEN_REN_CMD : BLOCK [8, BYTE];
  568.  
  569.         CONCAT (.GEN_REN_CMD [DSC$A_POINTER], .GEN_REN_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  570.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  571.         CONCAT (UPLIT (%ASCII' '), 1, POINTER, COMMAND_LENGTH);
  572.         CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH);
  573.         END;
  574.  
  575.     [GC_SEND_MSG] :
  576.         BEGIN
  577.  
  578.         EXTERNAL
  579.         GEN_SEND_CMD : BLOCK [8, BYTE];
  580.  
  581.         CONCAT (.GEN_SEND_CMD [DSC$A_POINTER], .GEN_SEND_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  582.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  583.         CONCAT (UPLIT (%ASCII' "'), 2, POINTER, COMMAND_LENGTH);
  584.         CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH);
  585.         CONCAT (UPLIT (%ASCII'"'), 1, POINTER, COMMAND_LENGTH);
  586.         END;
  587.  
  588.     [GC_TYPE] :
  589. !
  590. ! While KERMSG handles this for server requests, COMND_LOCAL in KERMIT does
  591. ! not.  Therefore, set up the request to open the correct file.
  592. !
  593.         BEGIN
  594.         CH$COPY (.GEN_1SIZE, GEN_1DATA, CHR_NUL, MAX_FILE_NAME, FILE_NAME);
  595.         FILE_SIZE = .GEN_1SIZE;
  596.         RETURN KER_NORMAL;
  597.         END;
  598.  
  599.     [GC_WHO] :
  600.         BEGIN
  601.  
  602.         EXTERNAL
  603.         GEN_WHO_CMD : BLOCK [8, BYTE];
  604.  
  605.         CONCAT (.GEN_WHO_CMD [DSC$A_POINTER], .GEN_WHO_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH);
  606.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  607.         CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH);
  608.         END;
  609.  
  610.     [GC_COMMAND] :
  611. ! Host command.  Just pass it to the process
  612.         CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH);
  613.  
  614.     [INRANGE, OUTRANGE] :
  615.         BEGIN
  616.         LIB$SIGNAL (KER_UNIMPLGEN);
  617.         RETURN KER_UNIMPLGEN;        ! We don't do any
  618.         END;
  619.     TES;
  620.  
  621. !
  622. ! If we fall out of the case statement, we need to create a mailbox and
  623. ! spawn a process to perform the command with its output going to the
  624. ! mailbox
  625. !
  626.     COMMAND_DESC [DSC$W_LENGTH] = .COMMAND_LENGTH;    ! Copy command length
  627.     ITMLST [0] = JPI$_PID^16 + 4;        ! Get PID
  628.     ITMLST [1] = OUR_PID;            ! Into OUR_PID
  629.     ITMLST [2] = ITMLST [2];            ! Get length here
  630.     ITMLST [3] = 0;                ! End of list
  631.     $GETJPI (ITMLST = ITMLST);            ! Get info for us
  632.     CH$COPY (11, CH$PTR (UPLIT (%ASCII'KERMIT$MBX_')), CHR_NUL, ! Build name
  633.     MAX_MBX_LEN, CH$PTR (MBX_NAME));    ! for mailbox
  634.     MBX_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
  635.     MBX_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
  636.     MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN - 12;    ! MBX name length
  637.     MBX_DESC [DSC$A_POINTER] = MBX_NAME + 11;    ! Where to build rest of name
  638.     OTS$CVT_L_TZ (OUR_PID, MBX_DESC, MAX_MBX_LEN - 12);    ! Generate rest of name
  639.     MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN - 1;    ! Set total length for create
  640.     MBX_DESC [DSC$A_POINTER] = MBX_NAME;    ! Point at start of name
  641.     STATUS = $CREMBX (CHAN = MBX_CHAN, LOGNAM = MBX_DESC);
  642.  
  643.     IF NOT .STATUS
  644.     THEN
  645.     BEGIN
  646.     LIB$SIGNAL (.STATUS);
  647.     RETURN .STATUS;
  648.     END;
  649.  
  650.     MBX_NAME [MAX_MBX_LEN - 1] = %C':';        ! Terminate with colon
  651.     MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN;    ! Set total length including colon
  652.     CH$COPY (MAX_MBX_LEN - 1, CH$PTR (MBX_NAME), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
  653.     FILE_SIZE = MAX_MBX_LEN - 1;        ! Set up FILE_NAME
  654.     FLAGS = 1;                    ! Don't wait for process
  655.     STATUS = LIB$SPAWN (            ! Spawn a DCL subprocess
  656.     COMMAND_DESC,                !  to do this command
  657.     (IF .VMS_VERSION LEQ 3            ! If old VMS
  658.      THEN
  659.          0                    ! Then no SYS$INPUT arg
  660.      ELSE
  661.          %ASCID'NLA0:'),            !  no SYS$INPUT
  662.     MBX_DESC,                !  set SYS$OUTPUT to mailbox
  663.     FLAGS,                    !  don't wait for process to complete
  664.     0,                    !  Process name
  665.     0,                    !  process id
  666.     0,                    !  completion status
  667.     0,                    !  ?
  668.     (IF .VMS_VERSION LEQ 3            ! If VMS 3 or earlier
  669.      THEN
  670.         PROCESS_COMPLETION_AST        !  We need to force eof
  671.      ELSE                    !  when process finishes
  672.         0),                    !  4.0 and on we get one free
  673.     .MBX_CHAN);                !  feed ast routine this value
  674.  
  675.     IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
  676.  
  677.     RETURN .STATUS;
  678.     END;                    ! End of SY_GENERIC
  679.  
  680. %SBTTL 'SY_DISMISS - Sleep for N seconds'
  681.  
  682. GLOBAL ROUTINE SY_DISMISS (SECONDS) : NOVALUE =
  683.  
  684. !++
  685. ! FUNCTIONAL DESCRIPTION:
  686. !
  687. !    This routine is called to cause KERMIT to sleep for the
  688. !    specified number of seconds.
  689. !
  690. ! CALLING SEQUENCE:
  691. !
  692. !    SY_DISMISS(Number of seconds);
  693. !
  694. ! INPUT PARAMETERS:
  695. !
  696. !    Number of seconds to sleep.
  697. !
  698. ! IMPLICIT INPUTS:
  699. !
  700. !    None.
  701. !
  702. ! OUTPUT PARAMETERS:
  703. !
  704. !    None.
  705. !
  706. ! IMPLICIT OUTPUTS:
  707. !
  708. !    None.
  709. !
  710. ! COMPLETION CODES:
  711. !
  712. !    None.
  713. !
  714. ! SIDE EFFECTS:
  715. !
  716. !    None.
  717. !
  718. !--
  719.  
  720.     BEGIN
  721.  
  722.     LOCAL
  723.     STATUS,
  724.     TOTAL_TIME : VECTOR [2, LONG];        ! Quad word for length of time to sleep
  725.  
  726.     IF .SECONDS EQL 0 THEN RETURN KER_NORMAL;
  727.  
  728.     TOTAL_TIME [0] = -.SECONDS*10*1000*1000;
  729.     TOTAL_TIME [1] = -1;
  730.     STATUS = $SETIMR (EFN = 1, DAYTIM = TOTAL_TIME);
  731.  
  732.     IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
  733.  
  734.     STATUS = $WAITFR (EFN = 1);
  735.  
  736.     IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
  737.  
  738.     END;                    ! End of SY_DISMISS(time)
  739.  
  740. %SBTTL 'SY_TIME - Return abbreviated system time'
  741.  
  742. GLOBAL ROUTINE SY_TIME =
  743.  
  744. !++
  745. ! FUNCTIONAL DESCRIPTION:
  746. !
  747. !    This routine will return the system time to the calling routine.
  748. !    This will allow for the calculation of the effective baud rate.
  749. !
  750. ! CALLING SEQUENCE:
  751. !
  752. !    TIME = SY_TIME ();
  753. !
  754. ! INPUT PARAMETERS:
  755. !
  756. !    None.
  757. !
  758. ! IMPLICIT INPUTS:
  759. !
  760. !    None.
  761. !
  762. ! OUTPUT PARAMETERS:
  763. !
  764. !    Time in milliseconds.
  765. !
  766. ! IMPLICIT OUTPUTS:
  767. !
  768. !    None.
  769. !
  770. ! COMPLETION CODES:
  771. !
  772. !    None.
  773. !
  774. ! SIDE EFFECTS:
  775. !
  776. !    None.
  777. !
  778. !--
  779.  
  780.     BEGIN
  781. !
  782. ! Local storage
  783. !
  784.  
  785.     LOCAL
  786.     Adjusted_Time : VECTOR [2, LONG],    ! System time - a constant.
  787.     MILLI_SECONDS,                ! Time in milliseconds
  788.     REMAINDER,                ! Remainder on EDIV
  789.     STATUS,                    ! Status returned by lower level
  790.     Time : VECTOR [2, LONG],        ! Quadword to hold system time.
  791.     TEN_FOURTH : VECTOR [2, LONG];        ! to hold 10**4
  792.  
  793. !
  794. ! LIB$EDIV will fail if the system time is too large, so we need
  795. ! to subtract some large constant from it - might as well use
  796. ! the current time.
  797. !
  798.  
  799.     IF .Subtrahend [0] EQL 0 AND .Subtrahend [1] EQL 0
  800.     THEN
  801.         BEGIN
  802.         STATUS = SYS$GETTIM(Subtrahend);
  803.         IF NOT .STATUS THEN RETURN 0;
  804.         END;
  805. !
  806. ! Get the VMS system time.
  807. !
  808.     STATUS = SYS$GETTIM(Time);
  809.     IF NOT .STATUS THEN RETURN 0;
  810.  
  811. !
  812. ! Compute the longword value from the quadword returned.
  813. !
  814.     Status = LIB$SUBX(Time, Subtrahend, Adjusted_Time);
  815.     IF NOT .STATUS THEN RETURN 0;
  816.  
  817.     TEN_FOURTH [0] = 1000*10;
  818.     TEN_FOURTH [1] = 0;
  819.     STATUS = LIB$EDIV (TEN_FOURTH, Adjusted_Time, MILLI_SECONDS, REMAINDER);
  820.  
  821.     IF NOT .STATUS AND .Status NEQ SS$_INTOVF THEN RETURN 0;
  822.  
  823.     RETURN .MILLI_SECONDS;
  824.     END;                    ! End of SY_TIME
  825.  
  826. %SBTTL 'End of KERSYS.BLI'
  827. END                        ! End of module
  828.  
  829. ELUDOM
  830.