PROCEDURE	<PINDX - PRINT INDEX COMMAND>,010000
;+
; Copyright (C) 1976
; Digital Equipment Corporation, Maynard, Mass.
;
; This software is furnished under  a license for use only  on  a
; single computer system and may be  copied only with  the inclu-
; sion 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 DEC.
;
; The information in this software  is  subject to change without
; notice and should not be construed  as  a commitment by Digital
; Equipment Corporation.
;
; DEC assumes no responsibility for the use or reliability of its
; software on equipment which is not supplied by DEC.
;
; Version M01
;
; Author: L. Wade 1-Jun-72
;
; Modified by:
;
;	E. Pollack U. of W. 19-Dec-73
;
;	D. N. Cutler 22-Sep-75
;
;	Modified: 27-Oct-81, John D. Leonard
;		Made changes compatible with ARAP spacing conventions
;
; Print Index command
;

	.SBTTL	MCALLS AND RUNOFF DEFINITIONS

; command routine is entered with:
; 
; 	R4=address of number conversion routine.
; 	R5=address of flag word F.1.
; 
; local data
; 
; output text
; 
	DATA	PINDXD

DOTXT:	.ASCIZ	/INDEX/		; index heading
INDMG:	.ASCIZ	/ ./		; index elipsis text
	.EVEN
PNTR:	.BLKW	1		; pointer to start of references
CNTR:	.BLKW	1		; reference counter
 
; 	index link block offsets
 
	ID.FWD	=	0	; foward pointer
	ID.BCK	=	ID.FWD + 2 ; back pointer
	ID.TXT	=	ID.BCK + 2 ; asciz text pointer
	ID.PNO	=	ID.TXT + 2 ; page number
	ID.CHA	=	ID.PNO + 2 ; chapter/appendix number.
	ID.LEN	=	ID.CHA + 2 ; length of index block header

	.SBTTL	DOINX -- DO INDEX COMMAND

	CODE	PINDX

DOINX::	CLR	$CBON		; Turn change bars off
	MOV	TTLBUF+BF.ADR,TTLBUF+BF.PTR ; clear title buffer
	CLR	TTLBUF+BF.LEN	; reset length
	MOV	STTLBF+BF.ADR,STTLBF+BF.PTR ; clear subtitle buffer
	CLR	STTLBF+BF.LEN	; reset length
	CLR	CNTR		; clear reference counter
	CLR	$CBON		; stop change bar
	.if	ndf	A$$RAP
	CLR	LMARG		; set left margin
	MOV	PRMRG,RMARG	; set right margin
	.endc
	MOV	#SPCNG,NSPNG	; set initial spacing
	BIS	#FILLF!JUSTF!PJUSTF,(R5) ; set fill and justify flags
	CLR	PAGENO		; clear page number
	TSTNE	LINEC,10$	; at top of page already?
	INC	PAGENO		; increment page number
10$:	CALL	PAGEC		; break page
	MOV	#<7*DIVPL>,R2	; set line count
	CALL	SKIPN		; skip seven lines
	CALL	SETTL		; move title to title buffer
	TSTNE	TTLBUF+BF.LEN,30$ ; title specified?
	MOV	#DOTXT,R3	; point to default text
20$:	MOVB	(R3)+,R1	; get next byte
	BEQ	30$		; if eq done
	MOV	#TTLBUF,R4	; point to title descriptor
	CALL	WCI		; write character in buffer
	BR	20$		; 
30$:	MOV	RMARG,R2	; calculate space count to center title text
	SUB	TTLBUF+BF.LEN,R2 ; less line size
	ASR	R2		; 
	ADD	RIGSHI,R2	; add on shift
	CALL	NSPAC		; space to text position
	MOV	#TTLBUF,R4	; set address of line descriptor
	CALL	PSTRPA		; output note text
	MOV	#<2*DIVPL>,R2		; set line count
	CALL	SKIPN		; skip lines
	MOVB	APNDN,-(SP)	; save current appendix
	MOVB	#'I-'A+1,APNDN	; set appendix to 'i' for index
	CALL	PINDX		; print the index
	MOVB	(SP)+,APNDN	; restore appendix number
	RETURN			; 

	.SBTTL	PINDX -- PRINT INDEX COMMAND

PINDX::	CLR	-(SP)		; clear current letter.
	CLR	CNTR		; Clear counter
	MOV	XFIRST,R5	; get first item in index.
	BNE	PINDL1		; NE - Then start processing
	JMP	PINDXX		; if EQ then to end already.
PINDL1:	CLR	R1		; Clear R1 for MOVB
	BISB	@ID.TXT(R5),R1	; Get the character without sign extend.
	BITB	#CHALC,CHATBL(R1) ; Is it lower case?
	BEQ	10$		; EQ - no
	BIC	#40,R1		; yes, make upper case.
10$:	CMPEQ	R1,(SP),PINDX1	; same as previous initial letter?
	MOV	R1,(SP)		; no, save new initial character.
	CALL	SKIP1		; and skip a line between letters.
PINDX1:	MOV	LMARG,R2	; space in to left margin.
	ADD	RIGSHI,R2	; allow for right shift
	CALL	NSPAC		; ..
	MOV	ID.TXT(R5),S1	; get text pointer.
	CALL	PSTRAZ		; output string of asciz
	MOV	RMARG,R2	; now go to middle of line
	SUB	#12.,R2		; Does this work ?
	MOV	R2,-(SP)	; Save for now
	ASR	(SP)		; Is it odd ?
	BCC	11$		; CC - no
	INC	(SP)		; Bump up pointer
11$:	ASL	(SP)		; Shift it back
	MOV	(SP)+,PNTR	; Store position
	INC	PNTR		; Account for extra space
	MOV	CPOS,R1		; Get current carriage position
	.if	df	A$$RAP
	ASR	R1		; CPOS is in # of half-spaces so /2
	.endc
	SUB	R1,R2		; minus current position
	BLE	PIND2		; there already
	ASR	R2		; even number of spaces and dots?
	BCC	10$		; if cc yes
	CALL	CCSPC		; output a space
10$:	MOV	#INDMG,S1	; ..
	CALL	FMSG		; ..
	DEC	R2		; middle of line?
	BGT	10$		; if GT no
PIND2:	CALL	CCSPC		; output a space
	INC	CNTR		; keep track of references so far
	CMP	#3,CNTR		; are there more than 2?
	BNE	5$		; NE - then don't skip to new line
	MOV	#1,CNTR		; reset counter.
	CALL	SKIPS		; skip to new line.
	MOV	PNTR,R2		; Get spacing
	CALL	NSPAC		; For spacing
5$:	MOV	ID.CHA(R5),R1	; chapter/appendix number?
	BEQ	30$		; if EQ no
	BMI	10$		; if MI chapter number
	ADD	#'A-1,R1	; appendix, convert to letter.
	CALL	FOUT		; output appendix designation
	BR	20$		;
10$:	CLR	R0		; get chapter number
	BISB	R1,R0		;
	CALL	DECPRT		; convert chapter number
20$:	MOV	#'-,R1		; output a dash
	CALL	FOUT		;
30$:	MOV	ID.PNO(R5),R0	; get page number
	CALL	DECPRT		; output page number
PINDX2: MOV	R5,R1		; get successor of this entry
	MOV	(R1),R5		;
	BEQ	PINDXX		; EQ - then we're at end of list.
	CMPNE	ID.TXT(R5),ID.TXT(R1),PINDX3 ; next item different?
	CMPNE	ID.PNO(R5),ID.PNO(R1),10$ ; page numbers different?
	CMPEQ	ID.CHA(R5),ID.CHA(R1),PINDX2 ; chapter/appendix match?
10$:	CMP	#2,CNTR		; Are there 2 references already ?
	BEQ	PIND2		; EQ - yes, skip comma
	MOV	#',,R1		; put comma between page numbers
	CALL	FOUT
	BR	PIND2		; and then output number
PINDX3:	CALL	SKIPS		; ..
	CLR	CNTR		; Reset counter
	JMP	PINDL1		; go on to next item in list.
PINDXX:	CALL	SKIPS		; ..
	MOV	XFIRST,R5	; get listhead of index.
10$:	TST	R5		; anything left in index entry?
	BEQ	20$		; no, just leave.
	MOV	R5,R1		; remember this index entry.
	MOV	(R5),R5		; get to the next entry
	CALL	FREE		; free up the index entry.
	BR	10$		; and loop until end of list.
20$:	CLR	XFIRST		; clear listhead of index.
	TST	(SP)+		; clean stack
	RETURN			;

; get offset routine
;

INDEXO::CALL	(R4)		; get argument for offset
	MOV	#0,R3		; if not force zero
	CMP	R3,#30.		; must be less than 30
	BLO	100$		; check if smaller
	MOV	#30.,R3		; force 30
100$:	MOV	R3,INDXOF	; save it
	RETURN			;

	.END