.TITLE	RNOIF
;
;								AZ (new)
;	NSWC Changes:						     V
;
;		17 Feb 87 - Add code to process /VARIANT qualifier on
;			     VAXes.
;		15 Mar 88 - Allow use of all 256 Extended ASCII characters.
;								     ^
;								AZ (new)
;	This section handles the following commands
;
;	.IF
;	.IFNOT
;	.ENDIF
;	.VARIANT
;	.NO VARIANT
;	.ENABLE UNCONDITIONAL
;	.DISABLE UNCONDITIONAL
;
IF.ON	= ^o10		; Zero if text enabled			; AZ 3/88
IF.ELS	= ^o4		; Set if no ELSE			; AZ 3/88
IF.NOT	= ^o2		; Set if in a not branch		; AZ 3/88
IF.VAR	= ^o1		; Set if variant command		; AZ 3/88
;								; AZ 3/88
IF.FLAGS = IF.ON + IF.NOT + IF.ELS + IF.VAR			; AZ 3/88
;								; AZ 3/88
	.vars
FIELD:	.BLKA	1
TYPE:	.BLKA	1
INLAB::	.BLKB	IFMAX+1						; AZ (::)
	.even
	.code
;
;	Routine to test if label present
;	And if not enter it into table
;
LABEN0:	CLR	R5
	BR	LABEN1
LABENT:	MOV	#-1,R5
LABEN1:	CALL	LABTS0
	BCC	LABENR						; AZ 3/88
LABEN2:	CALL	ENDBF			; Set up for output	; AZ 3/88 (:)
	MOV	#INLAB,R2		; get input buffer
10$:	MOVB	(R2)+,R1		; Get char
	BEQ	20$			; Done ?
	CALL	PBYT			; Save it
	BR	10$
20$:	CLR	R1						; AZ 3/88
	CALL	PBYT			; Chock end of string
LABENR:	RETURN				; No success		; AZ 3/88 (:)
;
;	Test if label present
;	Input:	R5 = 0 if wild chars ignored
;		R5 = -1 wild chars parsed
;	Output:	Carry set if no label
;		Carry clear if label
;		and R1 = status
;
MISERR:	MOV	#7,R0			; Error number
	JMP	ILCMA
LABTST:	MOV	#-1,R5
LABTS0:	CALL	SKPSP
	BCS	MISERR			; End of labels ?
10$:	CALL	BKSPI			; Backspace over char
	MOV	#INLAB,R2		; Temporary buffer for label
20$:	CALL	CCINUC			; Get 1 character of label
	BCS	30$			; At end of buffer ?
	MOVB	R1,(R2)+		; Save char
	CMP	R2,#INLAB+IFMAX		; Check how many chars
	BLOS	20$			; Not too many ?
	MOV	#51.,R0			; Label too long
	JMP	ILCMA
30$:	CLRB	(R2)+			; Chock end of buffer
	TSTEQB	INLAB,MISERR		; No string ?
FNDLAB:								; AZ (new)
	MOV	#IFBF,R3		; If buffer address
	CALL	BEGBF			; Start at beginning of IF buffer
;	Search for matching label
40$:	MOV	#INLAB,R2		; Now search buffer for label
50$:	CALL	GBYT			; Get first label
	BCS	80$			; None ?
	BITEQB	#^C<IF.FLAGS>,R1,70$	; At end of string ?	; AZ 3/88
55$:	CMPEQB	(R2)+,R1,50$		; Chars match ?
	TSTEQ	R5,60$			; Wild chars not allowed ?
	CMPEQB	R1,#STARR,65$		; Is it wild ?
;	Skip over rest of label
60$:	CALL	GBYT			; Get next input byte
	BCS	80$			; End of buffer ?
	BITEQB	#^C<IF.FLAGS>,R1,40$	; End of string ?	; AZ 3/88
	BR	60$			; Not yet
65$:	CALL	GBYT			; Get next input byte
	BCS	80$			; End of buffer ?
	BITEQB	#^C<IF.FLAGS>,R1,75$	; End of string ?	; AZ 3/88
	BR	65$			; Not yet
70$:	TSTNEB	(R2),40$		; Not end of input ?
75$:	CLC
80$:	RETURN
;								; AZ (new)
	.IF DF	$VMS						;      V
;
;	Process /VARIANT=(V1[,Vn]...) qualifier on VAXes.
;
QVARNT::CLR	R5						; AZ 3/88
	CALL	FNDLAB
	BCC	40$
	CALL	LABEN2						; AZ 3/88
40$:	BISB	#IF.VAR,@BF.ADD(R3)
	RETURN
;								;      ^
	.ENDC							; AZ (new)
;
;	Insert entry into if stack
;		Z set if no varint this entry
;		R0=points to $IFSTT
;
STKERR:	MOV	#53.,R0			; Error number
	JMP	ILCMA			; Kill this comand
INSERT:	TSTNEB	SUBSTK,STKERR		; Error in stack depth ?
	CLR	FIELD			; Clear field counter
1$:	INC	FIELD			; Increment field counter
	CALL	LABTST
	BCC	15$			; Found label ?
	CALL	SKPSP			; Get more chars ?
	BCS	2$			; No more
	CALL	BKSPI			; Backup 1 char
	BR	1$			; Try next one
2$:	CALL	ENDBF			; Set up for output
	MOV	#INLAB,R2		; get input buffer
5$:	MOVB	(R2)+,R1		; Get char
	BEQ	10$			; Done ?
	CALL	PBYT			; Save it
	BR	5$
10$:	CALL	CBYT			; Chock end of string	; AZ 3/88
15$:	BITNEB	#IF.VAR,R1,20$		; Variant set ?
	CALL	SKPSP			; Get more chars ?
	BCS	25$			; No more
	CALL	BKSPI			; Backup 1 char
	BR	1$			; Try another ?
20$:	CALL	SKPSP			; Skip rest of chars
	BCC	20$			; Not end of command ?
25$:	MOV	$IFSTK,R0		; Get if stack in R0
	BNE	30$			; Not first ?
	BIC	#IFFLG,F.1		; Reset if flag
30$:	INC	R0
	CMP	R0,#IFDPTH		; Check stack depth
	BLE	40$			; Is it OK?
	MOV	#45.,R0			; Error message number
	JMP	ILCMA
40$:	MOV	R0,$IFSTK		; new stack entry
	MOV	R0,R2			; Entry
	INDXA	R2			; Now is word pointer
	MOV	R0,R5
	ADD	#$IFSTT-1,R5		; Points to if status
	ADD	#$IFSTK,R2		; Point to if stack
	CLRB	(R5)			; Clean slate
	MOV	BF.FUL(R3),(R2)		; Store stack pointer
	BITEQ	#IFFLG,F.1,50$		; If flag clear ?
	BISB	#IF.NOT,(R5)		; Set not
50$:	MOVB	@BF.ADD(R3),R1		; get status
	BITB	#IF.VAR,R1		; Check variant
	RETURN
;
;	CHECK for current label
;		R1=Current stack value at end
;		R0=$IFSTK
;		R2=points to IFSTK
;		R5=points to $IFSTS
;
LABCK:	TSTEQB	SUBSTK,1$		; Zero stack level ?
	JMP	STKERR			; Error in stack depth ?
1$:	CALL	SKPSP			; Get first char
	BCC	5$			; Got one ?
	JMP	MISERR			; No parameter error
5$:	CMPEQB	R1,#STARR,10$		; Is it "*"
	CALL	BKSPI			; Save it
	CLR	FIELD
	CALL	LABTST			; Get label + find it
	BCC	10$			; Found one ?
	JMP	IFERR			; None ?
10$:	MOV	$IFSTK,R0
	MOV	R0,R5
	ADD	#$IFSTT-1,R5		; Points to if status
	MOV	R0,R2
	INDXA	R2			; If stack pointer
	ADD	#$IFSTK,R2
	CMPEQB	R1,#STARR,20$		; Is it "*"
	CMPEQ	(R2),BF.FUL(R3),20$	; Same ?
	JMP	IFERR			; not same ??
20$:	RETURN
;
;	IFNOT command Test if label is not present
;
IFNOT::	CALL	INSERT
	BNE	IFOFF			; Variant ?
	JMP	IFON			; Not variant ?
IFOFF:	BISB	#IF.ON,(R5)		; Disable it
IFRET:	MOV	$IFSTK,R5		; Get stack
	BNE	10$			; IF in progress ?
	BIC	#IFFLG,F.1		; Set no if
	TSTEQB	$IFUSW,15$		; Unconditional flag off
	BIS	#IFFLG,F.1		; Disable text output
	MOV	#CMADR,R0		; Set up for return
	MOV	#IFCMD,(R0)+		; Allow IF commands
	MOV	#IFNCMD,(R0)+		; Allow IFNOT commands
	MOV	#ENUCMD,(R0)+		; Allow ENable unconditional
	CLR	(R0)+
	BR	30$
10$:	ADD	#$IFSTT-1,R5		; Current entry
	BITNEB	#IF.NOT!IF.ON,(R5),20$	; NOT present?
	BIC	#IFFLG,F.1		; No text 
15$:	RETURN				; No keep rest of line
20$:	BIS	#IFFLG,F.1		; Set no text
	MOV	#CMADR,R0		; Set up for return
	MOV	#IFCMD,(R0)+		; Allow IF commands
	MOV	#IFNCMD,(R0)+		; Allow IFNOT commands
	MOV	#ELSCMD,(R0)+		; Allow else commands
	MOV	#EICMD,(R0)+		; Allow End commands
	CLR	(R0)+
30$:	JMP	COMNT			; And kill rest of line
;
;	error routine
;
IFERR:	MOV	#46.,R0			; Error message number
	JMP	ILCMA			; Now return
;
;	IF command Test if label is true
;
IF::	CALL	INSERT
	BNE	IFON			; Variant ?
	JMP	IFOFF			; Not variant ?
IFON:	BICB	#IF.ON,(R5)		; Enable it
	BR	IFRET
;
;	ELSE command
;
ELSE::	CALL	LABCK				; Check if correct entry
	BITNEB	#IF.ELS,(R5),IFERR		; Already else ?
	BISB	#IF.ELS,(R5)			; Set else
	BITNEB	#IF.ON,(R5),IFON		; If flag on ?
	BR	IFOFF				; no, turn it off
;
;	ENDIF command
;
ENDIF::	CALL	LABCK
	DEC	R0			; New stack entry
	BLT	IFERR			; Bad stack ?
	MOV	R0,$IFSTK		; new stack entry
	BR	IFRET			; return
;
;	VARIANT command
;
VARIAN::CLR	FIELD
1$:	CALL	SKPSP			; Check if second label ?
	BCS	20$			; None
	CALL	BKSPI			; Backspace over char
	CALL	LABEN0			; Get char string
	BISB	#IF.VAR,@BF.ADD(R3)	; Set label present
	BR	1$			; And try again
20$:	RETURN
;
;	NO VARIANT command
;
NOVARN::CLR	FIELD
1$:	CALL	SKPSP			; Check if second label ?
	BCS	20$			; None
	CALL	BKSPI			; Backspace over char
	CALL	LABEN0			; Get char string
	BICB	#IF.VAR,@BF.ADD(R3)	; Set variant off
	BR	1$			; And try again
20$:	RETURN
;
;	Subroutine to get only upper case input
;	INput:	R5 = 0 Wild chars allowed in input
;	Output:	C = clear if got char
;		C = set no char
;		R1 = char
;
CCINUC:	CALL	CCINP			; Get input char
	BCS	5$			; End of input ?
	CMPEQB	(R0),#GC.LC,10$		; Lower case ?
	CMPEQB	(R0),#GC.UC,20$		; Upper case letter ?
	CMPEQB	(R0),#GC.DIG,20$	; Number ?
	CMPEQB	R1,#UNDSC,20$		; Underscore
	TSTNE	R5,4$			; No special chars ?
	CMPEQB	R1,#STARR,20$		; Is it star
4$:	CALL	BKSPI			; Back over input char.
5$:	SEC				; And set end of input
	RETURN
10$:	SUB	#^o40,R1		; Make it upper
20$:	CLC				; Set char ok !
	RETURN
;
;	ENABLE UNCONDITIONAL
;	DISABLE UNCONDITIONAL
;
DSUNC::	BISB	#SW.DIS,$IFUSW		; Set unconditional off
	JMP	IFRET
ENUNC::	BICB	#SW.DIS,$IFUSW		; Set unconditional on
	JMP	IFRET
;
;	IMMEDIATE IF command
;	IMMEDIATE IFNOT command
;
IIF::	CLR	FIELD
	CALL	LABTST			; Get label + find it
	BCS	IINO			; Not present
	BITEQB	#IF.VAR,R1,IINO		; Not a variant ??
IIYES:	RETURN				; Accept the line
IIFNOT::CLR	FIELD
	CALL	LABTST			; Get label + find it
	BCS	IIYES			; None ?
	BITEQB	#IF.VAR,R1,IIYES	; Variant not enabled ?
IINO:	TST	(SP)+			; Pop stack
	JMP	COMNT			; Kill current line
	.END