;
; BINSRC.MAC
; SOURCE FOR MACRO SUBROUTINE TO DO A BINARY SEARCH ON AN INDEX FILE
; BASIC CALL:
;       CALL "BINSRC"(A$,A,B)
; WHERE:
;	A$ = STRING TO BE SEARCHED FOR
;	A  = FILE # OF INDEX FILE
;	     VALUE IS THAT ASSIGNED IN BASIC OPEN COMMAND
;	     EXECUTED ONCE BEFORE FIRST CALL TO SUBROUTINE
;	B  = REC # RETURNED BY SUBROUTINE
;
	.MCALL	ULODHD	FDOF$L	FCSBT$
	ULODHD	START,END,BINSRC
;
; DEFINE FLOATING REGS
;
AC0=%0
AC1=%1
AC2=%2
AC3=%3
FDOF$L
FCSBT$
;
; DEFINE ADDRESS OF .GET ROUTINE IN SYSRES
; THIS VALUE WILL BE DEFINED IN TKB COMMAND FILE
	.GLOBL	ADDGET
START:
BINSRC:	JSR	R4,@#GTRGPI	;GET ARGUMENTS
	.BYTE	3,1,2,0		;STRING,NUMERIC,NUMERIC RETURNED,END
	.EVEN
	JSR	PC,@#PARCHK	;CHECK FOR TRAILING PAREN
	MOV	SP,R5		;R5 HAS ARG LIST PTR
	CMP	(R5)+,(R5)+	;R5 POINTS TO NUMERIC FP VALUE
	LDF	(R5)+,AC0	;PUT LUN # IN AC0
	SETI
	STCFI	AC0,R4		;CONVERT TO INTEGER
	DEC	R4		;ITS LUN - 1
	MOV	#17400,R0	;PUT MASK IN R0
	JSR	PC,@#SRCHFL	;FIND FCB ADDRESS
	TST	R3		;IF 0 ERROR
	BEQ	10$		;BRANCH TO ERROR ROUTINE
	ADD	#26,R3		;FCB + 26 = FDB
	MOV	R3,R0		;FDB ADDRESS WILL BE KEPT IN R0 FOR GETS
	LDCIF	#2,AC3		;WE WANT REC # 2
	SETL
	STCFL	AC3,F.RCNM(R0)	;PUT REC # WANTED IN FDB
	JSR	PC,GETCOM	;SET READBUF ADDRESS AND LENGTH
	JSR	PC,@#ADDGET	;DO GET
	LDCLF	@F.URBD+2(R0),AC3  ;PUT CONTENTS OF 2ND REC IN AC0
	ADDF	#3,AC3		;+2+1 = LAST REC IN FILE
	SETI
	LDCIF	#2,AC0		;AC0 IS LOWER BOUNDARY
	STF	AC3,AC2		;AC2 IS UPPER BOUNDARY
1$:	SETI
	STF	AC0,AC1		;AC1 IS THE MIDDLE
	ADDF	AC2,AC1		;= (UPP + LOW + 1 )/2
	ADDF	#1,AC1
	DIVF	#2,AC1
	STCFI	AC1,R3		;TAKE THE INT()
	LDCIF	R3,AC1		;PUT BACK IN FPP
	CMP	R3,#2		;IS MIDDLE EQUAL TO LOW BOUND
	BEQ	11$		;BRANCH TO NOT FOUND
	CMPF	AC1,AC3		;IS MIDDLE EQUAL TO HIGH BOUND
	CFCC
	BEQ	12$		;BRANCH TO NOT FOUND
	SETL
	STCFL	AC1,F.RCNM(R0)	;PUT REC # WANTED IN FDB
	JSR	PC,GETCOM	;SET READBUF ADDRESS AND LENGTH
	JSR	PC,@#ADDGET
	MOV	(SP),R4		;PUT LEN IN R4
	MOV	2(SP),R2	;R2 HAS ADDRESS OF CHECKING STRING
	MOV	F.URBD+2(R0),R3	;R3 HAS ADDRESS OF READ STRING
	ADD	#4,R3		;FIRST FOUR BYTES ARE LONG INTEGER PTR, SKIP
3$:	CMPB	(R2)+,(R3)+	;COMPARE CHARS
	BLT	4$		;WANTED STRING IS LOWER THAN WHERE WE ARE
	BGT	5$		;WANTED STRING IS HIGHER THAN WHERE WE ARE
	SOB	R4,3$		;CHECK EACH CHAR
				;FOUND IT
9$:	STF	AC1,AC2		;PUT REC # IN AC2
	SUBF	#1,AC1		;BACKUP ONE RECORD
	SETL
	STCFL	AC1,F.RCNM(R0)	;PUT REC # WANTED IN FDB
	JSR	PC,GETCOM	;SET READBUF ADDRESS AND LENGTH
	JSR	PC,@#ADDGET
	MOV	(SP),R4		;PUT LEN IN R4
	MOV	2(SP),R2	;R2 HAS ADDRESS OF CHECKING STRING
	MOV	F.URBD+2(R0),R3	;R3 HAS ADDRESS OF READ STRING
	ADD	#4,R3		;FIRST FOUR BYTES ARE LONG INTEGER PTR, SKIP
8$:	CMPB	(R3)+,(R2)+	;COMPARE CHARS
	BLT	6$		;BACKED UP TO FAR
	SOB	R4,8$		;CHECK EACH CHAR
	BR	9$		;GO DO AGAIN
10$:	CLRF	AC2		;ERROR END
	BR	6$
11$:	LDF	#3,AC2		;WE WANT TO RETURN A -3
	BR	20$		;BRANCH TO NEGATE ROUTINE
12$:	STF	AC3,AC2		;STORE # OF RECORDS IN FILE + 1
	BR	20$		;BRANCH TO NEGATE
13$:	ADDF	#1,AC2		;WE SUBTRACTED ONE SO NOW WE MUST ADD ONE
20$:	NEGF	AC2		;NEGATE ROUTINE
6$:	STF	AC2,AC0		;PUT ANS IN AC0 FOR STORE ROUTINE
	ADD	#10,SP		;PUT STACK AT ADDRESS FOR ANS
	MOV	SP,R5		;R5 SHOULD HAVE ADDRESS FOR ROUTINE
	SETI
	JSR	PC,@#NSTORE	;STORE THE RESULT
	ADD	#12,SP		;CLEAN STACK
	RTS	PC		;RETURN
4$:	SUBF	#1,AC2		;DEC AC2
	CMPF	AC2,AC0		;ARE HIGH AND LOW BOUND EQUAL
	CFCC
	BEQ	13$		;BRANCH TO NOT FOUND
	STF	AC1,AC2		;MOVE DOWN HIGH BOUND
	BR	1$		;BRANCH TO REPEAT
5$:	ADDF	#1,AC0		;INC AC0
	CMPF	AC0,AC2		;ARE HIGH AND LOW BOUND EQUAL
	CFCC
	BEQ	20$		;BRANCH TO NOT FOUND
	STF	AC1,AC0		;MOVE DOWN HIGH BOUND
	BR	1$		;BRANCH TO REPEAT
GETCOM:	MOV	R0,-(SP)	;PUT FDB ADDRESS ON STACK
	ADD	#S.FDB,(SP)	;ADD OFFSET
	MOV	(SP)+,F.URBD+2(R0);PUT ADDRESS OF READ BUF INTO FDB BLOCK
	MOV	F.RSIZ(R0),F.URBD(R0);PUT REC SIZE IN READ BUF LEN IN FDB BLOCK
	RTS	PC		;RETURN
END:
	.END