$large ram Kermit$sys: do; /* * K e r m i t File Transfer Utility * * iRMX-86 Kermit, Version 2.3 * by Albert J. Goodman, Grinnell College * * System-dependent interface and utility procedures module. * Edit date: 2-June-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$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:NSTEXH.EXT) $include(:I:NCRSEM.EXT) $include(:I:NDSABL.EXT) $include(:I:NENABL.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 */ /* Hardware port addresses for our system */ T0$data$port literally '0D8h', /* T0 data port */ T0$status$port literally '0DAh', /* T0 status port */ base$port literally '030h', /* Base port for 534 board */ /* Encoded interrupt levels which we might have to disable */ level$534 literally '038h', /* 534-board interrupt level */ level$T0$in literally '068h', /* T0 (system console) input */ level$T0$out literally '078h', /* & output interrupt levels */ /* String constants */ 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 */ BREAK literally '08000h', /* Break key */ /* 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 */ /* Port addresses */ console$data$port word, /* Data port of the console (usually T0) */ console$status$port word, /* Status port of the console */ remote$data$port word, /* Data port of T3 (on 534-board) */ remote$status$port word, /* Status port of T3 (on 534-board) */ /* Flag affecting all console output */ communicating boolean initial( FALSE ), /* Whether we're communicating, i.e. console interrupts are disabled */ /* Buffers */ 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; /* * * Hardware port communication routines. * */ console$char$available: procedure boolean; /* * Return TRUE if there is a character available * at the console port. */ if ( ( input( console$status$port ) AND 02h ) = 0 ) then return( FALSE ); else return( TRUE ); end console$char$available; get$console$char: procedure( time$limit ) word public; /* * Return the next character from the console, waiting until * a character is available or until approximately TIME$LIMIT * seconds have elapsed, whichever comes first. If the * break key is pressed when this routine is first called, * it will return the constant BREAK (which is not a character * because it is larger than 0FFh). If not, the break key * is not checked for while waiting out a time limit. If the * time limit expires before any key is pressed, the constant * TIMEOUT (which also is larger than 0FFh) is returned. * If TIME$LIMIT is zero it will return immediately, with a * character if one was waiting or else with TIMEOUT. If * TIME$LIMIT = 0FFFFh it is taken to be infinite, i.e. TIMEOUT * will never be returned. This procedure assumes that * interrupts from the console are disabled. */ declare ( time$limit, i, j ) word; if ( ( input( console$status$port ) AND 40h ) <> 0 ) then return( BREAK ); /* The break key was pressed */ if ( time$limit = 0 ) then do; if ( console$char$available ) then return( input( console$data$port ) ); else return( TIMEOUT ); end; else if ( time$limit = 0FFFFh ) then do; do while ( not console$char$available ); /* just wait for a character */ end; return( input( console$data$port ) ); end; else do; do i = 1 to time$limit; do j = 1 to 1000; if ( console$char$available ) then return( input( console$data$port ) ); else call time( 9 ); /* wait about a millisecond */ end; end; return( TIMEOUT ); end; end get$console$char; xmit$console$char: procedure( ch ) public; /* * Send character CH to the console. */ declare ch byte; do while ( ( input( console$status$port ) AND 01h ) = 0 ); /* Wait for TxRDY (transmitter ready) */ end; output( console$data$port ) = ch; end xmit$console$char; select$data$block: procedure; /* * Select the 534-board "data block" ports. * This must be done once before accessing the * USART status and data ports. */ output( base$port + 0Dh ) = 0; end select$data$block; remote$char$available: procedure boolean; /* * Return TRUE if there is a character available * at the remote port. */ if ( ( input( remote$status$port ) AND 02h ) = 0 ) then return( FALSE ); else return( TRUE ); end remote$char$available; get$remote$char: procedure( time$limit ) word public; /* * Return the next character from the remote port, waiting until * a character is available or until approximately TIME$LIMIT * seconds have elapsed, whichever comes first. If the time * limit expires first, the constant TIMEOUT (which cannot be * a character because it is larger than 0FFh) is returned. * If TIME$LIMIT is zero it will return immediately, with a * character if one was waiting or else with TIMEOUT. If * TIME$LIMIT = 0FFFFh it is taken to be infinite. If a key * is pressed on the console while this procedure is waiting * for a remote character it will stop waiting; it will return * CTRL$C$CODE (which also cannot be a character since it too * is larger than 0FFh) if the key pressed was CTRL/C; otherwise * it will simply return TIMEOUT. This procedure assumes * that interrupts from both the console and the remote port * are disabled. */ declare ( time$limit, i, j ) word; if ( time$limit = 0 ) then do; if ( remote$char$available ) then return( input( remote$data$port ) ); else return( TIMEOUT ); end; else if ( time$limit = 0FFFFh ) then do; do while ( not remote$char$available ); if ( console$char$available ) then do; if ( input( console$data$port ) = CTRL$C ) then return( CTRL$C$CODE ); else return( TIMEOUT ); end; end; return( input( remote$data$port ) ); end; else do; do i = 1 to time$limit; do j = 1 to 1000; if ( remote$char$available ) then return( input( remote$data$port ) ); else if ( console$char$available ) then do; if ( input( console$data$port ) = CTRL$C ) then return( CTRL$C$CODE ); else return( TIMEOUT ); end; else call time( 9 ); /* wait about a millisecond */ end; end; return( TIMEOUT ); end; end get$remote$char; xmit$remote$char: procedure( ch ) public; /* * Send character CH out to the remote port. */ declare ch byte; do while ( ( input( remote$status$port ) AND 01h ) = 0 ); /* Wait for TxRDY (transmitter ready) */ end; output( remote$data$port ) = ch; end xmit$remote$char; xmit$break: procedure public; /* * Send a hardware break signal to the remote port. */ do while ( ( input( remote$status$port ) AND 01h ) = 0 ); /* Wait for TxRDY (transmitter ready) */ end; output( remote$status$port ) = 03Dh; call time( 5000 ); /* Wait about half a second */ output( remote$status$port ) = 035h; end xmit$break; /* * * 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, string based string$ptr structure( len byte, ch(1) byte), i byte; if ( communicating ) then /* we must send it directly to the ports */ do; if ( string.len > 0 ) then /* there are some characters */ do i = 0 to ( string.len - 1 ); call xmit$console$char( string.ch( i ) ); end; end; else /* we can use a system call */ 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); if ( communicating ) then /* just send it to the hardware ports */ call xmit$console$char( char ); else do; /* Form a one-character string and then print it */ string.ch = char; string.len = 1; call print( @string ); end; end print$char; setup$for$communication: procedure public; /* * This procedure does the setup to prepare for * communication by Kermit. It disables interrupts * from the remote port and the console and then * initializes the ports. */ declare i byte, status word; communicating = TRUE; /* flag that we are now communicating */ /* Disable the 534-board's interrupt level */ call rq$disable( level$534, @status ); /* Disable the console's interrupt levels too */ if ( console$data$port = T0$data$port ) then /* the console is T0 */ do; /* disable T0's interrupt levels */ call rq$disable( level$T0$in, @status ); call rq$disable( level$T0$out, @status ); end; /* Otherwise the console is T4 which is on the 534-board and so its */ /* interrupts have already been disabled above */ /* Next, initialize T3, the port to the remote system */ output( base$port + 0Ch ) = 0; /* select control block */ /* put counter 2 in mode 3 (for baud-rate generator) */ output( base$port + 3 ) = 0B6h; /* load count of 32 to get 2400 baud */ output( base$port + 2 ) = 32; /* LSB of count */ output( base$port + 2 ) = 0; /* and MSB */ remote$data$port = base$port + 4; /* for T3 */ remote$status$port = remote$data$port + 1; call select$data$block; do i = 1 to 4; /* Send USART 2 four zeros */ output( remote$status$port ) = 0; /* to get it into a known state */ call time( 1 ); /* Give the USART time to recover between writes */ end; /* Now reset the USART (USART 2 = port T3) */ output( remote$status$port ) = 40h; call time( 1 ); /* Give the USART time to recover between writes */ /* Send it a mode instruction: 1 stop bit, no parity, 8 bits, */ output( remote$status$port ) = 4Eh; /* and baud rate factor of X16 */ call time( 1 ); /* Give the USART time to recover between writes */ /* And a standard command instruction: set RTS, error reset, and */ output( remote$status$port ) = 35h; /* enable both receive and transmit */ /* We know the console has been initialized by the system */ /* So just give it a standard command instruction */ output( console$status$port ) = 35h; end setup$for$communication; finish$communication: procedure public; /* * This procedure finishes communication by * re-enabling the interrupt level(s) disabled * by SETUP$FOR$COMMUNICATION (above). */ declare status word; /* Re-enable the 534-board's interrupt level */ call rq$enable( level$534, @status ); /* Re-enable the console's interrupt levels too */ if ( console$data$port = T0$data$port ) then /* the console is T0 */ do; /* Re-enable T0's interrupt levels */ call rq$enable( level$T0$in, @status ); call rq$enable( level$T0$out, @status ); end; /* Otherwise the console is T4 which is on the 534-board and so its */ /* interrupts have already been re-enabled above */ communicating = FALSE; /* we are no longer communicating */ end finish$communication; 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 */ if ( communicating ) then /* make sure to restore interrupts */ call finish$communication; 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: procedure public; /* * This procedure does the system-dependent setup * which must be done when the Kermit program * is first started. */ declare status word, console token, cc$sema4 token, buffer structure( len byte, ch(5) byte), signal$pair structure( semaphore token, character byte); /* First, disable the system's exception handler */ call disable$exception$handler; /* Next, determine what ports to use for the console */ call rq$c$send$co$response( @buffer, size( buffer ), @( 37,'Are you at the system console ? ' ), @status ); call check$status( status ); if ( buffer.len > 0 ) and ( upcase( buffer.ch(0) ) = 'N' ) then do; /* They said no, so assume they're at T4 */ console$data$port = base$port + 6; /* for T4 */ console$status$port = console$data$port + 1; end; else do; /* Otherwise they're at T0 (the system console) */ console$data$port = T0$data$port; console$status$port = T0$status$port; end; call new$line; /* Leave a blank line below that question */ /* Now get a connection to the console */ console = rq$s$attach$file( @( 4,':CO:' ), @status ); call check$status( status ); /* Open it for both reading and writing */ /* (specify zero buffers for interactive use) */ call rq$s$open( console, 3, 0, @status ); call check$status( status ); /* Create a command connection, using the console for :CI: and :CO: */ comm$conn = rq$c$create$command$connection( console, console, 0, @status ); call check$status( status ); /* Prevent a CTRL/C typed on the console from aborting the program */ /* 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 ); /* Associate CTRL/C from the console with our semaphore */ signal$pair.semaphore = cc$sema4; signal$pair.character = CTRL$C; call rq$s$special( console, 6, @signal$pair, 0, @status ); call check$status( status ); end setup; read$char: procedure( file ) word public; /* * Return the next character from the file specified * by FILE (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 file token, ( bytes$read, status ) word, ch byte; /* Read the next byte from the file */ bytes$read = rq$s$read$move( file, @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 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, status ) 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 */ if ( info.len = 0 ) then /* there are no more filenames */ do; /* Delete the file connection */ call rq$s$delete$connection( file$list, @status ); call check$status( status ); end; 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 ); 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; 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; write$char: procedure( file, ch ) public; /* * Write the character CH out to the file specified by FILE * (which must be a connection open for writing). */ declare file token, ch byte, ( bytes$written, status ) word; bytes$written = rq$s$write$move( file, @ch, 1, @status ); call check$status( status ); end write$char; 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 ); end do$help; end kermit$sys;