$large

Kermit$util: do;

/*
 *      K e r m i t   File Transfer Utility
 *
 *      iRMX-86 Kermit, Version 2.3
 *      by Albert J. Goodman, Grinnell College
 *
 *      General Kermit utilities module.
 *      Edit date:  2-June-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$remote$char: procedure( ch ) external;
    declare
        ch  byte;
end xmit$remote$char;

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;

write$char: procedure( file, ch ) external;
    declare
        file    token,
        ch      byte;
end write$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, '<DEL>' ) );
        else
          do;   /* display an ordinary control character */
            call print( @( 6,'<Ctrl-' ) );
            call print$char( ctl( ch ) );
            call print$char( '>' );
          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$char: procedure( ch );

    /*
     *  Send the character CH to the other Kermit.
     */

    declare
        ch      byte;

    call xmit$remote$char( ch ); /* send it on the remote line */

end send$char;


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);

    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;
    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 */

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 */
    /* We would now flush the input buffer if we were using one */
    if ( debug ) then
      do;
        call print( @( 17,'Receive-packet:  ' ) );
        if ( ch = 0 ) then
            call print( @( 19,'<bad/absent packet>' ) );
        else if ( ch = 0FFh ) then
            call print( @( 14,'<CTRL/C abort>' ) );
        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 write$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;