<<< help.p86 >>> $large help: do; /* * HELP Utility Program * by Albert J. Goodman; Edit date: 30-July-85 * * Gives help on a topic specified on the command line. The * format of the command line is one or more keywords (separated * by one or more spaces and/or tabs), where each keyword after * the first is treated as a subtopic of topic specified by the * preceeding keyword(s). Topic keywords may be abbreviated by any * amount; if an abbreviation is given which matches the beginning * of more than one topic in the help library file, the first matching * topic will be displayed. If the first keyword begins with an * at-sign (@) the remainder of it is assumed to be the complete * pathname of the help library to be used for the source of the * help information. If the command line does not begin with an * at-sign, the default help library will be used, which has the * same name (presumably HELP) and directory as this program with * the extension ".HLP". The information required to create a * help library file is given below: * * A help library is conceptually a tree structure, with a root * help message and a list of subtopics, and similarly a help * message and a list of sub-subtopics for each of the subtopics, * and so on. The structure of a help library file is defined by * control lines beginning with a delimiter character (which may * nevertheless be used freely within help text if not at the * beginning of a line). Each help file has its own delimiter * character (which may be any character desired, but should not * be a digit because it's used to delimit numbers), defined by the * first character of the file. The remainder of the first line * of the file is ignored (thus it may be used for identification * of author, date, or other comments). Normal control lines each * begin with the delmiter, followed by a (decimal) number indicating * the nesting level of the help which follows this control line, * followed by the delimiter again to mark the end of the number. * A nesting level of one means a subtopic of the root; in other words, * the nesting level is the position of the associated keyword in a * command line (which may range from 1 to MAX$KEYWORDS minus one). * The rest of the control line contains the (sub)topic keyword for that * level which identifies the help text which follows this control line. * Thus the file begins with the delimiter on a line the rest of which * is ignored; following that comes zero or more lines of root help * text, terminated by the next line beginning with the delimiter; this * should contain the first subtopic keyword and a nesting level of * one. All sub-subtopic control lines are taken to be subtopics of * the most recent previous control line with a nesting level one * lower than theirs. Finally, the last help text in the file (for * the deepest nested help under the last keyword at each level above * it) must be terminated by a special control line consisting of the * delimiter followed by the word END (in upper or lower case) followed * by a final occurrence of the delimter. This marks the end of the help * library file as far as the HELP program is concerned: anything in * the file after this control line will be ignored, and if the physical * end-of-file is encountered before this control line an error message * will be generated. Also, the HELP program will indent all help text * by an amount determined by its nesting level, so there is no need for * indentation in the help library file. Similarly, blank lines between * the control lines and the help text are supplied and thus need not be * in the file. */ /* Get the needed iRMX 86 system call external declarations */ $include(:I:NEXCEP.LIT) $include(:I:LTKSEL.LIT) $include(:I:IEXIOJ.EXT) $include(:I:NSTEXH.EXT) $include(:I:HGTIPN.EXT) $include(:I:HGTICN.EXT) $include(:I:ISRDMV.EXT) $include(:I:HSNCOR.EXT) $include(:I:HFMTEX.EXT) $include(:I:HGTCHR.EXT) $include(:I:HGTCMD.EXT) declare MAX$KEYWORDS literally '9', /* Maximum topic keywords + 1 */ MAX$KEYWORD$LEN literally '23', /* Maximum length of a keyword */ boolean literally 'byte', /* Another useful type */ TRUE literally '0FFh', /* Boolean constant */ FALSE literally '000h', /* ditto */ CR literally '0Dh', /* ASCII Carriage-return */ LF literally '0Ah', /* ASCII Line-feed character */ HT literally '09h', /* ASCII tab character */ status word, /* Used for every system call */ file$token token, /* Connection to the help library file */ delim byte, /* Special delimiter character in help file */ level byte, /* Current nesting level being scanned for */ char byte, /* Current character being scanned */ ( i, j ) byte, /* General-purpose array index or counters */ finished boolean, /* Whether finished giving help */ file$name structure( /* Buffer for help library file name */ len byte, ch( 50 ) byte), num$keywords byte, /* Number of keywords in KEYWORD buffer */ keyword( MAX$KEYWORDS ) structure( /* Buffer for topic keywords */ len byte, ch( MAX$KEYWORD$LEN ) byte), line$buffer structure( /* General-purpose line buffer */ len byte, ch( 80 ) byte); /* * * System-dependent utility procedures. * */ print: procedure( string$ptr ); /* * Print a string (length byte followed by that many * characters) on the console. */ declare string$ptr pointer; call rq$c$send$co$response( 0, 0, string$ptr, @status ); end print; new$line: procedure; /* * Get the cursor to a new line (i.e. print CR/LF). */ call print( @( 2,CR,LF ) ); end new$line; print$char: procedure( char ); /* * Print a single character (since PRINT only prints a string). */ declare char byte, string structure( len byte, ch byte); string.len = 1; /* Form a one-character string */ string.ch = char; call print( @string ); /* and print it */ end print$char; abort$program: procedure( error$msg$ptr, file$name$ptr ); /* * Abort the program, displaying the error message pointed to * by ERROR$MSG$PTR, followed by the string pointed to by * FILE$NAME$PTR in quotes, followed by " -- HELP aborted." * If FILE$NAME$PTR is zero then it is skipped (including the * quotes), and if ERROR$MSG$PTR is zero no message is displayed. */ declare ( error$msg$ptr, file$name$ptr ) pointer; if ( error$msg$ptr <> 0 ) then /* If we have an error message */ do; call print( error$msg$ptr ); /* Print error message */ if ( file$name$ptr <> 0 ) then /* we have a filename also */ do; call print( @( 2,' "' ) ); /* open quote */ call print( file$name$ptr ); /* the filename */ call print$char( '"' ); /* close quote */ end; call print( @( 17,' -- HELP aborted.' ) ); end; /* if ( error$msg$ptr <> 0 ) */ call new$line; /* Get to a new line to tidy up display */ call rq$exit$io$job( 0, 0, @status ); /* And exit the program */ end abort$program; check$status: procedure; /* * Check the exception code returned by a system call to the global * variable STATUS. If it is not E$OK, display the exception code * and mnemonic at the console and abort the program. */ if ( status <> E$OK ) then do; /* Handle an exceptional condition */ /* Get the exception code and mnemonic into the line buffer */ line$buffer.len = 0; /* Init to null string */ call rq$c$format$exception( @line$buffer, size( line$buffer ), status, 1, @status ); /* Display the error message and abort the program */ call abort$program( @line$buffer, 0 ); 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 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; end disable$exception$handler; open$file: procedure( name$ptr ) boolean; /* * 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 FILE$TOKEN. * Returns TRUE if the open was successful, otherwise it prints * an error message on the console describing the problem * encountered and returns FALSE. */ declare name$ptr pointer; /* Try to open the file */ file$token = rq$c$get$input$connection( name$ptr, @status ); if ( status = E$OK ) then /* we were successful */ return( TRUE ); else /* the operation failed */ return( FALSE ); /* an error message has already been displayed */ end open$file; read$char: procedure byte; /* * Return the next character from the file specified by the global * token FILE$TOKEN (which must be open for reading). * If end-of-file is encountered, it aborts the program with an * error message. */ declare bytes$read word, ch byte; /* Read the next byte from the file */ bytes$read = rq$s$read$move( file$token, @ch, 1, @status ); call check$status; if ( bytes$read = 0 ) then /* we ran into end-of-file */ call abort$program( @( 25,'Unexpected end-of-file in' ), @file$name ); else /* we got a character */ return( ch ); /* so return it */ end read$char; upcase: procedure( x ) byte; /* * Force an ASCII letter to upper-case; * a non-letter is returned unchanged. */ declare x byte; if ( ( x >= 'a' ) and ( x <= 'z' ) ) then /* it was lower-case */ return( x - 'a' + 'A' ); /* return the upper-case equivalent */ else /* it was anything else */ return( x ); /* just return it unchanged */ end upcase; read$number: procedure byte; /* * Read a number from the file, terminated by the delimiter. * If the characters up to the next delimiter do not form an * integer (i.e. contain a non-digit--other than the word END-- * or contain no characters at all), abort with an appropriate * error message; otherwise, return the value of the number. * The file pointer is left after the terminating delimiter. * If the "number" consists of the word END, zero is returned. * (Otherwise the number is in base 10.) If the number has * more than 8 characters it will be truncated. */ declare num byte, i byte, string structure( len byte, ch( 8 ) byte); string.len = 0; string.ch( string.len ) = read$char; /* Read first char of number */ do while ( string.ch( string.len ) <> delim ); /* Read rest of number */ if ( string.len < last( string.ch ) ) then /* room for more digits */ string.len = ( string.len + 1 ); /* move to next digit */ string.ch( string.len ) = read$char; /* Read next character */ end; /* do while ( string.ch( string.len ) <> delim ) */ num = 0; /* Init number to zero */ if ( string.len = 0 ) then /* we got nothing at all */ call abort$program( @( 17,'Missing number in' ), @file$name ); else if ( ( string.len <> 3 ) or ( upcase( string.ch( 0 ) ) <> 'E' ) or ( upcase( string.ch( 1 ) ) <> 'N' ) or ( upcase( string.ch( 2 ) ) <> 'D' ) ) then /* it's not END */ do i = 0 to ( string.len - 1 ); /* for each digit */ if ( ( string.ch( i ) < '0' ) or ( string.ch( i ) > '9' ) ) then do; /* Handle error of non-digit */ call print( @( 16,'Invalid number "' ) ); call print( @string ); /* show what we got */ call abort$program( @( 4,'" in' ), @file$name ); end; /* if ... -- it's not a digit */ /* Combine this digit into the number */ num = ( ( num * 10 ) + ( string.ch( i ) - '0' ) ); end; /* do i = 0 to ( string.len - 1 ) */ return( num ); /* Return the number we got (zero if it was END) */ end read$number; read$line: procedure; /* * Read the current line from the file into the global LINE$BUFFER * up to the next LF (line-feed) character. */ declare ch byte; line$buffer.len = 0; line$buffer.ch( line$buffer.len ) = read$char; /* Read first char */ do while ( line$buffer.ch( line$buffer.len ) <> LF ); if ( line$buffer.len < last( line$buffer.ch ) ) then line$buffer.len = ( line$buffer.len + 1 ); /* Bump len if room */ line$buffer.ch( line$buffer.len ) = read$char; /* Read next char */ end; /* do while ( line$buffer.ch( line$buffer.len ) <> LF ) */ line$buffer.len = ( line$buffer.len + 1 ); /* Count final char (LF) */ end read$line; skip$text: procedure; /* * Skip a single help text entry. That is, read and discard lines * from the file until reaching a line which begins with DELIM. * The file pointer will be left just after this character, i.e. * the second character of the control line. If the first character * read at the current position is DELIM, only that character will * be read (i.e. it is assumed that we are at the beginning of a * line now). */ declare ch byte; ch = read$char; /* Get first character of this line */ do while ( ch <> delim ); /* As long as it's not a control line */ call read$line; /* Skip that line */ ch = read$char; /* And check on the next one */ end; /* do while ( ch <> delim ) */ end skip$text; keyword$match: procedure( knum ) boolean; /* * Compare KEYWORD( KNUM ) with the contents of LINE$BUFFER. * Return TRUE if they match (the keyword may be an abbreviation * of LINE$BUFFER), FALSE otherwise. */ declare ( knum, i ) byte; i = 0; do while ( ( i < keyword( knum ).len ) and ( i < line$buffer.len ) and ( line$buffer.ch( i ) <> CR ) ); if keyword( knum ).ch( i ) <> upcase( line$buffer.ch( i ) ) then return( FALSE ); /* Don't match */ i = ( i + 1 ); /* check next character */ end; /* do while ... */ if ( i < keyword( knum ).len ) then /* keyword too long */ return( FALSE ); else /* It matches */ return( TRUE ); end keyword$match; print$spaces: procedure( num ); /* * Print NUM spaces (i.e. indent by that many characters). * NUM must be no more than 20 unless the length of SPACES * (below) is increased. */ declare num byte, spaces(*) byte data( 20,' ' ), count byte at ( @spaces ); count = num; /* Set the length to be printed this time */ call print( @spaces ); /* Print COUNT spaces */ end print$spaces; show$line: procedure( level, char, line$ptr ); /* * Display the string pointed to by LINE$PTR, preceeded by the * character CHAR, indented appropriately for LEVEL of nesting. */ declare ( level, char ) byte, line$ptr pointer; call print$spaces( 2 * level ); /* Indent two spaces per level */ if ( char <> 0 ) then /* if we got a leading charcter */ call print$char( char ); /* Display it */ call print( line$ptr ); /* And print the line */ end show$line; /* * * Main program -- HELP * */ call new$line; /* Leave a blank line */ call disable$exception$handler; /* Parse the command line */ char = ' '; /* Insure at least one pass through the WHILE loop: */ do while ( char = ' ' ); /* Until we get the first non-space */ char = rq$c$get$char( @status ); /* Get next char from command line */ call check$status; end; /* do while ( char = ' ' ) */ if ( char = '@' ) then /* We have a help library filespec */ do; /* Get the filespec into the filename buffer */ call rq$c$get$input$path$name( @file$name, size( file$name ), @status ); call check$status; if ( file$name.len = 0 ) then /* no pathname there */ call abort$program( @( 34,'No help library pathname follows @' ), 0 ); char = rq$c$get$char( @status ); /* And get next character */ call check$status; end; /* if ( char = '@' ) */ else /* No at-sign, so use default help library */ do; /* Get its name into the filename buffer */ /* Get the name of the file containing this program */ call rq$c$get$command$name( @file$name, size( file$name ), @status ); call check$status; /* Append the .HLP suffix to it, forming the name of the help library */ call movb( @( '.HLP' ), @file$name.ch( filename.len ), 4 ); file$name.len = ( file$name.len + 4 ); end; /* else -- no at-sign */ if ( open$file( @file$name ) ) then /* Open the help library file */ do; /* Successfully opened, so parse rest of command line and give help */ i = 0; /* Start with the first keyword */ keyword( i ).len = 0; /* Init first keyword to null */ do while ( ( char <> 0 ) and ( char <> CR ) ); /* until end of line */ if ( ( char = HT ) or ( char = ' ' ) ) then /* it's a space or tab */ do; if ( keyword( i ).len > 0 ) then /* end of this keyword */ do; if ( i < last( keyword ) ) then i = ( i + 1 ); /* Move to next keyword */ keyword( i ).len = 0; /* and init it to null */ end; /* if ( keyword( i ).len > 0 ) */ /* else ignore redundant space or tab */ end; /* if ( ( char = HT ) or ( char = ' ' ) ) */ else /* non-space and non-tab character */ do; if ( keyword( i ).len < size( keyword.ch ) ) then do; /* Store character of keyword, capitalized */ keyword( i ).ch( keyword( i ).len ) = upcase( char ); keyword( i ).len = ( keyword( i ).len + 1 ); end; /* if ( keyword( i ).len < size( keyword.ch ) ) */ end; /* else -- non-space and non-tab character */ char = rq$c$get$char( @status ); /* Get the next character */ end; /* do while ( ( char <> 0 ) and ( char <> CR ) ) */ if ( ( keyword( i ).len > 0 ) and ( i < last( keyword ) ) ) then i = ( i + 1 ); /* Count final keyword */ num$keywords = i; /* Save number of keywords we got */ /* Begin reading help library file */ char = read$char; /* Get first character of file (special delimiter) */ delim = char; /* Save special delimiter for this file */ call read$line; /* Discard the rest of the first line */ level = 1; /* Init level number we're looking for */ finished = FALSE; /* not finished yet */ do while ( not finished ); /* until we're finished giving help */ if ( num$keywords >= level ) then /* got a keyword for this level */ do; call skip$text; /* Skip previous entry */ i = read$number; /* Get nesting level for next entry */ call read$line; /* And read its keyword */ if ( i < level ) then /* found an entry at a lower level */ do; call show$line( level, 0, @( 28,'Sorry, no help available on' ) ); do i = 0 to ( level - 1 ); call print$char( ' ' ); call print( @keyword( i ) ); end; /* do i = 0 to ( level - 1 ) */ call new$line; finished = TRUE; /* No more help to give on this topic */ end; /* if ( i < level ) */ else if ( i = level ) then /* found entry for level we want */ do; if keyword$match( level - 1 ) then /* keyword matches */ do; /* Show matching keyword */ call show$line( level, 0, @line$buffer ); call new$line; /* And leave a blank line */ level = ( level + 1 ); /* And go to next lower level */ end; /* if keyword$match( level - 1 ) */ end; /* if ( i = level ) */ end; /* if ( num$keywords >= level ) */ else if ( num$keywords = ( level - 1 ) ) then do; /* Display selected help text */ char = read$char; /* Get first char */ do while ( char <> delim ); /* Until next control line */ call read$line; /* Read the rest of this line of text */ call show$line( level, char, @line$buffer ); /* show it */ char = read$char; /* Read first char of next line */ end; /* do while ( char <> delim ) */ i = read$number; /* Get level of next entry */ if ( i < level ) then /* not a subtopic of selected entry */ finished = TRUE; /* no subtopics, so nothing more to do */ else /* we have subtopic(s) to list */ do; call new$line; /* Leave a blank line */ call show$line( level, 0, @( 28,'Further help available on:',CR,LF ) ); call new$line; /* And leave another blank line */ level = ( level + 1 ); /* Set level to list subtopics */ call read$line; /* Read first subtopic keyword */ line$buffer.len = ( line$buffer.len - 2 ); /* Remove CR/LF */ j = line$buffer.len; /* Save chars so far on this line */ call show$line( level, 0, @line$buffer ); /* show keyword */ end; /* else -- we have to list subtopics */ end; /* if ( num$keywords = ( level - 1 ) ) */ else /* we must be listing subtopics */ do; call skip$text; /* Skip previous entry */ i = read$number; /* Get nesting level for next entry */ call read$line; /* Read its keyword */ line$buffer.len = ( line$buffer.len - 2 ); /* And remove CR/LF */ if ( i < ( level - 1 ) ) then /* found entry at a lower level */ do; /* So no more subtopics of selected entry */ call new$line; /* Finish last line of list */ finished = TRUE; /* And we're all done */ end; /* if ( i < ( level - 1 ) ) */ else if ( i = ( level - 1 ) ) then /* found right level entry */ do; /* Show another subtopic keyword */ if ( j > 60 ) then /* time to start a new line (60=4*15) */ do; call new$line; call show$line( level, 0, @line$buffer ); j = line$buffer.len; /* Count chars on this line */ end; /* if ( j > 48 ) */ else /* Make another entry on this line */ do; call print$spaces( 15 - ( j mod 15 ) ); /* align columns */ j = ( j + ( 15 - ( j mod 15 ) ) + line$buffer.len ); call print( @line$buffer ); end; /* else -- continue this line */ end; /* if ( i = ( level - 1 ) ) */ end; /* else -- listing subtopics */ end; /* do while ( not finished ) */ /* Finished giving help on the selected topic */ end; /* if ( open$file( @file$name ) ) */ else /* Error occurred when opening file, abort with message. */ call abort$program( @( 30,'Can''t access help library file' ), @file$name ); call abort$program( 0, 0 ); /* Exit with no error message */ end help; <<< itemize.p86 >>> $large itemize: do; /* * This program copies each pathname given by the input filespec * to the corresponding output file. It is intended to be used * with a single output file and a wild-card input pathname, in * which case it places in that output file all pathnames matching * the input filespec. * * by Albert J. Goodman; Edit date: 30-July-1985 */ /* Get the needed iRMX 86 system call external declarations */ $include(:I:NEXCEP.LIT) $include(:I:LTKSEL.LIT) $include(:I:IEXIOJ.EXT) $include(:I:NSTEXH.EXT) $include(:I:HGTIPN.EXT) $include(:I:HGTOPN.EXT) $include(:I:HGTOCN.EXT) $include(:I:ISWRMV.EXT) $include(:I:ISCLOS.EXT) $include(:I:ISDLCN.EXT) declare CR literally '0Dh', /* ASCII Carriage-return character */ LF literally '0Ah', /* ASCII Line-feed character */ ( input$pathname, output$pathname ) structure( len byte, ch(80) byte), output$preposition byte, output$connection token, ( bytes$written, status ) word, exception$handler$info structure( offset word, base word, mode byte); check$excep: procedure; /* Check for an exception code */ if ( status <> E$OK ) then /* we got an exceptional condition */ call rq$exit$io$job( status, 0, @status ); /* abort the program */ end check$excep; /* begin ITEMIZE */ /* Disable our exception handler, so control never passes to it. */ exception$handler$info.offset = 0; exception$handler$info.base = 0; exception$handler$info.mode = 0; call rq$set$exception$handler( @exception$handler$info, @status ); call check$excep; /* get the first input pathname */ call rq$c$get$input$pathname( @input$pathname, size( input$pathname ), @status ); call check$excep; /* while we have any more pathnames */ do while ( input$pathname.len > 0 ); /* Get the matching output pathname (default to command output) */ output$preposition = rq$c$get$output$pathname( @output$pathname, size( output$pathname ), @( 7,'TO :CO:' ), @status ); call check$excep; /* Get a connection to the output file */ output$connection = rq$c$get$output$connection( @output$pathname, output$preposition, @status ); call check$excep; /* Copy the input pathname to the output file */ bytes$written = rq$s$write$move( output$connection, @input$pathname.ch, input$pathname.len, @status ); call check$excep; /* Append a carriage-return/line-feed line terminator */ bytes$written = rq$s$write$move( output$connection, @( CR,LF ), 2, @status ); call check$excep; /* Close the output file */ call rq$s$close( output$connection, @status ); call check$excep; /* And delete the output connection */ call rq$s$delete$connection( output$connection, @status ); call check$excep; /* Get the next input pathname, if any */ call rq$c$get$input$pathname( @input$pathname, size( input$pathname ), @status ); call check$excep; end; /* do while ( input$pathname.len > 0 ) */ /* Terminate the program, signalling O.K. */ call rq$exit$io$job( E$OK, 0, @status ); end itemize; <<< kermit.csd >>> ; KERMIT.CSD (AJG, 22-August-85) ; This command file is used to compile and link Kermit. ; Invoke it with the command ; SUBMIT KERMIT.CSD ; (All Kermit files are assumed to be in the default directory.) ; ; Compile all Kermit modules: PLM86 KERMIT.P86 PLM86 KERUTIL.P86 PLM86 KERSYS.P86 ; Link the Kermit modules together and to the system interface libraries: LINK86 KERMIT.OBJ, & KERUTIL.OBJ, & KERSYS.OBJ, & /RMX86/LIB/HPIFL.LIB, & /RMX86/LIB/LPIFL.LIB, & /RMX86/LIB/EPIFL.LIB, & /RMX86/LIB/IPIFL.LIB, & /RMX86/LIB/RPIFL.LIB & TO KERMIT OBJECTCONTROLS(PURGE) BIND & SEGSIZE(STACK(+800H)) MEMPOOL(+10H,+40000H) ; ; Finished. Kermit may now be run by typing KERMIT. ; <<< kermit.hlp >>> ~ iRMX-86 Kermit help library file (by Albert J. Goodman, revised 22-Aug-85) This is iRMX-86 Kermit, a file transfer utility. It can be used to transfer text files to or from any system which has an implementation of Kermit, as well as to make this system act as a "virtual terminal" to a remote system. Refer to the Kermit Users Guide for general information about Kermit. To obtain a list of commands type ? and press [RETURN] at the Kermit prompt. Similarly, any keyword in a command may be replaced by a ? to obtain a list of possible keywords which may go in that position. The only exceptions are the SEND and GET commands; anything following these commands (including a single ?) is treated as a filespec (file specification). Any command or keyword may be abbreviated as long as it is unambiguous. To obtain detailed help on any command type HELP followed by the name of the command. ~1~EXIT The EXIT command is used to leave the Kermit program and return to the local operating system. It has no effect on the remote system. ~1~SEND The SEND command is used to send one or more files to the remote system. Before giving the SEND command you should have given a RECEIVE or SERVER command to the remote Kermit. The word SEND should be followed by the name(s) of the file(s) to be sent. Normally one name is given, possibly with wild-cards to specify more than one file: a "?" will match any single character in its position and a "*" will match any number of characters (including zero). Thus, for example, the command "SEND ?" will send all files with one-letter names and the command "SEND *" will send all files (in the default directory). You may also specify more than one file name, but if you do so you must separate the names with commas and you must NOT include any spaces before or after the commas. A directory pathname or logical name (enclosed in colons) may preceed any filename. The filename (but not the directory if specified) will be sent to the remote Kermit to allow the file to be stored with the same name on the remote system. (You can expect a short delay after giving the SEND command before seeing the first message telling you what file is being sent.) ~1~RECEIVE The RECEIVE command is used to receive files being sent by the remote Kermit. Before giving the RECEIVE command you should have given a SEND command to the remote Kermit. If you wish to get files from a Kermit server you should use the GET command. RECEIVE will display the name of each file as it receives it, and it will store the files, under the name sent by the remote Kermit, in your current default directory. ~1~GET The GET command is used to request a remote Kermit server to send files to the local system. To receive files from a remote Kermit which is not a server you must use the RECEIVE command. GET must be followed by the filespec for the files on the remote system. Whether this filespec may contain wild-cards to get more than one file with a single command (and in fact the entire form of the filespec) depends on the remote Kermit. GET will display the name of each file received and store the files, under the name sent by the remote Kermit, in your current default directory. ~1~CONNECT The CONNECT command is used to make Kermit act as a "virtual terminal" to the remote system. After this command is given your terminal will behave like a terminal directly connected to the remote system, except for the "escape" character (see HELP CONNECT Escape). (However, some control characters have special meaning to the iRMX-86 and thus they will be intercepted by it and cannot be sent to the remote system; also the break key, which is not a character, cannot be sent.) CONNECT is usually used to log on to the remote system and start up the remote Kermit to allow a file transfer operation to begin. To leave connect mode and resume talking to the local Kermit, press the escape character followed by the letter C. ~2~Escape-character The escape character is used to talk to the local Kermit while in connect mode. By default it is (which means to hold down the "control" key while pressing the right bracket key "]"), but it may be changed if necessary by the SET ESCAPE command. It should be something not usually used in communication with the remote system. When the escape character is pressed, the local Kermit looks at the next character typed to determine what action to take. If the next character is: Kermit will: C (in upper or lower case) Close the connection, returning you to the local Kermit's command level. the escape character again Send the escape character itself to the remote system. ? (or in fact anything else) Display a brief message summarizing these options and continue the connection. If nothing is typed after the escape character for about 5 seconds, Kermit will act as if a ? was typed. ~1~BYE The BYE command is only used after exchanging files with a remote Kermit server. It tells the remote server to shut down and log itself out. After receiving an acknowledgement that this is being done, iRMX-86 Kermit will exit to the local operating system. (BYE is equivalent to LOGOUT followed by EXIT.) This prevents the need to connect back to the remote system to log out. ~1~LOGOUT The LOGOUT command is only used after exchanging files with a remote Kermit server. It tells the remote server to shut down and log itself out. After receiving an acknowledgement that this is being done, iRMX-86 Kermit will say "Ok" and prompt for another command. This prevents the need to connect back to the remote system to log out. This command is similar to BYE but leaves you at the local Kermit command level. ~1~FINISH The FINISH command is only used after exchanging files with a remote Kermit server. It tells the remote server to shut down (stop behaving as a server) but not to log out. Thus you may follow this command with CONNECT and you will be able to give further commands to the remote system. ~1~SET The SET command is used to set various flags and parameters which affect how iRMX-86 Kermit behaves. ~2~BEEP This determines whether Kermit will beep to alert you that it has finished a file transfer. If BEEP is set ON, Kermit will beep after finishing, either successfully or unsuccessfuly, any SEND, RECEIVE, or GET command. If BEEP is set OFF you will not hear any beeps. The initial state is BEEP ON. ~2~DEBUG This determines whether debugging information is displayed on the screen. If DEBUG is set ON, each packet sent or received will be displayed on the screen. DEBUG is normally OFF. ~2~ESCAPE This command sets the escape character used in CONNECT to get the attention of the local Kermit. SET ESCAPE must be followed by a decimal number representing the ASCII value of the new escape character desired. (The default escape character, , is ASCII 29.) See HELP CONNECT Escape-character for more information about the escape character. ~2~RETRY This command sets the maximum number of times iRMX-86 Kermit will attempt to send or receive a packet before giving up and aborting the operation. SET RETRY must be followed by a decimal number. Typical values are in the range 5 to 20; the initial value is 10. ~2~PACKET-LENGTH This command sets the maximum-length packet for Kermit to send. Actually, this value will not necessarily be used; iRMX-86 Kermit will send packets up to the size requested by the remote Kermit. Note that PACKET-LENGTH must NOT be set greater than 94! (It usually does not need to be set at all.) ~2~TIMEOUT This command sets the number of seconds to wait for a character from the remote system. (If no character is received within this time limit, the packet is assumed lost but the entire operation is not terminated unless this occurs a certain number of times--see HELP SET RETRY.) SET TIMEOUT must be follwed by the number of seconds desired (in decimal). Typical values are in the range 5 to 15; the intial value is 10. This parameter may be modified during a transaction by the remote Kermit, but may need to be set to get the first packet across. ~2~PADDING This command sets the number of padding characters to send between packets. It must be follwed by a decimal number. The intial (and typical) value is zero. This parameter may be modified during a transaction by the remote Kermit, but may need to be set to get the first packet across. ~2~PADCHAR This command sets the padding character to be sent between packets (if any padding is needed--see HELP SET PADDING). It must be followed by a decimal number representing the ASCII value of the character desired. The initial (and typical) value is ASCII 0, a null. This parameter may be modified during a transaction by the remote Kermit, but may need to be set to get the first packet across. ~2~END-OF-LINE This command sets the "end-of-line" character sent after each packet. SET END-OF-LINE must be followed by a decimal number giving the ASCII value of the character desired. The typical and initial value is ASCII 13, a carriage-return. This parameter may be modified during a transaction by the remote Kermit, but may need to be set to get the first packet across. ~2~QUOTE This command sets the prefix quoting character used to "quote" control characters in the files being sent. SET QUOTE must be follwed by a decimal number giving the ASCII value of the desired character. Normally the quote character is "#", ASCII 35. This can be changed by the remote Kermit during a transaction, and should only be set if necessary to get the first packet across. ~1~SHOW The SHOW command can display the current value of any parameter which may be set by the SET command, as well as the version identification of Kermit. ~2~VERSION This command is used to display the version of Kermit which you are running. It displays the same line which is displayed upon first entering the Kermit program, which includes this Kermit's name, version number, date of last modification, and initials of the author. ~2~BEEP This displays the current state of the BEEP flag. See HELP SET BEEP for more information. ~2~DEBUG This displays the current state of the debug-mode flag. See HELP SET DEBUG for more information about the debug-mode flag. ~2~ESCAPE This displays the current escape character used in CONNECT to talk to the local Kermit. Both a representation of the charcter and its ASCII value are given. The character representation is also displayed upon executing the CONNECT command. See HELP CONNECT Escape-character for more information about the escape character. ~2~RETRY This displays the maximum number of retires which will currently be attempted on any packet. See HELP SET RETRY for more information. ~2~PACKET-LENGTH This displays the current maximum packet length which Kermit will send. See HELP SET PACKET-LENGTH for more information. ~2~TIMEOUT This displays the current number of seconds after which to time out (assume the current packet was lost) if no character is received. See HELP SET TIMEOUT for more information. ~2~PADDING This displays the number of padding characters currently being sent between packets. See HELP SET PADDING for more information. ~2~PADCHAR This displays the character currently being used for padding (if any padding is being done), both in character representation and its ASCII value. See HELP SET PADCHAR for more information. ~2~END-OF-LINE This displays the current "end-of-line" character sent after each packet, both in character representation and its ASCII value. See HELP SET END-OF-LINE for more information. ~2~QUOTE This displays the current control-quoting prefix character, both in character representation and its ASCII value. See HELP SET QUOTE for more information. ~2~ALL This command is used to show all the information which SHOW can show with a single command. ~1~HELP The HELP command gives information to help in using Kermit. Simply typing HELP gives a general message; HELP followed by a command name gives help on that command. Whenever you see "Further help available on:" you may get help on any of the topics listed by typing the HELP command you used to obtain that message followed by one of the keywords listed below it. Any keyword in a HELP command may be abbreviated; if the abbreviation matches more than one keyword help will be displayed on the first matching one. ~1~Control-characters Control characters are typed by holding down the key marked "Control" or "Ctrl" while pressing another key. They are usually written as CTRL/x (where x represents the other key) or . You may use the normal command line editing characters while entering commands to Kermit. However, CTRL/C, which normally aborts the program, will have no effect while entering commands to Kermit. It may be used, though, to abort most Kermit commands and return to the iRMX-86 Kermit prompt. ~1~Ports Version 2.41 of iRMX-86 Kermit assumes that the port to which the remote system is connected has been already attached with the logical name :KERMITPORT: (for example with the command ATTACHDEVICE T4 AS :KERMITPORT: PHYSICAL). The baud rate and other characteristics of the port must be set prior to running Kermit (for example in the system configuration). ~1~Summary Program: iRMX-86 Kermit Author: Albert J. Goodman, Grinnell College Machine: Intel System 86/310 Operating system: iRMX 86 Language: PL/M-86 Version: 2.41 Date: August 22, 1985 iRMX-86 Kermit Capabilities At A Glance: Local operation: Yes Remote operation: No Transfers text files: Yes Transfers binary files: No Wildcard send: Yes ^X/^Y interruption: No, but ^C interruption Filename collision avoidance: Yes Can time out: Yes 8th-bit prefixing: No Repeat count prefixing: No Alternate block checks: No Terminal emulation: Yes Communication settings: Only some packet parameters Transmit BREAK: No IBM mainframe communication: No Transaction logging: No Session logging: No Raw transmit: No Act as server: No Talk to server: Yes Advanced server functions: No Advanced commands for servers: No Local file management: No Handle file attributes: No Command/init files: No Command macros: No ~END~ <<< kermit.p86 >>> $large optimize(3) Kermit: do; /* * K e r m i t File Transfer Utility * * iRMX-86 Kermit, Version 2.41 * by Albert J. Goodman, Grinnell College * * Main module, containg the main program and all commands. * Edit date: 22-August-1985 */ declare /* CONSTANTS */ /* Useful text substitutions */ boolean literally 'byte', /* define a new type */ TRUE literally '0FFh', /* and constants */ FALSE literally '000h', /* of that type */ forever literally 'while TRUE', /* a WHILE condition */ /* ASCII control character constants */ NUL literally '00h', /* null */ SOH literally '01h', /* start-of-header */ CTRL$C literally '03h', /* CTRL/C */ BEL literally '07h', /* bell (beep) */ BS literally '08h', /* backspace */ HT literally '09h', /* horizontal tab */ LF literally '0Ah', /* line-feed */ CR literally '0Dh', /* carriage-return */ CTRL$R$BRAK literally '1Dh', /* CTRL/] */ DEL literally '7Fh', /* delete (rubout) */ /* String constants */ sign$on(*) byte data( 48, 'iRMX-86 Kermit, Version 2.41 (AJG, 22-Aug-85)',CR,LF ), prompt(*) byte data( 16, 'iRMX-86 Kermit> ' ), dots$string(*) byte data( 7, ' . . . ' ), ok$string(*) byte data( 2, 'Ok' ), currently$string(*) byte data( 14, ' is currently ' ), /* Defaults for various Kermit parameters */ def$esc$char literally 'CTRL$R$BRAK', def$max$retry literally '10', def$packet$len literally '80', def$time$limit literally '10', def$num$pad literally '0', def$pad$char literally 'NUL', def$eol literally 'CR', def$quote literally '''#''', /* GET$CONSOLE$CHAR return codes (see KERMIT$SYS) */ TIMEOUT literally '0FFFFh', /* Time limit expired */ CTRL$C$CODE literally '08003h', /* CTRL/C abort */ /* Other constants */ MAX$PACKET$LEN literally '94', CONNECT$ESC$TIME$LIMIT literally '5', /* GLOBAL VARIABLES */ /* Kermit parameters */ beep boolean, /* Whether to beep when finished */ debug boolean public, /* Whether we're debugging the program */ max$retry byte public, /* Maximum number of times to retry a packet */ packet$len byte public, /* The maximum length packet to send */ time$limit byte public, /* Seconds to time out if nothing received */ num$pad byte public, /* The number of padding characters to send */ pad$char byte public, /* The padding character to send */ eol byte public, /* The EOL (end-of-line) character to send */ quote byte public, /* The control-quote character to be used */ esc$char byte, /* The "escape" character for CONNECT */ /* Other Kermit variables */ state byte public, /* Current state (see Kermit Protocol Manual) */ seq byte public, /* The current sequence number (0 to 63) */ tries byte public, /* Number of times current packet retried */ /* Buffers */ info structure( /* Buffer for the contents of a packet */ len byte, ch(MAX$PACKET$LEN) byte), info2 structure( /* Another packet buffer */ len byte, ch(MAX$PACKET$LEN) byte), /* Possible command keywords */ q$mark(*) byte data( 1, '?' ), exit$string(*) byte data( 4, 'EXIT' ), help$string(*) byte data( 4, 'HELP' ), send$string(*) byte data( 4, 'SEND' ), receive$string(*) byte data( 7, 'RECEIVE' ), get$string(*) byte data( 3, 'GET' ), connect$string(*) byte data( 7, 'CONNECT' ), bye$string(*) byte data( 3, 'BYE' ), logout$string(*) byte data( 6, 'LOGOUT' ), finish$string(*) byte data( 6, 'FINISH' ), set$string(*) byte data( 3, 'SET' ), show$string(*) byte data( 4, 'SHOW' ), beep$string(*) byte data( 4, 'BEEP' ), debug$string(*) byte data( 5, 'DEBUG' ), on$string(*) byte data( 2, 'ON' ), off$string(*) byte data( 3, 'OFF' ), escape$string(*) byte data( 6, 'ESCAPE' ), retry$string(*) byte data( 5, 'RETRY' ), packet$len$string(*) byte data( 13, 'PACKET-LENGTH' ), timeout$string(*) byte data( 7, 'TIMEOUT' ), padding$string(*) byte data( 7, 'PADDING' ), padchar$string(*) byte data( 7, 'PADCHAR' ), end$of$line$string(*) byte data( 11, 'END-OF-LINE' ), quote$string(*) byte data( 5, 'QUOTE' ), version$string(*) byte data( 7, 'VERSION' ), all$string(*) byte data( 3, 'ALL' ), /* Command and parameter lists */ command$list(*) pointer data( @exit$string, @send$string, @receive$string, @get$string, @connect$string, @bye$string, @logout$string, @finish$string, @set$string, @show$string, @help$string ), set$param$list(*) pointer data( @beep$string, @debug$string, @escape$string, @retry$string, @packet$len$string, @timeout$string, @padding$string, @padchar$string, @end$of$line$string, @quote$string ), show$param$list(*) pointer data( @version$string, @beep$string, @debug$string, @escape$string, @retry$string, @packet$len$string, @timeout$string, @padding$string, @padchar$string, @end$of$line$string, @quote$string, @all$string ), on$off$list(*) pointer data( @on$string, @off$string ), /* Comand parsing information (defined in KERMIT$UTIL) */ num$keywords byte external; /* Number of keywords found */ /* External procedures defined in KERMIT$SYS */ get$console$char: procedure( time$limit ) word external; declare time$limit word; end get$console$char; xmit$console$char: procedure( ch ) external; declare ch byte; end xmit$console$char; get$remote$char: procedure( time$limit ) word external; declare time$limit word; end get$remote$char; xmit$remote$char: procedure( ch ) external; declare ch byte; end xmit$remote$char; flush$input$buffer: procedure external; end flush$input$buffer; print: procedure( string$ptr ) external; declare string$ptr pointer; end print; new$line: procedure external; end new$line; exit$program: procedure external; end exit$program; setup: procedure external; end setup; get$first$file$name: procedure( keyword$num, info$ptr ) external; declare keyword$num byte, info$ptr pointer; end get$first$file$name; get$next$file$name: procedure( info$ptr ) external; declare info$ptr pointer; end get$next$file$name; finish$send: procedure external; end finish$send; prepare$file$name: procedure( info$ptr ) external; declare info$ptr pointer; end prepare$file$name; open$file: procedure( name$ptr ) boolean external; declare name$ptr pointer; end open$file; create$file: procedure( name$ptr ) boolean external; declare name$ptr pointer; end create$file; close$file: procedure external; end close$file; get$command$line: procedure( prompt$ptr ) external; declare prompt$ptr pointer; end get$command$line; do$help: procedure( num$params ) external; declare num$params byte; end do$help; /* External procedures defined in KERMIT$UTIL */ upcase: procedure( x ) byte external; declare x byte; end upcase; next$seq: procedure( seq$num ) byte external; declare seq$num byte; end next$seq; previous$seq: procedure( seq$num ) byte external; declare seq$num byte; end previous$seq; show$char: procedure( ch ) external; declare ch byte; end show$char; show$dec$num: procedure( num ) external; declare num word; end show$dec$num; show$flag: procedure( flag ) external; declare flag boolean; end show$flag; send$packet: procedure( type, num, info$ptr ) external; declare ( type, num ) byte, info$ptr pointer; end send$packet; receive$packet: procedure( num$ptr, info$ptr ) byte external; declare ( num$ptr, info$ptr ) pointer; end receive$packet; send$kermit$params: procedure( info$ptr ) external; declare info$ptr pointer; end send$kermit$params; get$kermit$params: procedure( info$ptr ) external; declare info$ptr pointer; end get$kermit$params; read$packet$from$file: procedure( info$ptr ) external; declare info$ptr pointer; end read$packet$from$file; write$packet$to$file: procedure( info$ptr ) external; declare info$ptr pointer; end write$packet$to$file; error$msg: procedure( msg$ptr ) external; declare msg$ptr pointer; end error$msg; unknown$packet$type: procedure( type, packet$ptr ) external; declare type byte, packet$ptr pointer; end unknown$packet$type; too$many$retries: procedure external; end too$many$retries; wrong$number: procedure external; end wrong$number; parse$command: procedure external; end parse$command; parse$dec$num: procedure( keyword$num, num$ptr ) boolean external; declare keyword$num byte, num$ptr pointer; end parse$dec$num; show$command: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end show$command; too$few$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end too$few$params; too$many$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end too$many$params; extra$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end extra$params; invalid$param: procedure( k$num, kp1, kp2, kp3 ) external; declare k$num byte, ( kp1, kp2, kp3 ) pointer; end invalid$param; keyword$match: procedure( keyword$num, keyword$ptr, min$len ) boolean external; declare ( keyword$num, min$len ) byte, keyword$ptr pointer; end keyword$match; list$choices: procedure( kp1, kp2, kp3, list$ptr, list$last ) external; declare ( kp1, kp2, kp3, list$ptr ) pointer, list$last byte; end list$choices; get$filespec: procedure( keyword$num, info$ptr ) external; declare keyword$num byte, info$ptr pointer; end get$filespec; send$generic$command: procedure( info$ptr, info2$ptr ) boolean external; declare ( info$ptr, info2$ptr ) pointer; end send$generic$command; /* * * Command implementation procedures * */ exit: procedure; /* * Implement the EXIT command. */ if ( num$keywords > 1 ) then /* a parameter followed EXIT */ call too$many$params( @exit$string, 0, 0 ); else call exit$program; end exit; connect: procedure; /* * Implement the CONNECT command by performing as a virtual * terminal to the remote system. Everything coming from the * remote computer is sent out to the console screen, and * everything typed on the console keyboard, except for the * "escape" character, is passed through to the remote system. * The escape character is by default; it can be * set by the SET ESCAPE command. * If the escape character is followed by "C" (in upper or * lower case) the connection is closed and you are returned to * the local Kermit's command level. * If the escape character is followed by itself (i.e. it * is typed twice) it will be sent (once) to the remote system, * since this is the only way to send the escape character to * the remote system in CONNECT. * If the escape character is followed by anything else, or * if nothing is typed on the console within CONNECT$ESC$TIME$LIMIT * seconds after the escape character, a message will be displayed * explaining the options and the connection will be continued. */ declare keep$connected boolean, ch word; /* Current character (or TIMEOUT) */ if ( num$keywords > 1 ) then /* a parameter followed CONNECT */ call too$many$params( @connect$string, 0, 0 ); else do; /* Keep the user informed of what we're doing */ call print( @( 37,'[ Connecting to remote system; type "' ) ); call show$char( esc$char ); call print( @( 31,'C" to return to local Kermit. ]' ) ); call new$line; call new$line; /* Leave a blank line */ /* begin the virtual terminal loop */ keep$connected = TRUE; do while ( keep$connected ); /* Get the next character (if any) from the remote system */ ch = get$remote$char( 0 ); /* don't wait */ if ( ch <> TIMEOUT ) then /* we got a character */ call xmit$console$char( ch ); /* so print it on the console */ /* Get the next character (if any) from the console */ ch = get$console$char( 0 ); /* don't wait */ if ( ch <> TIMEOUT ) then /* we got a character */ do; /* Handle the console character */ if ( ch = esc$char ) then /* we got the escape character */ do; /* Handle the escape sequence */ /* Get the next character from the console */ ch = get$console$char( CONNECT$ESC$TIME$LIMIT ); if ( upcase( ch ) = 'C' ) then /* If it was C */ keep$connected = FALSE; /* Close the connection */ else if ( ch = esc$char ) then /* They typed it twice */ /* Send the escape character to the remote system */ call xmit$remote$char( esc$char ); else /* Otherwise tell them what's going on */ do; call new$line; call print( @( 19,'[ You are connected' ) ); call print( @( 22,' to the remote system.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call print( @( 25,'C" to return to the local' ) ); call print( @( 24,' Kermit''s command level.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call show$char( esc$char ); call print( @( 12,'" to send a ' ) ); call show$char( esc$char ); call print( @( 22,' to the remote system.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call print( @( 23,'?" to see this message.' ) ); call new$line; call print( @( 26,' Connection continuing. ]' ) ); call new$line; end; /* else */ end; /* if ( ch = esc$char ) */ else if ( ch = CTRL$C$CODE ) then /* we got a CTRL/C */ call xmit$remote$char( CTRL$C ); /* so send one */ else /* we got an ordinary character from the console */ call xmit$remote$char( ch ); /* Send it to remote system */ end; /* if ( ch <> TIMEOUT ) */ end; /* do while ( keep$connected ) */ /* Keep the user informed */ call new$line; call print( @( 21,'[ Connection closed, ' ) ); call print( @( 23,'back at local Kermit. ]' ) ); end; /* else -- no parameter */ end connect; bye: procedure; /* * Implement the BYE command. */ if ( num$keywords > 1 ) then /* a parameter followed BYE */ call too$many$params( @bye$string, 0, 0 ); else do; /* Perform the BYE command */ /* Send Generic Kermit Logout/bye command */ if send$generic$command( @( 1,'L' ), @info2 ) then call exit$program; /* ACK'd O.K., so exit the program--bye! */ call new$line; call error$msg( @( 15,'Command failed.' ) ); end; /* else */ end bye; finish: procedure; /* * Implement the FINISH command. */ if ( num$keywords > 1 ) then call too$many$params( @finish$string, 0, 0 ); else do; /* Send Generic Kermit Finish command */ if send$generic$command( @( 1,'F' ), @info2 ) then call print( @ok$string ); /* tell them it went O.K. */ else do; call new$line; call error$msg( @( 15,'Command failed.' ) ); end; end; /* else */ end finish; logout: procedure; /* * Implement the LOGOUT command. */ if ( num$keywords > 1 ) then call too$many$params( @logout$string, 0, 0 ); else do; /* Send the Generic Kermit Logout command */ if send$generic$command( @( 1,'L' ), @info2 ) then call print( @ok$string ); /* tell them it went O.K. */ else do; call new$line; call error$msg( @( 15,'Command failed.' ) ); end; end; /* else */ end logout; help: procedure; /* * Implement the HELP command. */ /* Invoke the HELP program */ call do$help( num$keywords - 1 ); end help; set: procedure; /* * Implement the SET command by dispatching to the appropriate * routine based on the second keyword (the parameter following SET). */ set$flag: procedure( kp2, flag$ptr ); /* * SET a flag. KP2 points to the flag's name and * FLAG$PTR points the the boolean variable to be set. * ON means set the flag TRUE, OFF means FALSE. */ declare ( kp2, flag$ptr ) pointer, flag based flag$ptr boolean; if ( num$keywords < 3 ) then call too$few$params( @set$string, kp2, 0 ); else if ( num$keywords > 3 ) then call extra$params( @set$string, kp2, 0 ); else if keyword$match( 2, @q$mark, 1 ) then call list$choices( @set$string, kp2, 0, @on$off$list, last( on$off$list ) ); else if keyword$match( 2, @on$string, 2 ) then do; flag = TRUE; call print( @ok$string ); end; else if keyword$match( 2, @off$string, 2 ) then do; flag = FALSE; call print( @ok$string ); end; else call invalid$param( 2, @set$string, kp2, 0 ); end set$flag; set$byte: procedure( kp2, byte$ptr ); /* * SET a byte variable. KP2 points to its name, BYTE$PTR * points to the byte variable. A decimal number is used. */ declare ( kp2, byte$ptr ) pointer, num based byte$ptr byte, new$num word; if ( num$keywords < 3 ) then call too$few$params( @set$string, kp2, 0 ); else if ( num$keywords > 3 ) then call extra$params( @set$string, kp2, 0 ); else if keyword$match( 2, @q$mark, 1 ) then do; call show$command( @set$string, kp2, 0 ); call print( @( 38,' must be followed by a decimal number.' ) ); end; /* if keyword$match( 2, @q$mark, 1 ) */ else do; if ( parse$dec$num( 2, @new$num ) ) then do; num = new$num; call print( @ok$string ); end; /* if -- valid number */ else call invalid$param( 2, @set$string, kp2, 0 ); end; /* else */ end set$byte; /* begin SET */ if ( num$keywords < 2 ) then /* there was no second keyword */ call too$few$params( @set$string, 0, 0 ); else if keyword$match( 1, @q$mark, 1 ) then call list$choices( @set$string, 0, 0, @set$param$list, last( set$param$list ) ); else if keyword$match( 1, @escape$string, 2 ) then call set$byte( @escape$string, @esc$char ); else if keyword$match( 1, @beep$string, 1 ) then call set$flag( @beep$string, @beep ); else if keyword$match( 1, @debug$string, 1 ) then call set$flag( @debug$string, @debug ); else if keyword$match( 1, @retry$string, 1 ) then call set$byte( @retry$string, @max$retry ); else if keyword$match( 1, @packet$len$string, 3 ) then call set$byte( @packet$len$string, @packet$len ); else if keyword$match( 1, @timeout$string, 1 ) then call set$byte( @timeout$string, @time$limit ); else if keyword$match( 1, @padding$string, 4 ) then call set$byte( @padding$string, @num$pad ); else if keyword$match( 1, @padchar$string, 4 ) then call set$byte( @padchar$string, @pad$char ); else if keyword$match( 1, @end$of$line$string, 2 ) then call set$byte( @end$of$line$string, @eol ); else if keyword$match( 1, @quote$string, 1 ) then call set$byte( @quote$string, @quote ); else /* unknown parameter */ call invalid$param( 1, @set$string, 0, 0 ); end set; show: procedure; /* * Implement the SHOW command by dispatching to the appropriate * routine based on the second keyword (the parameter after SHOW). */ show$version: procedure; /* Implement the SHOW VERSION command */ if ( num$keywords > 2 ) then call too$many$params( @show$string, @version$string, 0 ); else do; call print( @( 8,'This is ' ) ); call print( @sign$on ); end; end show$version; show$flag$value: procedure( kp2, flag$ptr ); /* * Show the value of a flag. KP2 points to its name, * and FLAG$PTR points to the boolean variable. */ declare ( kp2, flag$ptr ) pointer, flag based flag$ptr boolean; if ( num$keywords > 2 ) then call too$many$params( @show$string, kp2, 0 ); else do; call print( kp2 ); call print( @currently$string ); call show$flag( flag ); call new$line; end; /* else */ end show$flag$value; show$byte: procedure( kp2, byte$ptr, char$flag, msg$ptr ); /* * SHOW a byte variable. KP2 points to its keyword name, * BYTE$PTR points to the byte itself, MSG$PTR points to * the message to be displayed before its value, and * CHAR$FLAG is TRUE if it is a character. */ declare ( kp2, byte$ptr, msg$ptr ) pointer, char$flag boolean, num based byte$ptr byte; if ( num$keywords > 2 ) then call too$many$params( @show$string, kp2, 0 ); else do; call print( msg$ptr ); call print( @currently$string ); if ( char$flag ) then do; call show$char( num ); call print( @( 8,', ASCII ' ) ); end; /* if ( char$flag ) */ call show$dec$num( num ); call print( @( 10,' (decimal)' ) ); call new$line; end; /* else */ end show$byte; show$all: procedure; /* Implement the SHOW ALL command. */ if ( num$keywords > 2 ) then call too$many$params( @show$string, @all$string, 0 ); else do; /* show all the things we can show */ call show$version; call show$flag$value( @beep$string, @beep ); call show$flag$value( @debug$string, @debug ); call show$byte( @escape$string, @esc$char, TRUE, @( 34,'The "escape" character for CONNECT' ) ); call show$byte( @retry$string, @max$retry, FALSE, @( 31,'Maximum times to retry a packet' ) ); call show$byte( @packet$len$string, @packet$len, FALSE, @( 29,'Maximum length packet to send' ) ); call show$byte( @timeout$string, @time$limit, FALSE, @( 37,'Seconds to wait for receive character' ) ); call show$byte( @padding$string, @num$pad, FALSE, @( 36,'Number of padding characters to send' ) ); call show$byte( @padchar$string, @pad$char, TRUE, @( 25,'Padding character to send' ) ); call show$byte( @end$of$line$string, @eol, TRUE, @( 29,'End-of-line character to send' ) ); call show$byte( @quote$string, @quote, TRUE, @( 25,'Control-quoting character' ) ); end; /* else -- no extra parameter */ end show$all; /* begin SHOW */ if ( num$keywords < 2 ) then /* there was no second keyword */ call too$few$params( @show$string, 0, 0 ); else if keyword$match( 1, @q$mark, 1 ) then call list$choices( @show$string, 0, 0, @show$param$list, last( show$param$list ) ); else if keyword$match( 1, @version$string, 1 ) then call show$version; else if keyword$match( 1, @beep$string, 1 ) then call show$flag$value( @beep$string, @beep ); else if keyword$match( 1, @debug$string, 1 ) then call show$flag$value( @debug$string, @debug ); else if keyword$match( 1, @escape$string, 2 ) then call show$byte( @escape$string, @esc$char, TRUE, @( 34,'The "escape" character for CONNECT' ) ); else if keyword$match( 1, @retry$string, 1 ) then call show$byte( @retry$string, @max$retry, FALSE, @( 31,'Maximum times to retry a packet' ) ); else if keyword$match( 1, @packet$len$string, 3 ) then call show$byte( @packet$len$string, @packet$len, FALSE, @( 29,'Maximum length packet to send' ) ); else if keyword$match( 1, @timeout$string, 1 ) then call show$byte( @timeout$string, @time$limit, FALSE, @( 37,'Seconds to wait for receive character' ) ); else if keyword$match( 1, @padding$string, 4 ) then call show$byte( @padding$string, @num$pad, FALSE, @( 36,'Number of padding characters to send' ) ); else if keyword$match( 1, @padchar$string, 4 ) then call show$byte( @padchar$string, @pad$char, TRUE, @( 25,'Padding character to send' ) ); else if keyword$match( 1, @end$of$line$string, 2 ) then call show$byte( @end$of$line$string, @eol, TRUE, @( 29,'End-of-line character to send' ) ); else if keyword$match( 1, @quote$string, 1 ) then call show$byte( @quote$string, @quote, TRUE, @( 25,'Control-quoting character' ) ); else if keyword$match( 1, @all$string, 1 ) then call show$all; else call invalid$param( 1, @show$string, 0, 0 ); end show; send: procedure; /* * Implement the SEND command. */ send$init: procedure; /* Implement the Send-initiate state. */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send a Send-init packet */ call flush$input$buffer; call send$kermit$params( @info2 ); /* Load our parameters */ call send$packet( 'S', seq, @info2 ); /* Send-initiate */ type = receive$packet( @num, @info2 ); /* Get the response */ /* If we got an acknowledgement with the proper number */ if ( ( type = 'Y' ) and ( num = seq ) ) then do; call get$kermit$params( @info2 ); /* Extract their params */ tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump sequence number */ if ( open$file( @info ) ) then /* open the file to be sent */ do; /* it was successfully opened */ /* Keep the user informed of our progress */ call print( @( 13,'Sending file ' ) ); call print( @info ); call print( @dots$string ); call prepare$file$name( @info ); state = 'F'; /* go to send-file state */ end; /* if ( open$file( @info ) ) */ else /* couldn't open file */ state = 'A'; /* abort--error message already given */ end; /* if ( ( type = 'Y' ) and ( num = seq ) ) */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then /* got wrong type packet */ call unknown$packet$type( type, @info2 ); /* abort */ /* Don't change state if got NAK, bad ACK, or nothing at all */ end; /* else -- send send-init */ end send$init; send$file$data: procedure; /* Implement the Send File-header and Send file-Data states */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send packet (file-name or data) */ call send$packet( state, seq, @info ); type = receive$packet( @num, @info2 ); /* get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump sequence number */ call read$packet$from$file( @info ); /* Load data packet */ if ( info.len = 0 ) then /* end-of-file */ state = 'Z'; /* so go to end-of-file state */ else /* data ready to be sent */ state = 'D'; /* go to (or stay in) send-Data state */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send packet */ end send$file$data; send$eof: procedure; /* Implement the Send-end-of-file state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send EOF packet */ call send$packet( 'Z', seq, 0 ); type = receive$packet( @num, @info2 ); /* Get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; call close$file; /* close the file we're done sending */ call print( @ok$string ); /* terminate the */ call new$line; /* "Sending file..." message */ tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump packet sequence number */ call get$next$file$name( @info ); /* Get next file to send */ if ( info.len = 0 ) then /* no more files */ state = 'B'; /* go to Break-transmission state */ else /* Another file to be sent */ do; if ( open$file( @info ) ) then /* open next file */ do; /* it was successfully opened */ /* Keep the user informed of our progress */ call print( @( 13,'Sending file ' ) ); call print( @info ); call print( @dots$string ); call prepare$file$name( @info ); state = 'F'; /* go to send-file state */ end; /* if ( open$file( @info ) ) */ else /* couldn't open file, so abort */ state = 'A'; /* error message already given */ end; /* else -- another file to be sent */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send EOF packet */ end send$eof; send$break: procedure; /* Implement the Send-Break (End-of-Transmission) state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* send the break (or EOT) packet */ call send$packet( 'B', seq, 0 ); type = receive$packet( @num, @info2 ); /* Get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump packet sequence number */ state = 'C'; /* and go to state Complete */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send break packet */ end send$break; /* begin SEND */ if ( num$keywords < 2 ) then do; /* tell them what kind of parameter is required */ call print( @send$string ); call print( @( 33,' must be followed by the filespec' ) ); call print( @( 28,' for the file(s) to be sent.' ) ); end; /* if ( num$keywords < 2 ) */ else if ( num$keywords > 2 ) then call extra$params( @send$string, 0, 0 ); else /* We have one parameter, the filespec */ do; /* perform the SEND command */ /* Get first filename to send, using second keyword as filespec */ call get$first$file$name( 1, @info ); if ( info.len > 0 ) then /* we got a valid filespec */ do; /* Implement the Send state-table switcher */ state = 'S'; /* Start with Send-init state */ seq = 0; /* Initialize the packet sequence numbers */ tries = 0; /* no retries yet */ /* do this as long as we're in a valid send state */ do while ( ( state = 'S' ) or ( state = 'F' ) or ( state = 'D' ) or ( state = 'Z' ) or ( state = 'B' ) ); /* Dispatch to appropriate routine (they switch the state) */ if ( state = 'S' ) then call send$init; else if ( ( state = 'F' ) or ( state = 'D' ) ) then call send$file$data; /* two states share one routine */ else if ( state = 'Z' ) then call send$eof; else /* state must be B */ call send$break; end; /* do while ... */ if ( beep ) then /* Alert them that we finished */ call xmit$console$char( BEL ); if ( state = 'C' ) then /* proper completion */ call print( @( 14,'Send complete.' ) ); else do; call new$line; if ( state = 0FFh ) then /* it was because of CTRL/C */ call error$msg( @( 23,'Send aborted by CTRL/C.' ) ); else call error$msg( @( 12, 'Send failed.' ) ); end; end; /* if ( info.len > 0 ) */ else /* invalid filespec */ call print( @( 29,'Bad filespec, send cancelled.' ) ); call finish$send; /* Clean up after ITEMIZE */ end; /* else -- we have one parameter */ end send; do$receive: procedure( get ); /* * Perform the RECEIVE (if GET is FALSE) * or GET (if GET is TRUE) command. */ declare get boolean, oldtries byte; /* tries for previous packet */ receive$init: procedure; /* Implement the Receive Send-init state */ declare type byte; /* Incoming packet type */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many tries */ call too$many$retries; /* give up--go to Abort state */ else do; /* try to receive a Send-init packet */ /* Get a packet, and set our sequence number to match its */ type = receive$packet( @seq, @info2 ); if ( type = 'S' ) then /* we got one */ do; call get$kermit$params( @info2 ); /* extract their params */ call send$kermit$params( @info2 ); /* and load ours */ call send$packet( 'Y', seq, @info2 ); /* send ACK */ oldtries = tries; /* save number of init tries */ tries = 0; /* Reset try counter for next packet */ seq = next$seq( seq ); /* Go to next sequence number */ state = 'F'; /* And enter Receive-file state */ end; /* if ( type = 'S' ) */ else if ( get and ( type = 'N' ) ) then /* Got NAK to our Receive-init, so send it again */ call send$packet( 'R', seq, @info ); else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info2 ); /* abort */ end; /* else -- not too many tries yet */ end receive$init; receive$file: procedure; /* Implement the Receive-file state */ declare ( type, num ) byte; /* Incoming packet type, sequence num */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many tries */ call too$many$retries; /* abort */ else /* get a packet */ do; type = receive$packet( @num, @info ); if ( type = 'S' ) then /* it was a Send-init */ do; oldtries = ( oldtries + 1 ); /* Increment its tries */ if ( oldtries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* It was the previous packet, so our ACK was lost */ call send$kermit$params( @info2 ); /* reload our params */ call send$packet( 'Y', num, @info2 ); /* previous ACK */ tries = 0; /* reset tries for file-header packet */ /* state and seq don't change, already updated */ end; else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'S' ) */ else if ( type = 'Z' ) then /* it was end-of-file */ do; oldtries = ( oldtries + 1 ); /* Increment its tries */ if ( oldtries > max$retry ) then /* too many tries */ call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* It was the previous packet, so our ACK was lost */ call send$packet( 'Y', num, 0 ); /* resend that ACK */ tries = 0; /* reset tries for file-header */ /* state and seq don't change */ end; else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'Z' ) */ else if ( type = 'B' ) then /* got Break */ do; if ( num = seq ) then /* got right number */ do; call send$packet( 'Y', seq, 0 ); /* ACK it */ state = 'C'; /* and go to complete state */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'B' ) */ else if ( type = 'F' ) then /* got File header */ do; if ( num = seq ) then /* got right number */ do; if ( create$file( @info ) ) then /* create the file */ do; /* file successfully created */ /* Keep the user informed of our progress */ call print( @( 15,'Receiving file ' ) ); call print( @info ); /* file name */ call print( @dots$string ); call send$packet( 'Y', seq, 0 ); /* ACK */ oldtries = tries; /* save previous tries */ tries = 0; /* and init new packet tries */ seq = next$seq( seq ); /* go to next packet number */ state = 'D'; /* and enter Receive-data state */ end; /* if ( create$file( @info ) ) */ else /* a problem creating the file, so abort */ state = 'A'; /* error message already given */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'F' ) */ else if ( type = 0FFh ) then /* got CTRL/C */ state = 0FFh; /* signal CTRL/C abort */ else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info ); /* abort */ end; /* else -- not too many tries */ end receive$file; receive$data: procedure; /* Implement the Receive-data state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count another try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; type = receive$packet( @num, @info ); /* get a packet */ if ( type = 'D' ) then /* got Data packet */ do; if ( num = seq ) then /* right number */ do; call write$packet$to$file( @info ); call send$packet( 'Y', seq, 0 ); /* ACK it */ oldtries = tries; /* save old try count */ tries = 0; /* and start a new one */ seq = next$seq( seq ); /* go to next packet number */ /* Remain in Receive-Data state */ end; /* if ( num = seq ) */ else /* wrong number */ do; oldtries = ( oldtries + 1 ); if ( oldtries > max$retry ) then call too$many$retries; /* too many tries, abort */ else if ( num = previous$seq( seq ) ) then do; /* got previous packet again */ call send$packet( 'Y', num, 0 ); /* ACK again */ tries = 0; /* reset tries for this one */ /* Stay in D state */ end; /* if ( num = previous$seq( seq ) ) */ else /* totally wrong number */ call wrong$number; /* abort */ end; /* else -- wrong number */ end; /* if ( type = 'D' ) */ else if ( type = 'F' ) then /* got file-header */ do; oldtries = ( oldtries + 1 ); if ( oldtries > max$retry ) then call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* Got previous packet again */ call send$packet( 'Y', num, 0 ); /* ACK again */ tries = 0; /* reset tries for this one */ /* State doesn't change */ end; /* if ( num = previous$seq( seq ) ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'F' ) */ else if ( type = 'Z' ) then /* got end-of-file */ do; if ( num = seq ) then /* right number */ do; call close$file; /* close the output file */ call print( @ok$string ); /* terminate the */ call new$line; /* "Receiving file..." message */ call send$packet( 'Y', seq, 0 ); /* ACK */ oldtries = tries; /* save old try count */ tries = 0; /* and init a new one */ seq = next$seq( seq ); /* go to next packet number */ state = 'F'; /* and go to Receive-File state */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'Z' ) */ else if ( type = 0FFh ) then state = 0FFh; /* signal CTRL/C abort */ else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info ); /* abort */ end; /* else -- not too many tries */ end receive$data; /* begin DO$RECEIVE */ state = 'R'; /* Start with receive-init state */ seq = 0; /* initialize packet sequence number */ tries = 0; /* no retries yet */ if ( get ) then do; /* Request the file(s) from the server */ call get$filespec( 1, @info ); /* get second keyword into INFO */ call send$packet( 'R', seq, @info ); /* send Receive-initiate */ /* And fall through to normal RECEIVE */ end; /* if ( get ) */ /* Implement the Receive state-table switcher */ /* do this as long as we're in a valid receive state */ do while ( ( state = 'R' ) or ( state = 'F' ) or ( state = 'D' ) ); /* Dispatch to appropriate routine (they switch the state) */ if ( state = 'R' ) then call receive$init; else if ( state = 'F' ) then call receive$file; else /* state must be D */ call receive$data; end; /* do while ... */ if ( beep ) then /* Alert them that we finished */ call xmit$console$char( BEL ); if ( state = 'C' ) then /* proper completion */ call print( @( 17,'Receive complete.' ) ); else do; call new$line; if ( state = 0FFh ) then /* it was because of CTRL/C */ call error$msg( @( 26,'Receive aborted by CTRL/C.' ) ); else call error$msg( @( 15,'Receive failed.' ) ); end; end do$receive; receive: procedure; /* * Implement the RECEIVE command. */ if ( num$keywords > 1 ) then /* a parameter followed RECEIVE */ call too$many$params( @receive$string, 0, 0 ); else /* Perform the RECEIVE command */ call do$receive( FALSE ); end receive; get: procedure; /* * Implement the GET command. */ if ( num$keywords < 2 ) then do; /* tell them what kind of parameter is required */ call print( @get$string ); call print( @( 33,' must be followed by the filespec' ) ); call print( @( 30,' for the file(s) to be gotten.' ) ); end; /* if ( num$keywords < 2 ) */ else if ( num$keywords > 2 ) then call extra$params( @get$string, 0, 0 ); else /* We have one parameter, the filespec */ call do$receive( TRUE ); /* perform the GET command */ end get; execute$command: procedure; /* * Execute the command specified by the first keyword parsed * from the command line. If it is not a valid command, issue * an appropriate error message to the console. */ if keyword$match( 0, @q$mark, 1 ) then call list$choices( 0, 0, 0, @command$list, last( command$list ) ); else if keyword$match( 0, @exit$string, 1 ) then call exit; else if keyword$match( 0, @help$string, 1 ) then call help; else if keyword$match( 0, @send$string, 3 ) then call send; else if keyword$match( 0, @receive$string, 1 ) then call receive; else if keyword$match( 0, @get$string, 1 ) then call get; else if keyword$match( 0, @connect$string, 1 ) then call connect; else if keyword$match( 0, @bye$string, 1 ) then call bye; else if keyword$match( 0, @logout$string, 1 ) then call logout; else if keyword$match( 0, @finish$string, 1 ) then call finish; else if keyword$match( 0, @set$string, 3 ) then call set; else if keyword$match( 0, @show$string, 2 ) then call show; else call invalid$param( 0, 0, 0, 0 ); call new$line; /* Make sure the next prompt starts on a new line */ end execute$command; /* * * Main program -- Kermit * */ /* begin KERMIT */ call new$line; call print( @sign$on ); /* Identify who and what we are */ call new$line; call setup; /* Do system-dependent setup */ /* Initialize our parameters to their defaults */ beep = TRUE; /* Beep unless told to shut up */ debug = FALSE; /* We hope it doesn't need any more debugging... */ esc$char = def$esc$char; max$retry = def$max$retry; packet$len = def$packet$len; time$limit = def$time$limit; num$pad = def$num$pad; pad$char = def$pad$char; eol = def$eol; quote = def$quote; /* Begin the main command line loop */ do forever; /* Do this until some command exits the program */ call get$command$line( @prompt ); /* Get a command line */ call parse$command; /* Parse the command line */ if ( num$keywords > 0 ) then /* If we got at least one keyword */ call execute$command; /* perform the command requested */ end; /* do forever */ end Kermit; <<< kersys.p86 >>> $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; <<< kerutil.p86 >>> $large optimize(3) Kermit$util: do; /* * K e r m i t File Transfer Utility * * iRMX-86 Kermit, Version 2.41 * by Albert J. Goodman, Grinnell College * * General Kermit utilities module. * Edit date: 22-August-1985 */ /* Define the system type TOKEN */ $include(:I:LTKSEL.LIT) 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 */ NUL literally '00h', /* null */ SOH literally '01h', /* start-of-header */ CTRL$C literally '03h', /* CTRL/C */ BEL literally '07h', /* bell (beep) */ BS literally '08h', /* backspace */ HT literally '09h', /* horizontal tab */ LF literally '0Ah', /* line-feed */ CR literally '0Dh', /* carriage-return */ CTRL$R$BRAK literally '1Dh', /* CTRL/] */ DEL literally '7Fh', /* delete (rubout) */ /* Defaults for various Kermit parameters */ def$packet$len literally '80', def$time$limit literally '10', def$num$pad literally '0', def$pad$char literally 'NUL', def$eol literally 'CR', def$quote literally '''#''', /* GET$REMOTE$CHAR return codes (see KERMIT$SYS) */ TIMEOUT literally '0FFFFh', /* Time limit expired */ CTRL$C$CODE literally '08003h', /* CTRL/C abort */ /* READ$CHAR return code (see KERMIT$SYS) */ EOF$CODE literally '0FF00h', /* end-of-file */ /* Other constants */ MAX$PACKET$LEN literally '94', MAX$KEYWORDS literally '5', /* String constant (for PRINT$SPACES) */ spaces$string(*) byte data( 15, ' ' ), /* GLOBAL VARIABLES */ /* Token (defined in KERMIT$SYS) */ cur$file token external, /* Connection to the current file */ /* Kermit parameters (defined in main module) */ debug boolean external, /* Whether we're debugging the program */ max$retry byte external, /* Maximum number of times to retry a packet */ packet$len byte external, /* The maximum length packet to send */ time$limit byte external, /* Seconds to time out if nothing received */ num$pad byte external, /* The number of padding characters to send */ pad$char byte external, /* The padding character to send */ eol byte external, /* The EOL (end-of-line) character to send */ quote byte external, /* The control-quote character to be used */ /* Other Kermit variables (defined in main module) */ state byte external, /* Current state */ seq byte external, /* The current sequence number (0 to 63) */ tries byte external, /* Number of times current packet retried */ /* Buffers */ com$line structure( /* The buffer for the command line */ len byte, ch(80) byte) external, /* defined in KERMIT$SYS */ /* Comand parsing information */ num$keywords byte public, /* Number of keywords in KEYWORD array */ keyword(MAX$KEYWORDS) structure( /* the keywords in COM$LINE */ index byte, /* starting index */ len byte); /* length without spaces */ /* External procedures defined in KERMIT$SYS */ get$remote$char: procedure( time$limit ) word external; declare time$limit word; end get$remote$char; xmit$packet: procedure( packet$ptr, len ) external; declare packet$ptr pointer, len word; end xmit$packet; flush$input$buffer: procedure external; end flush$input$buffer; print: procedure( string$ptr ) external; declare string$ptr pointer; end print; new$line: procedure external; end new$line; print$char: procedure( ch ) external; declare ch byte; end print$char; read$char: procedure( file ) word external; declare file token; end read$char; put$char: procedure( file, ch ) external; declare file token, ch byte; end put$char; /* * * General Kermit utility functions * */ char: procedure( x ) byte; /* * Transform an integer in the range 0 to 94 (decimal) * into a printable ASCII character. */ declare x byte; return( x + ' ' ); end char; unchar: procedure( x ) byte; /* * Reverse the CHAR transformation. */ declare x byte; return( x - ' ' ); end unchar; ctl: procedure( x ) byte; /* * Transform a control character into its printable representation, * and vice-versa. I.e. CTRL/A becomes A, and A becomes CTRL/A. */ declare x byte; return( x XOR 40h ); end ctl; upcase: procedure( x ) byte public; /* * Force an ASCII letter to upper-case; * a non-letter is returned unchanged. */ declare x byte; if ( ( x >= 'a' ) and ( x <= 'z' ) ) then /* it was lower-case */ return( x - 'a' + 'A' ); /* return the upper-case equivalent */ else /* it was anything else */ return( x ); /* just return it unchanged */ end upcase; low7: procedure( x ) byte; /* * Return the low-order seven bits of a character, * i.e. set the eighth bit to zero, stripping the parity bit. */ declare x byte; return( x AND 07Fh ); end low7; not$printable: procedure( x ) boolean; /* * Determine whether an ASCII character is a printable character * or not; return TRUE if it is a control character, FALSE if it's * printable. Assumes the high-order (parity) bit is not set. */ declare x byte; return( ( x < ' ' ) or ( x = DEL ) ); end not$printable; special$char: procedure( x ) boolean; /* * Returns TRUE if X is a quoting or prefix * character currently being used (i.e. if * it needs to be quoted itself). Assumes * the high-order (parity) bit is not set. */ declare x byte; /* Only the control-quote is implemented so far */ return( x = quote ); end special$char; next$seq: procedure( seq$num ) byte public; /* * Return the next sequence number after SEQ$NUM; that is, * SEQ$NUM + 1 modulo 64. */ declare seq$num byte; return( ( seq$num + 1 ) AND 03Fh ); end next$seq; previous$seq: procedure( seq$num ) byte public; /* * Return the previous sequence number to SEQ$NUM. */ declare seq$num byte; if ( seq$num = 0 ) then return( 63 ); else return( seq$num - 1 ); end previous$seq; /* * * Output display procedures * */ show$char: procedure( ch ) public; /* * Display a character on the console in readable form, * even if it is a control character. It is assumed * that the high-order bit is not set. */ declare ch byte; if ( not$printable( ch ) ) then do; /* Display the character in a readable form */ if ( ch = DEL ) then /* Display DEL specially */ call print( @( 5, '' ) ); else do; /* display an ordinary control character */ call print( @( 6,'' ); end; /* else */ end; /* if ( not$printable( ch ) ) */ else /* It's printable, so just display it */ call print$char( ch ); end show$char; show$dec$num: procedure( num ) public; /* * Display the value of a number in decimal on the console. */ declare ( num, digit, i ) word, string structure( len byte, ch(5) byte); i = 5; /* Start at the last (least-significant) digit */ do while ( num > 0 ); /* As long as there are more digits */ digit = num mod 10; /* Get the current least-significant digit */ num = ( num - digit ) / 10; /* Remove it from the number */ i = i - 1; /* Back up one place */ string.ch(i) = digit + '0'; /* Convert the digit to ASCII */ end; /* do while */ string.len = 5 - i; /* Find the length of the number */ if ( string.len = 0 ) then do; /* Display zero as 0, not a null string */ string.ch(0) = '0'; string.len = 1; end; /* if ... */ else if ( i > 0 ) then /* If we didn't use all five spaces, */ /* Move the number down to the start of the buffer */ call movb( @string.ch(i), @string.ch(0), string.len ); call print( @string ); /* display the number */ end show$dec$num; show$flag: procedure( flag ) public; /* * Display the value of a boolean flag on the console: * If the flag is TRUE, display ON, if the flag is FALSE, * display OFF. */ declare flag boolean; if ( flag ) then call print( @( 2,'ON' ) ); else call print( @( 3,'OFF' ) ); end show$flag; print$spaces: procedure( num ); /* * Print NUM spaces on the console. */ declare num byte, len byte at( @spaces$string ); len = num; /* set length to be printed this time--must not be > 15 */ call print( @spaces$string ); /* print them */ end print$spaces; /* * * Kermit protocol communication routines * */ send$packet: procedure( type, num, info$ptr ) public; /* * Send a packet to the remote Kermit. TYPE is the character * for the packet type, NUM is the packet number to be used, * and INFO$PTR points to a string (length byte followed by * data bytes) containing the contents of the packet to be sent, * with all control-quoting or other processing already done. * INFO$PTR may be zero in which case an "emtpy" packet is sent. * The length field is assumed to be at least five less than * PACKET$LEN (the maximum length packet to send, i.e. the other * Kermit's buffer size)--this is not checked here. */ declare ( type, num, i, checksum ) byte, info$ptr pointer, info based info$ptr structure( len byte, ch(1) byte), out$buff structure( len byte, ch(256) byte); send$char: procedure( ch ); /* * Send the character CH to the other Kermit. * This routine now buffers the output. */ declare ch byte; out$buff.ch( out$buff.len ) = ch; /* put it into the buffer */ out$buff.len = out$buff.len + 1; /* update length, MOD 256 */ if ( out$buff.len = 0 ) then /* the buffer is full */ call xmit$packet( @out$buff.ch, 256 ); /* so send it */ /* and the buffer is now empty so it can be refilled */ end send$char; send$packet$char: procedure( ch ); /* * Send one character of a packet (other than the SOH or * checksum) by adding it to the checksum and then actually * sending it. */ declare ch byte; checksum = ( checksum + ch ); /* Accumulate checksum */ call send$char( ch ); /* send the char */ end send$packet$char; /* begin SEND$PACKET */ if ( debug ) then do; call print( @( 20,'Send-packet: num = ' ) ); call show$dec$num( num ); call print( @( 9,'; type = ' ) ); call show$char( type ); call print( @( 10,'; data = "' ) ); if ( info$ptr <> 0 ) then call print( info$ptr ); call print$char( '"' ); call new$line; end; out$buff.len = 0; /* initialize the output buffer */ do i = 1 to num$pad; /* Send any padding requested */ call send$char( pad$char ); end; /* do i = 1 to num$pad */ call send$char( SOH ); /* Send the synchronization character */ checksum = 0; /* Initialize the checksum */ if ( info$ptr = 0 ) then /* no info to be sent */ call send$packet$char( char( 3 ) ); /* so length is three */ else /* send packet length */ call send$packet$char( char( info.len + 3 ) ); call send$packet$char( char( num ) ); /* send packet number */ call send$packet$char( type ); /* send packet type */ if ( info$ptr <> 0 ) then /* they gave us an info string */ if ( info.len > 0 ) then /* there is some data to be sent */ do i = 0 to ( info.len - 1 ); /* for each character of data */ call send$packet$char( info.ch( i ) ); /* send it */ end; /* do i = 0 to ( info.len - 1 ) */ /* Now compute the final checksum by folding the high bits in */ checksum = ( ( checksum + shr( checksum, 6 ) ) AND 03Fh ); call send$char( char( checksum ) ); /* and send the checksum */ /* The packet itself has now been sent */ call send$char( eol ); /* now send the EOL character */ /* Finally, send the packet we've accumulated in the buffer */ call xmit$packet( @out$buff.ch, out$buff.len ); end send$packet; receive$char: procedure( time$limit ) word; /* * Receive a character from the other Kermit, timing out * after TIME$LIMIT seconds. Returns the same special * codes as GET$REMOTE$CHAR. */ declare ( time$limit, ch ) word; ch = get$remote$char( time$limit ); /* receive from remote port */ if ( ch < 0100h ) then /* we got a real character, not a special code */ ch = low7( ch ); /* so strip the 8th bit in case it's parity */ return( ch ); /* and return what we received */ end receive$char; receive$packet: procedure( num$ptr, info$ptr ) byte public; /* * Receive a packet from the remote Kermit. NUM$PTR points * to a byte which receives the sequence number of the incoming * packet, INFO$PTR points to a string which receives the * data field of the incoming packet, and the function returns * the type character of the incoming packet. If no character * is received for TIME$LIMIT seconds at any point in the process, * the receive operation will be abandoned and zero will be returned. * (TIME$LIMIT is a global used here.) * Zero will also be returned if a packet with a bad checksum is * received. If CTRL/C is pressed on the console the receive * will be aborted and 0FFh will be returned. (Note that if a * character with ASCII value 0 or 0FFh is received during a packet, * that code will be returned; however this does not apply outside * the packet, and if a NUL or character 0FFh is received during a * packet that indicates an error anyway.) */ declare ( num$ptr, info$ptr ) pointer, num based num$ptr byte, ( checksum, type, i ) byte, ch word, info based info$ptr structure( len byte, ch(1) byte); get$packet$char: procedure byte; /* * Return the next character of a packet and add it to the * checksum. Returns zero or 0FFh as described above for * RECEVIE$PACKET. */ declare ch word; ch = receive$char( time$limit ); /* Get a char */ if ( ch = TIMEOUT ) then /* nothing received in time */ return( 0 ); else if ( ch = CTRL$C$CODE ) then /* CTRL/C abort */ return( 0FFh ); else /* got a character */ do; checksum = ( checksum + ch ); /* accumulate checksum */ return( ch ); /* and return the character */ end; end get$packet$char; /* begin RECEIVE$PACKET */ ch = receive$char( time$limit ); /* Get first character */ /* As long as we got characters, but not the synchronization mark */ do while ( ( ch <> TIMEOUT ) and ( ch <> CTRL$C$CODE ) and ( ch <> SOH ) ); ch = receive$char( time$limit ); /* keep getting them */ end; /* do while ... */ /* convert error conditions to our return codes */ if ( ch = TIMEOUT ) then ch = 0; else if ( ch = CTRL$C$CODE ) then ch = 0FFh; do while ( ch = SOH ); /* if we got SOH, get the packet which follows */ checksum = 0; /* initialize the checksum */ ch = get$packet$char; /* get what should be the count */ /* If we got a character, not SOH */ if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then do; info.len = ( unchar( ch ) - 3 ); /* store data length */ ch = get$packet$char; /* now try for the sequence number */ if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then do; num = unchar( ch ); /* store packet number */ ch = get$packet$char; /* now the type */ if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then do; type = ch; /* store packet type for later */ i = 0; /* init data index */ /* while we're still getting the data field */ do while ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) and ( i < info.len ) ); ch = get$packet$char; /* get next data char */ info.ch( i ) = ch; /* store data character */ i = ( i + 1 ); /* and bump data index */ end; /* do while ... */ if ( ( ch <> 0 ) and ( ch <> 0FFh ) and ( ch <> SOH ) ) then /* got data O.K. */ do; /* Get the incoming checksum */ ch = receive$char( time$limit ); if ( ch = TIMEOUT ) then ch = 0; /* signal no packet received */ else if ( ch = CTRL$C$CODE ) then ch = 0FFh; /* signal CTRL/C abort */ else if ( ch <> SOH ) then /* got checksum */ do; /* finish computing our checksum */ checksum = ( ( checksum + shr( checksum, 6 ) ) AND 03Fh ); /* if incoming checksum and ours disagree */ if ( checksum <> unchar( ch ) ) then ch = 0; /* signal bad packet received */ else /* finally got good, complete, packet */ ch = type; /* so return its type */ end; /* else if ( ch <> SOH ) */ end; /* if ... */ end; /* if ... */ end; /* if ... */ end; /* if ... */ end; /* do while ( ch = SOH ) */ /* Finished with that packet */ call flush$input$buffer; if ( debug ) then do; call print( @( 17,'Receive-packet: ' ) ); if ( ch = 0 ) then call print( @( 19,'' ) ); else if ( ch = 0FFh ) then call print( @( 14,'' ) ); else do; call print( @( 6,'num = ' ) ); call show$dec$num( num ); call print( @( 9,'; type = ' ) ); call show$char( ch ); call print( @( 10,'; data = "' ) ); call print( info$ptr ); call print$char( '"' ); end; call new$line; end; return( ch ); /* return packet type or error code (0 or 0FFh) */ end receive$packet; send$kermit$params: procedure( info$ptr ) public; /* * This procedure places our current parameters into the * buffer pointed to by INFO$PTR in the format required for * a Send-init packet or the acknowledgement to one. */ declare info$ptr pointer, info based info$ptr structure( len byte, ch(1) byte); info.len = 6; info.ch( 0 ) = char( packet$len ); /* longest packet to send */ info.ch( 1 ) = char( time$limit ); /* number of seconds to time-out */ info.ch( 2 ) = char( num$pad ); /* number of padding chars */ info.ch( 3 ) = ctl( pad$char ); /* padding character */ info.ch( 4 ) = char( eol ); /* end-of-line character */ info.ch( 5 ) = quote; /* control-quote character */ end send$kermit$params; get$kermit$params: procedure( info$ptr ) public; /* * This procedure sets our parameters based on the contents of * the buffer pointed to by INFO$PTR which should contain the * data field from a Send-init packet or the acknowledgement to one. */ declare i byte, info$ptr pointer, info based info$ptr structure( len byte, ch(1) byte); do i = info.len to 5; /* for each field they omitted which we use */ info.ch( i ) = ' '; /* make it a space, i.e. default it */ end; /* do i = info.len to 5 */ /* Set buffer size. */ if ( info.ch( 0 ) = ' ' ) then packet$len = def$packet$len; /* use default */ else packet$len = unchar( info.ch( 0 ) ); /* use what they sent */ /* Set time-out limit. */ if ( info.ch( 1 ) = ' ' ) then time$limit = def$time$limit; /* use default */ else time$limit = unchar( info.ch( 1 ) ); /* use theirs */ /* Set number of padding chars. */ if ( info.ch( 2 ) = ' ' ) then num$pad = def$num$pad; /* use default */ else num$pad = unchar( info.ch( 2 ) ); /* use theirs */ /* Set the padding character. */ if ( info.ch( 3 ) = ' ' ) then pad$char = def$pad$char; /* use default */ else pad$char = ctl( info.ch( 3 ) ); /* use theirs */ /* Set the end-of-line character. */ if ( info.ch( 4 ) = ' ' ) then eol = def$eol; /* use default */ else eol = unchar( info.ch( 4 ) ); /* use theirs */ /* Set the control-quote character. */ if ( info.ch( 5 ) = ' ' ) then quote = def$quote; /* use default */ else quote = info.ch( 5 ); /* use theirs */ end get$kermit$params; read$packet$from$file: procedure( info$ptr ) public; /* * Fill the buffer pointed to by INFO$PTR with the next packet * of the current file. This routine does the quoting/prefixing. * If zero bytes are loaded into the buffer, then we ran into * end-of-file. */ declare info$ptr pointer, i byte, ch word, info based info$ptr structure( len byte, ch(1) byte); i, ch = 0; /* While we have more characters from the file and the packet */ /* has room for another char (possibly with control quote) */ do while ( ( ch <> EOF$CODE ) and ( i < ( packet$len - 6 ) ) ); ch = read$char( cur$file ); /* get a char from the file */ if ( ch <> EOF$CODE ) then /* we got one */ do; ch = low7( ch ); /* strip the 8th bit, just in case... */ /* If this character needs to be quoted */ if ( not$printable( ch ) or special$char( ch ) ) then do; info.ch( i ) = quote; /* Put control-quote in buffer */ i = ( i + 1 ); /* and update index */ if ( not$printable( ch ) ) then ch = ctl( ch ); /* make control characters printable */ end; /* if ... -- needs to be quoted */ info.ch( i ) = ch; /* put character in buffer */ i = ( i + 1 ); /* and update index */ end; /* if ( ch <> EOF$CODE ) */ end; /* do while ... */ info.len = i; /* store length of what we put in buffer */ end read$packet$from$file; write$packet$to$file: procedure( info$ptr ) public; /* * Write the contents of a received packet (in the buffer pointed * to by INFO$PTR) out to the current file. This routine deals * with quoting characters in the incoming data. */ declare info$ptr pointer, ( x, i ) byte, info based info$ptr structure( len byte, ch(1) byte); i = 0; /* start at the beginning */ do while ( i < info.len ); /* while we have any more data */ x = info.ch( i ); /* get the current character */ if ( x = quote ) then /* it's the control-quote character */ do; i = ( i + 1 ); /* go to the next (quoted) character */ x = info.ch( i ); /* and get it */ /* If it's not a quoting or prefix character */ if ( not special$char( x ) ) then /* it's a control char */ x = ctl( x ); /* so restore the actual character */ end; /* if ( x = quote ) */ call put$char( cur$file, x ); /* write char to file */ i = ( i + 1 ); /* now go to next char */ end; /* do while ( i < info.len ) */ end write$packet$to$file; /* * * Error handling routines * */ error$msg: procedure( msg$ptr ) public; /* * Send an error packet to the remote Kermit * and display the error message on the console too. */ declare msg$ptr pointer; /* Send Error packet to the other Kermit */ call send$packet( 'E', seq, msg$ptr ); /* send Error packet */ seq = next$seq( seq ); /* and bump sequence number */ call print( msg$ptr ); /* print it on the console too */ end error$msg; unknown$packet$type: procedure( type, packet$ptr ) public; /* * Deal with a received packet of an unexpected type. */ declare type byte, /* type of the packet received */ packet$ptr pointer; /* points to contents of the packet */ if ( type = 'E' ) then /* it is an error packet */ do; /* Display the error message we received from the remote Kermit */ call print( @( 20,'Remote Kermit error:' ) ); call new$line; call print( packet$ptr ); call new$line; end; else /* an unknown packet type */ do; /* Display an appropriate error message */ call print( @( 24,'Unexpected packet type (' ) ); call show$char( type ); call print( @( 11,') received.' ) ); end; state = 'A'; /* In any case, abort the current operation */ end unknown$packet$type; too$many$retries: procedure public; /* * Deal with the retry count reaching its limit. */ /* Display an error message */ call print( @( 17,'Too many retries.' ) ); state = 'A'; /* and abort the operation */ end too$many$retries; wrong$number: procedure public; /* * Deal with a received packet with wrong sequence number. */ /* Display an error message */ call print( @( 27,'Unexpected packet sequence.' ) ); state = 'A'; /* and abort the operation */ end wrong$number; /* * * Command parsing and display procedures * */ parse$command: procedure public; /* * Parse the command line in the global buffer COM$LINE into * keywords, separated by spaces. The keywords are stored * in the global KEYWORD array, the count in NUM$KEYWORDS. */ declare ( i, j ) word; num$keywords = 0; /* Initially we don't have any keywords yet */ i = 0; /* Start at the beginning of the command line */ /* Go until we get to the end or have the maximum number of keywords */ do while ( ( i < com$line.len ) and ( num$keywords < MAX$KEYWORDS ) ); keyword( num$keywords ).index = i; /* store start of this keyword */ /* Find the next space (end of this keyword) */ j = findb( @com$line.ch( i ), ' ', ( com$line.len - i ) ); if ( j = 0FFFFh ) then /* there isn't another space */ j = ( com$line.len - i ); /* this keyword is rest of the line */ keyword( num$keywords ).len = j; /* store its length */ num$keywords = ( num$keywords + 1 ); /* bump the keyword count */ i = ( i + j + 1 ); /* next keyword starts after the space */ end; /* do while ( i < com$line.len ) */ end parse$command; parse$dec$num: procedure( keyword$num, num$ptr ) boolean public; /* * Parse a decimal number out of keyword number KEYWORD$NUM; * i.e. interpret the string of characters that make up that * keyword as a decimal number, and place its value into * the word pointed to by NUM$PTR. It returns a value of * TRUE if this was successful, FALSE if the keyword does not * represent a number (e.g. contains letters). */ declare ( keyword$num, i ) byte, num$ptr pointer, num based num$ptr word, ( first, last, ch ) byte, valid boolean; num = 0; /* Init the number to zero */ valid = TRUE; /* Assume it's valid until proven otherwise */ first = keyword( keyword$num ).index; /* Get starting position */ last = first + keyword( keyword$num ).len - 1; /* and ending one */ do i = first to last; /* Step through each character in turn */ ch = com$line.ch( i ); /* Get current character */ if ( ( ch >= '0' ) and ( ch <= '9' ) ) then /* valid digit */ num = ( num * 10 ) + ( ch - '0' ); /* Accumulate value */ else /* not a decimal digit */ valid = FALSE; /* Flag that it's invalid--NUM is meaningless */ end; /* do i = first to last */ return( valid ); end parse$dec$num; show$keyword: procedure( keyword$num ); /* * Display keyword number KEYWORD$NUM (as parsed into the * global array KEYWORD) on the console. */ declare ( keyword$num, first, last, i ) byte; /* Get the location of the first character of the keyword */ first = keyword( keyword$num ).index; /* and the location of the last character of the keyword */ last = first + keyword( keyword$num ).len - 1; /* Display each character in turn */ do i = first to last; call print$char( com$line.ch( i ) ); end; /* do i = first to last */ end show$keyword; show$command: procedure( kp1, kp2, kp3 ) public; /* * Display a command (one to three keywords) on the console. * Used for error messages. */ declare ( kp1, kp2, kp3 ) pointer; call print( kp1 ); if ( kp2 <> 0 ) then do; call print$char( ' ' ); call print( kp2 ); if ( kp3 <> 0 ) then do; call print$char( ' ' ); call print( kp3 ); end; /* if ( kp3 <> 0 ) */ end; /* if ( kp2 <> 0 ) */ end show$command; hint$command: procedure( kp1, kp2, kp3 ); /* * Give a hint on using the command (called if too few * parameters or invalid parameter). */ declare ( kp1, kp2, kp3 ) pointer; call print( @( 7,' (Type' ) ); if ( kp1 <> 0 ) then /* it's a subcommand */ do; call print$char( ' ' ); call show$command( kp1, kp2, kp3 ); end; /* if ( kp1 <> 0 ) */ call print( @( 23,' ? to see the choices.)' ) ); end hint$command; too$few$params: procedure( kp1, kp2, kp3 ) public; /* * Issue the error messages for commands which require * parameters when they were not followed by any keywords. */ declare ( kp1, kp2, kp3 ) pointer; call show$command( kp1, kp2, kp3 ); call print( @( 22,' requires a parameter.' ) ); call hint$command( kp1, kp2, kp3 ); end too$few$params; too$many$params: procedure( kp1, kp2, kp3 ) public; /* * Issue the error messages for commands which don't take * parameters when they are followed by extra keyword(s). */ declare ( kp1, kp2, kp3 ) pointer; call show$command( kp1, kp2, kp3 ); call print( @( 26,' does not take parameters.' ) ); end too$many$params; extra$params: procedure( kp1, kp2, kp3 ) public; /* * Issue the error messages for commands which take only * one parameter when they are followed by more than one * keyword. */ declare ( kp1, kp2, kp3 ) pointer; call show$command( kp1, kp2, kp3 ); call print( @( 26,' takes only one parameter.' ) ); end extra$params; invalid$param: procedure( k$num, kp1, kp2, kp3 ) public; /* * Issue the error messages for invalid parameters. */ declare k$num byte, ( kp1, kp2, kp3 ) pointer; call show$keyword( k$num ); call print( @( 16,' is not a valid ' ) ); if ( kp1 = 0 ) then call print( @( 8,'command.' ) ); else do; call print( @( 13,'parameter to ' ) ); call show$command( kp1, kp2, kp3 ); call print$char( '.' ); end; /* else */ call hint$command( kp1, kp2, kp3 ); end invalid$param; keyword$match: procedure( keyword$num, keyword$ptr, min$len ) boolean public; /* * Compare keyword number KEYWORD$NUM (as parsed into the KEYWORD * array) with the keyword (string) pointed to by KEYWORD$PTR, * and return TRUE if the keyword is an abbreviation of the string * containing at least MIN$LEN characters, otherwise return FALSE. */ declare ( keyword$num, min$len ) byte, keyword$ptr pointer, string based keyword$ptr structure( len byte, ch(1) byte); if ( keyword( keyword$num ).len < min$len ) then return( FALSE ); /* the keyword is too short */ else if ( keyword( keyword$num ).len > string.len ) then return( FALSE ); /* the keyword is too long */ else if ( cmpb( @com$line.ch( keyword( keyword$num ).index ), @string.ch, keyword( keyword$num ).len ) = 0FFFFh ) then return( TRUE ); /* the keyword matches */ else return( FALSE ); /* the keyword doesn't match */ end keyword$match; list$choices: procedure( kp1, kp2, kp3, list$ptr, list$last ) public; /* * List the choices for commands or parameters to commands, * in response to the ? "parameter." */ declare ( kp1, kp2, kp3, list$ptr ) pointer, (list$element based list$ptr)(1) pointer, element$ptr pointer, element$len based element$ptr byte, ( list$last, i, j, k ) byte; call print$spaces( 2 ); call print( @( 10,'Available ' ) ); if ( kp1 = 0 ) then call print( @( 8,'commands' ) ); else do; call print( @( 14,'parameters to ' ) ); call show$command( kp1, kp2, kp3 ); end; /* else */ call print( @( 5,' are:' ) ); k = 5; /* Set to start a new line immediately */ do i = 0 to list$last; /* for each entry in the list */ if ( k > 4 ) then /* start a new line every 5 columns */ do; call new$line; call print$spaces( 4 ); /* indent */ k = 0; /* reset column counter */ end; /* if ( k > 4 ) */ element$ptr = list$element( i ); /* Compute number of spaces to next column */ j = ( 15 - ( element$len MOD 15 ) ); /* And update columns on this line so far */ k = ( k + ( element$len / 15 ) + 1 ); call print( element$ptr ); call print$spaces( j ); end; /* do i = 0 to list$last */ end list$choices; /* * * Other utility procedures * */ get$filespec: procedure( keyword$num, info$ptr ) public; /* * Get the filespec in keyword number KEYWORD$NUM into * the buffer pointed to by INFO$PTR. */ declare keyword$num byte, info$ptr pointer, info based info$ptr structure( len byte, ch(1) byte); /* Copy the keyword into the INFO buffer */ info.len = keyword( keyword$num ).len; call movb( @com$line.ch( keyword( keyword$num ).index ), @info.ch, info.len ); end get$filespec; send$generic$command: procedure( info$ptr, info2$ptr ) boolean public; /* * Send a Generic Kermit Command (the data field of which * INFO$PTR must point to) to the other Kermit. This only * deals with commands to which no reply other than ACK or NAK * or possibly an Error message is expected. If an Error packet * is received the error message is displayed and FALSE is returned; * if a NAK is received the packet is retransmitted up to the * global MAX$RETRY count, at which point an error message is * displayed and FALSE is returned; if an ACK is received TRUE * is returned. INFO2$PTR points to the buffer which receives * the contents of the response packet. */ declare ( info$ptr, info2$ptr ) pointer, ( type, num ) byte; /* Incoming packet type, number */ seq = 0; /* Set packet sequence number */ tries = 0; /* Init try count */ do while ( tries < max$retry ); tries = ( tries + 1 ); /* count a try */ call send$packet( 'G', seq, info$ptr ); /* send generic command */ type = receive$packet( @num, info2$ptr ); /* get response */ if ( ( type = 'Y' ) and ( num = seq ) ) then /* got good ACK */ return( TRUE ); else if ( type = 0FFh ) then /* CTRL/C abort */ do; call print( @( 26,'Command aborted by CTRL/C.' ) ); return( FALSE ); end; else if ( ( type <> 'N' ) and ( type <> 'Y' ) and ( type <> 0 ) ) then do; call unknown$packet$type( type, info2$ptr ); return( FALSE ); end; end; /* do while ( tries < max$retry ) */ call too$many$retries; return( FALSE ); end send$generic$command; end kermit$util;