.TITLE PINDX
	.IDENT	/M02/
	.IDENT	/M02.1/
	.IDENT	/M03/

;
; 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 M02
;
; AUTHOR: L. WADE 1-JUN-72
;
; MODIFIED BY:
;
;	E. POLLACK U. OF W. 19-DEC-73
;
;	D. N. CUTLER 22-SEP-75
;
;	J. CLEMENT September 1982
;
; CARTS LUG MODIFICATIONS
;
;	CAR  1 --> ADD CHANGE BAR AND RIGHT SHIFT
;
; PRINT INDEX COMMAND
;
; COMMAND ROUTINE IS ENTERED WITH:
;
;	R4=ADDRESS OF NUMBER CONVERSION ROUTINE.
;
; LOCAL DATA
;
; OUTPUT TEXT
;

	.PSECT	TEXT,D,RO,LCL,CON
DOTXT:	.ASCIZ	/INDEX/		; INDEX HEADING
INDMG:	.ASCIZ	/ ./		; INDEX ELIPSIS TEXT
BLKMG:	.ASCIZ	/  /	; 2 spaces
	.EVEN
	.psect	$TEMP,D,RW,GBL,OVR
STAT:	.BLKW	1		; input status
LINK:	.BLKW	1		; current link
FLINK:	.BLKW	1		; foreward link
TTSAV:	.BLKW	1		; temporary buffer index
FIRST:	.BLKW	1		; last leading character
LCHAR:	.BLKW	1		; current leading char
NIND:	.BLKW	1		; Indentation for numbers

;
; DO INDEX COMMAND
;
	.PSECT	$CODE,RO,I,LCL
DOINX::	TSTEQB	$INXSW,5$	; INDEXING ENABLED?
	RETURN		; 			
5$:	BISB	#100,$CBRSW	; STOP CHANGE BAR
	MOV	#TTLBF,R3	; CLEAR TITLE BUFFER
	CALL	CLRBF
	MOV	#STLBF,R3	; CLEAR SUBTITLE
	CALL	CLRBF
	CLR	LMARG		; SET LEFT MARGIN
	MOV	PRMRG,RMARG	; SET RIGHT MARGIN
	MOV	PLMRG,LMARG
	MOV	PTMRG,TMARG
	MOV	#SPCNG,NSPNG	; SET INITIAL SPACING
	CALL	PAGRST		; New page and reset page number
	MOV	#7.,R2		; SET LINE COUNT
	CALL	SKIPN		; SKIP SEVEN LINES
	CALL	SETTL		; MOVE TITLE TO TITLE BUFFER
	TSTNE	BF.SPC(R3),30$	; TITLE SPECIFIED?
	MOV	#DOTXT,R2	; POINT TO DEFAULT TEXT
20$:	MOVB	(R2)+,R1	; GET NEXT BYTE	
	BEQ	30$		; IF EQ DONE
	MOV	#TTLBF,R3	; POINT TO TITLE DESCRIPTOR
	CALL	PBYT		; WRITE CHARACTER IN BUFFER
	INC	BF.SPC(R3)	; INCREMENT CHAR COUNTER
	BR	20$		; 
30$:	MOV	RMARG,R2	; CALCULATE SPACE COUNT TO CENTER TITLE TEXT
	SUB	BF.SPC(R3),R2	; 
	ASR	R2		; 
	ADD	RIGSHI,R2	; ADD ON SHIFT		
	CALL	NSPAC		; SPACE TO TEXT POSITION
	MOV	#TTLBF,R3	; SET ADDRESS OF LINE DESCRIPTOR
	CALL	PSTRPA		; OUTPUT NOTE TEXT
	MOV	#2.,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			; 

;
; PRINT INDEX COMMAND
;
PINDX:: MOV	#INXBF,R3	; get index buffer
	CLRB	FIRST		; first letter
	CLR	STAT		; no status
	CALL	BEGBF		; Start at beginning
	CALL	GWRD
	BCC	10$		; no index items?
1$:	CLR	XFIRST		; declare index empty
	CALL	CLRBF		; clear buffer also
	RETURN
10$:	MOV	R1,FLINK
20$:	BITNE	#X.ENT,STAT,25$	; already have entry?
	CALL	GPAG		; Get first page of data
	BCS	1$		; Nothing to index
	BITEQ	#X.ENT,STAT,40$	; no entries?
25$:	MOV	#INXBF,R3	; index buffer
	CALL	GBYT		; get first char
	MOVB	R1,LCHAR	; save it
	CMPEQB	GCTABL(R1),#GC.UC,30$ ; first letter upper case?
	BIC	#40,R1		; no make upper
30$:	CMPEQB	R1,FIRST,45$	; SAME AS INITIAL LETTER OF PREVIOUS ONE?
	MOVB	R1,FIRST	; SAVE THIS CHARACTER
	MOV	PARSP,R1	; Get spacing
	BEQ	35$		; None?
	MOV	NSPNG,R0	; Spaces/line
	CALL	$MUL		; get product R1,R0
	TSTEQB	$PAGBR,35$	; Already broken?
	MOV	R1,R2		; Number of blank lines to insert
	CALL	SKIPN		; Skip N lines
35$:	MOV	PARPT,R3	; Paragraph test page
	CALL	TESTP		; Check if enough lines available
	BR	45$
40$:	CALL	TESTL		; Test if at end of page
	MOV	PARIND,R2	; Indent non index item
	BR	46$
45$:	CALL	TESTL		; test if at end of page
	CLR	R2
46$:	ADD	LMARG,R2	; SPACE IN TO LEFT MARGIN
	ADD	RIGSHI,R2	;  ALLOW FOR RIGHT SHIFT	
	ADD	EBSIZ,R2	; add change bar shift
	CALL	NSPAC		;  ..
	BITEQ	#X.ENT,STAT,60$	; no entry to print
	MOVB	LCHAR,R1	; first letter
	MOV	#INXBF,R3	; index buffer
50$:	TSTEQB	R1,55$		; last char in string?
	CALL	CCOUT
	CALL	GBYT		; get next one
	BR	50$		; and put it out too
55$:	MOV	#5,R2		; Spacing between name and number
	BITNE	#JUSTF,F.1,60$	; Justify?
	CALL	NSPAC		;  ..
60$:	MOV	#TTBF,R3	; temporary buffer
	CALL	CLRBF		; set it for input
	CALL	CCSPC		; insert space
	BITEQ	#1,CPOS,70$	; even number position?
	BITEQ	#JUSTF,F.1,70$	; No justity?
	CALL	CCSPC		; no insert 1 space to make even
70$:	MOV	#TTBF,R3		;
	MOV	BF.FUL(R3),TTSAV	; current index
	BR	90$		; skip comma
80$:	MOV	#", ,R1		; comma between entries
	MOV	#TTBF,R3	; temporary buffer
	MOV	BF.FUL(R3),TTSAV
	CALL	PWRD
90$:	CALL	PAGCV		; Convert page number into buffer
	MOV	CPOS,R2		; current position
	SUB	RIGSHI,R2	; minus right shift
	SUB	EBSIZ,R2	; minus extra shift
	ADD	BF.FUL(R3),R2	; plus pending numbers
	CMP	R2,RMARG	; are we past right margin
	BLT	160$		; no
	MOV	LINK,FLINK	; backup input
	MOV	#TTBF,R3	; temporary buffer
	MOV	TTSAV,R1	; output buffer index
	CALL	RSTBF		; backup temporary buffer
110$:	MOV	RMARG,R2	; NOW find how much padding?
	ADD	EBSIZ,R2	; minus shift
	ADD	RIGSHI,R2	; minus shift
	MOV	#TTBF,R3	; temporary buffer
	SUB	BF.FUL(R3),R2	; minus numbers to print
	SUB	CPOS,R2		; minus current position
	BITEQ	#JUSTF,F.1,140$	; Justify flag not on?
120$:	CMP	R2,#1		; no more ellipses
	BLE	130$		; THERE ALREADY
	MOV	#INDMG,S1	;  ..
	BITNE	#FILLF,F.1,122$	; Fill flag on?
	MOV	#BLKMG,S1	; No do not fill with ellipses
122$:	CALL	PSTRAZ		;  ..
	SUB	#2,R2		; End of padding?
	BR	120$
130$:	INC	R2		; compensate position
	BEQ	140$
	CALL	NSPAC		; 1 blank
140$:	MOV	#TTBF,R3	; Temporary buffer for page #
	CALL	PSTRPA		; output it
	CALL	SKIPS
	JMP	20$
160$:	CALL	GPAG		; next entry
	BCS	110$		; finish up
	BITNE	#X.ENT,STAT,110$ ; new entry?
	BR	80$		; no, just a number

;
;	Subroutine to get initial params
;
GPAG:	MOV	(SP)+,R4	; unstack
	CLR	STAT		; initial status
	MOV	#INXBF,R3	; index buffer
	MOV	FLINK,R1	; next entry
	MOV	R1,LINK		; save current entry
	BEQ	110$		; no more?
10$:	CALL	FNDBF		; get it
	CALL	GWRD		; get foreward linkk
	BCS	100$		; End of buffer
	MOV	R1,FLINK	; save it
	CALL	GBYT		; status
	MOV	R1,STAT		; save it
	MOV	R1,R2
	CLR	-(SP)		; end of numbers
	BITEQ	#X.AP,R2,50$	; no appendix?
	CALL	GBYT		; get appendix
	BIS	APNDSP,R1	; set the format
	MOV	R1,-(SP)	; save it
50$:	BITEQ	#X.CH,R2,60$	; no chapter?
	CALL	GBYT		; get chapter
	BIS	CHPDSP,R1	; set the format
	MOV	R1,-(SP)	; save it
60$:	BITEQB	#X.PAG,R2,70$	; no page number?
	CALL	GWRD		; get chapter
	MOV	R1,-(SP)	; save it
70$:	BITEQB	#X.SPG,R2,80$	; no subpage?
	CALL	GBYT		; get subpage
	BIS	SUBDSP,R1	; set format
	MOV	R1,-(SP)	; save it
80$:	CLC			; OK!
100$:	JMP	(R4)		; return
110$:	SEC			; mark it as end
	JMP	(R4)
	.END