.TITLE	INDEX
	.IDENT	/BL2.0/
XTSIZ=24.
;
;	This is a completely rewritten version of INDEX designed
;	to word with the dynamic memory routines.
;
;	J. CLEMENT	September 1982
;
; INDEX COMMAND
;
;
;	Index generates a table with the following structure
;	Word 1	- First entry
; Entry:
;	Word 1	- Next entry
;	Byte	- Status = X.ENT+subentry number
;	N bytes	- Text terminated by zero
;  .or....
;
; Entry
;	Word	- Next entry
;	byte	- Status = X.pag+(X.ch,x.spg,x.apn)	(or/and)
;	byte	- number - If(x.chp or x.apn)
;	word	- number - If(x.pag)
;	byte	- number - If(x.spg)
;	This is filled in later when the page number is determined.
;
; Fast index table
;	Word	- Next entry
;	byte	- Status = X.ent+X.pag+Subentry number
;	byte	- Letter A+^o200
;	Word	- Next entry
;	byte	- Status = X.ent+X.pag+Subentry number
;	byte	- Letter B+^o200
;		........
;	byte	- Letter Z+^o200
;	Word	- Next entry
;	byte	- Status
;	byte	- -1
;		This is used to find entries quickly and is set up
; If FASTX is defined. 
;
; LOCAL DATA
	.vars
;
;	Impure data section
;
FCHAR:	.BLKA	1		; First char
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>/$WORDL
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
	MOV	R1,R0
	ADD	#GCTABL,R0
	MOVB	(R0),-(SP)	; Save old flag
	MOVB	#GC.SPC,(R0)	; and substitute new
	CALL	SETBF		; Get index term
	MOVB	$IFLSW,R1	; Get index flag
	MOV	R1,R0
	ADD	#GCTABL,R0
	MOVB	(SP)+,(R0)	; 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
	MOV	R1,R0
	ADD	#GCTABL,R0
	MOVB	(R0),-(SP)	; Save old flag
	TSTNEB	$SIFSW+1,5$	; Subindex flag disabled ?
	CMPEQB	(R0),#GC.MSC,4$	; Flag not already in use ?
	CMPNEB	(R0),#GC.IFL,5$	; Flag not index flag ?
4$:	MOVB	#GC.SIX,(R0)	; and substitute new
5$:	CALL	SETBF		; Get index term
	MOVB	$SIFSW,R1	; Get subindex flag
	MOV	R1,R0
	ADD	#GCTABL,R0
	MOVB	(SP)+,(R0)	; Restore flag
	TSTEQB	$INXSW,10$	; INDEXING ENABLED?
	RETURN			; NO		
10$:	MOV	#TTBUF,R2	; Get buffer address
	MOV	R2,R4		; Again
20$:	MOVB	(R2)+,R1	; Strip out leading blanks after subindex
	CMPEQB	R1,#SPC,20$	; Blank ?
	TSTB	R1
	BR	35$		; Save it
30$:	MOVB	(R2)+,R1	; Get char
35$:	BEQ	50$		; Done ?
	CMPNEB	R1,#SXCHR,40$	; Not Subindex flag ?
	CLRB	(R4)+		; Make flag a null
	INC	SUBINT		; Total number of subindex flags
	CMP	SUBINT,#X.SEN	; Check number
	BLT	20$		; Not too many ?
	MOV	#36.,R0		; Message number to output
	JMP	ILCMA		; too many, give error
40$:	MOVB	R1,(R4)+	; Save char
	BR	30$		; And try again
50$:	CLRB	(R4)+		; Chock it again
INDEX1:	MOV	#TTBUF,STRADD	; Clear string address
	MOVB	#X.ENT,STAT	; first entry status
	CLR	BLINK		; Clear for first time
	CLR	LINK
	CLR	FLINK
	MOV	#INXBF,R3	; Index buffer
	CALL	BEGBF		; Set to start of buffer
	CALL	GWRD		; get foreward link
	BCC	10$		; not first time for indexing
	MOV	#INXBF,R3	; Get index buffer
	CALL	CLRBF
	.if df	FASTX		; Fast indexing ??
	CLRB	FCHAR
	MOV	#$WORD2,R1	; Points to first entry
	CALL	PWRD		; Initial word
	CALL	XTSET
	.endc
	CALL	CWRD
	CALL	BEGBF		; Start at beginning again
	CALL	GWRD		; Get foreward link
10$:	MOV	R1,FLINK	; foreward link
	CALL	TSTS		; Test string
	BCS	KEEP		; New entry/ save it
	CALL	GETLNK
	MOVB	#-1,STAT	; Set status
	JMP	KEEP1
;
;	Subroutine to Keep the entry + fill in page number etc.
;
KEEP:	CLRB	STAT		; Initial status
KEEP0:	TSTNEB	@STRADD,5$	; Not null entry ?
	INC	STRADD		; Skip it
	JMP	95$		; Do not enter it
5$:	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
	ADD	SUBINX,R1	; Current subindex number	
	MOVB	R1,STAT		; Save
	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
95$:	CMPNE	SUBINX,SUBINT,100$	; More levels ?
	JMP	KEEP1 		; Finished all levels
100$:	INC	SUBINX		; Do next level
	.if df	fastx		; Fast indexing ??
	INCB	STAT		; Set to current level
	TSTEQB	ENT,130$	; Not optimized subindex ??
	MOVB	@STRADD,R1	; First char.	
	MOV	R1,R4
	BIC	#^C<^o177>,R4	; strip char.
	ADD	#GCTABL,R4
	CMPNEB	(R4),#GC.LC,110$ ; Not lower case?
	SUB	#^o40,R1	; Convert to upper case
110$:	MOVB	R1,FCHAR
	MOV	BLINK,R1	; Backward link
	CALL	FNDBF		; go to it
	BCC	120$
	CALL	HLTER
120$:	MOV	LINK,FLINK	; Get current link
	MOV	BF.MAX(R3),R1	; Final index
	MOV	R1,LINK		; New Current link
	CALL	PWRD		; link it in
	CALL	ENDBF		; back to end buffer
	CALL	XTSET		; Set up table
130$:
	.endc
	JMP	KEEP0
KEEP1:	TSTEQB	STAT,110$	; No entry ?
	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	20$		; OK ?
	CALL	HLTER
20$:	CALL	GWRD		; get next foreward link
	BCC	30$		; OK ?
	CALL	HLTER		; End of buffer is error
30$:	MOV	R1,FLINK	; next foreward link
	CALL	GBYT		; get status byte
	BCC	40$		; OK ?
	CALL	HLTER		; End of buffer is error
40$:	BITEQ	#X.ENT,R1,GETLNK; No entry ?
	MOVB	R1,STAT		; get status
	CLC			; Success for next entry
	RETURN
;
;	Subroutine to compare input string to table
;
TSTS:	CALL	GETLNK		; Get link and status
	BCC	1$
	RETURN			; None so save current entry
1$:	MOVB	STAT,R0		; Get current status
	BIC	#^C<X.SEN>,R0	; Get subentry number
	CMPEQ	R0,SUBINX,5$	; Not same level ?
	.if df	FASTX
	BGT	6$		; LArger
	.endc
	JMP	65$
	.if df	FASTX
6$:	BITEQB	#X.PAG,STAT,TSTS	; Not fast entry ?
	MOV	LINK,R1
	ADD	#<XTSIZ*<$WORD2+2>>,R1	; End of table
	MOV	R1,LINK
	CALL	FNDBF
	CALL	GWRD		; Get end of table
	MOV	R1,FLINK	; Next link
	BR	TSTS
	.endc
5$:	MOV	STRADD,R2	; Input string address
10$:	CALL	GBYT		; get table entry
	MOVB	(R2)+,R0	; input string char
	BEQ	50$		; end of string?
	CMPEQB	R0,R1,10$	; same, continue
	MOV	R1,R4
	BIC	#^C<^o177>,R4	; strip char.
	ADD	#GCTABL,R4
	CMPNEB	(R4),#GC.LC,20$ ; Not lower case?
	SUB	#^o40,R1	; Convert to upper case
20$:	MOV	R0,R4
	BIC	#^C<^o177>,R4	; strip char.
	ADD	#GCTABL,R4
	CMPNEB	(R4),#GC.LC,30$	; Not lower case?
	SUB	#^o40,R0	; Convert to upper case
30$:	CMPEQB	R0,R1,10$	; same, continue
	.if df	FASTX		; Fast index ??
	TSTB	R1		; No fast ?
	BGE	60$		; None ?
	CMPEQB	R1,#-1,40$	; Terminator ?
	BIC	#^c<^o177>,R1	; Clear extra bit
	CMPEQB	R0,R1,40$	; Correct char ?
	BLT	80$		; Before ??
	MOV	BF.FUL(R3),FLINK	; NEXT LINK
40$:	JMP	TSTS
	.endc
	BR	60$
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$:	CMPB	R0,R1		; final compare
65$:	BEQ	70$		; Ok ?
	BLT	80$		; Less than ?
	JMP	TSTS		; Input string > table entry (try again)
70$:	CLC			; Found same string
	RETURN
80$:	SEC
	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	#TTBF,R3	; Restore buffer address
	CALL	CBYT		; Insert null into title
	RETURN			;
;
;	Setup fast index table
;
	.if df	FASTX		; Fast indexing ??
XTSET:	MOV	#A,R4		; First char
	MOV	#XTSIZ,R2	; Number of entries
	BISB	#X.pag,STAT	; Setup table entry
1$:	MOV	BF.FUL(R3),R1	; Next entry
	CMPNEB	R4,FCHAR,10$	; Not first char
	MOV	R1,BLINK	; Save backward link
10$:	ADD	#$WORD2+2,R1	; Points to next
	CALL	PWRD		; Next entry
	MOVB	STAT,R1		; Get status
	CALL	PBYT		; Set entry status
	MOV	R4,R1		; Next letter
	BIS	#^o200,R1	; Negative
	CALL	PBYT		; Single letter for index
	CMPNEB	R4,FCHAR,20$	; Not first char
	MOV	BF.FUL(R3),LINK	; Save backward link
20$:	INC	R4		; Next letter
	SOB	R2,1$		; Continue till done
	CMPB	R4,FCHAR	; Test
	BGT	30$		; Already taken care of ?
	MOV	BF.FUL(r3),R1	; Current address
	MOV	R1,LINK		; Current link
	SUB	#$WORD2+2,R1	; Points to previous link
	MOV	R1,BLINK	; Backwards link
30$:	MOV	FLINK,R1		; Next link
	CALL	PWRD		; Last
	MOVB	STAT,R1		; Current status
	CALL	PBYT
	MOV	#-1,R1		; Maximum char stops search
	CALL	PBYT
	RETURN
	.endc
	.END