$eject
check$choice: procedure(index,mindex) byte;
                                        /* does this modifier go with this
                                           option? */
        declare
                index   byte,
                mindex  byte;

        return(opt$mod(index).modifier(mindex));

end check$choice;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


                    * * *  Option scanner  * * *


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


separator: procedure(character) byte;

                                        /* determines if character is a 
                                           delimiter and which one */
        declare k       byte,
                character       byte;

        k = 1;
loop:   if delimiters(k) = end$list then return(0);
        if delimiters(k) = character then return(k);    /* null = 25 */
                k = k + 1;
                go to loop;

end separator;

opt$scanner:    procedure(list$ptr,off$ptr) byte;

             /* list$ptr        -       pointer to list of known strings
                off$ptr         -       pointer to offsets into known string
                                        list
                buf$ptr         -       pointer to input string

                Scans the known string list for an occurrance of the input
                string.  If the input string is not found in the known list
                then return(0). Otherwise, return the index of the known string
                that matches the input.

                1. Find the known string that matches the input string on the 
                   first letter.

                        do i = 1 to #known_strings
                                if Known_string(i,1) = input(1) then do

                                   if length(Known_string(i)) < end_of_input
                                       then return(0)

                                   do j = 2 to end_of_input

                                        if Known_string(i,j) ~= input(j) then
                                                go to again
                                   end

                                   go to 2
                                end
                 again: end

                        return (0)              !no matchs

                2. Test to see if the input string does not match another Known
                   string.  This may happen if the input string is not a
                   unique sub-string of the Known string, ie., DI is a 
                   sub-string of DIRECTORY and DISK.

                        index = i

                        do i = index+1 to #known_strings
                                do j = 1 to end of input

                                        if Known_string(i,j) ~= input(j) then
                                                go to next
                                end

                                return(0)       !not unique
                next:   end;

                        return(index)           !unique substring 

                                P.Balma   10/82  */

        declare
                buff            based buf$ptr (1) byte,
                off$ptr         address,
                list$ptr        address;

        declare
                i               byte,
                j               byte,
                list            based list$ptr (1) byte,
                offsets         based off$ptr (1) byte,
                wrd$pos         byte,
                character       byte,
                letter$in$word  byte,
                found$first     byte,
                start           byte,
                index           byte,
                save$index      byte,
                (len$new,len$found)     byte,
                valid           byte;

/*****************************************************************************/
/*                      internal subroutines                                 */
/*****************************************************************************/

check$in$list: procedure;
                                /* find known string that has a match with 
                                   input on the first character.  Set index
                                   = invalid if none found.   */
                        
        declare i       byte;

        i = start;
        wrd$pos = offsets(i);
        do while list(wrd$pos) <> end$list;
                i = i + 1;
                index = i;
                if list(wrd$pos) = character then return;
                wrd$pos = offsets(i);
        end;
                        /* could not find character */
        index = 0;
        return;
end check$in$list;

setup:  procedure;
        character = buff(0);
        call check$in$list;
        letter$in$word = wrd$pos;
                        /* even though no match may have occurred, position
                           to next input character.  */
        i = 1;
        character = buff(1);
end setup;

test$letter:    procedure;
                        /* test each letter in input and known string */

        letter$in$word = letter$in$word + 1;

                                        /* too many chars input? 0 means
                                           past end of known string */
        if list(letter$in$word) = end$of$string then valid = false;
        else
        if list(letter$in$word) <> character then valid = false;

        i = i + 1;
        character = buff(i);

end test$letter;

skip:   procedure;
                                        /* scan past the offending string;
                                           position buf$ptr to next string...
                                           skip entire offending string;
                                           ie., falseopt=mod, [note: comma or
                                           space is considered to be group 
                                           delimiter] */
        character = buff(i);
        delimiter = separator(character);
        do while ((delimiter <> 2) and (delimiter <> 4) and (delimiter <> 5)
                   and (delimiter <> 25));
                i = i + 1;
                character = buff(i);
                delimiter = separator(character);
        end;
        endbuf = i;
        buf$ptr = buf$ptr + endbuf + 1;
        return;
end skip;

eat$blanks: procedure;

        declare charac  based buf$ptr byte;

        do while(delimiter := separator(charac)) = SPACE;
                buf$ptr = buf$ptr + 1;
        end;

end eat$blanks;

/*****************************************************************************/
/*                      end of internals                                     */
/*****************************************************************************/


                                        /* start of procedure */
        call eat$blanks;
        start = 0;
        call setup;

                                        /* match each character with the option
                                           for as many chars as input 
                                           Please note that due to the array
                                           indices being relative to 0 and the
                                           use of index both as a validity flag
                                           and as a index into the option/mods
                                           list, index is forced to be +1 as an
                                           index into array and 0 as a flag*/

        do while index <> 0;
                start = index;
                delimiter = separator(character);

                                        /* check up to input delimiter */

                valid = true;           /* test$letter resets this */
                do while delimiter = 0;
                        call test$letter;
                        if not valid then go to exit1;
                        delimiter = separator(character);
                end;

                go to good;

                                        /* input ~= this known string;
                                           get next known string that 
                                           matches */
exit1:          call setup;
        end;
                                        /* fell through from above, did
                                           not find a good match*/
        endbuf = i;                     /* skip over string & return*/
        call skip;
        return(0);

                                        /* is it a unique match in options
                                           list? */
good:   endbuf = i;
        len$found = endbuf;
        save$index = index;
        valid = false;
next$opt:
                start = index;
                call setup;
                if index = 0 then go to finished;

                                        /* look at other options and check
                                           uniqueness */

                len$new = offsets(index + 1) - offsets(index) - 1;
                if len$new = len$found then do;
                        valid = true;
                        do j = 1 to len$found;
                                call test$letter;
                                if not valid then go to next$opt;
                        end;
                end;
                else go to nextopt;
                                        /* fell through...found another valid
                                           match --> ambiguous reference */
        call skip;              /* skip input field to next delimiter*/
        return(0);

finished:                       /* unambiguous reference */
        buf$ptr = buf$ptr + endbuf;
        call eat$blanks;
        if delimiter <> 0 then buf$ptr = buf$ptr + 1;
        else delimiter = SPACE;

        return(save$index);

end opt$scanner;

error$prt:      procedure;
        declare i       byte,
                t       address,
                char    based t byte;

        t = buf$ptr - endbuf - 1;
        do i = 1 to endbuf;
                call printchar(char);
                t = t + 1;
        end;

end error$prt;

