.TITLE	IF_MOD Compare File Modification Dates.
		.IDENT	/1.00/
;   ---------------------------------------------------------------------------
;   IFMOD.MAR - The function of this program is to compare the modification
;	dates of specified files and depending on whether the results are
;	true or false execute a specified DCL command (similar to the DCL IF
;	command).
;
;   Calling Procedure:
;
;	$ IFMOD := $disk:[directory]IFMOD
;	$ IFMOD	     file-spec[,file-spec,...]  	-
;		     operator  				-
;		     file-spec[,file-spec,...] 		-
;		     .OR. 				-
;		     file-spec[,file-spec,...]  	-
;		     operator  				-
;		     file-spec[,file-spec,...] 		-
;		     .AND. 				-
;		     file-spec[,file-spec,...]  	-
;		     operator  				-
;		     file-spec[,file-spec,...] 		-
;		     THEN 				-
;		     dcl_command
;
;   Parameters:
;
;	file-spec[,file-spec,...] - is a list of file names seperated by 
;		commas that are to have their modification dates fetched.  
;		The highest date from the list is files specified is saved 
;		for comparison.  The disk, directory, filename, and file type 
;		default from the previous file in the list.  The first file 
;		in the list always takes its disk and directory defaults from 
;		the current default directory.
;
;	operator - is on of the following: 
;
;			.LT.	.LE.	.EQ.	.NE.	.GE.	.GT.
;
;		and they are used to control the comparision of the two lists 
;		of file names.  A true or false value will be the result of 
;		the compare.
;
;	.OR. - is a connector which allows for the comparison of additional 
;		files in the same IFMOD command.  The result is OR'ed to the 
;		result of the previous comparison.
; 
;	.AND. - is a connector which allows for the comparison of additional 
;		files in the same IFMOD command.  The result is AND'ed 
;		to the result of the previous comparison.
;
;	.NOT. - is a modifier which will negate the true/false value of the 
;		comparison which follows it.
; 
;	THEN - is used to indicate the end of the comparison operations.  
;		When this is encountered, if the result of the previous 
;	 	comparisons was true then the DCL command that follows is 
;		executed, otherwise, it is not.
;
;   Qualifiers:
;
;	/NOECHO
;	/ECHO - This qualifier will cause IFMOD to echo the command (following
;		the 'THEN' parameter) to SYS$OUTPUT: if and only if the 
;		command is passed to DCL for execution.
;
;	/ERROR=label - This qualifier will cause the command to
;		return control at the specified 'label' if one of the
;		files specified has not been found.  This is very useful
;		if say the object files were deleted since the last time
;		the program was built.  This could be used to force control 
;		to the compile phase reguardless of whether other files did
;		exist.
;
;		If this qualifier is not specified and a specified file is 
;		not found then an error will be issued and the command will
;		abort.
;
;		If 'label' is specified as .TRUE. or .FALSE. then the following
;		will happen if a file is not found:
;
;		    .TRUE.  - Assume the comparisons were true and execute
;			      the DCL command following the 'THEN'.
;			      .TRUE. may also be specified as .T.
;		    .FALSE. - Assume the comparisons were false and
;			      exit the program normally (the next command
;			      in the command procedure would get executed).
;			      .FALSE. may also be specified as .F.
;
;	/INCLUDE=(module,...) - This file_spec qualifier specifies that the
;		file it follows is a library file (OBJECT, TEXT, HELP, or
;		MACRO library) and that the insertion dates for the list of 
;		'modules' specified are to be extracted for comparison.
;
;		NOTE:  The dates are the module insertion date and have NO
;			(NONE, ZERO, ZILCH) relation to the original input 
;			files modification date.
;
;	/NOLOG
;	/LOG - This qualifier specifies that the date fetched for each file
;		(or library module) be logged to SYS$OUTPUT:
;
;   Parentheses:
;
;	Parentheses are allowed and work the way you would expect.
;
;   Operator Precedence:
;
;	Precedence of operators is:
;
;		.OR.	1
;		.AND.	2	
;		.NOT.	3
;
;		.LT.	4
;		.LE.	4
;		.EQ.	4
;		.NE.	4
;		.GE.	4
;		.GT.	4
;
;	Parentheses will force the operations within to be of higher 
;	precedence than the operations preceeding then.
;
;   ---------------------------------------------------------------------------
		.PAGE
		.SBTTL	IF_MOD Symbol Definitations
;
		$TPADEF			; LIB$TPARSE symbol definitions.
		$RMSDEF			; RMS symbol definitions.
		$SSDEF			; Return status symbol definitions.
		$LBRDEF			; library definitions
;
;
LEFT_ANGLE_BRACKET	=	^x3C	; <
RIGHT_ANGLE_BRACKET	=	^x3E	; >
;
;
		.SBTTL	IF_MOD Data Area
		.PSECT	IF_MOD_DATA,WRT,NOEXE
;
;     Storage for the command line as fetched by LIB$GET_FOREIGN
;
LC_LINEZ	=	512			; lowercase string length.
LC_LINE_DESC:	.LONG	LC_LINEZ,LC_LINE	; lowercase string descriptor.
LC_LINE:	.BLKB	LC_LINEZ		; lowercase string.
;
;
CMD_LINEZ	=	512			; string length.
CMD_LINE_DESC:	.LONG	CMD_LINEZ,CMD_LINE	; string descriptor.
CMD_LINE:	.BLKB	CMD_LINEZ		; string.
;
;
		.PAGE
		.SBTTL	IF_MOD Main Routine.
		.PSECT	IF_MOD,NOWRT,EXE
;;;;
;     Entry point.
;;;;
		.ENTRY	IF_MOD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
;
;     Fetch the command line from DCL.
;
		PUSHAL	LC_LINE_DESC		; address of rtn str length.
		PUSHL	#0			; no prompt line.
		PUSHAL	LC_LINE_DESC		; address of str desc.
		CALLS	#3,G^LIB$GET_FOREIGN	; fetch command line.
;
;     Check to see if any parameters were passed.
;
		CMPL	#0,LC_LINE_DESC		; is the length .eq. zero?
		BNEQU	10$			;   No
		MOVL	#IPSS$IFM_INSFPARAM,R0	;   Yes; exit with error.
		BRW	999$
10$:
;
;     Upcase the input line.
;
		MOVL	LC_LINE_DESC,-		; store the length in the
			CMD_LINE_DESC		;   upcased string.
		PUSHAL	LC_LINE_DESC		; address of input str.
		PUSHAL	CMD_LINE_DESC		; address of output str.
		CALLS	#2,G^STR$UPCASE		; upcase the string.
;
;     Store the length and address of the command line string in the LIB$TPARSE
;	  Control table.
;
		MOVAL	CMD_LINE_DESC,R1	; Fetch adr of cmd desc str.
		MOVAL	TPA_PARAM_BLK,R2	; Fetch adr of tpa param blk.
		MOVZWL	(R1),TPA$L_STRINGCNT(R2) ;Store length of cmd str.
		MOVL	4(R1),TPA$L_STRINGPTR(R2);Store adr of cmd str.
;
;     Invoke LIB$TPARSE to parse the line and perform the desired operations.
;
		PUSHAL	TPA_KEY_TABLE		; *---
		PUSHAL	TPA_STATE_TABLE		; *
		PUSHL	R2			; *
		CALLS	#3,G^LIB$TPARSE		; * Call TPARSE.
		BLBC	R0,999$			; *---
;
		MOVL	#SS$_NORMAL,R0
999$:		RET
;
		.PAGE
		.SBTTL	LIB$TPARSE Writable Area.
		.PSECT	IF_MOD_TPA_TABLE_WRITABLE,NOEXE,WRT
;
;     LIB$TPARSE parameter block.
;
TPA_PARAM_BLK:	.LONG	TPA$K_COUNT0
		.BLKB	TPA$K_LENGTH0-4
;
;
TPA_FNF:	.LONG	0		; File Not Found Flag 
;					;  =0 - no /ERROR qualifier specified.
;					;  =1 - /ERROR=label specified.
;					;  =3 - /ERROR=.FALSE. specified.
;					;  =5 - /ERROR=.TRUE. specified.
;
TPA_FNF_DESC:	.BLKL	2		; Desc pointing to FNF label string.
;
;
TPA_ECHO:	.LONG	0		; Echo 'THEN' command if executed.
;
;
TPA_LOG:	.LONG	0		; Log the dates and the files processed
;
;
TPA_CMD_DESC:	.BLKL	2		; Desc pointing to THEN command string.
;
;
TPA_FILE_DESC:	.BLKL	2		; Desc pointing to a file spec.
;
;
TPA_DEF_FILEZ	=	256		; length of default file string.
TPA_DEF_FILE_DESC: .LONG 0,TPA_DEF_FILE	; desc pointing to default file spec.
TPA_DEF_FILE:	.BLKB	TPA_DEF_FILEZ	; string for default file.
;
;
TPA_LIB_INDEX:	.LONG	0		; Storage for library index.
;
;
TPA_MODULE_DESC: .BLKL	2		; Desc for library module name.
;
;
TPA_OPERAND:	.BLKL	2		; temp storage area for operand.
;
;
TPA_WK_BUF_DESC: .BLKL	2		; desc for work area.
;
TPA_WK_BUFZ	=	256		; work area.
TPA_WK_BUF:	.BLKB	TPA_WK_BUFZ
;
;
TPA_PAREN_NEST:	.LONG	0		; Paren nesting levels.
;
;   ---
;
;     Operator stack values.  The 1st 4 bits specify the operator precedence
;	and the last 4 bits are for distinguesing multiple operators at the 
;	same precedence.
;
OP_THEN		=	^x00	; THEN token		
OP_BEGIN	=	^x10	; Beginning of stack	
OP_CLOSE	=	^x20	; Close paren		
;
OP_OR		=	^x40	; .OR.			
OP_AND		=	^x50	; .AND.			
OP_NOT		=	^x60	; .NOT.			
;
OP_LT		=	^x70	; .LT.			
OP_LE		=	^x71	; .LE.			
OP_EQ		=	^x72	; .EQ.			
OP_NE		=	^x73	; .NE.			
OP_GE		=	^x74	; .GE.			
OP_GT		=	^x75	; .GT.			
;
OP_OPEN		=	^xE0	; Open paren		
;
OPERATOR_STACKZ		=	128
OPERATOR_STACK_P:	.LONG	0
OPERATOR_STACK:		.BLKB	OPERATOR_STACKZ
			.LONG	0
;
;     Operand stack is set up to handle quadword entries.  File modification
;	dates use the entire quadword.  True/false entries use the least
;	significent bit and waste the rest.
;
S_TOP	=	0
S_2ND	=	8
;
HI	=	4
LOW	=	0
;
OPERAND_STACKZ		=	OPERATOR_STACKZ*2*8
OPERAND_STACK_P:	.LONG	0
OPERAND_STACK:		.BLKB	OPERAND_STACKZ
			.LONG	0,0,0,0,0,0,0,0
;
		.SBTTL	LIB$TPARSE Constant Area.
		.PSECT	IF_MOD_TPA_TABLE_CONSTANT,NOEXE,NOWRT
;
;
TPA_GOTO:	.ASCII	/GOTO /
TPA_GOTOZ	=	.-TPA_GOTO
;
;
TRUE_VALUE:	.LONG	-1,-1		;True value to put on operand stack.
;
;     Operator codes already stored in memory.
;
OP_THEN_B:	.BYTE	OP_THEN
OP_BEGIN_B:	.BYTE	OP_BEGIN
OP_CLOSE_B:	.BYTE	OP_CLOSE
OP_OR_B:	.BYTE	OP_OR
OP_AND_B:	.BYTE	OP_AND
OP_NOT_B:	.BYTE	OP_NOT
OP_LT_B:	.BYTE	OP_LT
OP_LE_B:	.BYTE	OP_LE
OP_EQ_B:	.BYTE	OP_EQ
OP_NE_B:	.BYTE	OP_NE
OP_GE_B:	.BYTE	OP_GE
OP_GT_B:	.BYTE	OP_GT
OP_OPEN_B:	.BYTE	OP_OPEN
;
;
		.PAGE
		.SBTTL	LIB$TPARSE Table Area.
		.PSECT	IF_MOD_TPA_TABLE,NOWRT,NOEXE
;
;     LIB$TPARSE state tables.
;
	$INIT_STATE	TPA_STATE_TABLE,TPA_KEY_TABLE
;
;     Check for a qualifier on the IFMOD command.
;
	$STATE						; initialize the file
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_FNF	;   not found flag.
	$STATE						; initialize the ECHO
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_ECHO	;   THEN command flag.
	$STATE						; initialize the LOG
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_LOG	;   dates & files flag.
;
	$STATE	DO_QUALIFIER
	$TRAN	!QUALIFIER,DO_QUALIFIER			; check for qualifier.
	$TRAN	TPA$_LAMBDA
;
;     Initialize the operator and operand stacks.
;
	$STATE						; initialize the stack
	$TRAN	TPA$_LAMBDA,,INIT_STACKS		;   pointers.
	$STATE						; initialize operator
	$TRAN	TPA$_LAMBDA,,PUSH_OPERATOR,,,OP_BEGIN_B	;   stack
;
;     Initialize the parenthesis nesting count.
;
	$STATE
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_PAREN_NEST
;
;     Parsing loop.
;
	$STATE	PARSE
	$TRAN	!PAREN,DO_OPERATOR_CMP
	$TRAN	!THEN,DO_OPERATOR_CMP
	$TRAN	!OPERATOR,DO_OPERATOR_CMP
	$TRAN	!FILE_LIST			; fetch file(s) mod date.
	$TRAN	TPA$_LAMBDA,TPA$_FAIL,ERROR_FAO,,,IPSS$IFM_SYNTAX
	$STATE
	$TRAN	!PAREN
	$TRAN	!THEN
	$TRAN	!OPERATOR			; fetch operator.
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_INVOPER
;
	$STATE	DO_OPERATOR_CMP			; Do
	$TRAN	TPA$_LAMBDA,PARSE,IF_OP_OPEN	;   loop if prev is open paren
	$TRAN	TPA$_LAMBDA,,IF_OPERATOR_LE	;   process if top is .le. next
	$TRAN	TPA$_LAMBDA,PARSE		;   loop if nothing else works.
;
	$STATE					;   process previous oper
	$TRAN	TPA$_LAMBDA,DO_OPERATOR_CMP,-	; enddo
			PROC_PREV_OPERATOR 
;
;   ---
;
;     Process a qualifier.
;
	$STATE	QUALIFIER
	$TRAN	<'/'>
	$STATE
	$TRAN	TPA$_LAMBDA,,ABBREV		; set abbreviate allowed
	$STATE
	$TRAN	'ERROR',GO_ERROR,NO_ABBREV	; is qualifier ERROR
	$TRAN	'ECHO',GO_ECHO,NO_ABBREV	; is qualifier ECHO
	$TRAN	'NOECHO',GO_NOECHO,NO_ABBREV	; is qualifier NOECHO
	$TRAN	'LOG',GO_LOG,NO_ABBREV		; is qualifier LOG
	$TRAN	'NOLOG',GO_NOLOG,NO_ABBREV	; is qualifier NOLOG
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_INVQUAL
;
;     /ERROR qualifier.
;
	$STATE	GO_ERROR
	$TRAN	<'='>
	$TRAN	<':'>
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_QSYNTAX
	$STATE
	$TRAN	<'('>
	$TRAN	TPA$_LAMBDA
	$STATE
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_FNF
	$STATE
	$TRAN	TPA$_SYMBOL,,,,TPA_FNF_DESC	; store label desc.
	$TRAN	!TRUE,,,5,TPA_FNF		; flag .true. found.
	$TRAN	!FALSE,,,3,TPA_FNF		; flag .false. found.
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_QSYNTAX
	$STATE
	$TRAN	<')'>
	$TRAN	TPA$_LAMBDA
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,,1,TPA_FNF ; flag GOTO label found.
;
;     /ECHO processing.
;
	$STATE	GO_ECHO
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,,1,TPA_ECHO	; Set ECHO flag.
;
;     /NOECHO processing.
;
	$STATE	GO_NOECHO
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,CLEAR_LONG,,,TPA_ECHO ; clear ECHO flag.
;
;     /LOG processing.
;
	$STATE	GO_LOG
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,,1,TPA_LOG 	; Set LOG flag.
;
;     /NOLOG processing.
;
	$STATE	GO_NOLOG
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,CLEAR_LONG,,,TPA_LOG ; clear LOG flag.
;
;   ---
;
;     Test for .TRUE.
;
	$STATE	TRUE
	$TRAN	<'.'>
	$STATE
	$TRAN	'TRUE'
	$TRAN	'T'
	$STATE
	$TRAN	<'.'>,TPA$_EXIT
;
;   ---
;
;     Test for .FALSE.
;
	$STATE	FALSE
	$TRAN	<'.'>
	$STATE
	$TRAN	'FALSE'
	$TRAN	'F'
	$STATE
	$TRAN	<'.'>,TPA$_EXIT
;
;   ---
;
;     Fetch a file list.
;
	$STATE	FILE_LIST
	$TRAN	TPA$_LAMBDA,,CLEAR_QUAD,,,TPA_OPERAND
	$STATE
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_DEF_FILE_DESC
;
	$STATE	DO_FILE
	$TRAN	!FILE_SPEC,,,,TPA_FILE_DESC
	$TRAN	TPA$_LAMBDA,TPA$_FAIL
;
	$STATE
	$TRAN	!INCLUDE_QUALIFIER,LIBRARY_FILE
	$TRAN	TPA$_LAMBDA
;
	$STATE
	$TRAN	TPA$_LAMBDA,,GET_HIGH_MOD_DATE,,,TPA_OPERAND
;
	$STATE	NEXT_FILE
	$TRAN	<','>,DO_FILE
	$TRAN	<'+'>,DO_FILE
;
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,PUSH_OPERAND,,,TPA_OPERAND
;
;   ---
;
;     Process the modules in the library file.
;
	$STATE	LIBRARY_FILE
	$TRAN	TPA$_LAMBDA,,LIB_OPEN
;
	$STATE
	$TRAN	<'('>,DO_MODULE
	$TRAN	TPA$_SYMBOL,,,,TPA_MODULE_DESC
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_QSYNTAX
;
;    Process only one module.
;
	$STATE
	$TRAN	TPA$_LAMBDA,CLOSE_LIB,LIB_MODULE,,,TPA_OPERAND
;
;    loop for list of modules.
;
	$STATE	DO_MODULE
	$TRAN	TPA$_SYMBOL,,,,TPA_MODULE_DESC
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_QSYNTAX
;
	$STATE
	$TRAN	TPA$_LAMBDA,,LIB_MODULE,,,TPA_OPERAND
;
	$STATE
	$TRAN	<','>,DO_MODULE
	$TRAN	<')'>,CLOSE_LIB
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_QSYNTAX
;
	$STATE	CLOSE_LIB
	$TRAN	TPA$_LAMBDA,NEXT_FILE,LIB_CLOSE
;
;   ---
;
;     Check for /INCLUDE qualifier on file spec.
;
	$STATE	INCLUDE_QUALIFIER
	$TRAN	<'/'>
	$STATE
	$TRAN	TPA$_LAMBDA,,ABBREV
	$STATE
	$TRAN	'INCLUDE'
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_INVQUAL
	$STATE
	$TRAN	<'='>,TPA$_EXIT
	$TRAN	<':'>,TPA$_EXIT
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_INVQUAL
;
;   ---
;
;     Process Paren's.
;
	$STATE	PAREN
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_WK_BUF
	$STATE
	$TRAN	<'('>,,INC_LONG,OP_OPEN,TPA_WK_BUF,TPA_PAREN_NEST
	$TRAN	<')'>,,DEC_LONG,OP_CLOSE,TPA_WK_BUF,TPA_PAREN_NEST
	$STATE
	$TRAN	TPA$_LAMBDA,,PAREN_CHECK
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,PUSH_OPERATOR,,,TPA_WK_BUF
;
;   ---
;
;     Process dot operator dot
;
	$STATE	OPERATOR
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_WK_BUF
	$STATE
	$TRAN	<'.'>
;
	$STATE
	$TRAN	'OR',,,OP_OR,TPA_WK_BUF
	$TRAN	'AND',,,OP_AND,TPA_WK_BUF
	$TRAN	'NOT',,,OP_NOT,TPA_WK_BUF
	$TRAN	'LT',,,OP_LT,TPA_WK_BUF
	$TRAN	'LE',,,OP_LE,TPA_WK_BUF
	$TRAN	'EQ',,,OP_EQ,TPA_WK_BUF
	$TRAN	'NE',,,OP_NE,TPA_WK_BUF
	$TRAN	'GE',,,OP_GE,TPA_WK_BUF
	$TRAN	'GT',,,OP_GT,TPA_WK_BUF
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,ERROR_FAO,,,IPSS$IFM_INVOPER
;
	$STATE	
	$TRAN	<'.'>
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,ERROR_FAO,,,IPSS$IFM_INVOPER
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,PUSH_OPERATOR,,,TPA_WK_BUF
;
;   ---
;
;    Process the THEN state; end of command line
;
	$STATE	THEN
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_WK_BUF
	$STATE
	$TRAN	'THEN',,,OP_THEN,TPA_WK_BUF
	$STATE
	$TRAN	TPA$_LAMBDA,,VALIDITY_CHECK
	$STATE
	$TRAN	!COMMAND,,,,TPA_CMD_DESC ; fetch the command string.
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,PUSH_OPERATOR,,,TPA_WK_BUF
;
;   ---
;
;     Find the command string and return the descriptor.
;
	$STATE	COMMAND
	$TRAN	TPA$_ANY			; must be at least one char
	$TRAN	TPA$_LAMBDA,,ERROR,,,IPSS$IFM_NOCMDFOU
;
	$STATE	DO_CMD_LOOP			; do till no more char
	$TRAN	TPA$_SYMBOL,DO_CMD_LOOP		;   get a symbol
	$TRAN	TPA$_ANY,DO_CMD_LOOP		;   get char
	$TRAN	TPA$_LAMBDA,TPA$_EXIT		; enddo
;
;   ---
;
;     Fetch a file spec.
;
	$STATE	FILE_SPEC
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_WK_BUF
	$STATE
	$TRAN	TPA$_LAMBDA,,BLANKS
;
	$STATE	DO_FILE_SPEC
	$TRAN	TPA$_BLANK,DO_FILE_SPEC
	$TRAN	!NODE_NAME
	$TRAN	TPA$_LAMBDA
;
	$STATE
	$TRAN	!DEVICE_NAME
	$TRAN	TPA$_LAMBDA
;
	$STATE
	$TRAN	!DIRECTORY_NAME
	$TRAN	TPA$_LAMBDA
;
	$STATE
	$TRAN	!FILE_NAME
	$TRAN	TPA$_LAMBDA
;
	$STATE
	$TRAN	TPA$_LAMBDA,,NO_BLANKS
	$STATE
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,FILE_CHECK,,,TPA_WK_BUF
;
;   ---
;
;     Process node name.
;
	$STATE	NODE_NAME
	$TRAN	TPA$_SYMBOL
	$STATE	
	$TRAN	!QUOTED_STRING
	$TRAN	TPA$_LAMBDA
	$STATE
	$TRAN	<':'>
	$STATE
	$TRAN	<':'>,TPA$_EXIT,,1,TPA_WK_BUF
;
;   ---
;
;     Process the device name.
;
	$STATE	DEVICE_NAME
	$TRAN	TPA$_SYMBOL
	$STATE
	$TRAN	<':'>,TPA$_EXIT,,1,TPA_WK_BUF
;
;   ---
;
;     Process the directory name(s).
;
	$STATE	DIRECTORY_NAME
	$TRAN	<'['>,,,1,TPA_WK_BUF
	$TRAN	LEFT_ANGLE_BRACKET,,,1,TPA_WK_BUF	; '<'
	$STATE	DO_DIRECTORY_NAME
	$TRAN	<']'>,TPA$_EXIT
	$TRAN	RIGHT_ANGLE_BRACKET,TPA$_EXIT		; '>'
	$TRAN	TPA$_STRING,DO_DIRECTORY_NAME
	$TRAN	TPA$_ANY,DO_DIRECTORY_NAME
	$TRAN	TPA$_LAMBDA,TPA$_EXIT			; RMS will issue error.
;
;   ---
;
;     Process the file name.
;
	$STATE	FILE_NAME
	$TRAN	TPA$_LAMBDA
	$STATE	DO_FILE_NAME
	$TRAN	!FILE_EXTENSION,TPA$_EXIT
	$TRAN	TPA$_STRING,DO_FILE_NAME,,1,TPA_WK_BUF
	$TRAN	<'*'>,DO_FILE_NAME,,1,TPA_WK_BUF
	$TRAN	<'%'>,DO_FILE_NAME,,1,TPA_WK_BUF
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
;   ---
;
;     Process the file extension.
;
	$STATE	FILE_EXTENSION
	$TRAN	<'.'>,,,1,TPA_WK_BUF
	$STATE	DO_FILE_EXTENSION
	$TRAN	!FILE_VERSION,TPA$_EXIT
	$TRAN	TPA$_STRING,DO_FILE_EXTENSION
	$TRAN	<'*'>,DO_FILE_EXTENSION
	$TRAN	<'%'>,DO_FILE_EXTENSION
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
;
;   ---
;
;     Process file version.
;
	$STATE	FILE_VERSION
	$TRAN	<';'>
	$TRAN	<'.'>
	$STATE
	$TRAN	<'-'>
	$TRAN	TPA$_LAMBDA
	$STATE
	$TRAN	TPA$_DECIMAL,TPA$_EXIT,,1,TPA_WK_BUF
	$TRAN	<'*'>,TPA$_EXIT,,1,TPA_WK_BUF
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,,1,TPA_WK_BUF
;
;   ---
;
;     Process a quoted string.
;
	$STATE	QUOTED_STRING
	$TRAN	<'"'>				; identify first quote
	$STATE	DO_QUOTED_STRING		; do till last quote found
	$TRAN	<'"'>,TPA$_EXIT			;   if quote, undo
	$TRAN	TPA$_ANY,DO_QUOTED_STRING	; enddo
;
;   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---
;
;     This section of the state tables is used to skip over the parameters
;	  in the IFMOD command till it finds and processes the 
;	  'THEN dcl_command'.
;
	$STATE	SKIP_TO_COMMAND				; initialize the 
	$TRAN	TPA$_LAMBDA,,INIT_STACKS		;   stack pointers.
	$STATE						; initialize the
	$TRAN	TPA$_LAMBDA,,CLEAR_LONG,,,TPA_PAREN_NEST;  paren nesting count.
	$STATE						; initialize the
	$TRAN	TPA$_LAMBDA,,PUSH_OPERATOR,,,OP_BEGIN_B	;   operator stack
;
;     Loop until 'THEN' is found.
;
	$STATE	DO_SKIP
	$TRAN	!THEN					; is it 'THEN'?
	$TRAN	TPA$_SYMBOL,DO_SKIP			; is it a symbol?
	$TRAN	TPA$_ANY,DO_SKIP			; is it any char?
	$TRAN	TPA$_LAMBDA,,ERROR_FAO,,,IPSS$IFM_SYNTAX	; syntax error!
;
;     Issue the DCL command following the 'THEN' command.
;
	$STATE
	$TRAN	TPA$_LAMBDA,,PUSH_OPERAND,,,TRUE_VALUE
	$STATE
	$TRAN	TPA$_LAMBDA,,PROC_PREV_OPERATOR
;
	$STATE
	$TRAN	TPA$_LAMBDA,,ERROR,,,IPSS$IFM_INVOPCODE
;
;   ---
;
;     End of state table.
;
	$END_STATE
;
;   ---------------------------------------------------------------------------
		.PAGE
		.SBTTL	LIB$TPARSE Action Routines
		.PSECT	IF_MOD_TPA_ACTION,NOWRT,EXE
;
;   ---
;
;     Initialize the operator and operand stacks.
;
		.ENTRY	INIT_STACKS,^M<R2>
;
		MOVAL	OPERATOR_STACK+ -	; initialize stack for
			OPERATOR_STACKZ,-	;   keeping track of nested
			OPERATOR_STACK_P	;     operators.
;
		MOVAL	OPERAND_STACK+ -	; initialize stack for
			OPERAND_STACKZ,-	;   keeping track of nested
			OPERAND_STACK_P		;     operands.
;
		RET
;
;   ---
;
;     Clear the quadword specified by the tpa parameter field.
;
		.ENTRY	CLEAR_QUAD,^M<R2>
;
		CLRQ	@TPA$L_PARAM(AP)	; clear the specified quadword.
;
		RET
;
;   ---
;
;     Clear the longword specified by the tpa parameter field.
;
		.ENTRY	CLEAR_LONG,^M<R2>
;
		CLRL	@TPA$L_PARAM(AP)	; clear the specified longword.
;
		RET
;
;   ---
;
;     Push the quadword operand who's address is specified by the TPA
;	parameter field onto the operand stack.
;
		.ENTRY	PUSH_OPERAND,^M<R2>
;
		MOVL	OPERAND_STACK_P,R2	; fetch current stack pointer
		MOVQ	@TPA$L_PARAM(AP),-(R2)	; put operand on stack.
		MOVL	R2,OPERAND_STACK_P	; put updated stack ptr back.
;
		RET
;
;   ---
;
;     Push the byte operator who's address is specified by the TPA
;	parameter field onto the operator stack.
;
		.ENTRY	PUSH_OPERATOR,^M<R2>
;
		MOVL	OPERATOR_STACK_P,R2	; fetch current stack pointer
		MOVB	@TPA$L_PARAM(AP),-(R2)	; put operator on stack.
		MOVL	R2,OPERATOR_STACK_P	; put updated stack ptr back.
;
		RET
;
		.PAGE
;   ---
;
;     Action routine to open the specified library file for future module date
;	processing.
;
		.ENTRY LIB_OPEN,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
;
		PUSHAL	TPA_LOG			; push address of LOG flag.
		PUSHAL	TPA_FNF			; push address of FNF flag.
		PUSHAL	TPA_DEF_FILE_DESC	; push adr of def file str desc
		PUSHAL	TPA_FILE_DESC		; push adr of file str desc.
		PUSHAL	TPA_LIB_INDEX		; push adr of rtn for lib index
		CALLS	#5,G^IFMOD_LIBRARY_OPEN	; open the library file.
		BLBC	R0,10$			;   error; process error
		RET				; return
10$:
		PUSHL	AP			; push addr of tpa param block
		CALLS	#1,FNF_ERROR		; process the error
		RET				; don't really expect a return.
;
;   ---
;
;     Action routine to fetch the high modification date from the library
;	module specified.
;
		.ENTRY	LIB_MODULE,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
;
		PUSHAL	TPA_LOG			; push address of LOG flag.
		PUSHAL	TPA_FNF			; push address of FNF flag.
		PUSHL	TPA$L_PARAM(AP)		; push address of mod date.
		PUSHAL	TPA_MODULE_DESC		; push address of module desc.
		PUSHAL	TPA_LIB_INDEX		; push adr of lib index.
		CALLS	#5,G^IFMOD_LIBRARY_MODULE ; find the module date.
		BLBC	R0,10$			;   error; process error
		RET				; return
10$:
		PUSHL	AP			; push addr of tpa param block
		CALLS	#1,FNF_ERROR		; process the error
		RET				; don't really expect a return.
;
;   ---
;
;     Action routine to close the library file.
;
		.ENTRY	LIB_CLOSE,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
;
		PUSHAL	TPA_LIB_INDEX		; push adr of lib index.
		CALLS	#1,G^IFMOD_LIBRARY_CLOSE ; Close the file
		BLBC	R0,10$			;   error; process error
		RET				; return
10$:
		PUSHL	AP			; push addr of tpa param block
		CALLS	#1,FNF_ERROR		; process the error
		RET				; don't really expect a return.
;
		.PAGE
;   ---
;
;     Action routine to call RMS and fetch highest mod date using file spec.
;
		.ENTRY	GET_HIGH_MOD_DATE,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
;
		PUSHAL	TPA_LOG			; push address of LOG flag.
		PUSHAL	TPA_FNF			; push address of FNF flag.
		PUSHL	TPA$L_PARAM(AP)		; push address of mod date.
		PUSHAL	TPA_DEF_FILE_DESC	; push adr of def file str desc
		PUSHAL	TPA_FILE_DESC		; push adr of file str desc.
		CALLS	#5,G^IFMOD_RMS		; find the highest mod date.
		BLBC	R0,10$			;   error; process error
		RET				; return
10$:
		PUSHL	AP			; push addr of tpa param block
		CALLS	#1,FNF_ERROR		; process the error
		RET				; don't really expect a return.
;
		.PAGE
;   ---
;
;     This is a subroutine called by GET_MOD_HIGH_DATE & LIB_MODULE
;	  when either finds it has an error returned.  This routine will
;	  determine if the /ERROR qualifier path is to be taken and how or
;	  it an error should be logged.
;
;	4(AP) - will contain the address of the Tparse parameter list.
;	R0 - will have the error code in it on entry.
;
		.ENTRY	FNF_ERROR,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
;
		CMPL	#RMS$_FNF,R0		; is it File Not Found?
		BEQL	15$			;   Yes
;
		CMPL	R0,#LBR$_KEYNOTFND	; is it key not found?
		BEQL	15$			;   Yes
		BRW	999$			;   No; error exit
15$:						;   Yes
		BLBS	TPA_FNF,16$		;     is /ERROR specified?
		BRW	999$			;       no; log error
16$:
;
;     Determine if a GOTO label was supplied with the /ERROR or if a default
;	  condition value of .TRUE. or .FALSE. was supplied and act upon
;	  the type properly.
;
		CMPL	#3,TPA_FNF		; is it equal to .FALSE.?
		BNEQ	20$			;   no
		MOVL	#SS$_NORMAL,R0		;   yes; exit normal.
		BRW	999$
20$:
;
		CMPL	#5,TPA_FNF		; is it equal to .TRUE.?
		BNEQ	30$			;   no
;
;     /ERROR=.TRUE. was specified.  Call LIB$TPARSE to search for the
;	  'THEN dcl_command' and issue the command.
;
		PUSHAL	TPA_KEY_TABLE		; *---
		PUSHAL	SKIP_TO_COMMAND		; *
		PUSHL	4(AP)			; *
		CALLS	#3,G^LIB$TPARSE		; * Call TPARSE.
		BLBC	R0,999$			; *---
;
30$:
;
;     /ERROR=label was specified and an RMS error File Not Found was 
;	returned.  Issue a GOTO command using the label supplied by the
;	/ERROR qualifier.
;
		MOVAL	TPA_WK_BUF,R7		; fetch addr of work string.
;
		MOVC3	#TPA_GOTOZ,-		; move GOTO command into str.
			TPA_GOTO,-
			(R7)
;
		ADDL	#TPA_GOTOZ,R7		; adj str adr to append label
;
		MOVC3	TPA_FNF_DESC,-		; append label to GOTO command.
			@TPA_FNF_DESC+4,-
			(R7)
;
		ADDL3	#TPA_GOTOZ,-		; Calculate length of command.
			TPA_FNF_DESC,-
			TPA_WK_BUF_DESC
		MOVAL	TPA_WK_BUF,-		; store addr of work string.
			TPA_WK_BUF_DESC+4
;
;     If /ECHO was specified, log the goto command to sys$output.
;
		BLBC	TPA_ECHO,40$		; if /ECHO then
		PUSHAL	TPA_WK_BUF_DESC		;    push addr goto cmd desc
		CALLS	#1,G^LIB$PUT_OUTPUT	;    log goto cmd to sys$output
40$:						; endif
;
;     Pass the command to DCL for execution.
;
		PUSHAL	TPA_WK_BUF_DESC		; push address of cmd desc
		CALLS	#1,G^LIB$DO_COMMAND	; issue goto command.
;
999$:
		PUSHL	R0
		CALLS	#1,G^SYS$EXIT
;
		.PAGE
;   ---
;
;     Action routine to set abbreviate
;
		.ENTRY	ABBREV,^M<R2>
;
		BBCS	#TPA$V_ABBREV,-			; Set abbrev bit.
			TPA$L_OPTIONS(AP),-
			10$
10$:		RET
;
;   ---
;
;     Action routine to set no abbreviate
;
		.ENTRY	NO_ABBREV,^M<R2>
;
		BBSC	#TPA$V_ABBREV,-			; clear abbrev bit.
			TPA$L_OPTIONS(AP),-
			10$
10$:		RET
;
;   ---
;
;     Action routine to set explicit blank processing.
;
		.ENTRY	BLANKS,^M<R2>
;
		BBCS	#TPA$V_BLANKS,-			; set blank bit.
			TPA$L_OPTIONS(AP),-
			10$
10$:		RET
;
;   ---
;
;     Action routine to set invisible blank processing
;
		.ENTRY	NO_BLANKS,^M<R2>
;
		BBSC	#TPA$V_BLANKS,-			; clear blank bit.
			TPA$L_OPTIONS(AP),-
			10$
10$:		RET
;
;   ---
;
;     Action routine to determine if the top operator on the stack is
;	less than or equal to the previous operator on the stack.
;
;	R0 = 1 if top operator .le. previous operator.
;	R0 = 0 if top operator .gt. previous operator.
;
		.ENTRY	IF_OPERATOR_LE,^M<R2,R3>
;
		MOVL	OPERATOR_STACK_P,R2	; load address of stack
		EXTZV	#4,#4,1(R2),R3		; get previous oper precedence
		CMPZV	#4,#4,(R2),R3		; is top .le. prev oper prec
		BLEQU	10$			;   Yes; return true.
		CLRL	R0			;   No;  return false.
;
10$:
		RET
;
;   ---
;
;     Action routine to determine if previous operator is open paren and
;	top operator is NOT close paren.
;
;	R0 = 1 previous if open paren and top is NOT close paren
;	R0 = 0 otherwise.
;
		.ENTRY	IF_OP_OPEN,^M<R2>
;
		MOVL	OPERATOR_STACK_P,R2	; load address of stack
		CMPB	#OP_OPEN,1(R2)		; is prev operator open paren?
		BNEQ	5$			;   No; return false.
		CMPB	#OP_CLOSE,(R2)		; is top operator close paren?
		BNEQ	10$			;   No; return ture.
5$:		CLRL	R0			;   Yes;  return false.
;
10$:
		RET
;
;   ---
;
;     Action routine to increment the long word who's address is passed
;	  in the TPA parameter field.
;
		.ENTRY	INC_LONG,^M<R2>
;
		INCL	@TPA$L_PARAM(AP)	; increment specified long word
;
		RET
;
;   ---
;
;     Action routine to decrement the long word who's address is passed
;	  in the TPA parameter field.
;
		.ENTRY	DEC_LONG,^M<R2>
;
		DECL	@TPA$L_PARAM(AP)	; decrement specified long word
;
		RET
;
;   ---
;
;     Action routine to verify that the parentheses nesting level has not
;	  gone negative.  If it has gone negative it will return an error.
;
		.ENTRY	PAREN_CHECK,^M<R2>
;
		CMPL	TPA_PAREN_NEST,#0	; is nesting level negative?
		BGEQ	10$			;   no
		MOVL	#IPSS$IFM_UNBALPAR,R0	;   yes; return error.
		BRW	999$
10$:
		RET
;
;     Error; exit with error status.
;
999$:
		PUSHL	R0			; push error code
		CALLS	#1,G^SYS$EXIT		; exit the program.
;   ---
;
;     Action routine to determine if any protion of a file specification
;	  was found.  If not it will return false in R0.   The TPA
;	  parameter will contain the address of the flag
;
		.ENTRY	FILE_CHECK,^M<R2>
;
		CMPL	@TPA$L_PARAM(AP),#0	; is flag equal to zero?
		BNEQU	10$			;   no
		CLRL	R0			;   yes; return false.
10$:
;
		RET				; return
;   ---
;
;     Action routine to perform a validity check on the state of the cmd line.
;	  This check is performed when the THEN operator is encountered.
;	  If the state of the parsed line is invalid then an error is
;	  issued.
;
		.ENTRY	VALIDITY_CHECK,^M<R2>
;
;     Check for balenced parentheses.
;
		CMPL	#0,TPA_PAREN_NEST	; is nesting .eq. zero?
		BEQL	10$			;   yes
		MOVL	#IPSS$IFM_UNBALPAR,R0	;   no; issue error.
		BRW	999$
10$:
		RET				; Return; ok
;
;     Error; exit the program with an error.
;
999$:
		PUSHL	R0			; push the error code
		CALLS	#1,G^SYS$EXIT		; exit the program.
;
;   ---
;
;     Action routine to issue a specified error and exit the program.
;	  The error code is passed in the TPA parameter field.
;
		.ENTRY	ERROR,^M<R2>
;
		PUSHL	TPA$L_PARAM(AP)		; push the error code.
		CALLS	#1,G^SYS$EXIT
;
;   ---
;
;     Action routine to issue a specified error with 1 FAO argument that
;	  will output the remainder of the unparsed string, then exit the 
;	  program.  The error code is passed in the TPA parameter field.
;
		.ENTRY	ERROR_FAO,^M<R2>
;
		PUSHAL	TPA$L_STRINGCNT(AP)	; push adr of string.
		PUSHL	#1			; push cnt of FAO args.
		PUSHL	TPA$L_PARAM(AP)		; push the error code.
		CALLS	#3,G^LIB$STOP		; issue error & stop.
;
;   ---------------------------------------------------------------------------
;
;     The function of this action routine is to process the previous operator
;	located on the operator stack.  R10 will have operator stack pointer
;	and R11 will have operand stack pointer for all the operator action
;	routines.
;
		.ENTRY	PROC_PREV_OPERATOR,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
;
		MOVL	OPERAND_STACK_P,R11	; load operand stack address.
		MOVL	OPERATOR_STACK_P,R10	; load operator stack address.
		EXTZV	#4,#4,1(R10),R2		; fetch operator precedence.
		CASEB	R2,#0,#^xF		; vector to precedence routine.
1$:		.WORD	AC_THEN-1$		; 0
		.WORD	AC_BEGIN-1$		; 1
		.WORD	AC_CLOSE-1$		; 2
		.WORD	AC_INVALID-1$		; 3
		.WORD	AC_OR-1$		; 4
		.WORD	AC_AND-1$		; 5
		.WORD	AC_NOT-1$		; 6
		.WORD	AC_COMPARE-1$		; 7
		.WORD	AC_INVALID-1$		; 8
		.WORD	AC_INVALID-1$		; 9
		.WORD	AC_INVALID-1$		; A
		.WORD	AC_INVALID-1$		; B
		.WORD	AC_INVALID-1$		; C
		.WORD	AC_INVALID-1$		; D
		.WORD	AC_OPEN-1$		; E
		.WORD	AC_INVALID-1$		; F
;
		BRW	AC_RETURN
;
;   ---
;
;     Then code is only used to force the begin code to be executed.  The
;	begin code will be executed to complete the program.  This code is
;	never executed and as such it is an error.
;
AC_THEN:	BRW	AC_INVALID
;
;   ---
;
;     Action routine to either execute LIB$DO_COMMAND or return based on 
;	value of top element on operand stack.  If true then LIB$DO_COMMAND.
;
AC_BEGIN:
;
;     Check to see if the stacks are properly popped and empty.
;
		CMPL	#OPERAND_STACK+	-	; does operand stack have
			    OPERAND_STACKZ-8,-	;   only one entry on it?
			OPERAND_STACK_P		;
		BEQLU	20$			;    Yes
		MOVL	#IPSS$IFM_SYNTAX,R0	;    no; issue error
		BRW	999$
20$:
;
		CMPL	#OPERATOR_STACK+ -	; does the operator stack have
			    OPERATOR_STACKZ-2,-	;  only two entries on it
			OPERATOR_STACK_P	;  (begin & then)? 
		BEQLU	30$			;    Yes
		MOVL	#IPSS$IFM_SYNTAX,R0	;    no; issue error
		BRW	999$
30$:
;
;     Test the value of the top entry on the stack for true or false.
;
		MOVL	#SS$_NORMAL,R0		; Initialize R0 for good status
		BLBC	(R11),40$		; False; exit
;
;     Overlay lowercase copy of command line before echo and execution.
;
		MOVQ	LC_LINE_DESC,R6		; load length & source addr.
		MOVQ	CMD_LINE_DESC,R8	; load length & dest addr.
		MOVC5	R6,(R7),#^A/ /,R8,(R9)	; copy lowercase over cmd line.
;
;     If /ECHO was specified, log the goto command to sys$output.
;
		BLBC	TPA_ECHO,35$		; if /ECHO then
		PUSHAL	TPA_CMD_DESC		;    push addr goto cmd desc
		CALLS	#1,G^LIB$PUT_OUTPUT	;    log goto cmd to sys$output
35$:						; endif
;
;     Call LIB$DO_COMMAND to execute the user supplied command.
;
		PUSHAL	TPA_CMD_DESC		; Pass address of desc.
		CALLS	#1,G^LIB$DO_COMMAND	; Exit and have DCL execute cmd
40$:
;
999$:
		PUSHL	R0			; Exit the program 
		CALLS	#1,G^SYS$EXIT		;
;
;   ---
;
;     If top operator is close paren then both operators are removed from
;	the operator stack.  If top is not close paren then return R0=0.
;
AC_OPEN:
		CMPB	#OP_CLOSE,(R10)		; is top operator close paren?
		BNEQ	88$			;   No; return R0=0
;
		MOVB	(R10)+,R2		;   Yes; pop close paren
		MOVB	(R10)+,R2		;	 pop open paren
;
		BRW	AC_RETURN		; return.
;
88$:
		CLRL	R0
		BRW	AC_RETURN
;
;   ---
;
;     Close paren is only used to cause the stack to be popped until an
;	open is found.  It is not valid as second from top operator on stack
;
AC_CLOSE:	BRW	AC_INVALID
;
;   ---
;
;     Operator is .OR.  The top 2 operands the on the stack are OR'ed together
;	(and removed from the stack).  The result is left on the stack.  
;	The second from the top operator is removed from the stack.
;
AC_OR:
		MOVQ	(R11)+,R4		; pop operand from stack
		BISB2	R4,(R11)		; OR the 2 operands
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .OR. operator
;
		BRW	AC_RETURN		; return
;
;   ---
;
;     Operator is .AND.  The top 2 operands the on the stack are AND'ed 
;	together (and removed from the stack).  The result is left on the 
;	stack.  The second from the top operator is removed from the stack.
;
AC_AND:
		MOVQ	(R11)+,R4		; pop operand from stack
		MCOML	R4,R4			; negate operand for next inst
;						;   to perform an AND.
		BICB2	R4,(R11)		; OR the 2 operands
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .AND. operator
;
		BRW	AC_RETURN		; return
;
;   ---
;
;     Operator is .NOT.  The top operands the on the stack is inverted.
;	The second from the top operator is removed from the stack.
;
AC_NOT:
		MCOML	(R11),(R11)		; invert top operand.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .NOT. operator
;
		BRW	AC_RETURN		; return
;
;   ---
;
;     Compare the 2 operands.  First determine which type of comparison.
;
AC_COMPARE:
		EXTZV	#0,#4,1(R10),R2		; fetch operator subtype.
		CASEB	R2,#0,#5		; Select the right compare.
1$:		.WORD	ACC_LT-1$		; .LT.
		.WORD	ACC_LE-1$		; .LE.
		.WORD	ACC_EQ-1$		; .EQ.
		.WORD	ACC_NE-1$		; .NE.
		.WORD	ACC_GE-1$		; .GE.
		.WORD	ACC_GT-1$		; .GT.
;
		BRW	AC_INVALID		; log invalid operator error
;
;   ---
;
;     Compare 2nd from top operands for .LT. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .LT. operator is removed from the operator stack.
;
ACC_LT:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd < Top?
			S_TOP+HI(R11)
		BLSSU	99$			;   Yes; store true.
		BGTRU	88$			;   No; store false.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd < Top?
		BLSSU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Compare 2nd from top operands for .LE. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .LE. operator is removed from the operator stack.
;
ACC_LE:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd <= Top?
			S_TOP+HI(R11)
		BLSSU	99$			;   Yes; store true.
		BGTRU	88$			;   No; store false.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd <= Top?
		BLEQU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Compare 2nd from top operands for .EQ. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .EQ. operator is removed from the operator stack.
;
ACC_EQ:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd = Top?
			S_TOP+HI(R11)
		BNEQU	88$			;   No; store false.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd = Top?
		BEQLU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Compare 2nd from top operands for .NE. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .NE. operator is removed from the operator stack.
;
ACC_NE:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd <> Top?
			S_TOP+HI(R11)
		BNEQU	99$			;   No; store true.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd <> Top?
		BNEQU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Compare 2nd from top operands for .GE. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .GE. operator is removed from the operator stack.
;
ACC_GE:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd >= Top?
			S_TOP+HI(R11)
		BLSSU	88$			;   Yes; store false.
		BGTRU	99$			;   No; store true.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd >= Top?
		BGEQU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Compare 2nd from top operands for .GT. top operand.  remove both
;	operands from the stack and leave a true/false operand on the
;	stack.  The .GT. operator is removed from the operator stack.
;
ACC_GT:
		MOVL	#1,R2			; initialize to true
		CMPL	S_2ND+HI(R11),-		; is 2nd > Top?
			S_TOP+HI(R11)
		BLSSU	88$			;   Yes; store false.
		BGTRU	99$			;   No; store true.
;
		CMPL	S_2ND+LOW(R11),-	; Equal; test low half
			S_TOP+LOW(R11)		; is 2nd > Top?
		BGTRU	99$			;   Yes; store ture
88$:		
		CLRL	R2			;   No; store false
;
;     Remove 2 operands from the stack and store true/false result.
;
99$:
		CLRQ	(R11)+			; Remove top operand.
		MOVL	R2,(R11)		; overwrite 2nd operand.
;
;     Pop operator from stack.
;
		MOVB	(R10)+,R2		; pop top operator.
		MOVB	R2,(R10)		; overwrite .LT. operator
;
		BRW	AC_RETURN
;
;   ---
;
;     Invalid internal precedence code.
;
AC_INVALID:
		MOVZBL	1(R10),R2		; fetch operator value.
		PUSHL	R2			; push value of precedence code
		PUSHL	#1			; push # of FAO args
		PUSHL	#IPSS$IFM_INVOPCODE	; push error number
		CALLS	#3,G^LIB$SIGNAL		; signal the error
;
		CLRL	R0			; signal failure on tpa return
		BRW	AC_RETURN
;
;   ---
;
;     Store the stack pointers and return.
;
AC_RETURN:
		MOVL	R10,OPERATOR_STACK_P	; store operator stack pointer
		MOVL	R11,OPERAND_STACK_P	; store operand stack pointer
;
		RET				; return
;
;   ---------------------------------------------------------------------------
;
;     Routine to issue error message and then exit the program.  R0 has the
;	error number.
;
		.ENTRY	TPA_ERROR_EXIT,^M<R2>
;
		MOVL	R0,R2			; save return code.
		PUSHL	R0			; push error code
		CALLS	#1,G^LIB$SIGNAL		; signal error
;
		PUSHL	R2			; push error code.
		CALLS	#1,G^SYS$EXIT		; exit the program
;
;   ---
;
;     Action routine to log milestone.  Milestone number is in parameter field.
;
		.ENTRY	MILESTONE,^M<R2>
;
		PUSHL	TPA$L_PARAM(AP)
		PUSHL	#1
		PUSHL	#IPSS$IFM_MILESTONE
		CALLS	#3,G^LIB$SIGNAL
;
		CLRL	R0
		RET
;
;   ---
;
;     Action routine to log message.  Address of desc is in parameter field.
;
		.ENTRY	LOG,^M<R2>
;
		PUSHL	TPA$L_PARAM(AP)
		PUSHL	#1
		PUSHL	#IPSS$IFM_LOG
		CALLS	#3,G^LIB$SIGNAL
;
		CLRL	R0
		RET
;
		.END	IF_MOD