MODULE XPARSE (	IDENT = 'V1.2-23'		%TITLE 'XPO$PARSE_SPEC - XPORT File-spec Parser'
		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
		%BLISS36( ,ENTRY( XPO$PARSE_SPEC ),OTS='' )
		) =
BEGIN

!
!			  COPYRIGHT (c) 1983 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:  BLISS Library
!
! ABSTRACT:
!
!	This module parses a system-specific file-specification.
!
! ENVIRONMENT:  User Mode
!
! AUTHORS:  Ward Clark,			CREATION DATE:  6 August 1980
!	    Linda Duffell
!
!--

!
! INCLUDE FILES:
!

LIBRARY  'XPORT' ;					! Public XPORT control block and macro definitions
LIBRARY  'XPOSYS' ;					! Internal XPORT macro definitions

    $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11  )

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    xpo$parse_spec;					! Parsing control routine
%IF %BLISS(BLISS16) %THEN
EXTERNAL ROUTINE
%ELSE
FORWARD ROUTINE
%FI
    xpo$setup_parse :  NOVALUE,				! Parsing initialization
%IF $VMS %THEN
    xpo$node_parse,					! Node name parsing routine
%FI
    xpo$dvice_parse,					! Device parsing routine
%IF NOT $RT11 %THEN
    xpo$direct_parse,					! Directory parsing routine
%FI
    xpo$name_parse,					! File name/type parsing routine
%IF $RSTS %THEN
    xpo$ppn_parse,					! Special PPN parsing routine
    xpo$prot_parse,					! File protection parsing routine
    xpo$extra_parse,					! File option parsing routine
%FI
%IF $TOPS20 %THEN
    xpo$extra_parse,					! File attribute parsing routine
%FI
%IF $RT11 %THEN
    xpo$size_parse,					! File size parsing routine
%FI
    xpo$last_parse;					! Previous field cleanup routine

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! PSECT DECLARATIONS:
!

    $XPO_PSECTS						! Declare XPORT PSECT names and attributes

!
! OWN STORAGE:
!

GLOBAL
    xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
    xpo$scan_spec :  $STR_DESCRIPTOR( CLASS=BOUNDED ),	! File-specification scanning descriptor
    xpo$field_delim,					! Current delimiter code
    xpo$next_field;					! Expected field indicator

!
! EXTERNAL REFERENCES:
!

%IF $RT11 %THEN
EXTERNAL ROUTINE
    XRT$CHK_BACKGRD;					! Background job verification
%FI

GLOBAL ROUTINE XPO$PARSE_SPEC( file_spec, spec_block, free_temp, success_action, failure_action ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine controls file-specification parsing.
!
! FORMAL PARAMETERS:
!
!	file_spec - address of file-spec string descriptor
!	spec_block - address of XPORT file-specification parse block
!	free_temp - temporary string indicator ( 0 = don't free, 1 = free )
!	success_action - address of success action routine
!	failure_action - address of failure action routine
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the file-specification was successfully parsed
!
!	STR$_BAD_DESC - invalid file-spec descriptor
!		failure completion code from $STR_VALIDATE
!	XPO$_FOREGROUND - this is a foreground job (RT-11 only)
!	primary failure completion code from XPO$xxx_PARSE
!		secondary failure completion code from XPO$xxx_PARSE
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

%IF $VMS %THEN 
    LABEL
	vms_native;
    %IF NOT %DECLARED (FSCN$_FILESPEC)	! The definitions for the SYS$FILESCAN codes don't
    %THEN				!  go into STARLET until V3B.
	REQUIRE 'FSCN';			! Take this out after then.
    %FI
%FI

    MAP
	file_spec :  REF $STR_DESCRIPTOR(),
	spec_block : REF $XPO_SPEC_BLOCK ;

    LOCAL
	status;						! Temporary completion code

!
! Initialization
!

    $XPO_MAIN_BEGIN( PARSE )				! Beginning of MAIN_BLOCK code block

%IF $RT11 %THEN
    IF NOT XRT$CHK_BACKGRD()				! Verify that this is a background job.
    THEN
        $XPO_QUIT( FOREGROUND );
%FI

    $STR_VALIDATE( file_spec[$BASE], BAD_DESC );	! Validate the caller's file-spec descriptor.

    xpo$setup_parse( file_spec[$BASE],			! Setup the caller's file-spec block
		    spec_block[$BASE] );		! and internal parsing variables.


%IF $VMS %THEN
!
! Use native VMS systems call to parse the file spec
!
	vms_native:
	BEGIN					! The system service SYS$FILESCAN exists in VMS V3B,
	EXTERNAL ROUTINE SYS$FILESCAN :		!  but not before.
	    BLISS ADDRESSING_MODE (GENERAL) WEAK;

	IF sys$filescan	NEQ 0 THEN				! If it is non-zero then we can call it.
	    BEGIN

	    $LITERAL
		_FILESPEC = $DISTINCT -1,
		_NODE = $DISTINCT -1,
		_DEVICE = $DISTINCT -1,
		_DIRECTORY = $DISTINCT -1,
		_NAME = $DISTINCT -1,
		_TYPE = $DISTINCT -1,
		_VERSION = $DISTINCT -1,
		end_item_list = $DISTINCT -1;				! null item code specifies end of list

	    LOCAL
		items : BLOCKVECTOR [end_item_list + 1, FSCN$S_ITEM_LEN, 1]	! pseudo item list for SYS$FILESCAN
			PRESET(
				[_filespec, FSCN$W_ITEM_CODE] = FSCN$_FILESPEC,
				[_node, FSCN$W_ITEM_CODE] = FSCN$_NODE,
				[_device, FSCN$W_ITEM_CODE] = FSCN$_DEVICE,
				[_directory, FSCN$W_ITEM_CODE] = FSCN$_DIRECTORY,
				[_name, FSCN$W_ITEM_CODE] = FSCN$_NAME,
				[_type, FSCN$W_ITEM_CODE] = FSCN$_TYPE,
				[_version, FSCN$W_ITEM_CODE] = FSCN$_VERSION
				),
		filescan_spec :  $STR_DESCRIPTOR( CLASS=FIXED );	! File-specification scanning descriptor

	    $STR_DESC_INIT( DESCRIPTOR = filescan_spec,			! If and when BOUNDED and DYNAMIC_BOUNDED
			    CLASS = FIXED,				!  descriptors become part of VMS, we can 
			    STRING = file_spec[$BASE] );		!  eliminate this and just use xpo$scan_spec

	    SYS$FILESCAN (filescan_spec, items, 0);

	    IF .items[_filespec, FSCN$W_LENGTH]
		EQLU .filescan_spec[STR$H_LENGTH]		! Did SYS$FILESCAN accept the entire string?
	    THEN						! Then we have a good file spec.
		BEGIN
		!
		! Copy the lengths and pointers to the $XPO_SPEC_BLOCK descriptors
		!
		spec_block[XPO$H_NODE] = .items [_node, FSCN$W_LENGTH];
		spec_block[XPO$A_NODE] = .items [_node, FSCN$L_ADDR];
		spec_block[XPO$H_DEVICE] = .items [_device, FSCN$W_LENGTH];
		spec_block[XPO$A_DEVICE] = .items [_device, FSCN$L_ADDR];
		spec_block[XPO$H_DIRECT] = .items [_directory, FSCN$W_LENGTH];
		spec_block[XPO$A_DIRECT] = .items [_directory, FSCN$L_ADDR];
		spec_block[XPO$H_FILE_NAME] = .items [_name, FSCN$W_LENGTH];
		spec_block[XPO$A_FILE_NAME] = .items [_name, FSCN$L_ADDR];
		spec_block[XPO$H_FILE_TYPE] = .items [_type, FSCN$W_LENGTH];
		spec_block[XPO$A_FILE_TYPE] = .items [_type, FSCN$L_ADDR];
		spec_block[XPO$H_FILE_VER] = .items [_version, FSCN$W_LENGTH];
		spec_block[XPO$A_FILE_VER] = .items [_version, FSCN$L_ADDR];
		!
		!  SYS$FILESCAN does not return wildcard info so scan for wildcards
		!  This may break as file spec rules evolve -- BE CAREFULL!!
		!
		!  Scan the directory, file_name, file_type, and version for wildcards.
		!
		IF $STR_SCAN( STRING = spec_block[XPO$T_DIRECT], STOP = '*%', FAILURE = 0 ) EQLU STR$_NORMAL
		    THEN   spec_block[XPO$V_WILD_DIR] = 1;
		!
		!
		! If the file name is a quoted string, don't scan for wildcards.
		!
		IF NOT ( .spec_block[XPO$H_FILE_NAME] GEQ 2 AND
			CH$RCHAR( .spec_block[XPO$A_FILE_NAME] ) EQL %C'"' AND
			CH$RCHAR( CH$PLUS( .spec_block[XPO$A_FILE_NAME],  .spec_block[XPO$H_FILE_NAME] - 1 ) )
			    EQL %C'"' )
		THEN
		    IF $STR_SCAN( STRING = spec_block[XPO$T_FILE_NAME], STOP = '*%', FAILURE = 0 ) EQLU STR$_NORMAL
			THEN   spec_block[XPO$V_WILD_NAME] = 1;
		!
		IF $STR_SCAN( STRING = spec_block[XPO$T_FILE_TYPE], STOP = '*%', FAILURE = 0 ) EQLU STR$_NORMAL
		    THEN   spec_block[XPO$V_WILD_TYPE] = 1;
		!
		IF $STR_SCAN( STRING = spec_block[XPO$T_FILE_VER], STOP = '*%', FAILURE = 0 ) EQLU STR$_NORMAL
		    THEN   spec_block[XPO$V_WILD_VER] = 1;
		!
		! We will not support GRP,MBR binary conversion in VMS starting with V3B
		! I.e. both  spec_block[XPO$H_PROJ_NUMB] and  spec_block[XPO$H_PGMR_NUMB] will always be zero.
		!
		LEAVE vms_native;
		END;
	    $XPO_QUIT( BAD_SPEC, BAD_SYNTAX );		! Shall we do this instead of (2) below?
	    END;					! I.e. don't try to give a more specific error code.
    !							! It just makes for potential problems.	
    ! If (1) SYS$FILESCAN is not present (i.e. before VMS V3B) or
    !    (2) it didn't take the whole string as a valid file spec,
    ! we fall through to the old string scanning code to
    !    (1) parse the file spec ourselves, or
    !    (2) try to identify the error that stopped SYS$FILESCAN.
    !
%FI


!
! Scan the file-specification one field at a time.
!

    WHILE .xpo$field_delim NEQ null DO			! Repeat the following block as long
	BEGIN						! as there are characters to be processed.

!
! Search for the next delimiter character.
!

	$STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],
		    SUBSTRING = xpo$scan_spec[$BASE],
		    DELIMITER = xpo$field_delim,
		    FAILURE = 0,
		    SPAN = %STRING( 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
				    'abcdefghijklmnopqrstuvwxyz',
%IF $TOPS20 %THEN		    '$-_',	%FI
%IF $VMS %THEN			    '$_',	%FI
%IF $RSTS %THEN			    ' ',	%FI
				    '*0123456789' ) );
	    
!
! Check for a quoted file-spec string (VMS only).
!

%IF $VMS %THEN
	IF .xpo$field_delim EQL %C'"'
	THEN
	    BEGIN
	    LOCAL temp_pointer, temp_pfxlen;

	    temp_pointer = .xpo$scan_spec[STR$A_POINTER];
	    temp_pfxlen = .xpo$scan_spec[STR$H_PFXLEN];

	    WHILE 1 DO
		BEGIN
		xpo$scan_spec[STR$H_LENGTH] = .xpo$scan_spec[STR$H_LENGTH] + 1;

		IF NOT $STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],
				    FIND = '"',
				    SUBSTRING = xpo$scan_spec[$BASE],
				    DELIMITER = xpo$field_delim,
				    FAILURE = 0 )
		THEN
		    $XPO_QUIT( BAD_SPEC, BAD_SYNTAX );

		IF .xpo$field_delim NEQ %C'"'		! Check for a two imbedded quotation marks.
		THEN
		    EXITLOOP;
		END;

	    xpo$scan_spec[STR$H_LENGTH] = .xpo$scan_spec[STR$A_POINTER] - .temp_pointer + 1;
	    xpo$scan_spec[STR$A_POINTER] = .temp_pointer;
	    xpo$scan_spec[STR$H_PFXLEN] = .temp_pfxlen;
	    END;
%FI

!
! Select an appropriate processing routine based on the current delimiter.
!

	status = (SELECTONE .xpo$field_delim OF		! Use the delimiter value to select a processing routine.
	    SET

	    [ %C':' ] :
%IF $VMS %THEN
		IF .xpo$scan_spec[STR$H_MAXLEN] - .xpo$scan_spec[STR$H_PFXLEN]
				- .xpo$scan_spec[STR$H_LENGTH] GEQ 2 AND
		    CH$RCHAR( CH$PLUS( .xpo$scan_spec[STR$A_POINTER], .xpo$scan_spec[STR$H_LENGTH] + 1 ) ) EQL %C':'
		THEN
		    xpo$node_parse( spec_block[$BASE], secondary_code )
		ELSE
%FI
		    xpo$dvice_parse( spec_block[$BASE], secondary_code );

	    [ %C'[' ] :
%IF $RT11 %THEN
		xpo$size_parse( spec_block[$BASE], secondary_code );
%ELSE
		xpo$direct_parse( spec_block[$BASE], %C']', secondary_code );
%FI

%IF $TOPS20 OR $VMS %THEN
	    [ %C'<' ] :
		xpo$direct_parse( spec_block[$BASE], %C'>', secondary_code );
%FI

	    [ %C'.' ] :
		xpo$name_parse( spec_block[$BASE], secondary_code );

%IF $TOPS20 %THEN
	    [ %C';' ] :
		xpo$extra_parse( spec_block[$BASE], secondary_code );
%FI

%IF $VMS OR $11M %THEN
	    [ %C';' ] :
		xpo$name_parse( spec_block[$BASE], secondary_code );
%FI

%IF $RSTS %THEN
	    [ %C'<' ] :
		xpo$prot_parse( spec_block[$BASE], secondary_code );

    	    [ %C'(' ]:
		xpo$direct_parse( spec_block[$BASE], %C')', secondary_code );

    	    [ %C'$', %C'!', %C'%', %C'&', %C'#', %C'@' ]:
		xpo$ppn_parse( spec_block[$BASE], secondary_code );

            [ %C'/' ]:
		xpo$extra_parse( spec_block[$BASE], secondary_code );
%FI

	    [ null ] :
		xpo$last_parse( spec_block[$BASE], secondary_code );

	    [ OTHERWISE ] :
		$XPO_QUIT( BAD_SYNTAX, (STR$_BAD_CHAR) );

	    TES);

!
! Terminate file-spec parsing if an error is detected.
!

	IF NOT .status
	THEN
	    $XPO_QUIT( (.status) );
	END;						! End of scanning loop

%IF $VMS %THEN
	END;			! This terminates the VMS V3B labeled block - "vms_native"
%FI

!
! Complete the file-specification parse block.
!

    spec_block[XPO$V_WILD_CARD] =			! Turn on the overall wildcard indicator if any single
	.spec_block[XPO$V_WILD_NODE] OR			! wildcard indicator is on.
	.spec_block[XPO$V_WILD_DEV] OR
	.spec_block[XPO$V_WILD_DIR] OR
	.spec_block[XPO$V_WILD_NAME] OR
	.spec_block[XPO$V_WILD_TYPE] OR
	.spec_block[XPO$V_WILD_VER] OR
	.spec_block[XPO$V_WILD_ATTR];

    $XPO_QUIT( NORMAL );

    $XPO_MAIN_END;					! End of MAIN_BLOCK code block

!
! Call an appropriate action routine.
!

    $XPO_ACTION_RTN( .file_spec );

!
! Free an XPORT temporary string used in this file-spec parse.
!

    IF .free_temp					! If this is a user call,
    THEN						!
	$STR_FREE_TEMP( .file_spec );			! free the file-spec string if it is a temporary string.

!
! Return the final completion code to the caller.
!

    RETURN .primary_code

    END;

$XPO_MODULE( XPARS1 )

%TITLE 'XPO$SETUP_PARSE - File-spec Parsing Setup'

GLOBAL ROUTINE xpo$setup_parse( file_spec, spec_block ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine initializes the caller's file-spec parse block
!	and various internal file-spec parsing variables.
!
! FORMAL PARAMETERS:
!
!	file_spec - address of file-spec string descriptor
!	spec_block - address of file-spec block
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - file-spec parsing state vector zeroed
!	xpo$scan_spec - file-spec scanning descriptor initialized
!	xpo$field_delim - set to non-null
!	xpo$next_field - set to indicate file name expected
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	file_spec :  REF $STR_DESCRIPTOR(),
	spec_block : REF $XPO_SPEC_BLOCK ;

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(),		! File-specification scanning descriptor
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

!
! Zero all of the file-specification parsing state indicators.
!

    INCR index FROM 0 TO XPO$K_STATE_LEN-1 DO
	xpo$state[.index] = 0;

!
! Setup the file-spec scanning string descriptor.
!

    $STR_DESC_INIT( DESCRIPTOR = xpo$scan_spec[$BASE],
		    CLASS = BOUNDED,
		    STRING = file_spec[$BASE] );

!
! Initialize the current delimiter code to a non-null value.
!

    xpo$field_delim = del;

!
! Assume that the first file-spec field will be the file name.
!

    xpo$next_field = XPO$K_NAME_NEXT;

!
! Initialize the entire file-spec block.
!

    spec_block[XPO$V_SPEC_STAT] = 0;
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_NODE] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_DEVICE] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_DIRECT] );
    spec_block[XPO$H_PROJ_NUMB] = 0;
    spec_block[XPO$H_PGMR_NUMB] = 0;
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_FILE_NAME] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_FILE_TYPE] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_FILE_VER] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_FILE_PROT] );
    $STR_DESC_INIT( DESCRIPTOR = spec_block[XPO$T_EXTRA] );

!
! Return to the caller.
!

    RETURN
    END;

%TITLE 'XPO$NODE_PARSE - VAX/VMS Node Name Parsing'
%IF $VMS %THEN

ROUTINE xpo$node_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up node name information in the file-spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate node name processed
!	xpo$scan_spec - sub-string extended to include the trailing punctuation
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the node name was successfully processed
!	XPO$_BAD_NODE - the node name is invalid
!		XPO$_BAD_LENGTH - too long
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_WILDCARD - contains an imbedded wildcard
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR();		! File-specification scanning descriptor

    $XPO_PARSE_MAX					! Maximum field length literals

!
! Validate the node name.
!
							! Test for one of the following syntax errors:
    IF .xpo$state[XPO$V_SPEC_NODE]			!    node name already specified or assumed
    THEN
	$XPO_RETURN2( BAD_NODE, BAD_ORDER );

    IF .xpo$scan_spec[STR$H_LENGTH] EQL 0 OR		!    null node name
	.xpo$scan_spec[STR$H_LENGTH] GTR XPO$K_MAX_NODE	!    node name is too long
    THEN
	$XPO_RETURN2( BAD_NODE, BAD_LENGTH );
	
    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
    THEN
	IF .xpo$scan_spec[STR$H_LENGTH] NEQ 1		!    imbedded wild-card in node name
	THEN
	    $XPO_RETURN2( BAD_NODE, WILDCARD )
	ELSE
	    spec_block[XPO$V_WILD_NODE] = 1;

!
! Setup the node name information in the file-specification block.
!

    xpo$scan_spec[STR$H_LENGTH] =			! Add the delimiters to the node name.
		.xpo$scan_spec[STR$H_LENGTH] + 2;

    spec_block[XPO$H_NODE] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_NODE] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_NODE] = 1;			! Indicate a node name has been processed.

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
%FI

$XPO_MODULE( XPARS2 )

%TITLE 'XPO$DVICE_PARSE - Device Name Parsing'

GLOBAL ROUTINE xpo$dvice_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up device name information in the file-spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate device name processed
!	xpo$scan_spec - sub-string extended to include the trailing punctuation
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the device name was successfully processed
!	XPO$_BAD_DEVICE - the device name is invalid
!		XPO$_BAD_LENGTH - too long
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_WILDCARD - contains an imbedded wildcard
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR();		! File-specification scanning descriptor

    $XPO_PARSE_MAX					! Maximum field length literals

!
! Validate the device name.
!
							! Test for one of the following syntax errors:
    IF .xpo$state[XPO$V_SPEC_DEV]			!    device name already specified or assumed
    THEN
	$XPO_RETURN2( BAD_DEVICE, BAD_ORDER );

    IF .xpo$scan_spec[STR$H_LENGTH] EQL 0 OR		!    null device name
	.xpo$scan_spec[STR$H_LENGTH] GTR XPO$K_MAX_DEV	!    device name is too long
    THEN
	$XPO_RETURN2( BAD_DEVICE, BAD_LENGTH );
	
    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
    THEN
	IF .xpo$scan_spec[STR$H_LENGTH] NEQ 1		!    imbedded wild-card in device name
	THEN
	    $XPO_RETURN2( BAD_DEVICE, WILDCARD )
	ELSE
	    spec_block[XPO$V_WILD_DEV] = 1;

!
! Setup the device name information in the file-specification block.
!

    xpo$scan_spec[STR$H_LENGTH] =			! Add the colon to the device name.
		.xpo$scan_spec[STR$H_LENGTH] + 1;

    spec_block[XPO$H_DEVICE] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_DEVICE] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_DEV] = 1;			! Indicate a device name has been processed
    xpo$state[XPO$V_SPEC_NODE] = 1;			! and that a node name cannot appear later.

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;

$XPO_MODULE( XPARS3 )

%TITLE 'XPO$DIRECT_PARSE - Directory Spec Parsing'
%IF NOT $RT11 %THEN

GLOBAL ROUTINE xpo$direct_parse( spec_block, right_delimiter, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine processes a directory specification, converting PPN values
!	(if any) to binary.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	right_delimiter - end of field delimiter (either %C']' or %C'>' or %C')')
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate directory specification processed
!	xpo$scan_spec - sub-string extended thru the trailing punctuation
!	xpo$field_delim - end-of-directory-spec delimiter
!	xpo$next_field - XPO$K_NO_NEXT (conditionally on TOPS-10 only)
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the directory specification was successfully processed
!	XPO$_BAD_DIRECT - the directory specification specification is invalid
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_BAD_SYNTAX - invalid syntax
!		XPO$_WILDCARD - contains an imbedded wildcard
!	failure completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(		! File-specification scanning descriptor
				CLASS = BOUNDED ),
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

    LOCAL
	next_character;					! Look-ahead character

    MACRO
	ppn_radix =					! PPN radix for $STR_BINARY conversion
	    %IF $RSTS %THEN BASE10 %ELSE BASE8 %FI %;

!
! Complete the processing of the previous field, if any.
!

    $XPO_IF_NOT( xpo$last_parse( spec_block[$BASE], .secondary_code ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Verify the location of the directory specification.
!

    IF .xpo$state[XPO$V_SPEC_DIR]			! If a directory field has been processed or omitted,
    THEN						!
	$XPO_RETURN2( BAD_DIRECT, BAD_ORDER );		! return an error code to the caller.

!
! Scan the entire directory specification.
!

    $STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],	! Scan for the end of the directory specification.
		STOP = ']>)',
		SUBSTRING = xpo$scan_spec[$BASE],
		DELIMITER = xpo$field_delim,
		FAILURE = 0 );

    IF .xpo$field_delim EQL .right_delimiter		! Verify that the right delimiter is correct.
    THEN
	xpo$scan_spec[STR$H_LENGTH] =			! Include the right delimiter in the directory sub-string.
		.xpo$scan_spec[STR$H_LENGTH] + 1
    ELSE
%IF $TOPS10 OR $TOPS20 %THEN
	IF .xpo$field_delim NEQ null			! Allow no right delimiter on TOPS-10 and TOPS-20.
	THEN
%FI
	    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );

    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE],	! Test for a valid wildcard directory specification.
		FIND = '*',
		FAILURE = 0 )
    THEN
	IF .xpo$scan_spec[STR$H_LENGTH] EQL 3
	THEN
	    spec_block[XPO$V_WILD_DIR] = 1
	ELSE
	    $XPO_RETURN2( BAD_DIRECT, WILDCARD );

!
! Convert PPN values, if any, to binary.
!

    next_character = CH$RCHAR( CH$PLUS( .xpo$scan_spec[STR$A_POINTER], 1 ) );

    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE],	! If directory spec contains a comma, assume a P,PN format.
		FIND = ',',
		FAILURE = 0 )
    THEN
	BEGIN
	LOCAL
	    ppn_scan :  $STR_DESCRIPTOR( CLASS = BOUNDED );

	$STR_DESC_INIT( DESCRIPTOR = ppn_scan, CLASS = BOUNDED );
	ppn_scan[STR$H_LENGTH] = 1;
	ppn_scan[STR$A_POINTER] = .xpo$scan_spec[STR$A_POINTER];
	ppn_scan[STR$H_MAXLEN] = .xpo$scan_spec[STR$H_MAXLEN];
	ppn_scan[STR$H_PFXLEN] = .xpo$scan_spec[STR$H_PFXLEN];

	$STR_SCAN( REMAINDER = ppn_scan,		! Scan the project number field.
		    SPAN = %STRING( '0123456789' %IF $RSTS %THEN , '#' %FI ),
		    SUBSTRING = ppn_scan,
		    DELIMITER = xpo$field_delim,
		    FAILURE = 0 );

	IF .xpo$field_delim NEQ %C','			! The project number must be followed by a comma.
	THEN
	    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );

	IF .ppn_scan[STR$H_LENGTH] NEQ 0		! Bypass conversion if no project number specified.
	THEN
%IF $RSTS %THEN
	    IF CH$RCHAR( .ppn_scan[STR$A_POINTER] ) EQL %C'#'
	    THEN
		BEGIN					! Convert an octal project number to binary
		IF NOT $STR_BINARY( STRING = ( .ppn_scan[STR$H_LENGTH]-1, .ppn_scan[STR$A_POINTER]+1 ),
				OPTION = BASE8,
				RESULT = spec_block[XPO$H_PROJ_NUMB],
				FAILURE = 0 )
		THEN
		    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );
		END
	    ELSE
%FI
		BEGIN
		IF NOT $STR_BINARY( STRING = ppn_scan,	! Convert a project number to binary.
				OPTION = ppn_radix,
				RESULT = spec_block[XPO$H_PROJ_NUMB],
				FAILURE = 0 )
		THEN
		    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );
		END;
	
	ppn_scan[STR$H_LENGTH] = .ppn_scan[STR$H_LENGTH] + 1;

	$STR_SCAN( REMAINDER = ppn_scan,		! Scan the programmer number field.
		    SPAN = %STRING( '0123456789' %IF $RSTS %THEN , '#' %FI ),
		    SUBSTRING = ppn_scan,
		    DELIMITER = xpo$field_delim,
		    FAILURE = 0 );

	IF .xpo$field_delim NEQ .right_delimiter	! The programmer number must be followed
	THEN						! the the proper right delimiter.
%IF $TOPS10 %THEN
	    IF .xpo$field_delim EQL %C','		! A comma indicates a TOPS-10 SFD.
	    THEN
		spec_block[XPO$V_SFD] = 1
	    ELSE
%FI
		$XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );
	
	IF .ppn_scan[STR$H_LENGTH] NEQ 0		! Bypass conversion if no programmer number specified.
	THEN
%IF $RSTS %THEN
	    IF CH$RCHAR( .ppn_scan[STR$A_POINTER] ) EQL %C'#'
	    THEN
		BEGIN					! Convert an octal programmer number to binary
		IF NOT $STR_BINARY( STRING = ( .ppn_scan[STR$H_LENGTH]-1, .ppn_scan[STR$A_POINTER]+1 ),
				OPTION = BASE8,
				RESULT = spec_block[XPO$H_PGMR_NUMB],
				FAILURE = 0 )
		THEN
		    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );
		END
	    ELSE
%FI
		BEGIN
		IF NOT $STR_BINARY( STRING = ppn_scan,	! Convert a programmer number to binary.
				OPTION = ppn_radix,
				RESULT = spec_block[XPO$H_PGMR_NUMB],
				FAILURE = 0 )
		THEN
		    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );
		END;

	spec_block[XPO$V_PPN] = 1;			! Indicate that a PPN was specified.
	END
    ELSE
	IF .next_character NEQ %C'*' AND
	    .next_character NEQ .right_delimiter
	THEN
%IF $TOPS10 OR $11M OR $RSTS %THEN
	    $XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );	! Some systems require PPN, wild-card or null directory spec.
%ELSE
	    spec_block[XPO$V_DIR_NAME] = 1;		! Indicate a directory name was specified.
%FI

!
! Complete the PPN information in the file-specification block.
!

    spec_block[XPO$H_DIRECT] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_DIRECT] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_DIR] = 1;			! Indicate that a PPN has been processed
%IF NOT $RSTS %THEN					!
    xpo$state[XPO$V_SPEC_NODE] = 1;			! and that a node name or device name cannot appear later.
    xpo$state[XPO$V_SPEC_DEV] = 1;
%FI

%IF $TOPS10 %THEN
    IF .xpo$state[XPO$V_SPEC_NAME] OR			! If this TOPS-10 directory specification follows
	.xpo$state[XPO$V_SPEC_TYPE]			! a file name or file type,
    THEN						!
	BEGIN						!
	xpo$state[XPO$V_SPEC_NAME] = 1;			! indicate that neither can appear later
	xpo$state[XPO$V_SPEC_TYPE] = 1;			!
	xpo$next_field = XPO$K_NO_NEXT;			! and that no further fields are expected.
	END;
%FI

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
%FI

$XPO_MODULE( XPARS4 )

%TITLE 'XPO$NAME_PARSE - File Name, Type and Version Parsing'

GLOBAL ROUTINE xpo$name_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine completes the processing of a field which ends
!	with a comma.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$field_delim - current field delimiter (11M only)
!
! IMPLICIT OUTPUTS:
!
!	xpo$scan_spec - set to describe delimiter which will be part of the next field
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the previous field was successfully processed
!	XPO$_BAD_VER - the file version field is invalid (11M only)
!		XPO$_BAD_SYNTAX - period cannot precede version number
!	completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(),		! File-specification scanning descriptor
	xpo$field_delim;				! Current delimiter code

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

!
! Check for a period preceding a version number (11M only).
!

%IF $11M %THEN
    IF .xpo$field_delim EQL %C'.' AND .xpo$state[XPO$V_SPEC_NAME]
    THEN
	$XPO_RETURN2( BAD_VER, BAD_SYNTAX );
%FI

!
! Complete the processing of the previous field, if any.
!

    $XPO_IF_NOT( xpo$last_parse( spec_block[$BASE], .secondary_code ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Setup to process the next field.
!

    xpo$scan_spec[STR$H_LENGTH] = 1;			! Leave the scanning descriptor describing
							! the current delimiter (period or semi-colon).

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;

$XPO_MODULE( XPARS5 )

%TITLE 'XPO$PPN_PARSE - Special RSTS/E PPN Parsing'
%IF $RSTS %THEN

GLOBAL ROUTINE xpo$ppn_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up special PPN information in the file-spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate a directory spec has been processed
!	xpo$scan_spec - updated to describe the current special PPN
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the PPN was successfully processed
!	XPO$_BAD_DIRECT - the PPN specification is invalid
!		XPO$_BAD_ORDER - misplaced or duplicated
!	completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR();		! File-specification scanning descriptor

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

!
! Complete the processing of the previous field, if any.
!

    $XPO_IF_NOT( xpo$last_parse( xpo$scan_spec[$BASE] ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Verify the location of the PPN.
!

    IF .xpo$state[XPO$V_SPEC_DIR]			! If a directory field has been processed or omitted,
    THEN						!
	$XPO_RETURN2( BAD_DIRECT, BAD_ORDER );		! return an error code to the caller.

!
! Complete the special PPN information in the file-spec block.
!

    xpo$scan_spec[STR$H_LENGTH] = 1;			! Setup the scanning descriptor to describe
							! the current descriptor (special PPN).

    spec_block[XPO$H_DIRECT] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_DIRECT] = .xpo$scan_spec[STR$A_POINTER];

    spec_block[XPO$V_DIR_NAME] = 1;			! Indicate a special PPN was specified.

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_DIR] = 1;			! Indicate that a directory spec has been processed.

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
%FI

$XPO_MODULE( XPARS6 )

%TITLE 'XPO$PROT_PARSE - Special RSTS/E File Protection Parsing'
%IF $RSTS %THEN

GLOBAL ROUTINE xpo$prot_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up protection information in the file-spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate a protection spec has been processed
!	xpo$scan_spec - updated to describe the entire protection spec
!	xpo$field_delim - set to %C']'
!	xpo$next_field - set to indicate no further field expected
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the size was successfully processed
!	XPO$_BAD_PROT - the protection specification is invalid
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_BAD_SYNTAX - invalid syntax
!	completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(),		! File-specification scanning descriptor
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

!
! Complete the processing of the previous field, if any.
!

    $XPO_IF_NOT( xpo$last_parse( xpo$scan_spec[$BASE] ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Verify the location of the protection specification.
!

    IF .xpo$state[XPO$V_SPEC_PROT]			! If a protection field has been processed
    THEN						!
    	$XPO_RETURN2( BAD_PROT, BAD_ORDER );		! return an error code to the caller.

!
! Scan the entire protection specification.
!

    $STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],	! Scan for the end of the protection specification.
		STOP = '>',
		SUBSTRING = xpo$scan_spec[$BASE],
		DELIMITER = xpo$field_delim,
		FAILURE = 0 );

    IF .xpo$field_delim NEQ %C'>'			! Verify that the right delimiter is correct.
    THEN
	$XPO_RETURN2( BAD_DIRECT, BAD_SYNTAX );

    xpo$scan_spec[STR$H_LENGTH] =			! Include the right delimiter in the protection sub-string.
		.xpo$scan_spec[STR$H_LENGTH] + 1;

!
! Complete the protection information in the file-spec block.
!

    spec_block[XPO$H_FILE_PROT] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_FILE_PROT] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_PROT] = 1;			! Indicate that a protection spec has been processed
    xpo$state[XPO$V_SPEC_DEV] = 1;			! and that a device name,
    xpo$state[XPO$V_SPEC_NAME] = 1;			!    a file name,
    xpo$state[XPO$V_SPEC_TYPE] = 1;			!    or a file type cannot appear later.

    xpo$next_field = XPO$K_NO_NEXT;			! Indicate that no further field are expected.

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
%FI

$XPO_MODULE( XPARS7 )

%TITLE 'XPO$EXTRA_PARSE - Extra Field(s) Parsing'
%IF $TOPS20 OR $RSTS %THEN

GLOBAL ROUTINE xpo$extra_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine completes the processing of the previous field and
!	sets up the 'EXTRA' information in the file_spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$scan_spec - updated to describe the extra file-spec info
!	xpo$field_delim - set to "null"
!	xpo$next_field - set to indicate no further field expected
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the previous field was successfully processed.
!	XPO$_BAD_ATTR - invalid attribute
!		XPO$_BAD_LENGTH - too long (TOPS-20 only)
!		XPO$_WILDCARD - contains an imbedded wildcard
!	completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$scan_spec :  $STR_DESCRIPTOR(),		! File-specification scanning descriptor
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

    $XPO_PARSE_MAX					! Maximum field length literals

!
! Complete the processing of the previous field.
!

    $XPO_IF_NOT( xpo$last_parse( spec_block[$BASE], .secondary_code ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Scan to the end of the file-spec string.
!

    $STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],
		STOP = %CHAR(del),
		SUBSTRING = xpo$scan_spec[$BASE],
		DELIMITER = xpo$field_delim,
		FAILURE = 0 );

!
! Validate the file attribute.
!

%IF $TOPS20 %THEN					! Test for one of the following syntax errors:
    IF .xpo$scan_spec[STR$H_LENGTH] GTR XPO$K_MAX_ATTR	!    file attribute string is too long
    THEN
	$XPO_RETURN2( BAD_ATTR, BAD_LENGTH );
%FI

    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
    THEN
	IF .xpo$scan_spec[STR$H_LENGTH] NEQ 2		!    imbedded wildcard in attribute info
	THEN
	    $XPO_RETURN2( BAD_ATTR, WILDCARD )
	ELSE
	    spec_block[XPO$V_WILD_ATTR] = 1;

!
! Complete the file attribute information in the file-spec block.
!

    spec_block[XPO$H_EXTRA] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_EXTRA] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$next_field = XPO$K_NO_NEXT;			! Indicate no further field expected.

!
! Return to the caller
!

    RETURN XPO$_NORMAL

    END;
%FI

$XPO_MODULE( XPARS8 )

%TITLE 'XPO$SIZE_PARSE - Special RT-11 File Size Parsing'
%IF $RT11 %THEN

GLOBAL ROUTINE xpo$size_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up size information in the file-spec block.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate a size field has been processed
!	xpo$scan_spec - updated to describe the entire size field
!	xpo$field_delim - set to %C']'
!	xpo$next_field - set to indicate no further field expected
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the size was successfully processed
!	XPO$_BAD_SIZE - the size specification is invalid
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_BAD_SYNTAX - invalid syntax
!	completion code from XPO$LAST_PARSE
!
! SIDE EFFECTS:
!
!	This routine calls XPO$LAST_PARSE.
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(),		! File-specification scanning descriptor
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

    EXTERNAL ROUTINE
	xpo$last_parse;					! Previous field cleanup routine.

!
! Complete the processing of the previous field, if any.
!

    $XPO_IF_NOT( xpo$last_parse( xpo$scan_spec[$BASE] ) )
    THEN
	RETURN .$XPO_STATUS;

!
! Verify the location of the size specification.
!

    IF .xpo$state[XPO$V_SPEC_SIZE]			! If a size field has been processed or omitted,
    THEN						!
	$XPO_RETURN2( BAD_SIZE, BAD_ORDER );		! return an error code to the caller.

!
! Scan the size field.
!

    $STR_SCAN( REMAINDER = xpo$scan_spec[$BASE],	! Scan to the end of the size field.
		STOP = ']',
		SUBSTRING = xpo$scan_spec[$BASE],
		DELIMITER = xpo$field_delim,
		FAILURE = 0 );

    IF .xpo$field_delim NEQ %C']'
    THEN
	$XPO_RETURN2( BAD_SIZE, BAD_SYNTAX );

    xpo$scan_spec[STR$H_LENGTH] =			! Include the final delimiter in the size field.
	.xpo$scan_spec[STR$H_LENGTH] + 1;

!
! Complete the size field information in the file-spec block.
!

    spec_block[XPO$H_EXTRA] = .xpo$scan_spec[STR$H_LENGTH];
    spec_block[XPO$A_EXTRA] = .xpo$scan_spec[STR$A_POINTER];

!
! Setup to process the next field.
!

    xpo$state[XPO$V_SPEC_SIZE] = 1;			! Indicate that a size field has been processed
    xpo$state[XPO$V_SPEC_DEV] = 1;			! and that a device name,
    xpo$state[XPO$V_SPEC_NAME] = 1;			!    a file name,
    xpo$state[XPO$V_SPEC_TYPE] = 1;			!    and a file type cannot appear later.

    xpo$next_field = XPO$K_NO_NEXT;			! Indicate that there should be no other fields.

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
%FI
    
$XPO_MODULE( XPARS9 )

%TITLE 'XPO$LAST_PARSE - Previous Field Parsing'

GLOBAL ROUTINE xpo$last_parse( spec_block, secondary_code ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets up the field which precedes the current delimiter
!	and then updates the scanning string descriptor.
!
! FORMAL PARAMETERS:
!
!	spec_block - address of file-spec block
!	secondary_code - address of secondary completion code
!
! IMPLICIT INPUTS:
!
!	xpo$state - current parsing state
!	xpo$scan_spec - current file-spec field descriptor
!
! IMPLICIT OUTPUTS:
!
!	xpo$state - updated to indicate a file name, type or version has been processed
!	xpo$scan_spec - updated to describe null string preceding current delimiter
!	xpo$next_field - set to indicate next expected field
!
! COMPLETION CODES:  (secondary codes are indented)
!
!	XPO$_NORMAL - the previous field was successfully processed
!	XPO$_BAD_NAME - invalid file name
!		XPO$_BAD_LENGTH - too long
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_WILDCARD - contains an imbedded wildcard
!	XPO$_BAD_SYNTAX - invalid file-spec syntax
!		XPO$_BAD_ORDER - field is misplaced or duplicated
!	XPO$_BAD_TYPE - invalid file type
!		XPO$_BAD_LENGTH - too long
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_WILDCARD - contains an imbedded wildcard
!	XPO$_BAD_VER - invalid file version (TOPS20, VMS and 11M only)
!		XPO$_BAD_ORDER - misplaced or duplicated
!		XPO$_BAD_SYNTAX - invalid syntax (not numbers or wildcard)
!		XPO$_WILDCARD - contains an imbedded wildcard
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	spec_block :  REF $XPO_SPEC_BLOCK;		! Redefine the file-spec block parameter

    EXTERNAL
	xpo$state :  $XPO_PARSE_STATE,			! File-specification parsing state indicators
	xpo$scan_spec :  $STR_DESCRIPTOR(		! File-specification scanning descriptor
				CLASS = BOUNDED ),
	xpo$field_delim,				! Current delimiter code
	xpo$next_field;					! Expected field indicator

    $XPO_PARSE_MAX					! Maximum field length literals

!
! Determine whether a "previous field" exists.
!

    IF .xpo$scan_spec[STR$H_LENGTH] EQL 0 AND		! If there is no previous field,
	.xpo$field_delim NEQ %C'.' AND			!
	.xpo$field_delim NEQ %C';' AND			!
	.xpo$next_field EQL XPO$K_NAME_NEXT		!
    THEN						!
	RETURN XPO$_NORMAL;				! return a success code to the caller.

!
! Select processing based on the "expected field" type.
!

    CASE .xpo$next_field				! Use the expected field code to select
	FROM XPO$K_NO_NEXT				! appropriate processing.
%IF $TOPS20 OR $VMS OR $11M %THEN
		TO XPO$K_VER_NEXT
%ELSE
		TO XPO$K_TYPE_NEXT
%FI			OF
	SET

!
! File name processing.
!

	[ XPO$K_NAME_NEXT ] :
	    BEGIN					! Check for one of the following syntax errors:
	    IF .xpo$state[XPO$V_SPEC_NAME]		!    a file name has already appeared
	    THEN
		$XPO_RETURN2( BAD_NAME, BAD_ORDER );

	    IF .xpo$scan_spec[STR$H_LENGTH] GTR		!    the file name is too long
				XPO$K_MAX_NAME
	    THEN
		$XPO_RETURN2( BAD_NAME, BAD_LENGTH );

	    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
	    THEN
		IF .xpo$scan_spec[STR$H_LENGTH] NEQ 1	!    the file name contains an imbedded wildcard
		THEN
		    $XPO_RETURN2( BAD_NAME, WILDCARD )
		ELSE
		    spec_block[XPO$V_WILD_NAME] = 1;

	    spec_block[XPO$H_FILE_NAME] =		! Save the length of and a pointer to the file name.
			.xpo$scan_spec[STR$H_LENGTH];
	    spec_block[XPO$A_FILE_NAME] = .xpo$scan_spec[STR$A_POINTER];

	    xpo$state[XPO$V_SPEC_NAME] = 1;		! Indicate a file name has appeared.

%IF $VMS OR $11M %THEN
	    IF .xpo$field_delim EQL %C';'		! If the current delimiter is a semi-colon,
	    THEN					!
		BEGIN					!
		xpo$next_field = XPO$K_VER_NEXT;	! indicate that the next field should be a version
		xpo$state[XPO$V_SPEC_TYPE] = 1;		! and that a file type cannot appear later.
		END
	    ELSE
%FI
		xpo$next_field = XPO$K_TYPE_NEXT;	! Otherwise, indicate that a type is expected.
	    END;

!
! File type processing.
!

	[ XPO$K_TYPE_NEXT ] :
	    BEGIN					! Check for one of the following syntax errors:
	    IF .xpo$state[XPO$V_SPEC_TYPE]		!    a file type has already appeared
	    THEN
		$XPO_RETURN2( BAD_TYPE, BAD_ORDER );

	    IF .xpo$scan_spec[STR$H_LENGTH] GTR		!    the file type is too long
				XPO$K_MAX_TYPE
	    THEN
		$XPO_RETURN2( BAD_TYPE, BAD_LENGTH );

	    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
	    THEN
		IF .xpo$scan_spec[STR$H_LENGTH] NEQ 1	!    the file type contains an imbedded wildcard
		THEN
		    $XPO_RETURN2( BAD_TYPE, WILDCARD )
		ELSE
		    spec_block[XPO$V_WILD_TYPE] = 1;

	    spec_block[XPO$H_FILE_TYPE] =		! Save the length of and a pointer to the file type.
			.xpo$scan_spec[STR$H_LENGTH] + 1;
	    spec_block[XPO$A_FILE_TYPE] = CH$PLUS( .xpo$scan_spec[STR$A_POINTER], -1 );

	    xpo$state[XPO$V_SPEC_TYPE] = 1;		! Indicate a file type has appeared
	    xpo$state[XPO$V_SPEC_NAME] = 1;		! and that a file name cannot appear later.

%IF $TOPS20 OR $VMS OR $11M %THEN
	    xpo$next_field = XPO$K_VER_NEXT;		! Indicate that a file version is expected.
	    END;

!
! File version processing.
!

	[ XPO$K_VER_NEXT ] :
	    BEGIN					! Check for one of the following syntax errors:
	    IF .xpo$state[XPO$V_SPEC_VER]		!    a file version has already appeared
	    THEN
		$XPO_RETURN2( BAD_VER, BAD_ORDER );

	    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], SPAN = '0123456789*', FAILURE = 0 ) NEQ STR$_END_STRING
	    THEN
		$XPO_RETURN2( BAD_VER, BAD_SYNTAX );	!    file version was not a number or an asterisk

	    IF $STR_SCAN( STRING = xpo$scan_spec[$BASE], FIND = '*', FAILURE = 0 )
	    THEN
		IF .xpo$scan_spec[STR$H_LENGTH] NEQ 1	!    the file version contains an imbedded wildcard
		THEN
		    $XPO_RETURN2( BAD_VER, WILDCARD )
		ELSE
		    spec_block[XPO$V_WILD_VER] = 1;

	    spec_block[XPO$H_FILE_VER] =		! Save the length of and a pointer to the file version.
			.xpo$scan_spec[STR$H_LENGTH] + 1;
	    spec_block[XPO$A_FILE_VER] = CH$PLUS( .xpo$scan_spec[STR$A_POINTER], -1 );

	    xpo$state[XPO$V_SPEC_VER] = 1;		! Indicate a file version has appeared
	    xpo$state[XPO$V_SPEC_NAME] = 1;		! and that a file name or type cannot appear later.
	    xpo$state[XPO$V_SPEC_TYPE] = 1;
%FI
	    xpo$next_field = XPO$K_NO_NEXT;		! Indicate no further fields expected.
	    END;

!
! Expected null field processing.
!

	[ XPO$K_NO_NEXT ] :
	    IF .xpo$scan_spec[STR$H_LENGTH] EQL 0	! If there is no previous field,
	    THEN					!
		RETURN XPO$_NORMAL			! return a success code to the caller.
	    ELSE
		$XPO_RETURN2( BAD_SYNTAX, BAD_ORDER );	! Otherwise, return error codes to the caller.

	TES;

!
! Complete setup for processing the next field.
!

    xpo$scan_spec[STR$A_POINTER] =			! Setup the scanning descriptor describe a null string
	CH$PLUS( .xpo$scan_spec[STR$A_POINTER],		! which precedes the current delimiter.
		    .xpo$scan_spec[STR$H_LENGTH] );
    xpo$scan_spec[STR$H_PFXLEN] = .xpo$scan_spec[STR$H_PFXLEN] + .xpo$scan_spec[STR$H_LENGTH];
    xpo$scan_spec[STR$H_LENGTH] = 0;

							! Indicate that the following fields cannot appear later:
    xpo$state[XPO$V_SPEC_NODE] = 1;			!    node name
    xpo$state[XPO$V_SPEC_DEV] = 1;			!    device name
%IF NOT $TOPS10 AND NOT $RSTS %THEN			!
    xpo$state[XPO$V_SPEC_DIR] = 1;			!    directory specification
%FI

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;
END
ELUDOM