.TITLE	RNOIF
;
;	This section handles the following commands
;
;	.IF
;	.IFNOT
;	.ENDIF
;	.VARIANT
;	.NO VARIANT
;	.ENABLE UNCONDITIONAL
;	.DISABLE UNCONDITIONAL
;
IF.ON=10		; Zero if text enabled
IF.NOT=20		; Set if in a not branch
IF.ELS=40		; Set if no ELSE
IF.VAR=100		; Set if variant command
	.vars
TYPE:	.BLKA	1
INLAB:	.BLKB	IFMAX+1
	.even
	.code
;
;	Routine to test if label present
;	And if not enter it into table
;
LABENT:	CALL	LABTST
	BCC	40$
	CALL	ENDBF			; Set up for output
	MOV	#INLAB,R2		; get input buffer
10$:	MOVB	(R2)+,R1		; Get char
	BEQ	20$			; Done ?
	CALL	PBYT			; Save it
	BR	10$
20$:	MOV	#^o200,R1
	CALL	PBYT			; Chock end of string
40$:	RETURN				; No success
;
;	Test if label present
;	Carry set if no label
;	Carry clear if label
;		and R1 = status
;
LABTST:	CALL	SKPSP
	BCS	MISERR			; Control char ?
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 ?
	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 ?
	BLE	70$			; At end of string ?
55$:	CMPEQB	(R2)+,R1,50$		; Chars match ?
;	CMPEQB	R1,#STARR,60$		; Is it wild ?
;	Skip over rest of label
60$:	CALL	GBYT			; Get next input byte
	BCS	80$			; End of buffer ?
	BLE	40$			; End of string ?
	BR	60$			; Not yet
70$:
;	CMPEQB	(R2),#STARR,75$		; Is it wild ?
	TSTNEB	(R2),40$		; Not end of input ?
75$:	CLC
80$:	RETURN
MISERR:	MOV	#7,R0			; Error number
	JMP	ILCMA
;
;	Insert entry into if stack
;		Z set if no varint this entry
;
STKERR:	MOV	#53.,R0			; Error number
	JMP	ILCMA			; Kill this comand
INSERT:	TSTNEB	SUBSTK,STKERR		; Error in stack depth ?
	CALL	LABTST
	BCC	15$			; Found label ?
	CALL	SKPSP			; Get more chars ?
	BCS	1$			; No more
	CALL	BKSPI			; Backup 1 char
	BR	INSERT			; Try next one
1$:	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$:	MOV	#^o200,R1
	CALL	PBYT			; Chock end of string
15$:	BITNEB	#IF.VAR,R1,20$		; Variant set ?
	CALL	SKPSP			; Get more chars ?
	BCS	25$			; No more
	CALL	BKSPI			; Backup 1 char
	BR	INSERT			; 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
	CLRB	$IFSTT-1(R0)		; Clean slate
	MOV	R0,R2			; Entry
	INDXA	R2			; Now is word pointer
	MOV	BF.FUL(R3),$IFSTK(R2)	; Store stack pointer
	BITEQ	#IFFLG,F.1,50$		; If flag clear ?
	BISB	#IF.NOT,$IFSTT-1(R0)	; 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=2*$IFSTK
;
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
	CALL	LABTST			; Get label + find it
	BCC	10$			; Found one ?
	JMP	IFERR			; None ?
10$:	MOV	$IFSTK,R0
	MOV	R0,R2
	INDXA	R2			; If stack pointer
	CMPEQB	R1,#STARR,20$		; Is it "*"
	CMPEQ	$IFSTK(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,$IFSTT-1(R0)	; Disable it
IFRET:	MOV	$IFSTK,R0		; 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$:	BITNEB	#IF.NOT!IF.ON,$IFSTT-1(R0),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,$IFSTT-1(R0)	; Enable it
	BR	IFRET
;
;	ELSE command
;
ELSE::	CALL	LABCK				; Check if correct entry
	BITNEB	#IF.ELS,$IFSTT-1(R0),IFERR	; Already else ?
	BISB	#IF.ELS,$IFSTT-1(R0)		; Set else
	BITNEB	#IF.ON,$IFSTT-1(R0),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::CALL	LABENT			; Get char string
	BISB	#IF.VAR,@BF.ADD(R3)	; Set label present
	CALL	SKPSP			; Check if second label ?
	BCS	20$			; None
	CALL	BKSPI			; Backspace over char
	BR	VARIAN			; And try again
20$:	RETURN
;
;	NO VARIANT command
;
NOVARN::CALL	LABENT			; Get char string
	BICB	#IF.VAR,@BF.ADD(R3)	; Set variant off
	CALL	SKPSP			; Check if second label ?
	BCS	20$			; None
	CALL	BKSPI			; Backspace over char
	BR	NOVARN			; And try again
20$:	RETURN
;
;	Subroutine to get only upper case input
;
CCINUC:	CALL	CCIN			; Get input char
	CMPNEB	GCTABL(R1),#GC.LC,10$	; Not lower case ?
	SUB	#^o40,R1			; Make it upper
10$:	CMPEQB	GCTABL(R1),#GC.UC,20$	; Upper case letter ?
	CMPEQB	GCTABL(R1),#GC.DIG,20$	; Number ?
	CALL	BKSPI			; Kill input
	SEC				; And set end of input
	RETURN
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::	CALL	LABTST			; Check if label present
	BCS	IINO			; Not present
	BITEQB	#IF.VAR,R1,IINO		; Not a variant ??
IIYES:	RETURN				; Accept the line
IIFNOT::CALL	LABTST			; Check label
	BCS	IIYES			; None ?
	BITEQB	#IF.VAR,R1,IIYES	; Variant not enabled ?
IINO:	TST	(SP)+			; Pop stack
	JMP	COMNT			; Kill current line
	.END