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

module rectst (	! Establish a vector of test parameters
		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 declares a global vector TEST that contains parameters
!	used to exercise CMS for testing purposes.  It also contains
!	code to recognize special test qualifiers in the command string
!	and store values into the test vector accordingly.
!
! Environment:	Transportable
!
! Author:  Earl Van Horn	Creation Date:  July, 1980
!
!--

!
! Table of Contents:
!
forward routine
    rectst ;		! Recognize a special test qualifier.

!
! Include Files:
!
%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi
library 'XPORT:' ;
require 'BLISSX:' ;
require 'LANGME:' ;

!
! Macros:
!

!
! Equated Symbols:
!
bind

    ! Prefix for all special test qualifiers.
    test_spelling = lit('/T_E_S_T_') : desc_block ;

literal

    ! Last subscript in the global TEST vector.
    k_test_vector_end = 100 ;

!
! Own Storage:
!
global

    !+
    ! The TEST vector of CMS test parameters.  TEST[0] is TRUE if and only if
    ! at least one of the other components has been set by a special qualifier.
    ! TEST[n] is set to m by a qualifier of the form /T_E_S_T_n = m where
    ! n is between 1 and K_TEST_VECTOR_END, inclusive, and m is a non-negative
    ! integer.  Components not set by a qualifier are initialized to -1.
    !
    !
    !-------- replace algorithm modifiers
    !  [1]  = variation buffer character size
    !  [2]  = master buffer character size
    !  [3]  = variation buffer max lines
    !  [4]  = master buffer max lines
    !
    !-------- rolbck related
    !  [10] = (n>0) Inhibit roll-back.
    !  [11] = (n>0) Activate trace of file-openings and file-closings through
    !		    routines file$open and file$close.
    !  [12] = Control ROLBCK trace (only is rolbck compiled with /VAR:1)
    !		>=1 trace actual rolbck operation
    !		>=2 trace creation of rolbck data structures
    !
    !-

    test : vector[k_test_vector_end + 1]
		initial(false, rep k_test_vector_end of (-1)) ;

!
! External References:
!
external literal
    s_boundindx,	!index outside of allowed range
    s_needdigit,	!lexeme must be only digits
    s_noeqlsign,	!missing equal sign
    s_noindx,		!gives no index
    s_nondgindx;	!gives non-digit index

external routine
    ascdec,		! Convert decimal to binary.
    bug : novalue,	! Report a bug.
    ers,		! Report a user mistake.
    nxtlex,		! Get the next command lexeme.
    peekch ;		! Look ahead to the character after this lexeme.

global routine rectst(a_user_string, a_found_special) =

!++
! Functional Description:
!
!	This routine recognizes a special test qualifier of the form
!	
!		/T_E_S_T_n = m
!
!	where n is an integer between 1 and K_TEST_VECTOR_END, inclusive,
!	and m in a non-negative integer.  TEST[n] is set equal to m, where
!	TEST is a global vector declared in this module.
!
! Formal Parameters:
!
!	A_USER_STRING:	Address of a descriptor of the remaining user command
!			string, with no leading blanks or tabs.  If this string
!			begins with a special test qualifier, the descriptor
!			will be advanced over the qualifier and its value, by
!			calling NXTLEX.  If it does not begin with such a
!			qualifier, the descriptor will not be changed.
!	A_FOUND_SPECIAL:Address of a fullword that will be set to TRUE if a
!			special test qualifer is found, and to FALSE otherwise.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	The global vector TEST declared in this module.
!
! Routine Value:
! Completion Codes:
!
!	FALSE if the user made a mistake.  TRUE if the he made no mistake,
!	whether or not a special qualifier was found.
!
! Side Effects:
!
!	None
!
!--

    begin	! RECTST
    bind
	user_string = .a_user_string : desc_block,
	found_special = .a_found_special ;
    local
	lexeme : desc_block,		! Lexeme obtained from NXTLEX.
	p_this,				! Character pointer advanced by ASCDEC.
	test_index,			! Subscript in TEST vector.
	test_value ;			! Value to insert in TEST vector.

    ! Initialize.
    found_special = false ;

    ! The user string must be long enough for the qualifier with one digit.
    if .user_string[desc_len] leq .test_spelling[desc_len]
    then
	return true ;

    ! The non-numeric prefix must be spelled out fully.
    if ch$neq(.test_spelling[desc_len], .user_string[desc_ptr],
		len_comma_ptr(test_spelling))
    then
	return true ;

    ! Eat up the slash.
    if not nxtlex(user_string, k_normal_lex, k_null, lexeme)
    then
	bug(lit('NXTLEX missed slash for RECTST')) ;

    ! Obtain the test qualifier name.
    if not nxtlex(user_string, k_normal_lex, lit('test qualifier'), lexeme)
    then
	return false ;

    ! Make sure the qualifier name has a non-null index field.
    if .lexeme[desc_len] eql .test_spelling[desc_len] - 1
    then
	begin	! No index.
	ers(s_noindx,cat(test_spelling, ' gives no index')) ;
	return false ;
	end ;	! No index

    ! Identify the index in the qualifier name, which has no slash.
    p_this = ch$plus(.lexeme[desc_ptr], .test_spelling[desc_len] - 1) ;

    ! Convert the index.
    test_index = ascdec(p_this,
			.lexeme[desc_len] - (.test_spelling[desc_len] - 1)) ;
    if 0 neq ch$diff(.p_this, ch$plus(.lexeme[desc_ptr], .lexeme[desc_len]))
    then
	begin	! Non-digit index.
	ers(s_nondgindx,cat('/', lexeme, ' has a non-digit following ', 
				test_spelling)) ;
	return false ;
	end ;	! Non-digit index.

    ! Check the range of the index.
    if .test_index lss 1 or .test_index gtr k_test_vector_end
    then
	begin	! Index out of range.
	ers(s_boundindx,cat('/', lexeme, 
		' gives an index outside the allowed range')) ;
	return false ;
	end ;	! Index out of range.

    ! Pass over the equal sign.
    if not peekch(user_string, lit(s_chars_for_eql))
    then
	begin	! Missing equal sign.
	ers(s_noeqlsign,cat('/', lexeme, ' must be assigned a value')) ;
	return false ;
	end ;	! Missing equal sign.

    if not nxtlex(user_string, k_normal_lex, k_null, lexeme)
    then
	bug(lit('NXTLEX missed equal sign for RECTST')) ;

    ! Get the test value.
    if not nxtlex(user_string, k_normal_lex, lit('test value'), lexeme)
    then
	return false ;

    ! Convert the test value.
    p_this = .lexeme[desc_ptr] ;
    test_value = ascdec(p_this, .lexeme[desc_len]) ;
    if 0 neq ch$diff(.p_this, ch$plus(.lexeme[desc_ptr], .lexeme[desc_len]))
    then
	begin	! Bad value.
	ers(s_needdigit,cat(lexeme, ' must be only digits')) ;
	return false ;
	end ;	! Bad value.

    ! Put the value away.
    test[.test_index] = .test_value ;
    test[0] = true ;

    ! Tell the caller what happened.
    found_special = true ;
    true	! No user mistake.
    end ;	! RECTST

end				! Module RECTST
eludom