.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 .psect $TEMP,RW,D,GBL,OVR ; ; Impure data section ; BLINK: .BLKW 1 ; Points back to last item LINK: .BLKW 1 ; Points to current item FLINK: .BLKW 1 ; Points to next item STAT: .BLKW 1 ; Status byte SUBINX: .BLKW 1 ; Current Subindex count SUBINT: .BLKW 1 ; Total subindex count STRADD: .BLKW 1 ; String address SIZ=<.-BLINK>/2 ENT: .BLKW 1 ; Non zero if entry only .psect $CODE,ro,i,LCL,con ; ; 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 MOV #26.,R2 ; Number of alphabetical entries 10$: CLR R1 ; clear word CALL PWRD ; for first link SOB R2,10$ 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 ? CLR R1 CALL PBYT ; 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 #177770,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<177>,R1 ; strip char. CMPNEB GCTABL(R1),#GC.LC,20$ ; Not lower case? SUB #40,R1 ; Convert to upper case 20$: MOVB (R2)+,R0 ; input string char BEQ 50$ ; end of string? BIC #^C<177>,R0 ; strip char. CMPNEB GCTABL(R0),#GC.LC,30$ ; Not lower case? SUB #40,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: MOV #BLINK,R0 ; Table to clear MOV #SIZ,R1 ; Size of table 5$: CLR (R0)+ ; Clear entries SOB R1,5$ ; Till done CALL VARSAV ; Save variables 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.,LINBK ; Max size for index terms 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 CLR R1 CALL PBYT ; Insert null into title MOV #SW.IDS,R0 ; Input disable bits BICB R0,$EQFSW+1 ; Reenable equation mode BICB R0,$IFLSW+1 ; Reenable index flag RETURN ; .END