.TITLE	INDEX
	.IDENT	/BL1.1/

;
;	This is a completely rewritten version of INDEX designed
;	to word with the dynamic memory routines.
;
;	J. CLEMENT	September 1982
;
; INDEX COMMAND
;
; LOCAL DATA
	.vars
;
;	Impure data section
;
BLINK:	.BLKA	1		; Points back to last item
LINK:	.BLKA	1		; Points to current item
FLINK:	.BLKA	1		; Points to next item
STAT:	.BLKA	1		; Status byte
SUBINX:	.BLKA	1		; Current Subindex count
SUBINT:	.BLKA	1		; Total subindex count
STRADD:	.BLKA	1		; String address
SIZ=<.-BLINK>/2
ENT:	.BLKA	1		; Non zero if entry only
	.code
;
;	INDEX	- ADD INDEX ITEM TO INDEX DATA
;	AINDEX	- Autoindex by flag
;
AINDEX::TSTEQB	$INXSW,10$	; INDEXING ENABLED?
	RETURN			; NO		
10$:	CALL	BRKSV		; Save current loc. in input buffer
	INCB	RETSW		; Set up return on breakable char
	MOVB	$IFLSW,R1	; Get index flag
	MOVB	GCTABL(R1),-(SP); Save old flag
	MOVB	#GC.SPC,GCTABL(R1); and substitute new
	CALL	SETBF		; Get index term
	MOVB	$IFLSW,R1	; Get index flag
	MOVB	(SP)+,GCTABL(R1); Restore flag
	CLRB	RETSW
	CALL	BKUP		; Back up to break
	CLRB	ENT
	BR	INDEX1
ENTRY::	MOVB	#-1,ENT
	BR	INDEX0
INDEX::	CLRB	ENT
INDEX0:	CALL	$FRCND		; FORCE TO LOGICAL END OF COMMAND
	MOVB	$SIFSW,R1	; Get subindex flag
	MOVB	GCTABL(R1),-(SP); Save old flag
	TSTNEB	$SIFSW+1,5$	; Subindex flag disabled ?
	CMPEQB	GCTABL(R1),#GC.MSC,4$; Flag not already in use ?
	CMPNEB	GCTABL(R1),#GC.IFL,5$; Flag not index flag ?
4$:	MOVB	#GC.SIX,GCTABL(R1); and substitute new
5$:	CALL	SETBF		; Get index term
	MOVB	$SIFSW,R1	; Get subindex flag
	MOVB	(SP)+,GCTABL(R1); Restore flag
	TSTEQB	$INXSW,10$	; INDEXING ENABLED?
	RETURN			; NO		
10$:	MOV	#TTBUF,R2	; Get buffer address
17$:	MOVB	(R2)+,R1	; Get char
	BEQ	INDEX1		; Done ?
	CMPNEB	R1,#SXCHR,17$	; Not Subindex flag ?
	CLRB	-1(R2)		; Make flag a null
	INC	SUBINT		; Total number of subindex flags
	CMP	SUBINT,#6	; Check number
	BLE	17$		; Not too many ?
	MOV	#36.,R0		; Message number to output
	JMP	ILCMA		; too many, give error
INDEX1:	MOV	#TTBUF,STRADD	; Clear string address
	MOV	#INXBF,R3	; Index buffer
	CALL	BEGBF		; Set to start of buffer
	CALL	GWRD		; get foreward link
	BCS	STARTX		; not first time for indexing
	MOV	R1,FLINK	; foreward link
10$:	CALL	GETLNK		; Get link and status
	BCS	KEEP		; None so save current entry
	CALL	TSTS		; Test the string
	BGT	10$		; Input string > table entry
	BNE	KEEP		; New entry/ save it
	CALL	GETLNK
	JMP	KEEP1
;
;	Subroutine to Keep the entry + fill in page number etc.
;
STARTX:	MOV	#INXBF,R3	; Get index buffer
	CALL	CLRBF
	MOV	#X.ENT,STAT	; first entry status
	CALL	CWRD		; for first link
KEEP:	MOV	#INXBF,R3	; Get index buffer
	MOV	BLINK,R1	; Backward link
	CALL	FNDBF		; go to it
	BCC	10$
	CALL	HLTER
10$:	MOV	BF.MAX(R3),R1	; Final index
	MOV	R1,BLINK	; Now set current entry as backward link
	CALL	PWRD		; link it in
	CALL	ENDBF		; back to end buffer
	MOV	LINK,R1		; foreward link
	CALL	PWRD		; link it in
	MOV	#X.ENT,R1	; Initial status
	MOV	R1,R2		; Save
	ADD	SUBINX,R1	; Current subindex number	
	CALL	PBYT		; Store status
	MOV	STRADD,R2	; Entry buffer
90$:	MOVB	(R2)+,R1	; get byte
	CALL	PBYT		; save it
	TSTNE	R1,90$		; more to come?
	MOV	R2,STRADD	; Next starting address
	CMPEQ	SUBINX,SUBINT,KEEP1 ; Finished all levels ?
	INC	SUBINX		; Do next level
	BR	KEEP
KEEP1:	TSTNEB	ENT,110$	; No page number saved ?
	CALL	LINFAK
	MOV	#INDX,R1	; Get index flag
	CALL	PBYT		; Into output buffer
	MOV	BLINK,R1	; Link
	CALL	PWRD		; Save it too
	TSTNE	BF.HED(R3),110$	; Header exists ?
	CALL	CBYT		; Chock the line
	CALL	OUTLIN		; And output it
110$:	RETURN
;
;	Subroutine to get next link
;
GETLNK:	MOV	LINK,BLINK
	MOV	FLINK,R1	; next entry
	MOV	R1,LINK		; stack the links
	BNE	10$		; no more
	SEC			; end of buffer
	RETURN
10$:	CALL	FNDBF		; find it
	BCC	15$		; OK ?
	CALL	HLTER
15$:	CALL	GWRD		; get next foreward link
	BCS	110$		; end of input
	MOV	R1,FLINK	; next foreward link
	CALL	GBYT		; get status byte
	BCS	110$		; end of input
	BITEQ	#X.ENT,R1,GETLNK; No entry ?
	MOV	R1,STAT		; get status
	CLC			; Success for next entry
	RETURN
110$:	CALL	HLTER		; End of buffer is error
;
;	Subroutine to compare input string to table
;
TSTS:	MOV	STAT,R0		; Get current status
	BIC	#^C<X.SEN>,R0	; Get subentry number
	CMPNE	R0,SUBINX,70$	; Not same level ?
	MOV	STRADD,R2	; Input string address
10$:	CALL	GBYT		; get table entry
	BIC	#^C<^o177>,R1	; strip char.
	CMPNEB	GCTABL(R1),#GC.LC,20$ ; Not lower case?
	SUB	#^o40,R1	; Convert to upper case
20$:	MOVB	(R2)+,R0	; input string char
	BEQ	50$		; end of string?
	BIC	#^C<^o177>,R0	; strip char.
	CMPNEB	GCTABL(R0),#GC.LC,30$ ; Not lower case?
	SUB	#^o40,R0		; Convert to upper case
30$:	CMPEQ	R0,R1,10$	; same, continue
	RETURN
50$:	CMPEQ	SUBINX,SUBINT,60$ ; End of entire string ?
	TSTNE	R1,60$		; Not end of entry too ?
	INC	SUBINX		; Count it
	MOV	R2,STRADD	; Save next subentry address
	MOV	#-1,R1		; Guarantee another compare
60$:	CMP	R0,R1		; final compare
70$:	RETURN
;
;
;
SETBF:	CALL	VARSAV		; Save variables
	MOV	#BLINK,R0	; Table to clear
	MOV	#SIZ,R1		; Size of table
5$:	CLR	(R0)+		; Clear entries
	SOB	R1,5$		; Till done
	MOV	#TTBF,R3	; BUFFER TO GET TITLE
	CALL	CLRBF		; Clear the buffer
	MOV	#SW.IDS,R0	; Input disable bits
	BISB	R0,$EQFSW+1	; Disable equation mode
	BISB	R0,$IFLSW+1	; DISable index flag
	BISB	R0,$UNLSW	; Disable underlining
	BISB	R0,$OVRSW	; Disable overstriking
	BISB	R0,$AUBRK	; Disable autobreak
	BISB	R0,$TABSW	; DISABLE TABS
	BISB	R0,$ESCSW	; DISABLE ESCAPE SEQ.
	BISB	R0,$HYPSW	; Disable hyphenation
	BIS	#FILLF,F.1	; SET TO FILL (GET RID OF SPACES)
	CALL	VARSET		; Set the variables for begin line
	MOV	#100.,R0	; Max size for index terms
	CALL	CVHSP		; Convert
	MOV	R1,LINBK	; Now is max
10$:	CALL	GCIN		; READ TITLE OR SUBTITLE
	CMPNE	R1,#LF,11$	; End of line?
	CALL	BKSPI		; Backspace over LF
11$:	TST	LINBK		; Past end of line?
	BLT	15$		; No
	CMPNEB	LCH,#SPC,20$	; Last char in buffer not space?
15$:	MOV	#-1,BF.hed(R3)	; Fake header
	CALL	BKOUT		; Back up over last space
	CLR	BF.hed(R3)	; Fake header
20$:;	MOV	SPCH,BF.SPC(R3) ; SPACING CHAR COUNT
	MOV	#TTBF,R3	; Restore buffer address
	CALL	CBYT		; Insert null into title
	RETURN			;
	.END