.MCALL	.MODULE
.MODULE	INDIF1,VERSION=07,COMMENT=<IF statements>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.ENABL	GBL,LC

	.SBTTL	Data and macro definitions

	.MCALL	.DSTATUS
	.MCALL	DEFIN$,RT5DF$

DEFIN$				;Definitions for IND files
RT5DF$				;RT System definitions
	.PSECT	INDIF1

	.SBTTL	Tables

;+
;Table of commands handled by this module.
;
;*********************** NOTE****************************
; Because of the way the routine "TBSRC" works, "IF" must appear after
; all other IF-commands in the table.
;-

	.NLIST	BEX
CMDTAB:	.ASCIZ	/IFDF/
	.ASCIZ	/IFNDF/
	.ASCIZ	/IFT/
	.ASCIZ	/IFF/
	.ASCIZ	/IFLOA/
	.ASCIZ	/IFNLOA/
	.ASCIZ	/IFENABLED/
	.ASCIZ	/IFDISABLED/
	.ASCIZ	/IF/
	.ASCIZ	/AND/
	.ASCIZ	/OR/
	.BYTE	0		;End of table
	.LIST	BEX
	.EVEN

;+
;Jump table matching command table above.
;-

JTAB:	.WORD	IFDF
	.WORD	IFNDF
	.WORD	IFT
	.WORD	IFF
	.WORD	IFLOA
	.WORD	IFNLOA
	.WORD	IFENAB
	.WORD	IFDSAB
	.WORD	IF
	.WORD	AND
	.WORD	OR
	.SBTTL	Table of relational operators.

;+
;The ordering of the table below must reflect the ordering of the branch
;table "TSTTAB".
;
;*********************** NOTE****************************
; Because of the way the routine "TBSRC" works, ">" must appear after
; ">=" in the table, and "<" after "<=".
;-


RELTAB::

;+
;ENTRY 1 - corresponds to "TSTEQ"
;-

	.ASCIZ	/EQ/
	.ASCIZ	/=/

;+
;ENTRY 2 - corresponds to "TSTCC"
;-

	.ASCIZ	/GE/
	.ASCIZ	/>=/

;+
;ENTRY 3 - corresponds to "TSTLOS"
;-

	.ASCIZ	/LE/
	.ASCIZ	/<=/

;+
;Now entries 1-3 once more with inverted logic.
;-

	.ASCIZ	/NE/
	.ASCIZ	/<>/
;
	.ASCIZ	/LT/
	.ASCIZ	/</
;
	.ASCIZ	/GT/
	.ASCIZ	/>/

;+
;End of table.
;-

	.BYTE	0
	.EVEN
	.SBTTL	Indirect IF processor

;+
;IF0
;This is the entry point for .IF directives.
;
; Input:  R0 -> Next ASCII character after "." in string being processed.
;-

	.ENABL	LSB

IF0::	MOV	#<377>,CUROP	;Low byte-current operation-set TRUE
				;High byte-previous oper.-set FALSE (PRVOP)
	BISB	#<SEENIF>,BLKFLG ;Set to show IF has been executed
	CLRB	FLAG		;Next must be .IFxxx
1$:	MOV	#CMDTAB,R2	;Point to start of table of ASCII commands
	CALL	TBSRC		;Identify command
	BCS	2$		;Non-existant command - error
	CALL	@JTAB(R1)	;Command found - jump to appropriate routine
	CALL	$GNBLK		;Get next non-blank
	BCS	SYN1		;Syntax error occured
	CMPB	R2,#<DOT>	;Another command?
	BEQ	1$		;Yes, see if it's one that can be handled here
2$:	TSTB	-(R0)		;No, pointer must be before "."

;+
;This routine is entered upon completion of IF directive.
;-

	TSTB	FLAG		;Legal to exit now?
	BEQ	SYNERR		;No, .IFxxx was not seen, or last was .AND or
				;.OR - error
	BISB	CUROP,PRVOP	;Form final logical result
	BNE	3$		;TRUE - jump
	JMP	INDRD		;Go get another command line

3$:	JMP	INTST		;TRUE - go process rest of line

	.DSABL	LSB
	.SBTTL	Branch table for various tests.

TSTLOG:	TSTB	SETYP(R5)	;Is symbol set true or false?
	.ASSUME	<LOGT> EQ 0
	.BR	TSTTAB

;+
;The ordering of this table must reflect the ordering of the table "RELTAB".
;-

TSTTAB::.BR	TSTEQ
TSTEQ:	BEQ	TTRUE		;Equal = TRUE
	BR	TFALSE		;not equal = FALSE

TSTCC:	BCC	TTRUE		;C-bit cleared (higher or the same) = TRUE
	BR	TFALSE		;C-bit set (lower) = FALSE

TSTLOS:	BLOS	TTRUE		;Lower or the same = TRUE
	BR	TFALSE		;Higher = FALSE

TSTPL:	BPL	TTRUE		;Plus = TRUE
	.BR	TFALSE		;Minus = FALSE
TFALSE:	TST	(SP)+		;Condition inverted?
	BEQ	FALSE		;No - set to FALSE
	BR	TRUE		;Yes - set to TRUE

TTRUE:	TST	(SP)+		;Condition inverted?
	BEQ	TRUE		;No - set to TRUE
	.BR	FALSE		;Yes - set to FALSE
FALSE:	CLRB	CUROP		;Set current operand FALSE

;+
;Leave current operand untouched.
;-

TRUE:	INCB	FLAG		;Last was .IFxxx (legal to exit)
	RETURN

;+
;The following routines use the same set up upon entry.  When testing the
;positive condition a zero is pushed on the stack.  If the negative condition
;is being tested a non-zero value is pushed on the stack.  When testing is
;complete the value is popped off the stack at either TFALSE or TTRUE.
;-

	.SBTTL	IFDF/IFNDF - if defined or not defined

	.ENABL	LSB

;+
;If defined.
;-

IFDF:	CLR	-(SP)		;Store a zero on the stack for positive cond.
	BR	1$		;Branch to common routine

;+
;If not defined.
;-

IFNDF:	MOV	PC,-(SP)	;Push non-zero on to stack for negative cond.
1$:	CALL	GTSYM		;Get requested symbol
	BCS	SYNERR		;Syntax error
	CALL	SRSYM		;Is it defined?
	BR	TSTCC		;C-bit clear = defined;C-bit set = not defined

	.SBTTL	IFT/IFF - if true or false

;+
;If true.
;-

IFT:	CLR	-(SP)		;Store a zero on the stack for positive cond.
	BR	2$		;Branch to common routine

;+
;If false.
;-

IFF:	MOV	PC,-(SP)	;Push non-zero on to stack for negative cond.
2$:	CALL	$GNBLK		;Get next non-blank character
	BCS	SYNERR		;Branch if error
	CMPB	R2,#<OPBRK>	;Open bracket?
	BNE	3$		;Branch if straight forward IFT/IFF
	CALL	EVNX		;Evaluate expression
	SAVE	<R1>		;Save results
	CMPB	(R0)+,#<CLBRK>	;Ends with close bracket?
	BNE	SYNERR		;Branch if no
	CALL	GTSYM		;Get symbol to test
	BCS	SYNERR		;Branch if error
	CALL	SRSYM		;Find symbol in table
	BCS	UDSERR		;Branch if symbol not found
	BITB	#<NUM>,SETYP(R5);Numeric symbol?
	BEQ	TYPERR		;Branch if no
	BIT	(SP)+,SEVAL(R5)	;Do bit test
	BEQ	TFALSE		;If equal - FALSE
	BR	TTRUE		;Else - TRUE

3$:	DEC	R0		;Adjust pointer to start of symbol
	CALL	GTSY1		;Get requested symbol
SYN1:	BCS	SYNERR		;Syntax error
	CALL	SRSYM		;Find the symbol
	BCS	UDSERR		;Symbol no defined - error
	BIT	#<STR!NUM>,SETYP(R5) ;String or numeric symbol
	BEQ	TSTLOG		;Branch if logical - correct symbol
TYPERR:	TRAP	ERTYP		;Symbol type error
	.SBTTL	IFLOA/IFNLOA - if not loaded or not loaded

;+
;If loaded.
;-

IFLOA:	CLR	-(SP)		;Store a zero on the stack for positive cond.
	BR	4$		;Branch to common routine

;+
;If not loaded.
;-

IFNLOA:	MOV	PC,-(SP)	;Push non-zero on to stack for negative cond.
4$:	CALL	$GNBLK		;Get non-blank
	BCS	SYNERR		;Syntax error
	TST	R1		;Where any blanks seen?
	BEQ	SYNERR		;No, syntax error
	DEC	R0		;Adjust command buffer pointer
	CALL	CAT5		;Convert device name to RAD50. Treat as if 6
				;characters.  R2 = 0 if everything is ok
	BCS	SYNERR		;Something is wrong - give error
	TST	R2		;Was there more than 3 characters?
	BNE	SYNERR		;Branch if yes to syntax error
	MOV	R1,WRKFDB+2	;Store name
	CMPB	(R0)+,#<COLON>	;Colon?
	BEQ	5$		;Branch if yes. Ignore
	TSTB	-(R0)		;Restore pointer
5$:	SAVE	<R0>
	.DSTATUS #DVINFO,#WRKFDB+2 ;Get device status
	RESTOR	<R0>
	BCS	TFALSE		;Device not in device tables
	TST	DVINFO+4	;Driver resident?
	BEQ	TFALSE		;No, not resident
	BR	TTRUE		;Yes, resident
	.SBTTL	AND/OR processing

OR:	BISB	CUROP,PRVOP	;PRVOP <-- PRVOP .OR. CUROP
	MOVB	#<-1>,CUROP	;CUROP <-- .TRUE.
AND:	TSTB	FLAG		;.OR/.AND illegal if previous was not .IFXXX
	BEQ	SYNERR		;Branch if error
	CLRB	FLAG		;Clear flag
	RETURN

	.DSABL	LSB

SYNERR:	TRAP	ERSYN		;Syntax error
INVDEV:	TRAP	ERDEV		;Invalid device or unit
UDSERR:	TRAP	ERUDS		;Undefined symbol

	.ENABL	LSB

IFENAB::CLR	-(SP)		;Clear for positive condition
	BR	1$		;Branch to common routine

IFDSAB:	MOV	PC,-(SP)	;Make non-zero for negative condition
1$:	CALL	CHKLST		;Check list for valid mode specification
	BCS	SYNERR		;Syntax error
2$:	TST	(R3)+		;Point to the real flag word
	BIT	R1,@R3		;Is the bit clear or set?
	BEQ	TFALSE		;Clear, do inverted FALSE
3$:	BR	TTRUE		;Set, do inverted TRUE

TYPLNK:	BR	TYPERR		;Link to TYPERR

	.DSABL	LSB
	.SBTTL	IF - Generalized processing for IF directives
;+
;IF
;Routine to handle logical IF.
;-

	.ENABL	LSB

IF:	CALL	GTSYM		;Parse symbol name
	BCS	SYNERR		;Syntax error
	CALL	SRSYM		;Locate symbol
	BCS	UDSERR		;Undefined symbol error
	MOV	R5,OP1		;Save symbol table address
	CALL	$GNBLK		;Get next non-blank
	BCS	SYNERR		;End of line encountered - error
	TST	R1		;Any blanks seen?
	BEQ	SYNERR		;No, error
	DEC	R0		;Backup up to last non-blank
	MOV	#RELTAB,R2	;Point to table with relational operators
	CALL	TBSRC		;Search table for text
	BCS	SYNERR		;If not found syntax error
	BIC	#<2>,R1		;Clear synonym bit
	CLR	-(SP)		;Clear invert flag
	CMP	R1,#<14>	;Inverted logic?
	BLO	1$		;Branch if no
	SUB	#<14>,R1	;Subtract excess
	INC	@SP		;Set invert flag
1$:	MOVB	R1,COND		;Save relational operator
	MOV	OP1,R4		;Get first operand address
	MOVB	SETYP(R4),R3	;Get symbol type
	BICB	#<1>,R3		;Get first operator type
	CMPB	R3,#<NUM>	;Numeric?
	BNE	2$		;Branch if no

;+
;Numeric symbol
;-

	CALL	EVNX		;Evaluate numeric expression
	MOVB	COND,R2		;Get condition
	CMP	SEVAL(R4),R1	;Compare
	BR	8$		;Go do the test

2$:	CMPB	R3,#<STR>	;String?
	BEQ	3$		;Branch if yes

;+
;Logical symbol
;-

	TSTB	R1		;If 1st oper is log. operator must be EQ or NE
	BGT	SYNERR		;Syntax error
	CALL	GTSYM		;Get next symbol
	BCS	SYNERR		;Syntax error
	CALL	SRSYM		;Locate symbol in table
	BCS	UDSERR		;Undefined symbol error
	BITB	#^C<1>,SETYP(R5);Are any bits set?
	BNE	TYPLNK		;Yes, not a logical symbol - error
	MOVB	COND,R2		;Get condition
	MOV	OP1,R4		;Get SYMTAB entry of first operand
	CMPB	SETYP(R4),SETYP(R5) ;Compare values
	BR	8$		;Go do test

;+
;String symbol
;-

3$:	CALL	GSVAL		;Get value of second operandop
	MOVB	COND,R2		;Get condition
	CLR	R3
	BISB	SELEN(R4),R3	;Get length of first string
	ADD	#SEVAL,R4	;Get pointer to first string
4$:	DEC	R1		;Decreament byte count of string 2
	BMI	5$		;Branch if string 2 is done
	DEC	R3		;Decreament byte count of string 1op
	BMI	6$		;Branch if string 1 is done
	CMPB	(R4)+,(R5)+	;Compare the strings
	BNE	8$		;Branch out if not equal
	BR	4$		;Else loop

5$:	CLC			;Strings are not equal
	DEC	R3		;Are we at the end of string 1?
	BPL	7$		;Branch if no
	SEZ			;Strings are equal
	BR	8$		;Go to test

6$:	SEC			;String 1 is less than string 2
7$:	CLZ			;Strings not equal
8$:	JMP	TSTTAB(R2)	;Go do the test

	.DSABL	LSB

	.END