Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

module comcod (	!
		ident = '1',
		%if
		    %bliss(bliss32)
		%then
		    language(bliss32),
		    addressing_mode(external=long_relative,
				    nonexternal=long_relative)
		%else
		    language(bliss36)
		%fi
		) =
begin

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! Facility:
!
!	CMS Programming Library
!
! Abstract:
!
!	Obtain the integer code for the current command, to dispatch
!	to the proper image on TOPS-20.  For transportability, the same
!	logic is also used on VAX/VMS
!
! Environment:	Transportable
!
! Author:  Earl Van Horn	Creation Date:  December 12, 1979
!
!--

!
! Table of Contents:
!

forward routine
    comcod ;			! Obtain the integer code for the command.

!
! Include Files:
!

%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET';
%fi

%if %bliss(bliss36) %then
require 'JSYS:';
%fi

library 'XPORT:' ;
require 'BLISSX:' ;
require 'LANGME:' ;
require 'SCONFG:' ;
!
! Macros:
!

!
! Equated Symbols:
!

!
! Own Storage:
!

!
! External References:
!

external literal
    s_ambig,
    s_nosbcom;

external
    comzon,			! Identifier of zone for command stuff.
    gratab : gratab_vector ;	! Grammar table

external routine
    abbrev,			! Find one or more abbreviated word.
    ask,
    bldcom,			! add to user's command string
    codspl,			! Get the spelling for an integer code.
    ers,			! Report a user mistake
    getcom,			! Get the user's command string.
    nxtgra,			! Find the next entry in the grammar table.
    nxtlex;			! Get the next lexical item in a string.

global routine comcod(a_com_code) =

!++
! Functional Description:
!
!	This routine looks at the command the user typed and stores the
!	integer code for it into the fullword whose address is passed
!	as parameter.  If the user did not type a valid command, he is
!	so informed, and FALSE is returned; otherwise TRUE is returned.
!
! Formal Parameters:
!
!	a_com_code:	Address of a fullword where the code for the command
!			will be stored. If the user made a mistake (and FALSE
!			is returned) this fullword has undefined content.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistakes, and otherwise FALSE.
!
! Side Effects:
!
!	None
!
!--

    begin	! COMCOD
    bind
	com_code = .a_com_code ;

    local
	all_matches : desc_block,	! The matching commands, separated
					! by blanks.
	cmd_string : ref desc_block,	! prompt buffer pointer
	first_word : desc_block,	! The first word in the command.
	prev_com_code,			! Command code of the previous
					! grammar table entry.  Zero means
					! there is no previous entry, because
					! zero can never be a command code.
	this_x,				! Index in GRATAB.
	user_string : desc_block ;	! The user's command string.

    ! Get the command string from the operating system.
    if not getcom(user_string)
    then
	return false ;

    ! Get the first word of the command string.
    if
	.user_string[desc_len] neq 0
    then
	begin
	if
	    not nxtlex(user_string, k_normal_lex, lit('subcommand'), first_word)
	then
	    return false
	end
    else
	!ask user for more
	begin
	do
	    cmd_string=ask(prompt_lit('Subcommand'))
	until
	    .cmd_string[desc_len] neq 0;
	bldcom(.cmd_string);
	if
	    not nxtlex(.cmd_string, k_normal_lex, lit('subcommand'), first_word)
	then
	    return false
	end;

    ! Find the command it matches.
    com_code = 0 ;	! No command found so far.
    prev_com_code = 0 ;
    this_x = 0 ;	! Start at the beginning of the grammar table.
    $str_desc_init(descriptor = all_matches, string = (0, k_null)) ;
    while nxtgra(this_x) do
	begin		! Examine one entry in the grammar table.
	if .gratab[.this_x] neq .prev_com_code
	then
	    begin	! Not the same as the previous command.
	    if abbrev(first_word, codspl(.gratab[.this_x]),
			all_matches, comzon)
	    then
		com_code = .gratab[.this_x] ;
	    prev_com_code = .gratab[.this_x] ;
	    end ;	! Not the same as the previous command.
	end ;		! Examine one entry in the grammar table.

    if .com_code eql 0
    then
	begin	! Not a command.
	ers(s_nosbcom,cat(first_word,
		(%string(' is not a ',fac_name,' subcommand')))) ;
	return false ;
	end ;	! Not a command.

    if not ch$fail(ch$find_ch(len_comma_ptr(all_matches), %c' '))
    then
	begin	! Ambiguous.
	ers(s_ambig,cat(first_word, ' could mean: ', all_matches));
	return false ;
	end ;	! Ambiguous.

    true
    end ;	! COMCOD

end				! Module COMCOD
eludom