$large ram optimize(3) Kermit$sys: do; /* * K e r m i t File Transfer Utility * * iRMX-86 Kermit, Version 2.41 * by Albert J. Goodman, Grinnell College * * System-dependent interface and utility procedures module. * Edit date: 22-August-1985 */ /* Define the iRMX-86 operating system interface */ /* Define the exception codes we use */ declare E$OK literally '0000h', E$FNEXIST literally '0021h', /* non-existent file */ E$FACCESS literally '0026h', /* file access not granted */ E$FTYPE literally '0027h', /* bad file type */ E$LOG$NAME$NEXIST literally '0045h', /* non-existent logical name */ E$CONTINUED literally '0083h'; /* continued command line */ /* Define the system type TOKEN */ $include(:I:LTKSEL.LIT) /* Include external definitions for the iRMX-86 system calls we use */ $include(:I:HSNCOR.EXT) $include(:I:HFMTEX.EXT) $include(:I:HGTICN.EXT) $include(:I:HCRCCN.EXT) $include(:I:HSNCMD.EXT) $include(:I:HGTCMD.EXT) $include(:I:IEXIOJ.EXT) $include(:I:ISATFL.EXT) $include(:I:ISCRFL.EXT) $include(:I:ISOPEN.EXT) $include(:I:ISSPEC.EXT) $include(:I:ISRDMV.EXT) $include(:I:ISWRMV.EXT) $include(:I:ISCLOS.EXT) $include(:I:ISDLCN.EXT) $include(:I:ISDLFL.EXT) $include(:I:IGTTIM.EXT) $include(:I:NSTEXH.EXT) $include(:I:NRCUNI.EXT) $include(:I:NCRSEM.EXT) declare /* CONSTANTS */ /* Useful text substitutions */ boolean literally 'byte', /* define a new type */ TRUE literally '0FFh', /* and constants */ FALSE literally '000h', /* of that type */ /* ASCII control character constants */ CTRL$C literally '03h', /* CTRL/C */ HT literally '09h', /* horizontal tab */ LF literally '0Ah', /* line-feed */ CR literally '0Dh', /* carriage-return */ /* String constants */ remote$name(*) byte data( 12, ':KERMITPORT:' ), console$name(*) byte data( 4, ':CO:' ), file$list$name(*) byte data( 20, ':WORK:KERMITFLST.TMP' ), /* GET$CONSOLE$CHAR and GET$REMOTE$CHAR return codes */ TIMEOUT literally '0FFFFh', /* Time limit expired */ CTRL$C$CODE literally '08003h', /* CTRL/C abort */ /* READ$CHAR return code */ EOF$CODE literally '0FF00h', /* end-of-file */ /* GLOBAL VARIABLES */ /* Tokens (what the system uses to identify objects) */ cur$file token public, /* Connection to the current file */ comm$conn token, /* token for our command connection */ file$list token, /* Connection to the file containg a filename list */ console$tok token, /* Connection to the console */ remote$tok token, /* Connection to the remote port */ cc$sema4 token, /* Semaphore to signal when CTRL/C pressed */ /* Buffers */ in$buff structure( /* Buffer for input from remote */ next byte, /* next char to be read from buffer */ len byte, /* number of chars in the buffer */ ch(256) byte) initial( 0, 0 ), com$line structure( /* The buffer for the command line */ len byte, ch(80) byte) public; /* External procedures defined in KERMIT$UTIL */ get$filespec: procedure( keyword$num, info$ptr ) external; declare keyword$num byte, info$ptr pointer; end get$filespec; upcase: procedure( x ) byte external; declare x byte; end upcase; /* * * System-dependent utility procedures used by Kermit. * */ print: procedure( string$ptr ) public; /* * Print the string pointed to by STRING$PTR on the console. * A string consists of a length byte followed by the specified * number of characters (bytes). */ declare string$ptr pointer, status word; call rq$c$send$co$response( 0, 0, string$ptr, @status ); end print; new$line: procedure public; /* * Get the cursor to a new line on the console (i.e. print CR/LF). */ call print( @( 2,CR,LF ) ); end new$line; print$char: procedure( char ) public; /* * Print the character CHAR on the console. */ declare char byte, string structure( len byte, ch byte); /* Form a one-character string and then print it */ string.ch = char; string.len = 1; call print( @string ); end print$char; exit$program: procedure public; /* * Exit from the program, i.e. return to the operating system. * This procedure does not return to the calling routine. */ declare status word; call new$line; /* make sure the cursor's on a new line */ call rq$exit$io$job( 0, 0, @status ); end exit$program; disp$excep: procedure( excep$code ); /* * Display the exception code and associated mnemonic (error * message) on the console. (Does not include any CRLFs.) */ declare ( excep$code, status ) word, string$buffer structure( len byte, ch(40) byte); string$buffer.len = 0; /* Init to null string */ /* Get the exception code and mnemonic */ call rq$c$format$exception( @string$buffer, size(string$buffer), excep$code, 1, @status ); call print( @string$buffer ); /* Display the exception message */ end disp$excep; check$status: procedure( status ); /* * Check the exception code returned by a system call to the * variable STATUS. If it is not E$OK, display the exception code * and mnemonic at the console and abort the program. */ declare status word; if ( status <> E$OK ) then do; /* Handle an exceptional condition */ call new$line; /* Make sure we're at the start of a line */ call disp$excep( status ); /* Display the error message */ call print( @( 18,', program aborted.' ) ); /* And what we're doing */ call new$line; /* And abort the program. */ call exit$program; end; /* if ( status <> E$OK ) */ end check$status; disable$exception$handler: procedure; /* * Disable the default exception handler, to prevent it from gaining * control and aborting the program as soon as any exception occurs. */ declare status word, exception$handler$info structure( offset word, base word, mode byte); exception$handler$info.offset = 0; exception$handler$info.base = 0; exception$handler$info.mode = 0; /* Never pass control to EH */ call rq$set$exception$handler( @exception$handler$info, @status ); call check$status( status ); end disable$exception$handler; setup$terminals: procedure; /* * Set up both terminal lines used by the program--the line to * the remote computer and our local console--by getting * connections to them, opening them in read/write mode, * and setting their terminal characteristics to no echo and * transparent/polling (no line editing) modes. * Initializes the globals REMOTE$TOK and CONSOLE$TOK. */ declare status word, terminal$data structure( number$param word, number$used word, connection$flags word, terminal$flags word, in$baud$rate word, out$baud$rate word, scroll$lines word); /* Get both connections */ remote$tok = rq$s$attach$file( @remote$name, @status ); if ( status = E$LOG$NAME$NEXIST ) then do; /* Give a more helpful error message */ call print( @( 32,'Terminal line to remote computer' ) ); call print( @( 21,' must be attached as ' ) ); call print( @remote$name ); call new$line; /* And abort the program */ call exit$program; end; /* if ( status = E$LOG$NAME$NEXIST ) */ else call check$status( status ); console$tok = rq$s$attach$file( @console$name, @status ); call check$status( status ); /* Open both for both reading and writing */ /* Specify zero buffers for interactive use */ call rq$s$open( remote$tok, 3, 0, @status ); call check$status( status ); call rq$s$open( console$tok, 3, 0, @status ); call check$status( status ); /* Get current remote terminal characteristics */ terminal$data.number$param = 5; terminal$data.number$used = 1; call rq$s$special( remote$tok, 4, @terminal$data, 0, @status ); call check$status( status ); /* Set to transparent/polling mode and no echo */ terminal$data.connection$flags = ( terminal$data.connection$flags OR 0007h ); terminal$data.number$param = 5; terminal$data.number$used = 1; call rq$s$special( remote$tok, 5, @terminal$data, 0, @status ); call check$status( status ); /* Get current console characteristics */ terminal$data.number$param = 5; terminal$data.number$used = 1; call rq$s$special( console$tok, 4, @terminal$data, 0, @status ); call check$status( status ); /* Set to transparent/polling mode and no echo */ terminal$data.connection$flags = ( terminal$data.connection$flags OR 0007h ); terminal$data.number$param = 5; terminal$data.number$used = 1; call rq$s$special( console$tok, 5, @terminal$data, 0, @status ); call check$status( status ); end setup$terminals; retrap$control$c: procedure; /* * Prevent a CTRL/C typed on the console from interrupting * the program, after TRAP$CONTROL$C has been called once. * This is needed because each call to C$SEND$COMMAND re-enables * the system's CTRL/C trap, so this must be called to re-enable * ours. */ declare status word, signal$pair structure( semaphore token, character byte); /* Associate CTRL/C from the console with our semaphore */ signal$pair.semaphore = cc$sema4; signal$pair.character = CTRL$C; call rq$s$special( console$tok, 6, @signal$pair, 0, @status ); call check$status( status ); end retrap$control$c; trap$control$c: procedure; /* * Prevent a CTRL/C typed on the console from interrupting * the program, and instead allow us to test for whether CTRL/C * has been pressed by calling the function CONTROL$C$FLAG (defined * below). Initializes the global CC$SEMA4. (SETUP$TERMINALS must * have previously been called to get a connection to the console * into the global CONSOLE$TOK.) */ declare status word; /* Create a semaphore to receive a unit when a CTRL/C is pressed */ cc$sema4 = rq$create$semaphore( 0, 1, 0, @status ); call check$status( status ); /* And assign CTRL/C to our semaphore */ call retrap$control$c; end trap$control$c; control$c$flag: procedure boolean; /* * Return TRUE if CTRL/C has been pressed on the console, * FALSE otherwise. (TRAP$CONTROL$C must previously have been * called.) If it returns TRUE, it will return FALSE on succeeding * calls unless CTRL/C was pressed again. */ declare ( units$left, status ) word; /* Check for a unit at the semaphore (don't wait for one) */ units$left = rq$receive$units( cc$sema4, 0, 0, @status ); call check$status( status ); if ( units$left = 0 ) then /* there wasn't one */ return( FALSE ); /* so signal no CTRL/C */ else /* there was one */ do; /* Take that unit from the semaphore (so it won't be seen again) */ units$left = rq$receive$units( cc$sema4, 1, 0, @status ); call check$status( status ); return( TRUE ); /* And signal that we got a CTRL/C */ end; /* else */ end control$c$flag; setup: procedure public; /* * This procedure does the system-dependent setup * which must be done when the Kermit program * is first started. */ declare status word; call disable$exception$handler; call setup$terminals; call trap$control$c; /* Create a command connection, using the console for :CI: and :CO: */ comm$conn = rq$c$create$command$connection( console$tok, console$tok, 0, @status ); call check$status( status ); end setup; read$char: procedure( source ) word public; /* * Return the next character from the file (or device) specified * by SOURCE (which must be a connection open for reading). * Returns the constant EOF$CODE (which cannot be a character * because it is larger than 0FFh) if the file pointer is * at end-of-file. */ declare source token, ( bytes$read, status ) word, ch byte; if ( source = remote$tok) then do; /* do buffered input from remote */ if ( in$buff.next >= in$buff.len ) then do; /* re-fill the buffer */ bytes$read = rq$s$read$move( source, @in$buff.ch, 256, @status ); call check$status( status ); in$buff.next = 0; /* reset the pointers */ in$buff.len = bytes$read; if ( in$buff.len = 0 ) then /* there's no more to be read */ return( EOF$CODE ); /* so signal end-of-file */ end; /* if ... */ ch = in$buff.ch( in$buff.next ); /* get next char from the buffer */ in$buff.next = in$buff.next + 1; /* update the pointer */ return( ch ); /* and return the character */ end; /* if ... */ else do; /* Read the next byte from the file */ bytes$read = rq$s$read$move( source, @ch, 1, @status ); call check$status( status ); if ( bytes$read = 0 ) then /* we ran into end-of-file */ return( EOF$CODE ); /* so signal that */ else /* we got a character */ return( ch ); /* so return it */ end; /* else */ end read$char; get$next$file$name: procedure( info$ptr ) public; /* * Place the name of the next file to be sent into the buffer * pointed to by INFO$PTR. This assumes that GET$FIRST$FILE$NAME * has previously been called. When there are no more filenames, * the buffer receives a null string (length zero). */ declare info$ptr pointer, ch word, info based info$ptr structure( len byte, ch(1) byte); info.len = 0; /* init to null string */ ch = read$char( file$list ); /* read the first character */ /* Read characters from the file-list file up to return or EOF */ do while ( ( ch <> CR ) and ( ch <> EOF$CODE ) ); info.ch( info.len ) = ch; /* store previous char */ info.len = ( info.len + 1 ); /* update length */ ch = read$char( file$list ); /* get next char */ end; /* do while ( ( ch <> CR ) and ( ch <> EOF$CODE ) ) */ if ( ch = CR ) then /* we got a return */ ch = read$char( file$list ); /* discard the line-feed too */ end get$next$file$name; get$first$file$name: procedure( keyword$num, info$ptr ) public; /* * Get the first filename matching the filespec in keyword number * KEYWORD$NUM into the buffer pointed to by INFO$PTR. This routine * also does the setup necessary for handling wild-card file names so * that GET$NEXT$FILE$NAME can return the subsequent matching file * names. Returns a null string to the buffer if the name cannot * be parsed (e.g. contains wildcards which don't match any files). */ declare keyword$num byte, info$ptr pointer, ( status, com$status ) word, info based info$ptr structure( len byte, ch(1) byte); /* Get the filespec (possibly with wildcards) into the INFO buffer */ call get$filespec( keyword$num, info$ptr ); /* Send the ITEMIZE command to list the matching filenames */ call rq$c$send$command( comm$conn, @( 9,'ITEMIZE &' ), @com$status, @status ); if ( status <> E$CONTINUED ) then /* should be continued */ call check$status( status ); /* Append an ampersand to the filespec */ info.ch( info.len ) = '&'; info.len = ( info.len + 1 ); /* And concatenate it to the ITEMIZE command */ call rq$c$send$command( comm$conn, @info, @com$status, @status ); if ( status <> E$CONTINUED ) then /* should still be continued */ call check$status( status ); /* Form the rest of the command in the INFO buffer */ call movb( @( ' OVER ' ), @info.ch( 0 ), 6 ); /* the preposition */ /* and the output filename */ call movb( @file$list$name( 1 ), @info.ch( 6 ), file$list$name( 0 ) ); info.len = ( file$list$name( 0 ) + 8 ); /* store length */ info.ch( info.len - 2 ) = CR; info.ch( info.len - 1 ) = LF; /* Send the rest of the command and exectue it */ call rq$c$send$command( comm$conn, @info, @com$status, @status ); call check$status( status ); call retrap$control$c; if ( com$status = E$OK ) then /* it executed O.K. */ do; /* Get a connection to the file produced */ file$list = rq$c$get$input$connection( @file$list$name, @status ); call check$status( status ); call get$next$file$name( @info ); /* and get the first filename */ end; /* if ( com$status = E$OK ) */ else /* A problem with the ITEMIZE command */ info.len = 0; /* Return null-string as the file-name */ end get$first$file$name; finish$send: procedure public; /* * Clean up after the ITEMIZE command. */ declare status word; /* Delete the file connection, if possible */ call rq$s$delete$connection( file$list, @status ); /* And delete the temporary file itself, if possible */ call rq$s$delete$file( @file$list$name, @status ); /* STATUS is ignored because the file may not */ /* have been successfully created */ end finish$send; prepare$file$name: procedure( info$ptr ) public; /* * Prepare the filename in the buffer pointed to by INFO$PTR for * sending to the other Kermit--i.e. remove directory and/or device * names, leaving only the filename itself in the buffer. */ declare info$ptr pointer, ( i, ch ) byte, info based info$ptr structure( len byte, ch(1) byte); i = info.len; /* Start at the end of the pathname */ ch = info.ch( i - 1 ); /* Get last character */ do while ( ( ch <> '/' ) and ( ch <> '^' ) and ( ch <> ':' ) and ( i > 0 ) ); /* while we're still in the filename */ i = ( i - 1 ); /* scan backwards to the start of actual filename */ ch = info.ch( i - 1 ); /* get current character */ end; /* do while ... */ if ( i > 0 ) then /* there's a logical or directory name to be trimmed */ do; /* move the actual filename to the beginning of the buffer */ call movb( @info.ch( i ), @info.ch( 0 ), ( info.len - i ) ); info.len = ( info.len - i ); /* and update length */ end; /* if ( i > 0 ) */ end prepare$file$name; open$file: procedure( name$ptr ) boolean public; /* * Open the file specified in the string (length byte followed * by the characters of the name) pointed to by NAME$PTR, which is * assumed to already exist, for reading. Sets the global CUR$FILE. * Returns TRUE if the open was successful, otherwise it prints * an error message on the console describing the problem * encountered and returns FALSE. */ declare status word, name$ptr pointer; /* Get a connection to the file */ cur$file = rq$s$attach$file( name$ptr, @status ); if ( status = E$OK ) then /* we got a connection */ /* so open it, for reading only, with two buffers */ call rq$s$open( cur$file, 1, 2, @status ); if ( status = E$OK ) then /* we successfully opened the file */ return( TRUE ); /* indicate success */ else /* we encountered a problem */ do; /* Display an error message */ call print( @( 17,'Can''t open file "' ) ); call print( name$ptr ); call print( @( 3,'"; ' ) ); if ( status = E$FACCESS ) then call print( @( 20,'read access required' ) ); else if ( status = E$FNEXIST ) then call print( @( 19,'file does not exist' ) ); else if ( status = E$FTYPE ) then call print( @( 32,'can''t use data file as directory' ) ); else call disp$excep( status ); return( FALSE ); /* and indicate failure */ end; end open$file; create$file: procedure( name$ptr ) boolean public; /* * Create the file specified in the string (length byte followed * by the characters of the name pointed to by NAME$PTR and open * it for writing. If it already exists the user will be asked * whether to overwrite it. If the operation is successful the * global CUR$FILE is set and TRUE is returned, otherwise an * error message is displayed at the console and FALSE is returned. */ declare status word, answer byte, name$ptr pointer; /* First, check whether the file already exists */ cur$file = rq$s$attach$file( name$ptr, @status ); if ( status = E$OK ) then /* the file does already exist */ do; /* First, delete the connection we didn't really want */ call rq$s$delete$connection( cur$file, @status ); call check$status( status ); /* Now, ask the user whether to overwrite the file */ call print( @( 6,'File "' ) ); call print( name$ptr ); call print( @( 37,'" already exists; overwrite it ? ' ) ); answer = get$console$char( 0FFFFh ); /* wait for an answer */ call print$char( answer ); /* show them what they typed */ call new$line; /* and that the question is finished */ if ( upcase( answer ) = 'Y' ) then status = E$FNEXIST; /* act as if the file didn't exist */ else /* they don't want to overwrite it */ return( FALSE ); /* indicate failure, with no error message */ end; if ( status = E$FNEXIST ) then /* it's O.K. to go ahead and create it */ do; cur$file = rq$s$create$file( name$ptr, @status ); if ( status = E$OK ) then /* we created the file O.K. */ /* so open it, for writing only, with two buffers */ call rq$s$open( cur$file, 2, 2, @status ); end; if ( status = E$OK ) then /* we successfully created the file */ return( TRUE ); /* indicate success */ else /* we encountered a problem */ do; /* Display an error message */ call print( @( 19,'Can''t create file "' ) ); call print( name$ptr ); call print( @( 3,'"; ' ) ); if ( status = E$FACCESS ) then call print( @( 21,'write access required' ) ); else if ( status = E$FNEXIST ) then call print( @( 19,'file does not exist' ) ); else if ( status = E$FTYPE ) then call print( @( 32,'can''t use data file as directory' ) ); else call disp$excep( status ); return( FALSE ); /* and indicate failure */ end; end create$file; close$file: procedure public; /* * Close the file specified by the connection in the global * token CUR$FILE. */ declare status word; call rq$s$close( cur$file, @status ); /* close the file */ call check$status( status ); /* and delete the connection */ call rq$s$delete$connection( cur$file, @status ); call check$status( status ); end close$file; get$char: procedure( source, time$limit ) word; /* * Return the next character from the terminal line (connection) * indicated by SOURCE, waiting until a character arrives or * TIME$LIMIT seconds have elapsed; if the time limit expires * with no character having been received, return the constant * TIMEOUT (which cannot be a character because it is larger than * 0FFh). If CTRL/C is pressed on the console, it will immediately * return the constant CTRL$C$CODE (which also cannot be a character). * If TIME$LIMIT is zero, will return immediately, with a character * if one was waiting (or CTRL$C$CODE), otherwise with TIMEOUT. If * TIME$LIMIT = 0FFFFh it is taken to be infinite, i.e. it will * never time out. */ declare source token, ( time$limit, ch, status ) word, ( start$time, time$now ) dword, timed$out boolean; /* Store the time at which we started waiting */ start$time = rq$get$time( @status ); call check$status( status ); ch = EOF$CODE; /* we haven't gotten anything yet */ timed$out = FALSE; /* Ensure that we go through the loop at least once */ /* Loop until we time out or get a character */ do while ( ( not timed$out ) and ( ch = EOF$CODE ) ); /* Check for a control-C interrupt from the console */ if ( control$c$flag ) then /* We got one */ ch = CTRL$C$CODE; /* so return the "character" CTRL$C$CODE */ else /* no control-C */ ch = read$char( source ); /* look for a normal character */ if ( ch = EOF$CODE ) then /* if we didn't get anything */ do; /* check on the time limit */ if ( time$limit = 0 ) then /* if they don't want to wait */ timed$out = TRUE; /* time out immediately */ /* if they gave a finite time limit */ else if ( time$limit < 0FFFFh ) then do; /* check whether we've run out of time yet */ /* Get the time now */ time$now = rq$get$time( @status ); call check$status( status ); /* If the elapsed time is greater than the limit */ if ( ( time$now - start$time ) > time$limit ) then timed$out = TRUE; /* we ran out of time, stop waiting */ end; /* if ( time$limit < 0FFFFh ) */ /* If TIME$LIMIT is infinite (0FFFFh), TIMED$OUT stays FALSE */ end; /* if ( ch = EOF$CODE ) */ end; /* do while ( ( not timed$out ) and ( ch = EOF$CODE ) ) */ if ( timed$out ) then /* we ran out of time */ return( TIMEOUT ); /* so return that information */ else /* we got a character (or control-C) */ return( ch ); /* so return that */ end get$char; get$console$char: procedure( time$limit ) word public; declare time$limit word; return( get$char( console$tok, time$limit ) ); end get$console$char; get$remote$char: procedure( time$limit ) word public; declare time$limit word; return( get$char( remote$tok, time$limit ) ); end get$remote$char; put$char: procedure( destination, ch ) public; /* * Put the character CH out to the file or terminal line * specified by DESTINATION (which must be a connection * open for writing). */ declare destination token, ch byte, ( bytes$written, status ) word; bytes$written = rq$s$write$move( destination, @ch, 1, @status ); call check$status( status ); end put$char; xmit$console$char: procedure( ch ) public; /* * Send character CH to the console. */ declare ch byte; call put$char( console$tok, ch ); end xmit$console$char; xmit$remote$char: procedure( ch ) public; /* * Send character CH out to the remote port. */ declare ch byte; call put$char( remote$tok, ch ); end xmit$remote$char; xmit$packet: procedure( packet$ptr, len ) public; /* * Send a whole packet, pointed to by PACKET$PTR and * containing LEN characters, out to the remote port. */ declare packet$ptr pointer, ( len, bytes$written, status ) word; bytes$written = rq$s$write$move( remote$tok, packet$ptr, len, @status ); call check$status( status ); end xmit$packet; flush$input$buffer: procedure public; /* * Flush (empty) the input ("type-ahead") buffer for the * line on which we are connected to the other Kermit. * Also clears any stored-up CTRL/C's from the console. */ do while ( read$char( remote$tok ) <> EOF$CODE ); /* Keep reading (and discarding) characters */ /* until there aren't any more */ end; /* do while ( read$char( remote$tok ) <> EOF$CODE ) */ do while ( control$c$flag = TRUE ); /* And the same with control-C's */ end; /* do while ( control$c$flag = TRUE ) */ end flush$input$buffer; get$command$line: procedure( prompt$ptr ) public; /* * Display the string pointed to by PROMPT$PTR and get a command * line from the console into the global buffer COM$LINE. This * procedure also does some preliminary processing of the command line: * All letters are converted to upper-case, tabs are converted to * spaces, spaces which are redundant or at the beginning of the * command line are removed, and line terminators are removed. * Thus upon return the COM$LINE buffer should contain simply the * keyword(s), separated by only one space each. */ declare prompt$ptr pointer, space$flag boolean, /* TRUE if a space here is significant */ ( i, j ) byte, /* Indicies into the command line buffer */ status word; /* Issue the prompt and get the command line into the buffer */ call rq$c$send$co$response( @com$line, size( com$line ), prompt$ptr, @status ); call check$status( status ); if ( com$line.len = 0 ) then /* We got EOF (end-of-file, or ^Z) */ do; /* Treat the EOF like an EXIT command */ call print( @( 2,'^Z' ) ); /* Echo the ^Z */ call new$line; /* And echo a CRLF */ /* Put the EXIT command in the buffer */ call movb( @( 4,'EXIT' ), @com$line, 5 ); end; /* if ( com$line.len = 0 ) */ else /* We got a command line */ do; /* do the preliminary processing of the command line */ /* If the last character wasn't a line-feed */ if ( com$line.ch( com$line.len - 1 ) <> LF ) then call new$line; /* Get the cursor onto a new line */ /* Add a CR at the end in case there isn't one */ com$line.ch( com$line.len ) = CR; i, j = 0; /* init the pointers to the start of the buffer */ space$flag = FALSE; /* Initial spaces are meaningless */ /* Process the line until the CR */ do while ( com$line.ch( i ) <> CR ); if ( com$line.ch( i ) = HT ) then com$line.ch( i ) = ' '; /* convert tabs to spaces */ /* If this is a significant character */ if ( space$flag or ( com$line.ch( i ) <> ' ' ) ) then do; /* Process this character */ /* Store it (capitalized) in the resulting command line */ com$line.ch( j ) = upcase( com$line.ch( i ) ); j = j + 1; /* Increment the pointer to the result */ if ( com$line.ch( i ) = ' ' ) then /* if it's a space */ space$flag = FALSE; /* further spaces are redundant */ else /* it's not a space */ space$flag = TRUE; /* so a space after it is meaningful */ end; /* if ( space$flag or ( com$line.ch( i ) <> ' ' ) ) */ i = i + 1; /* Move to the next character of input */ end; /* do while ( com$line.ch( i ) <> CR ) */ com$line.len = j; /* Store the length of the result */ end; /* else -- we got a command line */ end get$command$line; do$help: procedure( num$params ) public; /* * Perform the HELP command. This procedure passes the name * of our help library and the number of parameters specified * by NUM$PARAMS to the HELP program. */ declare ( num$params, i ) byte, ( com$status, status ) word, buffer structure( len byte, ch(50) byte); /* Get the name of the file containing this program */ call rq$c$get$command$name( @buffer, size( buffer ), @status ); call check$status( status ); /* Append the .HLP suffix to it, forming the name of the help library */ call movb( @( '.HLP &' ), @buffer.ch( buffer.len ), 6 ); buffer.len = ( buffer.len + 6 ); /* Send the HELP command, with @ to signal library name comes next */ call rq$c$send$command( comm$conn, @( 7,'HELP @&' ), @com$status, @status ); if ( status <> E$CONTINUED ) then /* should be continued */ call check$status( status ); /* Add our help library name to it */ call rq$c$send$command( comm$conn, @buffer, @com$status, @status ); if ( status <> E$CONTINUED ) then /* should still be continued */ call check$status( status ); /* For each parameter which we have */ do i = 1 to num$params; call get$filespec( i, @buffer ); /* get the parameter */ buffer.ch( buffer.len ) = ' '; buffer.ch( buffer.len + 1 ) = '&'; /* add space and ampersand */ buffer.len = ( buffer.len + 2 ); /* Append the parameter to the HELP command line */ call rq$c$send$command( comm$conn, @buffer, @com$status, @status ); if ( status <> E$CONTINUED ) then /* should still be continued */ call check$status( status ); end; /* do i = 1 to num$params */ /* And finally execute the command */ call rq$c$send$command( comm$conn, @( 2,CR,LF ), @com$status, @status ); call check$status( status ); call retrap$control$c; end do$help; end kermit$sys;