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

module values (	! Recognize and process STEP qualifier values.
		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:
!
!	This module contains routines that analyze qualifier values for
!	CMS commands.  The principal routine, RECVAL, sees if a given
!	qualifier takes a value, and if so, calls other routines to
!	recognize and analyze it.
!
! Environment: Transportable
!
! Author:  Earl Van Horn	Creation Date:  June, 1979
!
!--

!
! Table of Contents:
!

forward routine
    check_date,			! Check the syntax of a date.
    recval,			! Recognize a qualifier's value, if any.
    required_eql,		! Eat up a required colon or equal sign.
    required_lexeme ;		! Obtain a required lexeme qualifier.

!
! Include Files:
!
%if %bliss(bliss32)

%then library 'sys$library:starlet';

%else require 'jsys:';

%fi

library 'XPORT:' ;
require 'BLISSX:' ;
require 'COMUSR:' ;		! Declarations for the user of the
				! language processor.
require 'LANGME:' ;		! Declarations internal to the language
				! processor.

!
! Macros:
!

!
! Equated Symbols:
!
bind
    chars_for_eql = lit( %bliss32(':=') %bliss36(':') %bliss16(':=') ) ;
			! Address of the descriptor of a string of the
			! characters that are allowed to separate a qualifier
			! from its value.

!
! Own Storage:
!

!
! External References:
!

external literal
	s_badvar,
	s_datebad,
	s_dayerr,
	s_eqlreq,
	s_hyphtwo,
	s_ilchar,
	s_invqual,
	s_montherr,
	s_nomondig,
	s_not20cent,
	s_noyearlet,
	s_valnotall,
	s_yearerr;

external routine
    bug,			! Report a bug.
    codspl,			! Return descriptor of spelling for code.
    ers,			! Report a user mistake.
    genexp,			! Recognize a generation expression.
    gennum,			! Check syntax of a generation number.
    genpri,			! Check syntax of a generation primary.
    nxtlex,			! Obtain the next lexeme.
    peekch ;			! Look ahead to the next command character.

routine check_date(a_lexeme, a_description) =

!++
! Functional Description:
!
!	This routine checks that the given lexeme is a valid date, and
!	returns TRUE if it is.  The given description is a phrase describing
!	what the lexeme is supposed to be, for use in error messages.
!
!	The lexeme must have the form:
!
!	    [digit] digit "-" letter letter letter "-" ["19"] digit digit
!
!	It is assumed that letters have already been converted to upper case.
!
! Formal Parameters:
!
!	a_lexeme:	Address of a descriptor of the lexeme whose syntax
!			is to be checked.
!	a_description:	Address of a descriptor of what the lexeme is supposed
!			to be, for use in error messages.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE if the lexeme has the syntax given above.
!	FALSE means the user has been told of his mistake.
!
! Side Effects:
!
!	None
!
!--

    begin	! CHECK_DATE
    bind
	lexeme = .a_lexeme : desc_block,
	description = .a_description : desc_block ;

    local
	day_digits,	! Number of digits seen in the day.
	hyphens,	! Number of hyphens encountered so far.
	month_letters,	! Number of letters seen in the month.
	p_this,		! Pointer to current character being checked.
	year_digits ;	! Number of digits seen in the year.

    ! Initialize to scan the lexeme.
    hyphens = 0 ;
    day_digits = 0 ;
    month_letters = 0 ;
    year_digits = 0 ;
    p_this = .lexeme[desc_ptr] ;

    ! Scan the lexeme from left to right.
    incr i from 1 to .lexeme[desc_len] do
	begin	! Examine one character and advance to the next.
	selectone ch$rchar(.p_this) of
	    set	! Examine one character.

	    [%c'-']:
		begin		! Hyphen.
		hyphens = .hyphens + 1 ;
		if .hyphens geq 3
		then
		    begin	! Too many hyphens.
		    ers(s_hyphtwo,cat('Your ', description, ' ', lexeme,
			' should have two hyphens')) ;
		    return false ;
		    end ;	! Too many hyphens.
		end ;		! Hyphen.

	    [%c'0' to %c'9']:
		selectone .hyphens of
		    set		! Digit action.
		    [0]:
			day_digits = .day_digits + 1 ;
		    [1]:
			begin	! Digits in month.
			ers(s_nomondig,cat('Your ', description, ' ', lexeme,
			   ' should not have a digit in the month'));
			return false ;
			end ;	! Digits in month.
		    [2]:
			year_digits = .year_digits + 1 ;
		    [otherwise]:
			bug(cat('CHECK_DATE hyphen error for digits of ',
				lexeme)) ;

		    tes ;	! Digit action.

	    [%c'A' to %c'Z']:
		selectone .hyphens of
		    set		! Letter action.
		    [0]:
			begin	! Leading letter.
			ers(s_datebad,cat('Your ', description, ' ', lexeme,
			   ' should have a form like: [d]d-mmm-19yy')) ;
			return false ;
			end ;	! Leading letter.
		    [1]:
			month_letters = .month_letters + 1 ;
		    [2]:
			begin	! Letter in year.
			ers(s_noyearlet,cat('Your ', description, ' ', lexeme,
			   ' should not have a letter in the year'));
			return false ;
			end ;	! Letter in year.
		    [otherwise]:
			bug(cat('CHECK_DATE hyphen error for letters of  ',
				lexeme)) ;
		    tes ;	! Letter action.

	    [otherwise]:
		begin		! Invalid character in date.
		ers(s_ilchar,cat('Your ', description, ' ', lexeme,
		    ' may not contain "', (1, .p_this), '"')) ;
		return false ;
		end ;		! Invalid character in date.

	    tes ;		! Examine one character.

	p_this = ch$plus(.p_this, 1) ;
	end ;	! Examine one character and advance to the next.

    if .hyphens lss 2
    then
	begin	! Not enough hyphens.
	ers(s_hyphtwo,cat('Your ', description, ' ', lexeme,
		' should have two hyphens')) ;
	return false ;
	end ;	! Not enough hyphens.

    if .day_digits lss 1 or .day_digits gtr 2
    then
	begin	! Day error.
	ers(s_dayerr,cat('Your ', description, ' ', lexeme,
	    ' should have a day of one or two digits')) ;
	return false ;
	end ;	! Day error.

    if .month_letters neq 3
    then
	begin	! Month error.
	ers(s_montherr,cat('Your ', description, ' ', lexeme,
	    ' should have a month of three letters')) ;
	return false ;
	end ;	! Month error.

    if .year_digits neq 2 and .year_digits neq 4
    then
	begin	! Year size error
	ers(s_yearerr,cat('Your ', description, ' ', lexeme,
	    ' should have a year of two or four digits')) ;
	return false ;
	end ;	! Year size error.

    if .year_digits eql 4
    then
	if ch$neq(2, ch$plus(.lexeme[desc_ptr], .lexeme[desc_len] - 4),
		len_comma_ptr('19'))
	then
	    begin	! Century error.
	    ers(s_not20cent,cat('In your ', description, ' ', lexeme,
		' the four-digit year should begin with "19"')) ;
	     return false ;
	    end ;	! Century error.

    true
    end ;	! CHECK_DATE

global routine recval(a_user_string, a_qua) =

!++
! Functional Description:
!
!	This routine determines whether a qualifer whose block is qiven
!	takes an optional or mandatory value.  If it does, the value is
!	obtained from the beginning of the user string, and is removed from
!	the user string.
!
! Formal Parameters:
!
!	a_user_string:	Address of a descriptor of the unprocessed characters
!			in the user's command string.  If the qualifier takes
!			a value, then a leading colon or equal sign indicates
!			that the user supplied a value.  The descriptor is
!			advanced beyond the value by NXTLEX.
!	a_qua:		Address of a qualifier block for the qualifier whose
!			value is to be looked for.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistake, otherwise FALSE.
!
! Side Effects:
!
!	None
!
!--

    begin	! RECVAL
    bind
	user_string = .a_user_string : desc_block,
	qua = .a_qua : qualifier_block ;

    ! Initialize the descriptor for the qualifier value.
    $str_desc_init(descriptor = qua[qua_value], string = (0, k_null)) ;

    ! Treat each qualifier separately.
    selectone .qua[qua_code] of
	set	! Examine the qualifier code.

	[k_all_qual, k_append_qual, k_brief_qual, k_class_qual,
	 k_delete_qual, k_if_absent_qual, k_if_present_qual, k_keep_qual,
	 k_nohistory_qual, k_nonotes_qual, k_parallel_qual, 
	 k_recover_qual, k_reserve_qual, k_supersede_qual, k_unusual_qual,
	 K_log_qual,k_nolog_qual,k_repair_qual,k_read_qual,k_noread_qual,
	 k_noappend_qual,k_nooutput_qual,k_nokeep_qual,k_noreserve_qual,
	 k_noparallel_qual,k_nomerge_qual,k_nosupersede_qual,k_novariant_qual,
	 k_noclass_qual,k_noformat_qual,k_nobrief_qual,k_nounusual_qual,
	 k_norecover_qual,k_norepair_qual,k_nodelete_qual]:
	    begin	! No value allowed.
	    if peekch(user_string, chars_for_eql)
	    then
		begin	! User tried to give a value.
		ers(s_valnotall,cat(codspl(.qua[qua_code]),
				 ' does not take a value')) ;
		return false ;
		end ;	! User tried to give a value.
	    end ;	! No value allowed.

	[k_output_qual]:
	    begin	! Optional file specification.
	    if peekch(user_string, chars_for_eql)
	    then
		begin	! User supplied an optional file specification.

		! Eat up the colon or equal sign.
		if not nxtlex(user_string, k_normal_lex, k_null,
				qua[qua_value])
		then
		    bug(lit('NXTLEX found no delimiter for /OUTPUT')) ;

		! Take the next lexeme as a file specification.
		if not nxtlex(user_string, k_file_spec_lex,
				codspl(k_file_spec_syn), qua[qua_value])
		then
		    return false ;
		end ;	! User supplied an optional file specification.
	    end ;	! Optional file specification.

	[k_gen_qual, k_merge_qual]:
	    begin	! Required generation expression.

	    ! Get the delimiter.
	    if not required_eql(user_string, k_gen_exp_syn, qua)
	    then
		return false ;

	    ! Recognize the generation expression.
	    if not genexp(user_string, k_gen_exp_syn, qua[qua_value],
						      qua[qua_a_tree])
	    then
		return false ;

	    end ;	! Required generation expression.
	    
	[k_from_qual]:
	    begin	! Required generation primary.
	    if not required_lexeme(user_string, k_normal_lex,
						k_gen_pri_syn, qua)
	    then
		return false ;

	    ! Make sure it has the right syntax.
	    if not genpri(qua[qua_value], codspl(k_gen_pri_syn))
	    then
		return false ;

	    end ;	! Required generation primary.

	[k_variant_qual]:
	    begin	! Required variant letter.
	    if not required_lexeme(user_string, k_normal_lex,
						k_var_let_syn, qua)
	    then
		return false ;

	    ! Make sure it is only one character.
	    if .qua[qua_value_len] gtr 1
	    then
		begin	! Variant value too long.
		ers(s_badvar,cat(qua[qua_value], ' is invalid because ',
			codspl(.qua[qua_code]), ' needs a single letter')) ;
		return false ;
		end ;	! Variant value too long.

	    ! Make sure it is a letter.
	    if ch$rchar(.qua[qua_value_ptr]) lss %c'A'
	    or ch$rchar(.qua[qua_value_ptr]) gtr %c'Z'
	    then
		begin	! Not a letter.
		ers(s_badvar,cat( qua[qua_value], ' is invalid because ',
		    codspl(.qua[qua_code]), ' needs a letter')) ;
		return false ;
		end ;	! Not a letter.

	    end ;	! Required variant letter.

	[k_position_qual, k_width_qual]:
	    begin	! Required non-negative integer.
	    local
		p_this ;	! Pointer to current character being examined.

	    ! Get the lexeme that is the qualifier value.
	    if not required_lexeme(user_string, k_normal_lex,
						k_char_pos_syn, qua)
	    then
		return false ;

	    ! Make sure it is a non-negative integer.
	    p_this = .qua[qua_value_ptr] ;
	    incr i from 1 to .qua[qua_value_len] do
		begin	! Examine one digit and advance to the next.
		if ch$rchar(.p_this) lss %c'0' or ch$rchar(.p_this) gtr %c'9'
		then
		    begin	! Non-digit.
		    ers(s_invqual,cat(qua[qua_value], ' is invalid because ',
				codspl(.qua[qua_code]),
				' needs a non-negative integer')) ;
		    return false ;
		    end ;	! Non-digit.
		p_this = ch$plus(.p_this, 1) ;
		end ;	! Examine one digit and advance to the next.

	    end ;	! Required non-negative integer.

	[k_history_qual, k_notes_qual]:
	    begin	! Required insertion pattern.
	    if not required_lexeme(user_string, k_quotation_lex,
						k_ins_pat_syn, qua)
	    then
		return false ;
	    end ;	! Required insertion pattern.

	[k_format_qual]:
	    begin	! Required format string.
	    if not required_lexeme(user_string, k_quotation_lex,
						k_format_syn, qua)
	    then
		return false ;
	    end ;	! Required format string.

	[k_since_qual]:
	    begin	! Required date.

	    ! Get the date string.
	    if not required_lexeme(user_string, k_normal_lex, k_date_syn, qua)
	    then
		return false ;

	    ! Check it for proper form.
	    if not check_date(qua[qua_value], codspl(k_date_syn))
	    then
		return false ;

	    end ;	! Required date.

	[otherwise]:
	    bug(cat(codspl(.qua[qua_code]), ' is not handled by RECVAL')) ;

	tes ;	! Examine the qualifier code.

    true
    end ;	! RECVAL

routine required_eql(a_user_string, syntax, a_qua) =

!++
! Functional Description:
!
!	This routine looks for a ":" or "=" as the next thing in the user's
!	command string.  The user string descriptor is advanced beyond this
!	delimiter by calling NXTLEX.
!
!	If the delimiter is not present, the user is told of his mistake,
!	and FALSE is returned.  The given syntactic category and the QUA_CODE
!	in the given qualifier block are used for messages.
!
! Formal Parameters:
!
!	a_user_string:	Address of a descriptor of the unprocessed characters
!			in the user's command string.  NXTLEX will advance
!			the descriptor just beyond the value found.
!	syntax:		Integer code giving the syntactic category of the
!			qualifier's value, for use in error messages.  These
!			codes are defined in COMUSR.REQ.
!	a_qua:		Address of a qualifier block for this qualifier.
!			The QUA_CODE field is used for messages.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistake, otherwise false.
!
! Side Effects:
!
!	None
!
!--

    begin	! REQUIRED_EQL
    bind
	user_string = .a_user_string : desc_block,
	qua = .a_qua : qualifier_block ;

    ! Look for the colon or equal sign.
    if not peekch(user_string, chars_for_eql)
    then
	begin	! Missing colon or equal sign.
	ers(s_eqlreq,cat(codspl(.qua[qua_code]),
	    	%string(' needs "' %bliss32(, '=" or "'), ':" followed by '),
		codspl(.syntax))) ;
	return false ;
	end ;	! Missing colon or equal sign.

    ! Eat up the colon or equal sign.
    if not nxtlex(user_string, k_normal_lex, k_null, qua[qua_value])
    then
	bug(cat('NXTLEX gave REQUIRED_EQL no delimiter at ',
		user_string)) ;

    true
    end ;	! REQUIRED_EQL

routine required_lexeme(a_user_string, lexical_rule, syntax, a_qua) =

!++
!
! Functional Description:
!
!	This routine looks for a ":" or "=" followed by a qualifier value
!	as the next things in the user's command string.  The value must
!	be present and satisfy the given lexical rule.  If these requirements
!	are not met, the user is told of his mistake, and FALSE is returned.
!	The given syntactic category and the QUA_CODE in the given qualifier
!	block are used for messages.  If the user made no mistake, the
!	QUA_VALUE descriptor in the qualifier block is made to denote
!	the value that was found.  The user string descriptor is advanced
!	beyond the value by NXTLEX.
!
! Formal Parameters:
!
!	a_user_string:	Address of a descriptor of the unprocessed characters
!			in the user's command string.  NXTLEX will advance
!			the descriptor beyond the value found.
!	lexical_rule:	Integer code giving the lexical rule to be satisfied
!			by the value.  These codes are defined in LANGME.REQ.
!	syntax:		Integer code giving the syntactic category of the
!			value, for use in error messages.  These codes are
!			defined in COMUSR.REQ.
!	a_qua:		Address of a qualifier block for this qualifier.
!			The QUA_CODE field is used for messages, and the
!			QUA_VALUE field is stored into.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE is returned if the user made no mistake, otherwise false.
!
! Side Effects:
!
!	None
!
!--

    begin	! REQUIRED_LEXEME
    bind
	user_string = .a_user_string : desc_block,
	qua = .a_qua : qualifier_block ;

    ! Eat up the delimiter.
    if not required_eql(user_string, .syntax, qua)
    then
	return false ;

    ! Get the required value.
    if not nxtlex(user_string, .lexical_rule, codspl(.syntax), qua[qua_value])
    then
	return false ;

    true
    end ;	! REQUIRED_LEXEME

end				! Module VALUES
eludom