.TITLE	RSO_OPEN
	.IDENT	/V3.002/
	.ENABLE SUPPRESSION
	.DISABLE GLOBAL,DEBUG,TRACEBACK
	.SUBTITLE Declarations and COMMONs

;+
;		Version:	VMS 4.1
;		Language:	MACRO-32
;		Date:		19-Feb-86
;		Author:		Victor Lindsey
;
;	The information in this document is subject to change without
;	notice and should not be construed as a commitment by VLSystems
;	to support it at this time, unless such is stated elsewhere in
;	writing.  This software is being made available to U.S. DECUS
;	members for use on Digital Equipment Corp. VAX computers running
;	VMS version 4.1 or later.  Neither the author nor VLSystems
;	warrants this software for any purpose; those who elect to use
;	this code do so at their own risk.
;
;	Submitted to the VAX SIG DECUS Library in May, 1986
;-
;	Defaults for /ABORT is:
		DFLT_ABORT = 1		; Never abort on error
;		DFLT_ABORT = 2		; Abort if and only if an unusual error
;		DFLT_ABORT = 3		; Always abort on an error
;	Defaults for /MESSAGE is:
;		DFLT_MESSAGE = 1	; Never MESSAGE on error
		DFLT_MESSAGE = 2	; MESSAGE if and only if an unusual error
;		DFLT_MESSAGE = 3	; Always MESSAGE on an error
;
;	Macro definitions go here
;
;	The following "homegrown" macros (which are .NLISTed below) are:
;
;		.EVENUP n           round up to multiple of "n"
;		.EVENDOWN n         round down to multiple of "n"
;               .BSECT n            start binary bit map section
;		.DSECT n            start definition of offsets section
;		.PBLKx n,var        define ".BLKx n" offset of positive value var
;		.NBLKx n,var        define ".BLKx n" offset of negative value var
;
	.NOCROSS
	.NOSHOW CONDITIONALS,EXPANSIONS,DEFINITIONS
	.NLIST				; Suppress listing here to save on paper

	.MACRO	.BLKDEF
	.IRPC $$$TMP,<ABDFGHLOQW>
		.MACRO	.PBLK'$$$TMP SIZE=1,NAME
			.NLIST
			.IIF NOT_BLANK,NAME,		NAME=.
			.BLK'$$$TMP	SIZE
			.LIST
		.ENDM	.PBLK'$$$TMP
		.MACRO	.NBLK'$$$TMP SIZE=1,NAME
			.NLIST
			.BLK'$$$TMP -<SIZE>
			.IIF NOT_BLANK,NAME,		NAME=.
			.LIST
		.ENDM	.NBLK'$$$TMP
	.ENDR
	.ENDM	.BLKDEF
	.BLKDEF		; Define .PBLKx and .NBLKx macros
	.MDELETE .BLKDEF

	.MACRO	.EVENDOWN ALIGN=2
	.NLIST
	.BLKB	-<<.&^X7FFF>-<<<.&^X7FFF>/ALIGN>*ALIGN>>
	.LIST
	.ENDM	.EVENDOWN

	.MACRO	.EVENUP ALIGN=2
	.NLIST
	.BLKB	<.&^X7FFF>-<<<.&^X7FFF>/ALIGN>*ALIGN>
	.LIST
	.ENDM	.EVENUP

	.MACRO	.BSECT	START=1,CRF
	.NLIST
	.PSECT	.ABS_ABS. ,NOPIC,CON,ABS,LCL,NOSHR,NOEXE,NORD,NOWRT,BYTE
	.=START
	.IF	BLANK CRF
		.LIST
		.MEXIT
	.ENDC
	.IF	IDENTICAL CRF CREF
		.CROSS
		.LIST
		.MEXIT
	.ENDC
	.IF	IDENTICAL CRF NOCREF
		.NOCROSS
		.LIST
		.MEXIT
	.ENDC
	.WARN	; .BSECT 2nd arg not CREF/NOCREF
	.LIST
	.ENDM	.BSECT

	.MACRO	.DSECT	START=0,CRF
	.NLIST
	.PSECT	.ABS_ABS. ,NOPIC,CON,ABS,LCL,NOSHR,NOEXE,NORD,NOWRT,BYTE
	.=START
	.IF	BLANK CRF
		.LIST
		.MEXIT
	.ENDC
	.IF	IDENTICAL CRF CREF
		.CROSS
		.LIST
		.MEXIT
	.ENDC
	.IF	IDENTICAL CRF NOCREF
		.NOCROSS
		.LIST
		.MEXIT
	.ENDC
	.WARN	; .DSECT 2nd arg not CREF/NOCREF
	.LIST
	.ENDM	.DSECT

	.LIST
	.SHOW BINARY,CALLS
;
;	Macros (which are .NLISTed below) are:
;		$TPADEF, $FABDEF, $NAMDEF, $XABDEF, $XABALLDEF, $XABDATDEF,
;		$XABPRODEF, $XABFHCDEF, $RABDEF, $SSDEF, $LIBDEF, $BASDEF,
;		$DSCDEF, $RMSDEF, $PUTMSGDEF
;
	.NOCROSS
	.NOSHOW CONDITIONALS,EXPANSIONS,DEFINITIONS
	.NLIST				; Suppress listing here to save on paper

	.MACRO	$DEFINI	STRUC,GBL,DOT=0	; Use our own "$DEFINI" macro so that...
	.SAVE	LOCAL_BLOCK		;...we can suppresses DEBUG and TRACEBACK
	.NOCROSS
	.IIF	DIF <GBL> <GLOBAL>,.ENABLE	SUPPRESSION
	.PSECT	$ABS$,ABS
	.DISABLE DEBUG,TRACEBACK
	$GBLINI	GBL
	.=DOT
	.ENDM	$DEFINI

	$TPADEF
	.MDELETE $TPADEF
	$FABDEF
	.MDELETE $FABDEF
	$NAMDEF
	.MDELETE $NAMDEF
	$XABDEF
	.MDELETE $XABDEF
	$XABALLDEF
	.MDELETE $XABALLDEF
	$XABDATDEF
	.MDELETE $XABDATDEF
	$XABPRODEF
	.MDELETE $XABPRODEF
	$XABFHCDEF
	.MDELETE $XABFHCDEF
	$RABDEF
	.MDELETE $RABDEF
	$SSDEF
	.MDELETE $SSDEF
	$LIBDEF
	.MDELETE $LIBDEF
	$BASDEF
	.MDELETE $BASDEF
	$DSCDEF
	.MDELETE $DSCDEF
	$RMSDEF
	.MDELETE $RMSDEF
	$PUTMSGDEF
	.MDELETE $PUTMSGDEF
	.LIST
	.SHOW BINARY,CALLS
	.EXTERNAL LIB$STOP
	.EXTERNAL LIB$TPARSE
	.EXTERNAL RSO__ABORT
	.EXTERNAL RSO__CONNECT
	.EXTERNAL RSO__CREATE
	.EXTERNAL RSO__FILENAME
	.EXTERNAL RSO__OPEN
	.EXTERNAL RSO__TPARSE
	.EXTERNAL SYS$ASCTOID
	.EXTERNAL SYS$BINTIM
	.EXTERNAL SYS$CONNECT
	.EXTERNAL SYS$CREATE
	.EXTERNAL SYS$OPEN
	.EXTERNAL SYS$PARSE
	.EXTERNAL SYS$PUTMSG
	.EXTERNAL SYS$SETDFPROT
	.CROSS
	.ENABLE DEBUG,TRACEBACK
;
;;;;;;;; Resultant Filename Table
;
;	CAUTION: If this code is to be part of a shareable library, you must
;	treat the following .PSECT as though it were an extention of the
;	transfer vector table at the beginning of the library--[1] no changes
;	in the size or order of the global RSO_G... variables, and [2] no
;	increase in the size of the transfer vector table that could change the
;	offset of _RSO_DATA within the library itself.  It is suggested that
;	_RSO_DATA be adjacent to the same library cluster as the transfer vector
;	table, and that the transfer vector table has sufficient unused entries
;	to accomodate all future expansion of the library.  Failure to adhere to
;	these rules will cause the library to loose its upward compatibility
;	with images that were LINKed to older versions of this library.
;
	.PSECT	_RSO_DATA,  PIC,OVR,REL,GBL,NOSHR,NOEXE,  RD,  WRT,PAGE
RSO_GW_NODE_OFF::		.BLKW
RSO_GW_DEV_OFF::		.BLKW
RSO_GW_DIR_OFF::		.BLKW
RSO_GW_NAME_OFF::		.BLKW
RSO_GW_TYPE_OFF::		.BLKW
RSO_GW_VER_OFF::		.BLKW
RSO_GW_NODE_LEN::		.BLKW
RSO_GW_DEV_LEN::		.BLKW
RSO_GW_DIR_LEN::		.BLKW
RSO_GW_NAME_LEN::		.BLKW
RSO_GW_TYPE_LEN::		.BLKW
RSO_GW_VER_LEN::		.BLKW
RSO_GL_FILESIZE::		.BLKL
RSO_GL_RSTS_MODE::		.BLKL
RSO_GL_RSTS_CLUSTER::		.BLKL
RSO_GL_RSTS_PROTECTION_CODE::	.BLKL
RSO_GL_RSTS_POSITION::		.BLKL
RSO_GT_DVI::			.BLKB	NAM$C_DVI
RSO_GW_DID1::			.BLKW
RSO_GW_DID2::			.BLKW
RSO_GW_DID3::			.BLKW
RSO_GW_FID1::			.BLKW
RSO_GW_FID2::			.BLKW
RSO_GW_FID3::			.BLKW
RSO_GQ_CREATION_DATE::		.BLKQ
RSO_GQ_REVISION_DATE::		.BLKQ
RSO_GQ_EXPIRATION_DATE::	.BLKQ
RSO_GQ_BACKUP_DATE::		.BLKQ
RSO_GL_UIC::			.BLKL
RSO_GL_NEXT_NEW_BLOCK::		.BLKL
RSO_GW_NEXT_NEW_BYTE::		.BLKW
RSO_GW_FILE_EXTENT::		.BLKW
RSO_GW_PROTECTION_CODE::	.BLKW
RSO_GW_VERSION_LIMIT::		.BLKW
RSO_GW_N.REVISIONS::		.BLKW
RSO_GW_BUFFER_COUNT::		.BLKW
RSO_GW_MULTI_BLOCK::		.BLKW
RSO_GW_FAB_IFI::			.BLKW
RSO_GL_RMS_STS::			.BLKL
RSO_GL_RMS_STV::		; This LONGWORD shares itself with ABORT and MESSAGE flags
RSO_GW_ABORT:			.BLKW		; (first half of RSO_GL_RMS_STV)
RSO_GW_MESSAGE:			.BLKW		; (second half of RSO_GL_RMS_STV)
RSO_GW_RAB_ISI::		.BLKW
RSO_GW_GLOBAL_BUFFER::		.BLKW
RSO_GB_CHAN_MODE::		.BLKB
RSO_GB_FILE_MODE::		.BLKB
RSO_GB_LNM_MODE::		.BLKB
				.BLKB		; Future
RSO_GB_FAB_FAC::		.BLKB
RSO_GB_FAB_SHR::		.BLKB
RSO_GW_WINDOWSIZE::		.BLKW
RSO_GL_DEVCHR::			.BLKL
RSO_GL_DEVCHR2::		.BLKL
RSO_GL_FAB_FOP::		.BLKL
RSO_GL_RAB_ROP::		.BLKL
RSO_GA_RAB_ADDR::		.BLKL
RSO_GL_ACL_CONTEXT::		.BLKL
RSO_GL_ACL_STS::		.BLKL
RSO_GW_ACLLEN::			.BLKW
RSO_GW_LEN::			.BLKW
RSO_GW_BLOCK_SIZE::		.BLKW
RSO_GB_MTACC::			.BLKB
				.ALIGN	LONG
	RSO_L.INIT_AREA = <. - RSO_GW_NODE_OFF>
RSO_GT_FILENAME::		.BLKB	NAM$C_MAXRSS	; (non-initialized)
				.ALIGN	LONG
	L.ACL_BUFFER = 512.
RSO_GT_ACL::			.BLKB	L.ACL_BUFFER	; (non-initialized)
				.ALIGN	LONG
	RSO_L.COMMON = <. - RSO_GW_NODE_OFF>
	.IIF NOT_EQUAL <RSO_L.COMMON-952.>, .ERROR ;_RSO_DATA Common size change!
				.ALIGN	PAGE		; (for future expansion)
;
;	Define certain ASCII values
;
	LEFT_ANGLE_BRACKET = ^X3C
	RIGHT_ANGLE_BRACKET = ^X3E
	COMMA = ^X2C
;
;	Define RSTS disk modes
;
	.BSECT	,CREF
.PBLKB	.,RSTS_DISK_MODE_UPDATE
.PBLKB	.,RSTS_DISK_MODE_APPEND
.PBLKB	.,RSTS_DISK_MODE_GUARD				; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_KEEP_UFD_CURRENT		; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_CTG
.PBLKB	.,RSTS_DISK_MODE_TEMP
.PBLKB	.,RSTS_DISK_MODE_COND_CTG
.PBLKB	.,RSTS_DISK_MODE_NO_SUPERSEDE
.PBLKB	.,RSTS_DISK_MODE_CACHE				; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_PLACE				; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_FIRST				; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_SEQ				; This bit is ignored
.PBLKB	.,RSTS_DISK_MODE_READ_REGARDLESS
.PBLKB	.,RSTS_DISK_MODE_READ_ONLY
.PBLKB	.,RSTS_DISK_MODE_WRITE_UFD			; This bit is ignored
.PBLKB	 ,RSTS_DISK_MODE_EXCEEDED	; Illegal /MODE value from here onward
;
;	Define message parameter area for largest possible msg vector
;
	.DSECT	,CREF
.PBLKL				; Number for LONGWORDs used in vector starting below
.PBLKL				; User-type msg code
.PBLKW				; msg's LONGWORD parameter count
.PBLKW				; msg's option (usually zero)
.PBLKL				; msg's 1st parameter
.PBLKL				; msg's 2nd parameter
.PBLKL				; RMS error code
.PBLKL				; System error code
.PBLKL				; User-type msg code
.PBLKW				; msg's LONGWORD parameter count
.PBLKW				; msg's option (usually zero)
.PBLKL				; msg's 1st parameter
.PBLKL				; msg's 2nd parameter
	L.MSG_AREA = .
;
;	Define Argument List
;
	.DSECT	,CREF
.PBLKB		,N.ARGS			; Number of arguments (always 3)
.PBLKB	3				; (undefined bytes)
.PBLKA		,FAB			; Address of File Access Block (FAB)
.PBLKA		,RAB			; Address of Record Access Block (RAB)
.PBLKA		,CHANNEL		; BASIC's channel number
.EVENUP	4
	N.ARGS.DEFINED = <./4>-1
;
;	Define Scratch Area Offsets
;
	.DSECT	,CREF
.NBLKQ		,TMP_S		; Tmp string descriptor
.NBLKQ		,FILENAME_S	; Filename string descriptor
.NBLKA		,LAST.XAB	; Ptr to last XAB that BASIC setup for FAB
.NBLKA		,FHC.ADDR	; Ptr to FHC XAB that BASIC setup for FAB
.NBLKL		,SYS$STATUS	; Save area for R0 message from SYS services
.NBLKW		,L.OUTPUT_W	; Length of string in output buffer
.NBLKB		,ABORT_F	; Result of /ABORT in filename given
.NBLKB		,MESSAGE_F	; Result of /MESSAGE in filename given
.NBLKB		,UNUSUAL_F	; 0 ==> Normally anticipated error
				; 1 ==> Unusual error
.NBLKB		,OPEN_F		; -1 ==> "OPEN FOR OUTPUT" (RSO_OPENO)
				;  0 ==> Parse only, (RSO_OPENX)
				;  1 ==> "OPEN FOR INPUT" (RSO_OPENI)
.EVENDOWN 4
.NBLKB	TPA$K_LENGTH0,PARAM	; Parameter block for parse function
.EVENDOWN 4
.NBLKB	XAB$C_DATLEN,DATE_XAB	; Date XAB to add for FAB
.EVENDOWN 4
.NBLKB	XAB$C_PROLEN,PRO_XAB	; Protection_code XAB to add for FAB
.EVENDOWN 4
.NBLKB	L.MSG_AREA,MSG_AREA	; Message assembly area
.EVENDOWN 4
	NL.SCRATCH.AREA = -<.>

	.SUBTITLE State table for parsing filename options
	.DISABLE DEBUG,TRACEBACK
;
;	Define state table for parser
;
	$INIT_STATE	RSO_OPEN_TPARSE_STATE_TABLE,RSO_OPEN_TPARSE_KEY_TABLE
	.WEAK	RSO_OPEN_TPARSE_STATE_TABLE,RSO_OPEN_TPARSE_KEY_TABLE
;
	$STATE
	$TRAN	LEFT_ANGLE_BRACKET
	$TRAN	TPA$_LAMBDA,SWITCHES
;
	$STATE
	$TRAN	TPA$_DECIMAL,,PRVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLFILNAM
;
	$STATE
	$TRAN	RIGHT_ANGLE_BRACKET,SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLFILNAM
;
	$STATE	SWITCHES
	$TRAN	TPA$_EOS,TPA$_EXIT
	$TRAN	'/'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLFILNAM
;
	$STATE
	$TRAN	'ABORT',ABT
	$TRAN	'ACL_CONTEXT',CTX
	$TRAN	'BACKUP',BDT
	$TRAN	'BLOCK_SIZE',BLS
	$TRAN	'BUFFER_COUNT',BC
	$TRAN	'CHAN_MODE',CHN
	$TRAN	'CLUSTERSIZE',CL
	$TRAN	'CREATION',CDT
	$TRAN	'DID',DID
	$TRAN	'DVI',DVI
	$TRAN	'EXTENT',EXT
	$TRAN	'EXPIRATION',EDT
	$TRAN	'FAC',FAC
	$TRAN	'FILESIZE',FSZ
	$TRAN	'FILE_MODE',FMD
	$TRAN	'FID',FID
	$TRAN	'FOP',FOP
	$TRAN	'GLOBAL_BUFFERS',GBL
	$TRAN	'LNM_MODE',LNM
	$TRAN	'MESSAGE',MSG
	$TRAN	'MODE',MO
	$TRAN	'MTACC',MTA
	$TRAN	'MULTI_BLOCK',MB
	$TRAN	'NUMBER_OF_REVISIONS',RVN
	$TRAN	'N_REVISIONS',RVN
	$TRAN	'OWNER',UIC
	$TRAN	'POSITION',PO
	$TRAN	'PROTECTION',PR
	$TRAN	'REVISION',RDT
	$TRAN	'RONLY',SWITCHES,ROVAL
	$TRAN	'ROP',ROP
	$TRAN	'SHR',SHR
	$TRAN	'SIZE',FSZ
	$TRAN	'VERSION_LIMIT',VLM
	$TRAN	'WINDOWSIZE',WND
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	BC
	$TRAN	!SWITCH_VALUE,SWITCHES,BCVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	GBL
	$TRAN	!SWITCH_VALUE,SWITCHES,GBLVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	MB
	$TRAN	!SWITCH_VALUE,SWITCHES,MBVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	CTX
	$TRAN	!SWITCH_VALUE,SWITCHES,CTXVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	BLS
	$TRAN	!SWITCH_VALUE,SWITCHES,BLSVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	MTA
	$TRAN	!SWITCH_VALUE,SWITCHES,MTAVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	CL
	$TRAN	!SWITCH_VALUE,SWITCHES,CLVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	MO
	$TRAN	!SWITCH_VALUE,SWITCHES,MOVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	CHN
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'USER',SWITCHES,CHNVAL,,,<3>
	$TRAN	'SUPERVISOR',SWITCHES,CHNVAL,,,<2>
	$TRAN	'EXECUTIVE',SWITCHES,CHNVAL,,,<1>
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FMD
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'USER',SWITCHES,FMDVAL,,,<3>
	$TRAN	'SUPERVISOR',SWITCHES,FMDVAL,,,<2>
	$TRAN	'EXECUTIVE',SWITCHES,FMDVAL,,,<1>
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	LNM
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'USER',SWITCHES,LNMVAL,,,<3>
	$TRAN	'SUPERVISOR',SWITCHES,LNMVAL,,,<2>
	$TRAN	'EXECUTIVE',SWITCHES,LNMVAL,,,<1>
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	UIC
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'['
	$TRAN	LEFT_ANGLE_BRACKET
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_SYMBOL,,UICID
	$TRAN	TPA$_OCTAL,UIC_C1,GRPVAL
;	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	']',SWITCHES
	$TRAN	RIGHT_ANGLE_BRACKET,SWITCHES
	$TRAN	COMMA,UIC_C2
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	UIC_C1
	$TRAN	COMMA,UIC_C2
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	UIC_C2
	$TRAN	TPA$_SYMBOL,,UICID
	$TRAN	TPA$_OCTAL,,MEMVAL
;	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	']',SWITCHES
	$TRAN	RIGHT_ANGLE_BRACKET,SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	DID
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'('
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,DIDVAL1
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	COMMA
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,DIDVAL2
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	COMMA
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,DIDVAL3
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	DVI
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_SYMBOL,SWITCHES,DVIVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FID
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'('
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,FIDVAL1
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	COMMA
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,FIDVAL2
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	COMMA
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	TPA$_DECIMAL,,FIDVAL3
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FAC
	$TRAN	'='
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	!FAC_VALUE,SWITCHES,FACSET
	$TRAN	'(',FAC_C1
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',SWITCHES,FACCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!FAC_VALUE,SWITCHES,FACCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FAC_C1
	$TRAN	!FAC_VALUE,FAC_C2,FACSET
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',FAC_C2,FACCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!FAC_VALUE,FAC_C2,FACCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FAC_C2
	$TRAN	COMMA,FAC_C1
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FOP
	$TRAN	'='
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	!FOP_VALUE,SWITCHES,FOPSET
	$TRAN	'(',FOP_C1
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',SWITCHES,FOPCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!FOP_VALUE,SWITCHES,FOPCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FOP_C1
	$TRAN	!FOP_VALUE,FOP_C2,FOPSET
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',FOP_C2,FOPCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!FOP_VALUE,FOP_C2,FOPCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FOP_C2
	$TRAN	COMMA,FOP_C1
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	FSZ
	$TRAN	!SWITCH_VALUE,SWITCHES,FSZVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	PR
	$TRAN	!PARSE_PROT,SWITCHES
	$TRAN	!SWITCH_VALUE,SWITCHES,PRVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	PO
	$TRAN	!SWITCH_VALUE,SWITCHES,POVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	EXT
	$TRAN	!SWITCH_VALUE,SWITCHES,EXTVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	CDT
	$TRAN	!DATE_TIME,SWITCHES,CDTVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	RDT
	$TRAN	!DATE_TIME,SWITCHES,RDTVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	EDT
	$TRAN	!DATE_TIME,SWITCHES,EDTVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	BDT
	$TRAN	!DATE_TIME,SWITCHES,BDTVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	ROP
	$TRAN	'='
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	!ROP_VALUE,SWITCHES,ROPSET
	$TRAN	'(',ROP_C1
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',SWITCHES,ROPCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!ROP_VALUE,SWITCHES,ROPCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	ROP_C1
	$TRAN	!ROP_VALUE,ROP_C2,ROPSET
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',ROP_C2,ROPCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!ROP_VALUE,ROP_C2,ROPCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	ROP_C2
	$TRAN	COMMA,ROP_C1
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	RVN
	$TRAN	!SWITCH_VALUE,SWITCHES,RVNVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	SHR
	$TRAN	'='
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	!SHR_VALUE,SWITCHES,SHRSET
	$TRAN	'(',SHR_C1
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',SWITCHES,SHRCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!SHR_VALUE,SWITCHES,SHRCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	SHR_C1
	$TRAN	!SHR_VALUE,SHR_C2,SHRSET
	$TRAN	'N'
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'O'
;
	$STATE
	$TRAN	'NE',SHR_C2,SHRCLR,,,<<-1>>	; i.e.; "NONE"
	$TRAN	!SHR_VALUE,SHR_C2,SHRCLR
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	SHR_C2
	$TRAN	COMMA,SHR_C1
	$TRAN	')',SWITCHES
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	VLM
	$TRAN	!SWITCH_VALUE,SWITCHES,VLMVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	WND
	$TRAN	!SWITCH_VALUE,SWITCHES,WNDVAL
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
;	Numeric value subexpression handler
;
	$STATE	SWITCH_VALUE
	$TRAN	':'
	$TRAN	'='
;
	$STATE
	$TRAN	'#',SWOCT
	$TRAN	'-',NEG_DECIMAL
	$TRAN	TPA$_DECIMAL,FINISH_DECIMAL
;
	$STATE	NEG_DECIMAL
	$TRAN	TPA$_DECIMAL
;
	$STATE
	$TRAN	TPA$_LAMBDA,,NEGVAL
;
	$STATE	FINISH_DECIMAL
	$TRAN	'.',TPA$_EXIT
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
	$STATE	SWOCT
	$TRAN	'-',NEG_OCTAL
	$TRAN	TPA$_OCTAL,TPA$_EXIT
;
	$STATE	NEG_OCTAL
	$TRAN	TPA$_OCTAL
;
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,NEGVAL
;
;	Date/time subexpression parser
;
	$STATE	DATE_TIME
	$TRAN	':'
	$TRAN	'='
;
	$STATE			; Day-of-month digits
	$TRAN	TPA$_DIGIT
	$STATE
	$TRAN	TPA$_DIGIT
;
	$STATE
	$TRAN	'-'
;
	$STATE			; Month
	$TRAN	TPA$_ALPHA
	$STATE
	$TRAN	TPA$_ALPHA
	$STATE
	$TRAN	TPA$_ALPHA
;
	$STATE
	$TRAN	'-'
;
	$STATE			; Year
	$TRAN	TPA$_DIGIT
	$STATE
	$TRAN	TPA$_DIGIT
	$STATE
	$TRAN	TPA$_DIGIT
	$STATE
	$TRAN	TPA$_DIGIT
;
	$STATE			; Time (optional)
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
	$STATE			; Hour (24 hr military style)
	$TRAN	TPA$_DECIMAL
;
	$STATE
	$TRAN	':'
;
	$STATE			; Minutes
	$TRAN	TPA$_DECIMAL
;
	$STATE
	$TRAN	':'
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
	$STATE			; Seconds (optional)
	$TRAN	TPA$_DECIMAL
;
	$STATE
	$TRAN	'.'
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
	$STATE			; Hundredths of seconds (optional)
	$TRAN	TPA$_DECIMAL
;
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
	$STATE	PARSE_PROT
	$TRAN	':'
	$TRAN	'='
;
	$STATE
	$TRAN	'(',,SET_UP_DEFLT_PROT
;
	$STATE	NEXT_PRO
	$TRAN	'SYSTEM',SYPR,DENY_SYPRO
	$TRAN	'OWNER',OWPR,DENY_OWPRO
	$TRAN	'GROUP',GRPR,DENY_GRPRO
	$TRAN	'WORLD',WOPR,DENY_WOPRO
	$TRAN	'S',SYPR,DENY_SYPRO
	$TRAN	'O',OWPR,DENY_OWPRO
	$TRAN	'G',GRPR,DENY_GRPRO
	$TRAN	'W',WOPR,DENY_WOPRO
;
	$STATE	SYPR
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	SYPRO
	$TRAN	'R',SYPRO,PROTVAL,,,<<^X0001>>
	$TRAN	'W',SYPRO,PROTVAL,,,<<^X0002>>
	$TRAN	'E',SYPRO,PROTVAL,,,<<^X0004>>
	$TRAN	'D',SYPRO,PROTVAL,,,<<^X0008>>
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	OWPR
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	OWPRO
	$TRAN	'R',OWPRO,PROTVAL,,,<<^X0010>>
	$TRAN	'W',OWPRO,PROTVAL,,,<<^X0020>>
	$TRAN	'E',OWPRO,PROTVAL,,,<<^X0040>>
	$TRAN	'D',OWPRO,PROTVAL,,,<<^X0080>>
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	GRPR
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	GRPRO
	$TRAN	'R',GRPRO,PROTVAL,,,<<^X0100>>
	$TRAN	'W',GRPRO,PROTVAL,,,<<^X0200>>
	$TRAN	'E',GRPRO,PROTVAL,,,<<^X0400>>
	$TRAN	'D',GRPRO,PROTVAL,,,<<^X0800>>
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	WOPR
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	WOPRO
	$TRAN	'R',WOPRO,PROTVAL,,,<<^X1000>>
	$TRAN	'W',WOPRO,PROTVAL,,,<<^X2000>>
	$TRAN	'E',WOPRO,PROTVAL,,,<<^X4000>>
	$TRAN	'D',WOPRO,PROTVAL,,,<<^X8000>>
	$TRAN	TPA$_LAMBDA,ENDPRO
;
	$STATE	ENDPRO
	$TRAN	COMMA,NEXT_PRO
	$TRAN	')',SWITCHES
;
	$STATE	FOP_VALUE
	$TRAN	'ALL',TPA$_EXIT,,,,<<-1>>
	$TRAN	'CBT',TPA$_EXIT,,,,<FAB$M_CBT>
	$TRAN	'CIF',TPA$_EXIT,,,,<FAB$M_CIF>
	$TRAN	'CTG',TPA$_EXIT,,,,<FAB$M_CTG>
	$TRAN	'DFW',TPA$_EXIT,,,,<FAB$M_DFW>
	$TRAN	'DLT',TPA$_EXIT,,,,<FAB$M_DLT>
	$TRAN	'MXV',TPA$_EXIT,,,,<FAB$M_MXV>
	$TRAN	'NAM',TPA$_EXIT,,,,<FAB$M_NAM>
	$TRAN	'NEF',TPA$_EXIT,,,,<FAB$M_NEF>
	$TRAN	'NFS',TPA$_EXIT,,,,<FAB$M_NFS>
	$TRAN	'OFP',TPA$_EXIT,,,,<FAB$M_OFP>
	$TRAN	'POS',TPA$_EXIT,,,,<FAB$M_POS>
	$TRAN	'RCK',TPA$_EXIT,,,,<FAB$M_RCK>
	$TRAN	'RWC',TPA$_EXIT,,,,<FAB$M_RWC>
	$TRAN	'RWO',TPA$_EXIT,,,,<FAB$M_RWO>
	$TRAN	'SCF',TPA$_EXIT,,,,<FAB$M_SCF>
	$TRAN	'SQO',TPA$_EXIT,,,,<FAB$M_SQO>
	$TRAN	'SPL',TPA$_EXIT,,,,<FAB$M_SPL>
	$TRAN	'SUP',TPA$_EXIT,,,,<FAB$M_SUP>
	$TRAN	'TEF',TPA$_EXIT,,,,<FAB$M_TEF>
	$TRAN	'TMD',TPA$_EXIT,,,,<FAB$M_TMD>
	$TRAN	'TMP',TPA$_EXIT,,,,<FAB$M_TMP>
	$TRAN	'UFO',TPA$_EXIT,,,,<FAB$M_UFO>
	$TRAN	'WCK',TPA$_EXIT,,,,<FAB$M_WCK>
;
	$STATE	ROP_VALUE
	$TRAN	'ALL',TPA$_EXIT,,,,<<-1>>
	$TRAN	'ASY',TPA$_EXIT,,,,<RAB$M_ASY>
	$TRAN	'BIO',TPA$_EXIT,,,,<RAB$M_BIO>
	$TRAN	'CCO',TPA$_EXIT,,,,<RAB$M_CCO>
	$TRAN	'CVT',TPA$_EXIT,,,,<RAB$M_CVT>
	$TRAN	'EOF',TPA$_EXIT,,,,<RAB$M_EOF>
	$TRAN	'ETO',TPA$_EXIT,,,,<RAB$M_ETO>
	$TRAN	'FDL',TPA$_EXIT,,,,<RAB$M_FDL>
	$TRAN	'KGE',TPA$_EXIT,,,,<RAB$M_KGE>
	$TRAN	'KGT',TPA$_EXIT,,,,<RAB$M_KGT>
	$TRAN	'LIM',TPA$_EXIT,,,,<RAB$M_LIM>
	$TRAN	'LOA',TPA$_EXIT,,,,<RAB$M_LOA>
	$TRAN	'LOC',TPA$_EXIT,,,,<RAB$M_LOC>
	$TRAN	'NLK',TPA$_EXIT,,,,<RAB$M_NLK>
	$TRAN	'NXR',TPA$_EXIT,,,,<RAB$M_NXR>
	$TRAN	'PMT',TPA$_EXIT,,,,<RAB$M_PMT>
	$TRAN	'PTA',TPA$_EXIT,,,,<RAB$M_PTA>
	$TRAN	'RAH',TPA$_EXIT,,,,<RAB$M_RAH>
	$TRAN	'REA',TPA$_EXIT,,,,<RAB$M_REA>
	$TRAN	'RLK',TPA$_EXIT,,,,<RAB$M_RLK>
	$TRAN	'RNE',TPA$_EXIT,,,,<RAB$M_RNE>
	$TRAN	'RNF',TPA$_EXIT,,,,<RAB$M_RNF>
	$TRAN	'RRL',TPA$_EXIT,,,,<RAB$M_RRL>
	$TRAN	'TMO',TPA$_EXIT,,,,<RAB$M_TMO>
	$TRAN	'TPT',TPA$_EXIT,,,,<RAB$M_TPT>
	$TRAN	'UIF',TPA$_EXIT,,,,<RAB$M_UIF>
	$TRAN	'ULK',TPA$_EXIT,,,,<RAB$M_ULK>
	$TRAN	'WAT',TPA$_EXIT,,,,<RAB$M_WAT>
	$TRAN	'WBH',TPA$_EXIT,,,,<RAB$M_WBH>
;
	$STATE	FAC_VALUE
	$TRAN	'ALL',TPA$_EXIT,,,,<<-1>>
	$TRAN	'BIO',TPA$_EXIT,,,,<FAB$M_BIO>
	$TRAN	'BRO',TPA$_EXIT,,,,<FAB$M_BRO>
	$TRAN	'DEL',TPA$_EXIT,,,,<FAB$M_DEL>
	$TRAN	'GET',TPA$_EXIT,,,,<FAB$M_GET>
	$TRAN	'PUT',TPA$_EXIT,,,,<FAB$M_PUT>
	$TRAN	'TRN',TPA$_EXIT,,,,<FAB$M_TRN>
	$TRAN	'UPD',TPA$_EXIT,,,,<FAB$M_UPD>
;
	$STATE	SHR_VALUE
	$TRAN	'ALL',TPA$_EXIT,,,,<<-1>>
	$TRAN	'DEL',TPA$_EXIT,,,,<FAB$M_SHRDEL>
	$TRAN	'GET',TPA$_EXIT,,,,<FAB$M_SHRGET>
	$TRAN	'MSE',TPA$_EXIT,,,,<FAB$M_MSE>
	$TRAN	'NIL',TPA$_EXIT,,,,<FAB$M_NIL>
	$TRAN	'PUT',TPA$_EXIT,,,,<FAB$M_SHRPUT>
	$TRAN	'UPD',TPA$_EXIT,,,,<FAB$M_SHRUPD>
	$TRAN	'UPI',TPA$_EXIT,,,,<FAB$M_UPI>
;
	$STATE	ABT
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'NEVER',SWITCHES,ABTVAL,,,<1>
	$TRAN	'UNUSUAL',SWITCHES,ABTVAL,,,<2>
	$TRAN	'ALWAYS',SWITCHES,ABTVAL,,,<3>
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE	MSG
	$TRAN	':'
	$TRAN	'='
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$STATE
	$TRAN	'NEVER',SWITCHES,MSGVAL,,,<1>
	$TRAN	'UNUSUAL',SWITCHES,MSGVAL,,,<2>
	$TRAN	'ALWAYS',SWITCHES,MSGVAL,,,<3>
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,TPAERROR_ILLSWIUSA
;
	$END_STATE

	.SUBTITLE RSO_OPEN Code
	.ENABLE DEBUG,TRACEBACK
;
;;;;;;;; Execution begins here
;
	.PSECT	_RSO_CODE,  PIC,CON,REL,LCL,  SHR,  EXE,  RD,NOWRT,LONG
;
;	Start here for OPEN FOR INPUT/OUTPUT where only switch analysis is done
;
	.ENTRY	RSO_OPENX,^M<R6,R7,R8,R9,R10,R11>
	SUBL2	#NL.SCRATCH.AREA,SP	; Allocate scratch area
	CLRB	OPEN_F(FP)		; Clear type-of-open flag
	BRB	RSO_OPEN_INIT		; Skip ahead
;
;	Start here for OPEN FOR INPUT statements
;
	.ENTRY	RSO_OPENI,^M<R6,R7,R8,R9,R10,R11>
	SUBL2	#NL.SCRATCH.AREA,SP	; Allocate scratch area
	MOVB	#1,OPEN_F(FP)		; Set type-of-open flag
	BRB	RSO_OPEN_INIT		; Skip ahead
;
;	Start here for OPEN FOR INPUT statements
;
	.ENTRY	RSO_OPENO,^M<R6,R7,R8,R9,R10,R11>
	SUBL2	#NL.SCRATCH.AREA,SP	; Allocate scratch area
	MNEGB	#1,OPEN_F(FP)		; Set type-of-open flag
;	BRB	RSO_OPEN_INIT		; Skip ahead
;
;	Now combine RSO_OPENI and RSO_OPENO
;
RSO_OPEN_INIT:
	CLRL	LAST.XAB(FP)		; Clear "last XAB" pointer
	CMPB	#N.ARGS.DEFINED,-
		N.ARGS(AP)		; Correct number of arguments?
	BLSSU	5$			; No, skip ahead if too many
	BEQL	10$			; Yes, skip to continue
	MOVL	#BAS$_TOOFEWARG,R0	; Return "?Too few arguments"
	BRW	EXIT
5$:	MOVL	#BAS$_TOOMANARG,R0	; Return "?Too many arguments"
	BRW	EXIT
;
;	Initialize variables
;
10$:	MOVC5	#0,(FP),#0,-		; Clear RSF common
	#RSO_L.INIT_AREA,G^RSO_GW_NODE_OFF
	MOVB	#1.,UNUSUAL_F(FP)	; Unless countered, all errors are "unusual"
	CLRQ	TMP_S(FP)		; Clear TMP String description
	CLRQ	FILENAME_S(FP)		; Clear FILENAME String description
	MOVAB	@FAB(AP),R7		; Fetch FAB base address
	MOVAB	@RAB(AP),R8		; Fetch RAB base address
	MOVAB	(R8),G^RSO_GA_RAB_ADDR
	MOVB	#DFLT_ABORT,G^RSO_GW_ABORT ; Set defaults for /ABORT and /MESSAGE
	MOVB	#DFLT_ABORT,ABORT_F(FP)
	MOVB	#DFLT_MESSAGE,G^RSO_GW_MESSAGE
	MOVB	#DFLT_MESSAGE,MESSAGE_F(FP)
	MOVB	FAB$B_FAC(R7),-		; Set defaults for /FAC and /SHR
		G^RSO_GB_FAB_FAC
	MOVB	FAB$B_SHR(R7),G^RSO_GB_FAB_SHR
	MOVL	FAB$L_FOP(R7),-		; Set defaults for /FOP and /ROP
		G^RSO_GL_FAB_FOP
	MOVL	RAB$L_ROP(R8),G^RSO_GL_RAB_ROP
;
;	Thread through existing XABs of FAB until end is found
;	At end of loop, R10 will point to last XAB of FAB's XAB chain
;
	MOVAB	@FAB$L_XAB(R7),R10	; Fetch addr of first XAB (always exists)
30$:	CMPB	#XAB$C_FHC,-		; Is XAB the File Header Control Block?
		XAB$B_COD(R10)
	BNEQ	35$			; No, go back and loop for next XAB
	MOVAB	(R10),FHC.ADDR(FP)
35$:	MOVAB	@XAB$L_NXT(R10),R11	; Fetch addr of next XAB
	BEQL	40$			; End this loop if last XAB found
	MOVAB	(R11),R10		; Make R10 last XAB addr
	BRB	30$
;
;	Initialize and link in new XABDAT and XABPRO fields
;
40$:	MOVAB	(R10),LAST.XAB(FP)
	MOVAB	DATE_XAB(FP),XAB$L_NXT(R10) ; Link XABDAT field
	MOVAB	@XAB$L_NXT(R10),R10	; Advance pointer to DATE_XAB block
	MOVC5	#0,(FP),#0,-		; Zero XABDAT field
		#XAB$C_DATLEN,(R10)
	MOVB	#XAB$C_DAT,XAB$B_COD(R10) ; Set XABDAT code in this XAB
	MOVB	#XAB$C_DATLEN,XAB$B_BLN(R10) ; Set length of this XABDAT
	MOVAB	PRO_XAB(FP),XAB$L_NXT(R10) ; Link XABPRO field
	MOVAB	@XAB$L_NXT(R10),R10	; Advance pointer to PRO_XAB block
	MOVC5	#0,(FP),#0,-		; Zero XABPRO field
		#XAB$C_PROLEN,(R10)
	MOVB	#XAB$C_PRO,XAB$B_COD(R10) ; Set XABPRO code in this XAB
	MOVB	#XAB$C_PROLEN,XAB$B_BLN(R10) ; Set length of this XABPRO
	MNEGW	#1,XAB$W_PRO(R10)	; Init protection_code field
;	CLRL	XAB$L_NXT(R10)		; Set end of FAB's XAB chain
;
;	Look for substring in filename to parse
;
RSO_OPEN_PARSER:
	MOVZBL	FAB$B_FNS(R7),R6
	BEQL	9$			; Skip parser if filename is null string
	MOVW	R6,-			; (init FILENAME_S)
		FILENAME_S+DSC$W_LENGTH(FP)
	MOVAB	@FAB$L_FNA(R7),R5
	MOVAB	(R5),FILENAME_S+DSC$A_POINTER(FP)
	LOCC	#^A"/",R6,@FAB$L_FNA(R7) ; Scan for "/": if found R1--> "/"
					;...if not found R1--> end-of-string+1
	MOVL	R0,TMP_S+DSC$W_LENGTH(FP) ; (construct desc of string to parse)
	MOVAB	(R1),TMP_S+DSC$A_POINTER(FP)
	CMPL	R1,R5			; Is there any chars before R1?
	BEQL	5$			; No, do parse where things were (not) found
	INCL	R0
	CMPB	#^A">",-(R1)		; Is <nnn> just before "/" or end-of-string?
	BNEQ	5$			; No, do parse where things were (not) found
	MOVL	#4.,R4			; Begin backwards scan for "<"
2$:	CMPL	R1,R5			; Is there any chars before R1?
	BEQL	5$			; No, do parse where things were (not) found
	INCL	R0
	CMPB	#^A"<",-(R1)		; Is previous char a corresponding "<"?
	BEQL	3$			; Yes, skip
	SOBGTR	R4,2$			; No, loop back to try prior character
	BRB	5$			; END*OF*LOOP: give up search for "<"
3$:	MOVL	R0,TMP_S+DSC$W_LENGTH(FP) ; (construct desc of string to parse)
	MOVAB	(R1),TMP_S+DSC$A_POINTER(FP)
	BRB	10$			; Do parse where "<" is found
5$:	TSTL	TMP_S+DSC$W_LENGTH(FP)	; Is there anything to parse?
	BNEQ	10$
9$:	BRW	PARSE
;
;	Parse the RSTS & VMS specifications in the filename
;
10$:	MOVL	#TPA$K_COUNT0,-
		PARAM+TPA$L_COUNT(FP)	; Initialize parameter block
	MOVL	#TPA$M_BLANKS,-
		PARAM+TPA$L_OPTIONS(FP)
	MOVB	#2,PARAM+TPA$B_MCOUNT(FP)
	MOVQ	TMP_S(FP),-
		PARAM+TPA$L_STRINGCNT(FP)
	PUSHAB	G^RSO_OPEN_TPARSE_KEY_TABLE ; CALL LIB$TPARSE(PARAM block BY REF
	PUSHAB	G^RSO_OPEN_TPARSE_STATE_TABLE ; ,RSO_OPEN_TPARSE_STATE_TABLE BY REF
	PUSHAB	PARAM(FP)		;       ,RSO_OPEN_TPARSE_KEY_TABLE BY REF)
	CALLS	#3,G^LIB$TPARSE
	MOVB	G^RSO_GW_ABORT,ABORT_F(FP) ; Save /ABORT and /MESSAGE results
	MOVB	G^RSO_GW_MESSAGE,MESSAGE_F(FP)
	MOVL	R0,G^RSO_GL_RMS_STS	; Save error codes in RSF
	CLRL	G^RSO_GL_RMS_STV
	BLBS	R0,MODE_HANDLER		; Skip if successful
	CMPB	#1.,MESSAGE_F(FP)	; Else print err msg unless /MESSAGE=NEVER
	BEQL	11$
	PUSHL	#RSO__TPARSE		; (Pass RSO_OPEN error msg code)
	BRW	PUT_SML_MSG
11$:	BRW	EXIT
;
;	Modify FAB according to /MODE value
;
;	NOTE: file protection code, /CLUSTERSIZE value, and /POSITION value
;	are purposely ignored (although they have their equivalents in VMS)
;	because they are not normally provided.  In the future, RSO_OPEN may
;	include support of these features.
;
MODE_HANDLER:
	MOVL	G^RSO_GL_RSTS_MODE,R0	; Fetch /MODE value
	BNEQ	1$			; Skip unless 0 (which implies "no /MODE")
	BRW	FILESIZE_HANDLER
1$:	CMPL	#RSTS_DISK_MODE_EXCEEDED,R0
	BGTRU	2$			; Skip unless undefined mode value
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage"
	BRW	EXIT
;
;	Handle update mode
;
2$:	BITL	#RSTS_DISK_MODE_UPDATE,R0
	BEQL	10$			; Skip if no update
	CMPB	#FAB$C_SEQ,FAB$B_ORG(R7)
	BEQL	3$			; Skip if SEQUENTIAL
	MOVL	#BAS$_ILLILLACC,R0	; Return "?Illegal or illogical access"
	BRW	EXIT
3$:	CMPB	#FAB$C_FIX,FAB$B_RFM(R7)
	BEQL	4$			; Skip if FIXED
	MOVL	#BAS$_ILLILLACC,R0	; Return "?Illegal or illogical access"
	BRW	EXIT
4$:	MOVZWL	FAB$W_MRS(R7),R1	; Fetch buffer size (implied recordsize)
	BITW	#^X01FF,R1
	BEQL	5$			; Skip if multiple of 512
	MOVL	#BAS$_ILLILLACC,R0	; Return "?Illegal or illogical access"
	BRW	EXIT
5$:	ASHL	#-9.,R1,R1		; Compute no. of blocks in buffer...
	MOVB	R1,RAB$B_MBF(R8)	;...and store it in multi-buffer count
	MOVW	#512.,FAB$W_MRS(R7)	; Force record length to 512
	MOVB	#FAB$M_BLK,FAB$B_RAT(R7) ; Set "no-span"; clear "CR", "FTN" & "PRN"
	MOVB	#<FAB$M_PUT!FAB$M_GET!FAB$M_UPD>,-
		G^RSO_GB_FAB_SHR		; Set the MODIFY allow/share bits in FAB
;	BICB2	#<FAB$M_BIO!FAB$M_BRO>,-
;		G^RSO_GB_FAB_FAC		; Clear "Block I/O allowed" in FAB
	MOVB	#<FAB$M_PUT!FAB$M_GET!FAB$M_UPD>,-
		G^RSO_GB_FAB_FAC		; Set the MODIFY access bits in FAB
;
;	Handle append mode
;
10$:	BITL	#RSTS_DISK_MODE_APPEND,R0
	BEQL	20$			; Skip if no append
	BISL2	#RAB$M_EOF,G^RSO_GL_RAB_ROP ; Set the EOF bit in RAB
;
;	Handle the contiguous bits
;
20$:	BITL	#<RSTS_DISK_MODE_CTG!RSTS_DISK_MODE_COND_CTG>,R0
	BEQL	30$			; Skip if no contiguousness requested
	BITL	#RSTS_DISK_MODE_CTG,R0
	BEQL	21$			; Skip unless contiguous
	BISL2	#FAB$M_CTG,G^RSO_GL_FAB_FOP ; Set contiguous bit in FAB
21$:	BITL	#RSTS_DISK_MODE_COND_CTG,R0
	BEQL	22$			; Skip unless conditionally contiguous
	BISL2	#FAB$M_CBT,G^RSO_GL_FAB_FOP ; Set contiguous-best-try bit in FAB
22$:	MOVAB	@FAB$L_XAB(R7),R1	; Fetch first XAB link
23$:	BEQL	30$			; Skip if no (more) XABs
	CMPB	#XAB$C_ALL,XAB$B_COD(R1)
	BNEQ	25$			; Skip if this is not an allocation XAB
	BITL	#RSTS_DISK_MODE_CTG,R0
	BEQL	24$			; Skip unless contiguous
	BISB2	#XAB$M_CTG,-
		XAB$B_AOP(R1)		; Set contiguous bit in XAB
24$:	BITL	#RSTS_DISK_MODE_COND_CTG,R0
	BEQL	25$			; Skip unless conditionally contiguous
	BISB2	#XAB$M_CBT,-
		XAB$B_AOP(R1)		; Set contiguous-best-try bit in XAB
25$:	MOVAB	@XAB$L_NXT(R1),R1	; Fetch next XAB link
	BRB	23$
;
;	Handle the no-supersede bit
;
30$:	BITL	#RSTS_DISK_MODE_NO_SUPERSEDE,R0
	BEQL	31$			; Skip unless no supersede
	BICL2	#FAB$M_SUP,G^RSO_GL_FAB_FOP ; Clear the supersede bit in FAB
;
;	Handle the temporary bit
;
31$:	BITL	#RSTS_DISK_MODE_TEMP,R0
	BEQL	32$			; Skip unless temporary
	BISL2	#FAB$M_TMD,G^RSO_GL_FAB_FOP ; Set the TMD bit in FAB
;
;	Handle the read-regardless bit
;
32$:	BITL	#RSTS_DISK_MODE_READ_REGARDLESS,R0
	BEQL	40$			; Skip unless read-regardless
	BISL2	#RAB$M_RRL,G^RSO_GL_RAB_ROP ; Set the RRL bit in RAB
;
;	Handle the read-only bit
;
40$:	BITL	#RSTS_DISK_MODE_READ_ONLY,R0
	BEQL	FILESIZE_HANDLER	; Skip unless read-only
	MOVB	#FAB$M_GET,G^RSO_GB_FAB_FAC ; Clear all but "read" access
	CMPB	#FAB$C_SEQ,FAB$B_ORG(R7) ; If organization not seq, then sharing OK
	BNEQ	47$
	CMPB	#FAB$C_FIX,FAB$B_RFM(R7) ; If 512-fixed seq, then sharing OK
	BNEQ	42$
	CMPW	#512.,FAB$W_MRS(R7)
	BEQL	45$
42$:	CLRB	G^RSO_GB_FAB_SHR	; No sharing specified
	BRB	FILESIZE_HANDLER
45$:	MOVB	#<FAB$M_PUT!FAB$M_UPD!FAB$M_GET>,-
		G^RSO_GB_FAB_SHR	; Set "writing" bits in FAB sharing
					;...so others may write on this file
	BISL2	#RAB$M_RRL,G^RSO_GL_RAB_ROP ; Permit "read regardless"
	BRB	FILESIZE_HANDLER
47$:	MOVB	#<FAB$M_PUT!FAB$M_UPD!FAB$M_GET!FAB$M_DEL>,-
		G^RSO_GB_FAB_SHR	; Set "writing" bits in FAB sharing
					;...so others may access this file
;
;	Handle the /FILESIZE or /SIZE value
;
FILESIZE_HANDLER:
	MOVL	G^RSO_GL_FILESIZE,R0	; Fetch /FILESIZE value
	BEQL	EXTENT_HANDLER		; Skip if none given
	BGTR	1$			; Skip if value OK
	MOVL	#BAS$_ILLSWIUSA,R0	;...else return "?Illegal switch usage"
	BRW	EXIT
1$:	MOVL	R0,FAB$L_ALQ(R7)	;...else place it in the FAB
	MOVAB	@FAB$L_XAB(R7),R1	; Fetch first XAB link
3$:	BEQL	EXTENT_HANDLER		; Skip if no (more) XABs
	CMPB	#XAB$C_ALL,XAB$B_COD(R1)
	BNEQ	5$			; Skip if this is not an allocation XAB
	MOVL	R0,XAB$L_ALQ(R1)	;...else place filesize in XABALL
5$:	MOVAB	@XAB$L_NXT(R1),R1	; Fetch next XAB link
	BRB	3$
;
;	Handle the /EXTENT value
;
EXTENT_HANDLER:
	MOVW	G^RSO_GW_FILE_EXTENT,R0	; Fetch /EXTENT value
	BEQL	ID_HANDLER		; Skip if none given
	MOVW	R0,FAB$W_DEQ(R7)	;...else place it in the FAB
	MOVAB	@FAB$L_XAB(R7),R1	; Fetch first XAB link
3$:	BEQL	ID_HANDLER		; Skip if no (more) XABs
	CMPB	#XAB$C_ALL,XAB$B_COD(R1)
	BNEQ	5$			; Skip if this is not an allocation XAB
	MOVW	R0,XAB$W_DEQ(R1)	;...else place EXTENT in XABALL
5$:	MOVAB	@XAB$L_NXT(R1),R1	; Fetch next XAB link
	BRB	3$
;
;	Load DVI, DID and FID
;
ID_HANDLER:
	TSTB	G^RSO_GT_DVI		; Is there any chars in DVI?
	BNEQ	10$			; Yes, handle DVI/DID/FID
	TSTL	G^RSO_GW_DID1		; Is there a DID given?
	BNEQ	10$			; Yes, handle DVI/DID/FID
	TSTL	G^RSO_GW_FID1		; Is there an FID given?
	BEQL	DATE_HANDLER		; No, skip DVI/DID/FID handler
10$:	BISL2	#FAB$M_NAM,G^RSO_GL_FAB_FOP ; Indicate presence of DVI/DID/FID
	MOVAB	@FAB$L_NAM(R7),R6	; Fetch NAM block pointer
	MOVC3	#NAM$C_DVI,-		; Update DVI in NAM block
		G^RSO_GT_DVI,NAM$T_DVI(R6)
	MOVL	G^RSO_GW_DID1,NAM$W_DID(R6) ; Update DID in NAM block
	MOVW	G^RSO_GW_DID3,NAM$W_DID+4(R6)
	MOVL	G^RSO_GW_FID1,NAM$W_FID(R6) ; Update FID in NAM block
	MOVW	G^RSO_GW_FID3,NAM$W_FID+4(R6)
;
;	Load date/times
;
DATE_HANDLER:
	MOVQ	G^RSO_GQ_BACKUP_DATE,-	; Xfer date to XABDAT block
		DATE_XAB+XAB$Q_BDT(FP)
	MOVQ	G^RSO_GQ_CREATION_DATE,- ; Xfer date to XABDAT block
		DATE_XAB+XAB$Q_CDT(FP)
	MOVQ	G^RSO_GQ_EXPIRATION_DATE,- ; Xfer date to XABDAT block
		DATE_XAB+XAB$Q_EDT(FP)
	MOVQ	G^RSO_GQ_REVISION_DATE,- ; Xfer date to XABDAT block
		DATE_XAB+XAB$Q_RDT(FP)
	MOVW	G^RSO_GW_N.REVISIONS,-	; Xfer date to XABDAT block
		DATE_XAB+XAB$W_RVN(FP)
;
;	FAB/XAB checks, version limit
;
	MOVAB	@FHC.ADDR(FP),R0
	MOVW	FAB$W_MRS(R7),XAB$W_MRZ(R0) ; Make sure MaxRecSiz in FAB = XABFHC
	MOVW	FAB$W_DEQ(R7),XAB$W_DXQ(R0) ; Make sure FilExtSiz in FAB = XABFHC
	MOVL	FAB$L_ALQ(R7),XAB$L_HBK(R0) ; Make sure AllocQuan in FAB = XABFHC
	MOVW	G^RSO_GW_VERSION_LIMIT,-    ; Xfer version limit to XABFHC block
		XAB$W_VERLIMIT(R0)
;
;	Fetch /CHAN_MODE, /FILE_MODE and /LNM_MODE values
;
	INSV	G^RSO_GB_CHAN_MODE,#FAB$V_CHAN_MODE,#2,FAB$B_ACMODES(R7)
	INSV	G^RSO_GB_FILE_MODE,#FAB$V_FILE_MODE,#2,FAB$B_ACMODES(R7)
	INSV	G^RSO_GB_LNM_MODE,#FAB$V_LNM_MODE,#2,FAB$B_ACMODES(R7)
;
;	Fetch protection code, MTACC, ACL context and UIC (if any)
;
	MCOMW	G^RSO_GW_PROTECTION_CODE,- ; Xfer prot code
		PRO_XAB+XAB$W_PRO(FP)
	MOVB	G^RSO_GB_MTACC,-	; Xfer magtape accessibility field
		PRO_XAB+XAB$B_MTACC(FP)
	MOVL	G^RSO_GL_ACL_CONTEXT,-	; Xfer ACL context
		PRO_XAB+XAB$L_ACLCTX(FP)
	MOVL	G^RSO_GL_UIC,-		; Xfer UIC
		PRO_XAB+XAB$L_UIC(FP)
;
;	Fetch /GLOBAL_BUFFER, /BLOCK_SIZE and /WINDOWSIZE 
;
	MOVW	G^RSO_GW_GLOBAL_BUFFER,FAB$W_GBC(R7)
	MOVW	G^RSO_GW_BLOCK_SIZE,FAB$W_BLS(R7)
	TSTB	G^RSO_GW_WINDOWSIZE
	BEQL	1$
	MOVB	G^RSO_GW_WINDOWSIZE,FAB$B_RTV(R7)
	BRB	2$
1$:	MOVZBW	FAB$B_RTV(R7),G^RSO_GW_WINDOWSIZE
2$:
;
;	Fetch and update FAB$L_FOP and RAB$L_ROP values
;
	MOVL	G^RSO_GL_FAB_FOP,FAB$L_FOP(R7)
	MOVL	G^RSO_GL_RAB_ROP,RAB$L_ROP(R8)
;
;	Set FAC and SHR byte values of FAB
;
	MOVB	G^RSO_GB_FAB_FAC,FAB$B_FAC(R7)
	MOVB	G^RSO_GB_FAB_SHR,FAB$B_SHR(R7)
;
;	Now perform the actual OPEN itself
;
PARSE:	MOVL	FAB$L_FOP(R7),G^RSO_GL_FAB_FOP ; Return FAB$L_FOP and RAB$L_ROP
	MOVL	RAB$L_ROP(R8),G^RSO_GL_RAB_ROP
	SUBB2	TMP_S+DSC$W_LENGTH(FP),-
		FAB$B_FNS(R7)		; Truncate filename spec
	MOVL	#SS$_NORMAL,R0		; Reset error flag
	TSTB	OPEN_F(FP)
	BLSS	CREATE			; Skip if OPEN FOR OUTPUTing
	BGTR	1$			; Skip if OPEN FOR INPUTing
	MOVAB	@FAB$L_NAM(R7),R6	; Go for NAM block
	MOVAB	@NAM$L_RSA(R6),-	; Expanded str addr from resultant str addr
		NAM$L_ESA(R6)
	MOVB	NAM$B_RSS(R6),-		; Expanded str size from resultant str size
		NAM$B_ESS(R6)
	$PARSE	FAB=(R7)		; Just parse filename if RSO_OPENXing
	ADDB2	TMP_S+DSC$W_LENGTH(FP),-
		FAB$B_FNS(R7)		; Restore filename spec
					; (so it can be deallocated)
	MOVL	FAB$L_STS(R7),-		; Save error codes in RSF
		G^RSO_GL_RMS_STS
	MOVL	FAB$L_STV(R7),G^RSO_GL_RMS_STV
	BRW	OPENOK
1$:	MOVAB	G^RSO_GT_ACL,-		; Pass ACL buffer addr
		PRO_XAB+XAB$L_ACLBUF(FP)
	MOVW	#L.ACL_BUFFER,-		; Pass ACL buffer length
		PRO_XAB+XAB$W_ACLSIZ(FP)
	BRW	OPEN

CREATE:	$CREATE	FAB=(R7)		;...else OPEN FOR OUTPUT
	ADDB2	TMP_S+DSC$W_LENGTH(FP),-
		FAB$B_FNS(R7)		; Restore filename spec
					; (so it can be deallocated)
	MOVL	FAB$L_STS(R7),-		; Save error codes in RSF
		G^RSO_GL_RMS_STS
	MOVL	FAB$L_STV(R7),G^RSO_GL_RMS_STV
	CMPL	#RMS$_FUL,R0		; Err = "Device full"?
	BEQL	3$			; Yes, abort as "usual" error
	CMPL	#RMS$_SYN,R0		; Err = "File specification syntax error"?
	BEQL	3$			; Yes, abort as "usual" error
	CMPL	#RMS$_PRV,R0		; Err = "Privilege/protection violation"?
	BEQL	3$			; Yes, abort as "usual" error
	CMPL	#RMS$_FEX,R0		; Err = "File already exists"?
	BNEQ	4$			; No, skip
3$:	CLRB	UNUSUAL_F(FP)		; Clear "unusual" flag
	CMPB	#3.,MESSAGE_F(FP)	; Do we print a "usual" error message?
	BEQL	5$			; Yes, print error message
	BRW	EXIT			;...else exit the usual way
4$:	BLBS	R0,OPENOK		; Skip if OK
	CMPB	#1.,MESSAGE_F(FP)	; /MESSAGE=NEVER?
	BNEQ	5$			; No, print messaage, then exit
	BRW	EXIT			;...else exit the usual way
5$:	PUSHL	#RSO__CREATE		; Pass RSO_OPEN error msg code
	BRW	PUT_BIG_MSG

OPEN:	$OPEN	FAB=(R7)		; OPEN FOR INPUT
	ADDB2	TMP_S+DSC$W_LENGTH(FP),-
		FAB$B_FNS(R7)		; Restore filename spec
					; (so it can be deallocated)
	MOVL	FAB$L_STS(R7),-		; Save error codes in RSF
		G^RSO_GL_RMS_STS
	MOVL	FAB$L_STV(R7),G^RSO_GL_RMS_STV
	CMPL	#RMS$_PRV,R0		; Err = "Privilege/protection violation"?
	BEQL	11$			; Yes, abort as "usual" error
	CMPL	#RMS$_SYN,R0		; Err = "File specification syntax error"?
	BEQL	11$			; Yes, abort as "usual" error
	CMPL	#RMS$_FNF,R0		; Err = "File not found"?
	BEQL	11$			; Yes, abort as "usual" error
	CMPL	#RMS$_DNF,R0		; Err = "Directory not found"?
	BNEQ	12$			; No, skip
11$:	CLRB	UNUSUAL_F(FP)		; Clear "unusual" flag
	CMPB	#3.,MESSAGE_F(FP)	; Do we print a "usual" error message?
	BEQL	13$			; Yes, print error message
	BRW	EXIT			;...else exit the usual way
12$:	BLBS	R0,OPENOK		; Skip if OK
	CMPB	#1.,MESSAGE_F(FP)	; /MESSAGE=NEVER?
	BNEQ	13$			; No, print messaage, then exit
	BRW	EXIT			;...else exit the usual way
13$:	PUSHL	#RSO__OPEN		; Pass RSO_OPEN error msg code
	BRW	PUT_BIG_MSG
;
;	Update _RSO_DATA area
;
OPENOK:	MOVW	FAB$W_IFI(R7),-		; Store internal file identifier
		G^RSO_GW_FAB_IFI
	MOVL	FAB$L_DEV(R7),-		; Store primary device characteristics flag
		G^RSO_GL_DEVCHR
	MOVL	FAB$L_SDC(R7),-		; Store secondary dev characteristics flag
		G^RSO_GL_DEVCHR2
	MOVW	FAB$W_BLS(R7),-		; Store block size (terminal's width)
		G^RSO_GW_BLOCK_SIZE
	MOVAB	@FAB$L_NAM(R7),R6	; Go for NAM block
	CLRL	R0
	MOVW	R0,G^RSO_GW_NODE_OFF	; Store offset to node in RSO_GT_FILENAME
	MOVZBL	NAM$B_NODE(R6),R1
	MOVW	R1,G^RSO_GW_NODE_LEN	; Store length of node
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_DEV_OFF	; Store offset to device in RSO_GT_FILENAME
	MOVZBW	NAM$B_DEV(R6),R1
	MOVW	R1,G^RSO_GW_DEV_LEN	; Store length of device
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_DIR_OFF	; Store offset to dir in RSO_GT_FILENAME
	MOVZBW	NAM$B_DIR(R6),R1
	MOVW	R1,G^RSO_GW_DIR_LEN	; Store length of directory
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_NAME_OFF	; Store offset to name in RSO_GT_FILENAME
	MOVZBW	NAM$B_NAME(R6),R1
	MOVW	R1,G^RSO_GW_NAME_LEN	; Store length of name
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_TYPE_OFF	; Store offset to type in RSO_GT_FILENAME
	MOVZBW	NAM$B_TYPE(R6),R1
	MOVW	R1,G^RSO_GW_TYPE_LEN	; Store length of type
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_VER_OFF	; Store offset to version in RSO_GT_FILENAME
	MOVZBW	NAM$B_VER(R6),R1
	MOVW	R1,G^RSO_GW_VER_LEN	; Store length of version
	ADDW2	R1,R0
	MOVW	R0,G^RSO_GW_LEN		; Store total length of RSO_GT_FILENAME
	MOVC5	R0,@NAM$L_RSA(R6),-	; Transfer resultant string...
		#^A" ",#NAM$C_MAXRSS,-	;...(space filled)...
		G^RSO_GT_FILENAME	;...to RSO_GT_FILENAME
	TSTB	NAM$T_DVI(R6)		; Store Device ID if any is returned
	BEQL	26$
	MOVC3	#NAM$C_DVI,NAM$T_DVI(R6),G^RSO_GT_DVI
26$:	MOVL	NAM$W_DID(R6),G^RSO_GW_DID1 ; Store Directory ID
	MOVW	NAM$W_DID+4(R6),G^RSO_GW_DID3
	MOVL	NAM$W_FID(R6),G^RSO_GW_FID1 ; Store File ID
	MOVW	NAM$W_FID+4(R6),G^RSO_GW_FID3
	TSTB	OPEN_F(FP)		; RSO_OPENX?
	BNEQ	27$			; No, skip
	MOVL	#RMS$_NORMAL,R0		; (RSO_OPENX always sucessful)
	BRW	EXIT			; Yes, exit...we are all done
;
;	Return Date/times and other statistics
;
27$:	MOVQ	DATE_XAB+XAB$Q_BDT(FP),- ; Xfer date from XABDAT block
		G^RSO_GQ_BACKUP_DATE
	MOVQ	DATE_XAB+XAB$Q_CDT(FP),- ; Xfer date from XABDAT block
		G^RSO_GQ_CREATION_DATE
	MOVQ	DATE_XAB+XAB$Q_EDT(FP),- ; Xfer date from XABDAT block
		G^RSO_GQ_EXPIRATION_DATE
	MOVQ	DATE_XAB+XAB$Q_RDT(FP),- ; Xfer date from XABDAT block
		G^RSO_GQ_REVISION_DATE
	MOVW	DATE_XAB+XAB$W_RVN(FP),- ; Xfer date from XABDAT block
		G^RSO_GW_N.REVISIONS
	MCOMW	PRO_XAB+XAB$W_PRO(FP),-	 ; Xfer protection code from XABPRO block
		G^RSO_GW_PROTECTION_CODE
	MOVL	PRO_XAB+XAB$L_ACLCTX(FP),-; Xfer ACL context from XABPRO block
		G^RSO_GL_ACL_CONTEXT
	MOVL	PRO_XAB+XAB$L_ACLSTS(FP),-; Xfer ACL status from XABPRO block
		G^RSO_GL_ACL_STS
	MOVW	PRO_XAB+XAB$W_ACLLEN(FP),-; Xfer total ACL length from XABPRO block
		G^RSO_GW_ACLLEN
	MOVL	PRO_XAB+XAB$L_UIC(FP),-	 ; Xfer UIC from XABPRO
		G^RSO_GL_UIC
	MOVB	PRO_XAB+XAB$B_MTACC(FP),-; Xfer magtape accessibility field
		G^RSO_GB_MTACC
	MOVAB	@FHC.ADDR(FP),R0	; Fetch FHC (File Header Control) block
	MOVL	XAB$L_HBK(R0),-		; Xfer number of highest block
		G^RSO_GL_FILESIZE
	MOVL	XAB$L_EBK(R0),-		; Xfer end-of-file block
		G^RSO_GL_NEXT_NEW_BLOCK
	MOVW	XAB$W_FFB(R0),-		; Xfer first free byte in the above block
		G^RSO_GW_NEXT_NEW_BYTE
	MOVW	XAB$W_DXQ(R0),-		; Fetch default file extension quantity
		G^RSO_GW_FILE_EXTENT	; (equals XAB$W_DEQ of XABALL)
					; (overrides FAB$W_DEQ)
	TSTB	OPEN_F(FP)		; OPEN FOR INPUT?
	BLEQ	30$			; No, skip
	MOVL	XAB$L_SBN(R0),-		; Yes, return file's starting block number
		G^RSO_GL_RSTS_POSITION
30$:	MOVW	XAB$W_VERLIMIT(R0),-	; Xfer max-number-of-versions parameter
		G^RSO_GW_VERSION_LIMIT
;
;	Fetch /MULTI_BLOCK, /GLOBAL_BUFFERS and /BUFFER_COUNT values
;
	TSTB	G^RSO_GW_MULTI_BLOCK
	BEQL	41$
	MOVB	G^RSO_GW_MULTI_BLOCK,RAB$B_MBC(R8)
	BRB	42$
41$:	MOVZBW	RAB$B_MBC(R8),G^RSO_GW_MULTI_BLOCK
42$:
	TSTW	G^RSO_GW_GLOBAL_BUFFER
	BEQL	44$
	MOVW	G^RSO_GW_GLOBAL_BUFFER,FAB$W_GBC(R7)
	BRB	45$
44$:	MOVW	FAB$W_GBC(R7),G^RSO_GW_GLOBAL_BUFFER
45$:
	TSTB	G^RSO_GW_BUFFER_COUNT
	BEQL	47$
	MOVB	G^RSO_GW_BUFFER_COUNT,RAB$B_MBF(R8)
	BRB	48$
47$:	MOVZBW	RAB$B_MBF(R8),G^RSO_GW_BUFFER_COUNT
48$:
;
;	"Connect" successful FAB to RAB
;
CONNCT:	MOVL	G^RSO_GL_RMS_STS,R0	; Restore error flag
	BBS	#FAB$V_UFO,-		; No $CONNECT if UFO bit set
		FAB$L_FOP(R7),31$
	$CONNECT RAB=(R8)
	MOVL	RAB$L_STS(R8),-		; Save error codes in RSF
		G^RSO_GL_RMS_STS
	MOVL	RAB$L_STV(R8),G^RSO_GL_RMS_STV
	BLBS	R0,31$			; Skip if OK
	PUSHL	#RSO__CONNECT		; Pass RSO_OPEN error msg code
	BRW	PUT_BIG_MSG
;
;	Now store RAB address for reference in IO$ if /MODE:1
;
31$:	MOVW	RAB$W_ISI(R8),G^RSO_GW_RAB_ISI ; Return RAB's ISI
;
;;;;;;;;;;;;;;; Normal exit routine
;
;	Disconnect the last two "added-on" XABs so BASIC doesn't try to
;	"deallocate" them.
;
EXIT:	MOVAB	@LAST.XAB(FP),R9
	BEQL	1$			; Skip if "last XAB" not extended
	CLRL	XAB$L_NXT(R9)
1$:	BLBS	R0,99$			; Skip ahead if no error
	CMPB	#1.,ABORT_F(FP)		; /ABORT=NEVER?
	BEQL	99$			; Yes, skip ahead
	CMPB	#3.,ABORT_F(FP)		; /ABORT=ALWAYS?
	BEQL	10$			; Yes, abort this program
	TSTB	UNUSUAL_F(FP)		; Unusual error?
	BEQL	99$			; No--exit normally
10$:	PUSHL	R0			; Pass R0 as error condition flag
	CALLS	#1.,G^LIB$STOP		; Abort this program
99$:	RET				; Exit this program
;
;;;;;;;;;;;;;;; Output error messages
;
;	RSO_OPEN msg code pushed on stack
;	R0 = error code
;
PUT_BIG_MSG:
	MOVL	R0,SYS$STATUS(FP)	; Save error code
	MOVAB	MSG_AREA(FP),R1		; Setup message vector area
	MOVL	#10.,(R1)+		; (overall msg vector length)
	BICL3	#^XFFFFFFF8,-		; Get severity code
		R0,R2
	BICL2	#7,(SP)			; Clear severity from RSO_OPEN msg code
	BISL3	R2,(SP)+,(R1)+		; Merge them and place in msg vector
	MOVL	#2.,(R1)+		; (two args of RSO_OPEN msg)
	MOVL	G^RSO_GL_RMS_STS,(R1)+
	MOVL	G^RSO_GL_RMS_STV,(R1)+
	MOVL	G^RSO_GL_RMS_STS,(R1)+	; Then make system evaluate RMS errors
	MOVL	G^RSO_GL_RMS_STV,(R1)+
	BRB	PUT_FINISH_MSG

PUT_SML_MSG:
	MOVL	R0,SYS$STATUS(FP)	; Save error code
	MOVAB	MSG_AREA(FP),R1		; Setup message vector area
	MOVL	#7.,(R1)+		; (overall msg vector length)
	BICL3	#^XFFFFFFF8,-		; Get severity code
		R0,R2
	BICL2	#7,(SP)			; Clear severity from RSO_OPEN msg code
	BISL3	R2,(SP)+,(R1)+		; Merge them and place in msg vector
	MOVL	#1.,(R1)+		; (one arg of RSO_OPEN msg)
	MOVL	R0,(R1)+

PUT_FINISH_MSG:
	BISL3	R2,-			; Then append channel/filename msg
		#<^XFFFFFFF8&RSO__FILENAME>,(R1)+
	MOVL	#2.,(R1)+
	MOVL	@CHANNEL(AP),(R1)+	; Fetch logical unit (channel)
	MOVAQ	FILENAME_S(FP),(R1)	; (filename desc header)
	$PUTMSG_S-
		MSGVEC=MSG_AREA(FP)	; (Ignore possible errors)
	MOVL	SYS$STATUS(FP),R0	; Restore error code
	CMPB	#1,ABORT_F(FP)		; /ABORT=NEVER?
	BNEQ	10$			; No, skip
	BRW	EXIT			; Yes, exit normally
10$:	CMPB	#2,ABORT_F(FP)		; /ABORT=UNUSUAL?
	BNEQ	20$			; No, skip (must be /ABORT=ALWAYS)
	TSTB	UNUSUAL_F(FP)		; Yes...is this "unusual" error?
	BNEQ	20$			; Yes, abort
	BRW	EXIT			; No, exit normally
20$:	PUSHL	#RSO__ABORT		; Pass abort message
	CALLS	#1.,G^LIB$STOP		; Halt program with traceback
	HALT				; (execution should never get to here)
;
;;;;;;;;;;;;;;; Parse action routines
;
;	Parsing error handlers
;
TPAERROR_ILLFILNAM:
	.WORD	^M<>
	MOVL	#BAS$_ILLFILNAM,R0	; Return "?Illegal filename" error
	RET

TPAERROR_ILLSWIUSA:
	.WORD	^M<>
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	RET
;
;	Parsing store-switch-value handlers
;
BCVAL:	.WORD	^M<>
	BITL	#<^XFFFFFF80>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),G^RSO_GW_BUFFER_COUNT
2$:	RET

GBLVAL:	.WORD	^M<>
	BITL	#<^XFFFF8000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),G^RSO_GW_GLOBAL_BUFFER
2$:	RET

MBVAL:	.WORD	^M<>
	BITL	#<^XFFFFFF80>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),G^RSO_GW_MULTI_BLOCK
2$:	RET

RVNVAL:	.WORD	^M<>
	BITL	#<^XFFFF8000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),-
		G^RSO_GW_N.REVISIONS	; /N_REVISIONS <-- switch value
2$:	RET

VLMVAL:	.WORD	^M<>
	BITL	#<^XFFFF8000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),-
		G^RSO_GW_VERSION_LIMIT	; /VERSION_LIMIT <-- switch value
2$:	RET

WNDVAL:	.WORD	^M<>
	BITL	#<^XFFFFFF00>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVZBW	TPA$L_NUMBER(AP),-
		G^RSO_GW_WINDOWSIZE	; /WINDOWSIZE <-- switch value
2$:	RET

MTAVAL:	.WORD	^M<>
	BITL	#<^XFFFFFF80>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVB	TPA$L_NUMBER(AP),-
		G^RSO_GB_MTACC		; /MTACC <-- switch value
2$:	RET

BLSVAL:	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_BLOCK_SIZE	; /BLOCK_SIZE <-- switch value
2$:	RET

EXTVAL:	.WORD	^M<>
	BITL	#<^XFFFF8000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	CVTLW	TPA$L_NUMBER(AP),-
		G^RSO_GW_FILE_EXTENT	; /EXTENT <-- switch value
2$:	RET

CTXVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-
		G^RSO_GL_ACL_CONTEXT	; /ACL_CONTEXT <-- switch value
	RET

CLVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-
		G^RSO_GL_RSTS_CLUSTER	; /CLUSTERSIZE <-- switch value
	RET

MOVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-
		G^RSO_GL_RSTS_MODE	; /MODE <-- switch value
	RET

ABTVAL:	.WORD	^M<>
	MOVB	TPA$L_PARAM(AP),-	; Set the /ABORT flag
		G^RSO_GW_ABORT
	RET

CHNVAL:	.WORD	^M<>
	MOVB	TPA$L_PARAM(AP),-	; Set channel mode
		G^RSO_GB_CHAN_MODE
	RET

FACCLR:	.WORD	^M<>
	BICB2	TPA$L_PARAM(AP),-	; Clear corresponding FAC bit
		G^RSO_GB_FAB_FAC
	RET

FACSET:	.WORD	^M<>
	BISB2	TPA$L_PARAM(AP),-	; Set corresponding FAC bit
		G^RSO_GB_FAB_FAC
	RET

FMDVAL:	.WORD	^M<>
	MOVB	TPA$L_PARAM(AP),-	; Set file mode
		G^RSO_GB_FILE_MODE
	RET

FOPCLR:	.WORD	^M<>
	BICL2	TPA$L_PARAM(AP),-	; Clear corresponding FOP bit
		G^RSO_GL_FAB_FOP
	RET

FOPSET:	.WORD	^M<>
	BISL2	TPA$L_PARAM(AP),-	; Set corresponding FOP bit
		G^RSO_GL_FAB_FOP
	RET

FSZVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-	; /SIZE <-- switch value or
		G^RSO_GL_FILESIZE	; /FILESIZE <-- switch value
	RET

LNMVAL:	.WORD	^M<>
	MOVB	TPA$L_PARAM(AP),-	; Set logical name translation mode
		G^RSO_GB_LNM_MODE
	RET

MSGVAL:	.WORD	^M<>
	MOVB	TPA$L_PARAM(AP),-	; Set /MESSAGE flag
		G^RSO_GW_MESSAGE
	RET

POVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-
		G^RSO_GL_RSTS_POSITION	; /POSITION <-- switch value
	RET

PRVAL:	.WORD	^M<>
	MOVL	TPA$L_NUMBER(AP),-
		G^RSO_GL_RSTS_PROTECTION_CODE ; /PROTECT <-- switch value
	RET

PROTVAL:.WORD	^M<>
	BISW2	TPA$L_PARAM(AP),-	; Set selected bit
		G^RSO_GW_PROTECTION_CODE
	RET

ROVAL:	.WORD	^M<>
	BISL2	#RSTS_DISK_MODE_READ_ONLY,- ; Set /RO bit in MODE
		G^RSO_GL_RSTS_MODE
	RET

ROPCLR:	.WORD	^M<>
	BICL2	TPA$L_PARAM(AP),-	; Clear corresponding ROP bit
		G^RSO_GL_RAB_ROP
	RET

ROPSET:	.WORD	^M<>
	BISL2	TPA$L_PARAM(AP),-	; Set corresponding ROP bit
		G^RSO_GL_RAB_ROP
	RET

SHRCLR:	.WORD	^M<>
	BICB2	TPA$L_PARAM(AP),-	; Clear corresponding SHR bit
		G^RSO_GB_FAB_SHR
	RET

SHRSET:	.WORD	^M<>
	BISB2	TPA$L_PARAM(AP),-	; Set corresponding SHR bit
		G^RSO_GB_FAB_SHR
	RET

GRPVAL:	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GL_UIC+2		; Store group number of UIC
2$:	RET

MEMVAL:	.WORD	^M<>
	BITL	#<^XFFFFC000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GL_UIC+0		; Store member number of UIC
2$:	RET

UICID:	.WORD	^M<>
	PUSHL	#0			; 3rd arg: ID attribute (ignored)
	PUSHAL	G^RSO_GL_UIC		; 2nd arg: Identifier result
	PUSHAQ	TPA$L_TOKENCNT(AP)	; 1st arg: descriptor of name
	CALLS	#3.,G^SYS$ASCTOID	; Translate Identifier Name to UIC
	RET

DIDVAL1:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_DID1		; Store first number of DID
2$:	RET

DIDVAL2:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_DID2		; Store second number of DID
2$:	RET

DIDVAL3:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_DID3		; Store third number of DID
2$:	RET

FIDVAL1:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_FID1		; Store first number of FID
2$:	RET

FIDVAL2:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_FID2		; Store second number of FID
2$:	RET

FIDVAL3:
	.WORD	^M<>
	BITL	#<^XFFFF0000>,-		; Is value too big?
		TPA$L_NUMBER(AP)
	BEQL	1$			; No, skip
	MOVL	#BAS$_ILLSWIUSA,R0	; Return "?Illegal switch usage" error
	BRB	2$
1$:	MOVW	TPA$L_NUMBER(AP),-
		G^RSO_GW_FID3		; Store third number of FID
2$:	RET

NEGVAL:	.WORD	^M<>
	MNEGL	TPA$L_NUMBER(AP),-
		TPA$L_NUMBER(AP)	; Convert value passed to negative
	RET
;
;	DVI - Device name handler
;
DVIVAL:	.WORD	^M<R2,R3,R4,R5,R6>
	CVTLW	TPA$L_TOKENCNT(AP),R6	; Retrieve n.chars for device name
	CVTWB	R6,G^RSO_GT_DVI
	MOVC5	R6,@TPA$L_TOKENPTR(AP),- ; Retrieve the device name itself
		#0,#<NAM$C_DVI-1>,G^RSO_GT_DVI+1
	MOVL	#SS$_NORMAL,R0		; Reset error flag
	RET
;
;	Date handlers
;
BDTVAL:	.WORD	^M<R2,R3,R4,R5>
	JSB	EVAL_DATE_TIME
	BLBC	R0,1$			; Skip if error
	MOVQ	R2,G^RSO_GQ_BACKUP_DATE
1$:	RET

CDTVAL:	.WORD	^M<R2,R3,R4,R5>
	JSB	EVAL_DATE_TIME
	BLBC	R0,1$			; Skip if error
	MOVQ	R2,G^RSO_GQ_CREATION_DATE
1$:	RET

EDTVAL:	.WORD	^M<R2,R3,R4,R5>
	JSB	EVAL_DATE_TIME
	BLBC	R0,1$			; Skip if error
	MOVQ	R2,G^RSO_GQ_EXPIRATION_DATE
1$:	RET

RDTVAL:	.WORD	^M<R2,R3,R4,R5>
	JSB	EVAL_DATE_TIME
	BLBC	R0,1$			; Skip if error
	MOVQ	R2,G^RSO_GQ_REVISION_DATE
1$:	RET

EVAL_DATE_TIME:
	INCL	TPA$L_TOKENPTR(AP)	; Adjust "input" string, exlude leading =/:
	DECL	TPA$L_TOKENCNT(AP)
	MOVAB	@TPA$L_TOKENPTR(AP),R4
	MOVB	11.(R4),R5		; Save 12th char (presumeably a colon)
	MOVB	#^A" ",11.(R4)		; Change 12th char (a colon) to a space
	CLRQ	-(SP)			; Clear temp on stack
	PUSHAQ	(SP)			; Push "temp"
	PUSHAQ	TPA$L_TOKENCNT(AP)	; Push "token" descriptor
	CALLS	#2,G^SYS$BINTIM		; Call $BINTIM (ascii to binary time)
	MOVQ	(SP)+,R2		; Load R2:R3 with resulting quadword time
	MOVB	R5,11.(R4)		; Restore 12th char
	INCL	TPA$L_TOKENCNT(AP)	; Restore token's description block
	DECL	TPA$L_TOKENPTR(AP)
	RSB
;
;	Setup default protection code in RSF field before processing
;	the /PROTECTION=(...) filename switch
;
SET_UP_DEFLT_PROT:
	.WORD	^M<>
	PUSHAW	G^RSO_GW_PROTECTION_CODE
					; Push addr loc for default protection code
	CLRL	-(SP)			; Ignore setting new default protection code
	CALLS	#2,G^SYS$SETDFPROT
	MCOMW	G^RSO_GW_PROTECTION_CODE,- ; Complement it so LIB$TPARSEr...
		G^RSO_GW_PROTECTION_CODE ;...can set bits in it
	RET
;
;	Set bits in RSF protection field to deny access to RWED if protection_
;	type qualifier (e.g., GROUP) present but has no arguments
;
DENY_SYPRO:
	.WORD	^M<>
	BICW2	#^X000F,G^RSO_GW_PROTECTION_CODE
	MOVL	#1,R0			; Set return flag as "successful"
	RET

DENY_OWPRO:
	.WORD	^M<>
	BICW2	#^X00F0,G^RSO_GW_PROTECTION_CODE
	MOVL	#1,R0			; Set return flag as "successful"
	RET

DENY_GRPRO:
	.WORD	^M<>
	BICW2	#^X0F00,G^RSO_GW_PROTECTION_CODE
	MOVL	#1,R0			; Set return flag as "successful"
	RET

DENY_WOPRO:
	.WORD	^M<>
	BICW2	#^XF000,G^RSO_GW_PROTECTION_CODE
	MOVL	#1,R0			; Set return flag as "successful"
	RET

	.END