Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/getcom.bli
There are no other files named getcom.bli in the archive.
module getcom (	! Get the user's command string.
		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 Library Processor
!
! Abstract:
!
!	Obtain the command string from the host system and make it
!	available to the rest of the CMS processor.
!
! Environment: Transportable
!
! Author:  Earl Van Horn	Creation Date:  April, 1979
!
!--
!
! Table of Contents:
!

forward routine
    bldcom,			! Add to the existing command line
    getcom ;			! Get the command string that invoked this image.

!
! Include Files:
!

%if %bliss(bliss32) %then

library 'sys$library:starlet';

undeclare %quote $descriptor;

%fi

%if %bliss(bliss36) %then

require 'jsys:';

%fi

library 'XPORT:' ;

require 'BLISSX:' ;

require 'sconfg:';

!
! Macros:
!

!
! Equated Symbols:
!

!
! Own Storage:
!
own
    max_com_chars : initial(max_com_size),! Maximum number of characters in
					! a command string.
    prev_results : initial(false),	! Means the routine has been called
					! before in this job, so that the
					! content of PREV_VALUE and USR_CMD
					! are defined.
    prev_value ;			! Value returned by a previous call to
					! GETCOM.

global
    usr_line : vector[ch$allocation(max_com_size+1)],
    usr_cmd : desc_block;

!
! External References:
!
external
    comzon ;			! Storage zone for command processor stuff.

external routine
    bug,			! Report a bug.
    filter,			! Copy a string and detect illegal characters.
    getcline,			! Host dependent routine to get command line.
    zalloc ;			! Allocate a segment in a zone.
global routine bldcom (new_string) =

!++
! Functional Description:
!
!	This routine adds text to the accumulated user command line
!	so that command prompting will work correctly.
!
! Formal Parameters:
!
!	NEW_STRING - address of a descriptor pointing to the text
!		     to be added.
!
! Implicit Inputs:
!
!	USR_CMD - points to the existing command line so far
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistake, otherwise FALSE.
!
! Side Effects:
!
!	None.
!
!--

    begin

    map
	new_string : ref desc_block;

    local
	new_ptr;

    !Don't proceed if there hasn't been a call to GETCOM
    if
	not .prev_results
    then
	return false;

    !Append the new string to the old one.
    new_ptr=ch$plus(.usr_cmd[desc_ptr],.usr_cmd[desc_len]);
    ch$move(.new_string[desc_len],.new_string[desc_ptr],.new_ptr);
    usr_cmd[desc_len]=.usr_cmd[desc_len]+.new_string[desc_len];

    !check for funny characters
    if
	not filter(usr_cmd)
    then
	false
    else
	true

    end;				!End of BLDCOM
global routine getcom(a_user_string) =

!++
! Functional Description:
!
!	This routine obtains the command string that invoked the current
!	image, stores the command string in space allocated from free storage,
!	and makes the supplied descriptor denote the command string.  If the
!	user typed too many characters or an illegal character, then he is
!	informed, FALSE is returned, and the content of the supplied descriptor
!	is undefined.
!
!	The results of the first call are remembered, so that on the second and
!	subsequent calls the routine will return the same results without any
!	additional processing or interaction with the user.
!
! Formal Parameters:
!
!	a_user_string:		Address of a descriptor where GETCOM will
!				identify the command string.
!
! Implicit Inputs:
!
!	GETCLINE is called to obtain the command line from the host.
!	PREV_RESULTS and PREV_VALUE are own variables of this
!	module that are used to remember the previous results.
!	MAX_COM_CHARS is an own variable in this module that contains the
!	maximum number of characters allowed in a command string.
!
! Implicit Outputs:
!
!	PREV_RESULTS and PREV_VALUE are own variables of this
!	module that are used to remember the previous results.
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistake, otherwise FALSE.
!
! Side Effects:
!
!	Storage for the string is allocated using ZALLOC.
!
!--

    begin	! GETCOM
    bind
	user_string = .a_user_string : desc_block ;

    local
	a_buffer,		! Address of buffer for command string.
	result ;		! Value returned by GETCLINE

    if .prev_results
    then
	begin	! Return the previous results.

        LOCAL
           length;              ! Calculated length of the line.

        ! since nxtlex updates usr_cmd each time it parses we must
        ! go back to the begging of the string.  Use base length of zero
	! if descriptor is invalid.
	if .usr_cmd[desc_ptr] eqla k_null
	then
	    length = 0
	else
	    length = ch$diff(.usr_cmd[desc_ptr],ch$ptr(usr_line))+ .usr_cmd[desc_len];

	! Return the results in a separate buffer, allowing one extra
	! character position for NXTLEX to store a closing quotation mark.
	a_buffer = zalloc(units_for_chars(.length + 1), comzon);


	! Initialize the user string to point to the buffer.
	$str_desc_init(descriptor = user_string, string =
		( .length , ch$ptr(.a_buffer))) ;

	! Copy the results into the user string.
	ch$move(.length , ch$ptr(usr_line) , .user_string[desc_ptr]) ;

	return .prev_value ;
	end ;	! Return the previous results.

    ! Initialize the user string descriptor for error returns.
    $str_desc_init(descriptor = user_string, string = (0, k_null)) ;

    ! Initialize the previous values, for subsequent calls.
    $str_desc_init(descriptor = usr_cmd , string = user_string) ;
    prev_value = false ;
    prev_results = true ;

    ! Allocate storage for the buffer.  It must accommodate the maximum number
    ! of characters the user is allowed to type, plus one for a closing
    ! quotation mark that NXTLEX might insert.
    a_buffer = zalloc(units_for_chars(.max_com_chars + 1), comzon) ;

    ! Get the command string from the host.
    result = getcline(.a_buffer, .max_com_chars) ;
    if .result lss 0		! User has been told the command is too long.
    then
	return false ;

    ! Complete the user string descriptor.
    user_string[desc_len] = .result ;
    user_string[desc_ptr] = ch$ptr(.a_buffer) ;

    ! Remember the string in a separately allocated buffer, so the rest of
    ! the program can modify the string that is returned, and a subsequent
    ! call to this routine will return the original string content.
    usr_cmd[desc_len]=.result;
    usr_cmd[desc_ptr]=ch$ptr(usr_line);
    ch$move(len_comma_ptr(user_string),.usr_cmd[desc_ptr]);

    ! Look for illegal characters.
    if not filter(user_string)
    then
	return false ;

    prev_value = true ;
    true
    end ;	! GETCOM
end				! Module GETCOM
eludom