.TITLE	INSKEY ... inspect database records via Keywords
.IDENT	/170883/
.ENABL	LC
;
;
;	Written by	Ray Di Marco
;			4-Jan-82.
;
;
;	Version		040182/04
;
;
;-----------------------------------------------------------------------------
;
; This file contains the main module for the INSKEY program; it is to be
; assembled with the DBSLIB.SML macro library and linked with the DBSLIB.OBJ
; object library. The resulting program allows database records to be retrieve
; and displayed on the user's terminal. Records are selected for retrieval and
; display by specifying one or more keywords. The program will find the
; records that best match the specified keywords.
; 
; An 'INDEX' file is used to translate the keywords specified by the user into
; database record numbers. The INDEX file is in the 'SORTER.DAT' format, and
; consists of an ascii string and the number of the database record associated
; with the string. The SELECT cusp is used to load the index file with the
; keywords; SORTER is then used to sort the keywords.
; 
; The index file is searched (using a binary search technique) for each
; specified keyword to locate any matching index file entries; each time an
; entry is found to match a keyword the database record from which the entry
; was extracted is credited with one match. After all keywords have been
; processed and a small number of matching records have been found, the
; program prompts the user for a command. Commands consist of a single letter.
; 
;

.SBTTL	Modifications
;
;
; 3-Feb-83	Changed main loop code so that will exit via CON.EX if
;		no keys are defined. This was done to make INSKEY operate
;		line other CUSPs (ie exit if no operation specified).
;		Change search routine @2000$ code to prevent more than
;		one hit per record per key. This was achieved by setting
;		MSB of records match count when a hit occured.
;
; 7-Mar-83	Change so that message 'no possible matches' is displayed
;		if have more than SCROLL limit matches and no records match
;		all specified keys!
;
;		If TAB entered during key entry mode the key buffer is
;		zeroed.
;
;		Add in page Flip command to supoort multi-page templates.
;		Also enable other single letter's to perform other functions.
;
; 17-Aug-83	Major reorganization of program. Program documentation was
;		removed from file to reduce size. Online HELP facility was
;		added. SCROLL limit was removed. Layout of top three lines
;		of screen was changed. Semi-colan keyword delimiter (ie exact
;		match) added.

.SBTTL	Declarations
;
;
.MCALL	.PRINT,.EXIT,ABORT			; used for error handling
.MCALL	.PUSH,.POP				; stacking
.MCALL	CNAF					; used for numeric i/o
.MCALL	FILSPT					; file i/o support
	FILSPT
;
;
.GLOBL	FORM$$					; start user template
.GLOBL	$$FORM					; pointer for rtns
.GLOBL	PAGE$$					; Page number
.GLOBL	DBSLDR					; template loader
;
.GLOBL	CON.ST,CON.XY,CON.EX,CON.EL,CON.ES	; "CONIO"
.GLOBL	CON.LO,CON.LI,CON.CO,CON.CI		; "CONIO"
.GLOBL	FRM.FG,FRM.BG				; "FEDMNG"
.GLOBL	FIL.DR,FILINT				; "FILEIO"
.GLOBL	FLD.OU,FLD.CK,FLD.IN,FLD.ZE		; "FLDIO"
.GLOBL	WND.IN,WND.BL				; "WNDIO"
.GLOBL	SFLINT,SFLPSN,SFLINP,SFLINC,SFLPAR,SFLNME; "SRTFIO"
.GLOBL	FRMINT,FRMRST,FRMINC,FRMNME		; "FRMFIO"
.GLOBL	MEMMNG					; "MEMMNG"
;
	.PSECT	CODE				; open code
;	======	====
;
;

.SBTTL	Macro Definitions
;
.MACRO	DISPLAY	STR,X,Y,ERASE=NO
	.IF	NB,X
			MOV	#<Y*256.>+X,R0
			.IIF	DIF,ERASE,NO,	CALL	CON.EL
			CALL	CON.XY
	.ENDC
	JSR	R1,OUTIT
	.NLIST	BIN
	.ASCII	|'STR'|
	.BYTE	0
	.EVEN
	.LIST	BIN
.ENDM	DISPLAY
;
;
.MACRO	PRINT	STR
	.IIF	NB,STR, MOV STR,R0
	CALL	CON.LO
.ENDM	PRINT
;
;
.MACRO	GTLIN	BUF=R0,STR
	.IF	NB,STR
		.GLOBL	CON.LO
		MOV	STR,R0
		CALL	CON.LO
	.ENDC
	MOV	BUF,R0
	.GLOBL	CON.LI
	CALL	CON.LI
.ENDM	GTLIN
;

.SBTTL	Initialization code
;
; initialize TTY driver and identify program
;
START:	CALL	CON.ST				; initialize TTY interface
	PRINT	#700$				; identify self
	BR	1000$				; skip over message
;
; messages placed here as LINBUF overlays initialization code and
; is used in next section of code - messey but saves a bit of memory
;
.nlist	bin
700$:	.ASCIZ	/INSKEY RDM170883./
710$:	.ASCII	/		 Database TEMPLATE: /<200>
720$:	.ASCII	/			Index file: /<200>
730$:	.ASCII	/			 Help file: /<200>
.even
.list	bin
;
;
; load template if needed
;
1000$:	MOV	$$FORM,R1			; template linked in?
	BNE	2000$				;  yes -> skip
	GTLIN	#LINBUF,#710$			; get template name
	MOV	#LINBUF,R0			; R0 -> name
	CALL	DBSLDR				; load template
	MOV	R0,$$FORM			; setup pointer
	MOV	R0,R1				; R1 =	load address
;
; obtain memory for profile table
;
2000$:	MOV	14(R1),R0			; R0 =	number records needed
	MOV	R0,DBSENT			; DBSENT is number DBS entries
	INC	R0				;	allow for rec 0
	CALL	MEMMNG				; R0 ->	start buffer area
	MOV	R0,PRFTAB			; 	save start profile
;
; gain access to index file
;
	GTLIN	#SFLNME,#720$			; get name of 'SFL' file
	CALL	SFLINT				; OPEN DATA FILE
	CMP	SFLPAR,#3			; minimum record size = 3
	ABORT	<SFL file records too small>,LO	;  abort  if too small
	CMP	SFLINT+2,#2			; need at least 2 records
	ABORT	<not enought SFL records>,LO	;  abort if too few
;
; gain access to HELP file (if specified)
;
4000$:	GTLIN	#FRMNME,#730$			; get name of help file
	PURGE	#7000$				; purge FDB
	BIS	#F.NERR,FDB.FL(R5)		; disable error messages
	NAME	STRING=#FRMNME,EXTENS=#^RFRM,ERROR=5000$
	LOOKUP	ERROR=5000$			;	ensure file exists
	PURGE					;	ensure channel free
	CALL	FRMINT				;	open file
	MOV	#NOP,C.HELP			;	enable HELP routine!
;
;
; enter main loop after setting up screen
;
5000$:	CALL	FILINT				; open database files
	CALL	ZERKEY				; no keywords
	CALL	C.RFSH				; refresh CRT screen
	JMP	RESTRT				; enter loop
;
;
; FDB needed to insure HELP file exists
;
FDB	7000$,CHANNEL=14.,BUFFER=LINBUF
;

.SBTTL	Main Loop Code
;
; Are here to accept a new set of KEYWORDs. Issue prompt and accept keys.
;
RESTRT:	DISPLAY	<Enter KEYWORDs seperate by "," or ";">			00,1,E
	DISPLAY	< Press [RETURN] to initiate search>
	DISPLAY	<                                      >		60,0
	CLR	ONSCRN			;	no record displayed
	CALL	EDTKEY			;	let keys be entered
	CMPB	LINBUF,#40		;	any keys entered?
	BEQ	2700$			;	 no --> no possible matches
;
; Search for possible matches
;
	DISPLAY	<Searching for possible matches - Please Wait!>		00,1,E
	CALL	MTHZR0			;	reset profile table
	CALL	MTHFND			;	build profile table
	CALL	MTHSUM			;	summarize data
;
; See if have found reasonable number of matches
;
	CMP	R4,NUMKEY		;	reasonable degree of matching?
	BLO	2700$			;	 no --> no possible matches
	TST	MTHCNT			;	got any matchs?
	BNE	3000$			;	 yes -> command dispatch
2700$:	CLR	MTHCNT			;	 no -->	disable scrolling
;
;

;
;
; If only 1 match display immediately
;
3000$:	CMP	MTHCNT,#1		;	only 1 match?
	BNE	3100$			;	 no --> skip
	CALL	C.SHOW			;	 yes -> display
;
; Indicate number remaining matches and issue prompt
;
3100$:	DISPLAY	<Commands: >						00,1,E
	DISPLAY	<[RETURN]=Exit, Help, Keys, Add, Next, Print, Flip, Refresh>
3200$:	TST	MTHCNT			;	any matches?
	BNE	3220$			;	 yes -> 3220$
	DISPLAY	<--- NO MATCH FOUND --->				60,0
	BR	3300$
 3220$:	CNAF	SSSSD,NUMBER=MTHCNT,STRING=#F.MTCH
	DISPLAY	<Matches: >						60,0
	PRINT	#F.MTCH
3300$:	DISPLAY	<Enter Command:>					00,2,E
;
; input and decode command
;
3400$:	CALL	CON.CI			;	get a character
	BIC	#^C137,R0		;	insure UC letter
	MOV	#3700$,R1		; R1 -> table
3410$:	CMPB	R0,(R1)			;	match?
	BEQ	3420$			;	 yes -> skip
	ADD	#4,R1			; R1 -> next entry
	TST	(R1)			;	eot?
	BNE	3410$			;	 no --> try again
	BR	3400$			;	 yes -> ignore command
3420$:	CALL	@2(R1)			;	envoke routine
	BR	3300$			;	loop
;

;
;	Command disptach table, consisting of command letter and subroutine
;	addresses.
;
3700$:	.WORD	 15,CON.EX		;	exit
	.WORD	 'A,4100$		;	Add key
	.WORD	 'E,CON.EX		;	Exit
	.WORD	 'F,4400$		;	Flip page
	.WORD	 'K,4000$		;	Keys
	.WORD	 'N,4200$		;	Next match
	.WORD	 'P,C.PRNT		;	print
	.WORD	 'R,4300$		;	Refresh screen
	.WORD	 'H,4500$		;	Help
;
	.WORD	'P+200,C.PRNT		;	PF1	Print
;;	.WORD	'Q+200,??????		;	PF2
	.WORD	'R+200,4200$		;	PF3	Next match
	.WORD	'S+200,4400$		;	PF4	Flip page
;
	.WORD	302,4200$		;	V	Next match
	.WORD	304,4000$		;	<-	Keys
	.WORD	303,4100$		;	->	Additionl Keys
	.WORD	0,0
;

;
; enter new-set/additional keys
;
4000$:	CALL	ZERKEY			;	zero keys
4100$:	TST	(SP)+			;	clean up stack
	JMP	RESTRT			;	restart time
;
;
; scroll through possible matchs
;
4200$:	CMP	MTHCNT,#1		;	more than 1 match?
	BHI	4210$			;	 yes -> scroll time
	BLO	4201$			;	 non -> 4201$
	DISPLAY	<Sorry, no other matches!>				60,0
 4201$:	RETURN				;	 no -->	ignore
 4210$:	TST	ONSCRN			;	first scroll operation?
	BEQ	4211$			;	 yes -> data ready
	CALL	MTHNXT			;	 no --> setup data
 4211$:	CALL	C.SHOW			;	show data
	TST	(SP)+			;	discard return address
	JMP	3200$			;	restart at POSSIBLE MATCHES
;
; repaint screen
;
4300$:	CALL	C.RFSH			;	refresh screen
	TST	(SP)+			;	discard return address
	JMP	3100$			;	restart at [Keys, Add keys .]
;
; page scroll
;
4400$:	MOV	$$FORM,R0		; R0 ->	template
	CMP	10(R0),#1		;	more than 1 page?
	BHI	4410$			;	 yes -> skip
	RETURN				;	 no -->	ignore
4410$:	INC	PAGE$$			;	 yes -> bump page number
	CMP	PAGE$$,10(R0)		;	gone too far?
	BLOS	4420$			;	 no --> skip
	MOV	#1,PAGE$$		;	 yes -> select desired page
4420$:	BR	4300$			;	do a refresh
;
; display help text
;
4500$:	CMP	C.HELP,#NOP		;	help enabled?
	BEQ	4510$			;	 yes -> skip
	RETURN				;	 no -->	abort
 4510$:	CALL	C.HELP			;	display help text
	CALL	C.RFSH			;	refresh screen
	TST	(SP)+			;	discard return address
	JMP	3100$			;	restart at [Keys, Add keys .]
;

.SBTTL	Routine - "C.HELP"	...	display help text
;
; initialize
;
C.HELP:	RETURN				;	patched to NOP by init code
	CALL	FRMRST			;	reset file
	CALL	CON.ES			;	erase screen
	DISPLAY	<>,00,23.,E		;	clear bottom line
	PRINT	#7000$			;	display help mode message
;
; display a page of text
;
1000$:	DISPLAY	<>,00,23.,E		;	clear bottom line
	MOV	#21.,R5			; R5 =	line counter
1100$:	CALL	FRMINC			;	input character
	BCS	2000$			;	exit loop if hit EOF
	CALL	CON.CO			;	output character
	CMP	R0,#12			;	was it a LF?
	BNE	1100$			;	 no --> loop
	SOB	R5,1100$		;	loop till output a page
;
; see if want More, Exit or Restart
;
	PRINT	#7100$			;	show options
1700$:	CALL	CON.CI			;	input character
	BIC	#^C137,R0		;	insure UC letter
	CMP	R0,#'H			;	restart HELP text?
	BEQ	C.HELP			;	 yes -> restart time
	CMP	R0,#'R			;	restart HELP text?
	BEQ	C.HELP			;	 yes -> restart time
	CMPB	R0,#'M			;	want more?
	BEQ	1000$			;	 yes -> next page
	CMPB	R0,#40			;	want more?
	BEQ	1000$			;	 yes -> next page
	CMPB	R0,#'E			;	want to exit?
	BEQ	1770$			;	 yes -> exit
	CMPB	R0,#15			;	want to exit?
	BNE	1700$			;	 no --> wait for legal command
1770$:	RETURN				;	 yes ->	exit
;
; see if want to Exit or Restart
;
2000$:	PRINT	#7200$			;	show options
2700$:	CALL	CON.CI			;	input character
	BIC	#^C137,R0		;	insure UC letter
	CMP	R0,#'H			;	restart HELP text?
	BEQ	C.HELP			;	 yes -> restart time
	CMP	R0,#'R			;	restart HELP text?
	BEQ	C.HELP			;	 yes -> restart time
	CMPB	R0,#'E			;	want to exit?
	BEQ	2770$			;	 yes -> exit
	CMPB	R0,#15			;	want to exit?
	BNE	2700$			;	 no --> wait for legal command
2770$:	RETURN				;	 yes ->	exit
;
.nlist	bin
7000$:.ASCIZ <203>|INSKEY RDM170883 - help mode!|<204><15><12>
7100$:.ASCII <203>|Press [E] to exit, [M] for more, [R] to restart!|<204><200>
7200$:.ASCII <203>|Press [E] to exit, [R] to restart!|<204><200>
.even
.list
;

.SBTTL	Command Routine - "C.RFSH"	...	refresh screen
;
; This routine refreshes the top line of the screen and the template display
; area.
;
; paint form background
;
C.RFSH:	CALL	CON.ES			;	erase screen
	MOV	$$FORM,R0		; R0 -> template
	CALL	FRM.BG			;	display BG
;
; paint foreground if record loaded
;
	TST	ONSCRN			;	record loaded?
	BEQ	3000$			;	 no --> skip
	MOV	(R0),R5			; R5 ->	buffer
	CALL	FRM.FG			;	display record

;
; identify program, database and currently selected page
;
3000$:	DISPLAY	<INSKEY RDM170883, Database=>				00,0
	MOV	$$FORM,R0		; R0 ->	Template
	MOV	10(R0),R5		; R5 =	number pages in template
	ADD	#40,R0			; R0 ->	DBS name
	PRINT	R0			;	identify file
	DISPLAY	<, Page >						41,0
	CNAF	FFFFD,NUMBER=PAGE$$,STRING=#..TARG
	MOVB	#'/,(R1)+		;	delimiter
	CNAF	NUMBER=R5		;	number available pages
	MOVB	#200,(R1)		;	terminate
	PRINT	#..TARG			;	output
	RETURN				;	exit
;
;

.SBTTL	Command Routine - "C.SHOW"	...	Display Record on Screen
;
; Display currently selected record (ie ..RECN) on screen
;
;
C.SHOW:	CMP	..RECN,ONSCRN		;	record already on screen?
	BEQ	1000$			;	 yes --> skip
;
	MOV	..RECN,R0		; R0 =	record number
	CALL	FIL.DR			;	read record
	MOV	$$FORM,R0		; R0 ->	template
	MOV	(R0),R5			; R5 ->	buffer
	CALL	FRM.FG			;	display record
	MOV	..RECN,ONSCRN		;	remember record on screen
;
1000$:	RETURN				;	all done
;
;

.SBTTL	Command Routine - "C.PRNT"	...	Print data on printer
;
; Issue order to VT100 to print screen
;
C.PRNT:	CMP	#^RV10,@#542				; VT100?
	BNE	1000$					; NO -> skip
	.PRINT	#7000$					; send print command
1000$:	RETURN						; exit
;
.NLIST	BIN
7000$:	.ASCII	<33>/[5i/<12><15><33>/[4i/		; position head
	.ASCII	<33>/[0;4;24i/				; dump screen
	.ASCII	<33>/[5i/
	.ASCII	<12><12><12><12><12><12><12><12><12><12>
	.ASCII	<15><33>/[4i/				; leave few lines
	.ASCIZ	//
.EVEN
.LIST	BIN
;

.SBTTL	Routine - "MTHFND"	...	find any matchs
;
; are here to find best match for keys - initialize for loop
;
MTHFND:	CLR	NUMKEY				;	no keywords as yet
	MOV	#LINBUF,R0			; R0 -> input
;
;
; Extract next key. If terminated by '.' do biased search, if terminated
; by ',' do unbiased search.
;
100$:	MOV	#..TARG,R1			; R1 ->	target buffer
	CLR	2610$				;	allow BIASED search
110$:	MOVB	(R0)+,(R1)+			;	setup target
	BEQ	130$				;	skip if @EOS
	CMPB	-(R1),#40			;	ignore
	BEQ	110$				;	 <SPACEs>
	CMPB	(R1)+,#';			;	want BIASED search?
	BEQ	140$				;	 yes -> skip
	CMPB	-1(R1),#',			;	key delimiter?
	BNE	110$				; 	 no  -> loop
130$:	INC	2610$				;	disable biased search
;
; Work out string size to use for comparison. If user specified target is
; greater in lenght than keys in SFL file cannot do a biased search.
;
140$:	SUB	#..TARG+1,R1			; R1 =	target size
	BEQ	170$				;	terminate if size=0
	MOV	R1,TARSIZ			;	save size
	MOV	SFLPAR,R1			; R1 =	number of data bytes
	SUB	#2,R1				;	 in index file entry
	CMP	R1,TARSIZ			;	use lenght of shortest
	BHIS	160$				;	 string (ie key or
	MOV	R1,TARSIZ			;	  entry) as lenght
	INC	2610$				;	disabled BIASED match
;
; Perform match.
;
160$:	MOV	R0,-(SP)			;	save pointer
	CALL	200$				;	perform search
	MOV	(SP)+,R0			;	restore pointer
	INC	NUMKEY				;	one more keyword
;
; Continue search till all input processed
;
170$:	TSTB	-1(R0)				;	hit EOS?
	BNE	100$				;	 no -> next key
	RETURN					;	 yes-> done
;

;
; Convert LC to UC
;
200$:	MOV	#..TARG,R1			; R1 ->	TARGET
	MOV	TARSIZ,R2			; R2 =	counter
210$:	CMPB	(R1)+,#140			; LC character?
	BLO	240$				;  no -> skip
	BICB	#40,-1(R1)			; convert UC
240$:	SOB	R2,210$				; loop till all done
;
; perform a binary seach of index file to find best match.
; use R4 as step size and R3 as pointer
;
	MOV	SFLPAR+2,R4		; R4 = number of entries
	CALL	5000$			; R4 = R4 / 2
	MOV	R4,R3			; R3 = starting entry
2000$:	CMP	R3,SFLPAR+2		;	in range?
	BLOS	2010$			;	yes -> skip
	MOV	SFLPAR+2,R3		;	force into range
2010$:	MOV	R3,R0			; R0 =	next entry to search
	CALL	SFLPSN			;	position on entry R0
	CALL	5000$			; R4 =	step size
	BEQ	2400$			;	out of steps -> done
	ADD	R4,R3			;	assume going to step up
	CALL	5400$			;	compare TAR to REC
	BHI	2000$			;	TAR > REC -> step up
	SUB	R4,R3			;	we are not stepping up ...
	SUB	R4,R3			;	... we are stepping down
	BGT	2000$			;	loop not wrapped arround
	MOV	#1,R3			;	don't allow wrap arround
	BR	2000$			;	loop
;
; insure that R3 points to a valid entry
;
2400$:	CMP	R3,#1			;	at first entry?
	BHI	2440$			;	no -> skip
	MOV	#2,R3			;	force to second
2440$:	DEC	R3			;	skip back 1 record
;

;
; increase match count for each record that has a key that matchs specified
; target. To protect against the same record being matched twice (eq assume
; target is CON and record has keys CONSTRUCTION and CONSECUTIVE) mark
; each record by setting HOB of count when match found to stop multi- matches.
;
	DEC	R3			;	preloop fudge
2500$:	INC	R3			;	try next record
	CMP	R3,SFLPAR+2		;	all done?
	BHI	2700$			;	 yes -> terminate
	MOV	R3,R0			; R0 =	match area
	CALL	SFLPSN			;	position file
	CALL	5400$			;	compare TAR with REC
	BLO	2700$			;	TAR < REC -> terminate
	BHI	2500$			;	TAR > REC -> loop
	MOV	..RECN,R1		; R1 =	DBS rn of matching record
	ADD	PRFTAB,R1		; R1 ->	profile entry for record
	TSTB	(R1)			;	already had a match?
	BLT	2600$			;	 yes -> ignore
	INCB	(R1)			;	 no --> bump count for record
	BISB	#200,(R1)		;		flag as a hit
;
; This code bumps up the match count for a record if the target matched
; the record keyword exactly.
;
2600$:	TST	(PC)+			;	biased match disabled?
2610$:	.WORD	0			;	1 -> no biased match
	BNE	2500$			;	 yes -> done
	CALL	SFLINC			; R0 =	next SFL character
	CMP	R0,#40			;	was it a space?
	BNE	2500$			;	 no --> done
	INCB	(R1)			;	 yes -> was exact match
	BR	2500$			;	loop
;
; insure that 200 bit (used above to prevent multiple hits is clear
;
2700$:	.PUSH	<R1,R2>			;	save
	MOV	DBSENT,R2		; R2 =	counter
	MOV	PRFTAB,R1		; R1 ->	profile table
2710$:	BICB	#200,(R1)+		;	clear hit bit
	SOB	R2,2710$		;	loop
	.POP	<R2,R1>			;	restore
	RETURN
;

;
; R4 = R4/2	used to calculate new step-size
;
5000$:	CMP	R4,#1			;	last step = 1?
	BEQ	5040$			;	yes -> skip
	INC	R4			; R4 =	number+1
5040$:	ASR	R4			; R4 =	number/2 rounded up
	BIC	#100000,R4		;	ensure sign bit clear
	RETURN				;	bye
;
; CMP TAR,ENT	used to compare target with entry @R3
;
5400$:	CALL	SFLINC			;	setup LOB
	MOVB	R0,..RECN		;	 record number
	CALL	SFLINC			;	setup HOB
	MOVB	R0,..RECN+1		;	 record number
	MOV	TARSIZ,R2		; R2 =	record size
	MOV	#..TARG,R1		; R1 =	TARGET
5600$:	CALL	SFLINC			; R0 =	next input character
	CMPB	(R1)+,R0		;	comp TAR to REC byte
	BNE	5700$			;	skip no match
	SOB	R2,5600$		;	loop if matched
5700$:	RETURN				;	all done
;

.SBTTL	Routine - "MTHZR0"	...	zero match profile
;
; This routine is called to zero the match profile table; this is done prior
; to using a new set of keys to locate a record.
;
;
MTHZR0:	MOV	PRFTAB,R0		; R0 ->	profile table
	MOV	DBSENT,R2		; R2 =	number database records
	INC	R2			;	allow for record 0
1000$:	CLRB	(R0)+			;	Reset match counts
	SOB	R2,1000$		;	 for all records
	RETURN				;	exit
;
;

.SBTTL	Routine - "MTHSUM"	...	summaries match profile data
;
; This routine calculates the number of records that best match the
; specified keys.
;
MTHSUM:	MOV	PRFTAB,R0		; R0 ->	profile table
	MOV	DBSENT,R2		; R2 =	number database records
	CLR	R3			; R3 =	first matching record
	CLR	R4			; R4 =	degree of match
	CLR	R5			; R5 =	number matching records
;
; setup R3, R4 and R5 with pointer to first matching record, degree of
; match and count of number of possible matching records
;
1000$:	CMPB	(R0)+,R4		;	higher match count?
	BLO	1700$			;	 no ---> ignore
	BEQ	1400$			;	 same -> log
	MOVB	-1(R0),R4		;	remember best match
	MOV	R0,R3			;	remember number of record
	CLR	R5			;	reset record counter
1400$:	INC	R5			;	found another possible match
1700$:	SOB	R2,1000$		;	loop
;
	MOV	R5,MTHCNT		;	setup number matchs counter
	MOV	R3,MTHPNT		;	setup pointer to 1st match
	MOV	R3,R0			; R0 =	pointer to record
	SUB	PRFTAB,R0		; R0 =	record
	DEC	R0			;	 number
	MOV	R0,..RECN		;	save for later
	RETURN				;	exit
;

.SBTTL	Routine - "MTHNXT"	...	find next matching record
;
; This routine is called after MTHSUM to re-summarize the profile data
; if the currently selected record is to be ignored and the next one used.
;
MTHNXT:	MOV	MTHPNT,R3		; R3 ->	after last match
	MOV	MTHCNT,R5		; R5 =	number remaining matchs
	DEC	R5			;	take another match
	BEQ	1700$			;	skip if all done
	MOV	R3,R0			; R0 =	pointer
	MOVB	-1(R3),R4		; R4 =	degree of match
1000$:	CMPB	(R0)+,R4		;	loop till find
	BNE	1000$			;	 next match
	MOV	R0,R3			;	remember number of record
;
1700$:	MOV	R5,MTHCNT		;	setup number matchs counter
	MOV	R3,MTHPNT		;	setup pointer to 1st match
	MOV	R3,R0			; R0 =	pointer to record
	SUB	PRFTAB,R0		; R0 =	record
	DEC	R0			;	 number
	MOV	R0,..RECN		;	save for later
	RETURN				;	exit
;

.SBTTL	Primitives -"???KEY"	...	input NEW, EDiT, ZERo or SHoW keys
;
;
; The NEWKEY and EDTKEY routines are called to allow the user to modify the
; keywords stored in the buffer; the editted keywords are returned in ASCIZ
; format in LINBUF.
;
NEWKEY:	CALL	ZERKEY				;	zero keys
EDTKEY:	DISPLAY	<Keywords:>						00,2,E
	MOV	#KEYFDB,R0			; R0 ->	field descriptor block
	MOV	#LINBUF,R5			; R5 ->	buffer
	CMP	WND.BL+4,#7.			;	XBASE valid?
	BNE	400$				;	 no -> skip
	CMP	WND.BL+6,#0.			;	YBASE valid?
	BEQ	600$				;	 yes-> all ok
400$:	CALL	FLD.OU				;	 no --> reactivate fld
600$:	MOV	$$XPOS,WND.BL			;	reposition cursor	
1000$:	CALL	WND.IN				;	input data
	CMPB	R0,#'I-'@			;	<TAB> terminator?
	BEQ	NEWKEY				;	 yes -> erase data
	CALL	FLD.CK				;	check data
	BCS	1000$				;	ignore bad data
	CALL	FLD.IN				;	accept data
	CLRB	70.(R5)				;	terminate input
	MOV	WND.BL,$$XPOS			;	save X position
	RETURN					;	all done
;
;
; ZERKEY is called to zero the contents of the keyword buffer
;
ZERKEY:	MOV	#KEYFDB,R0			; R0 ->	field descriptor block
	MOV	#LINBUF,R5			; R5 ->	buffer
	CALL	FLD.ZE				;	zero field
;;	CALL	FLD.OU				;	reactivate field
	CLR	$$XPOS				;	reset cursor
	RETURN					;	done
;
;
; SHWKEY is called to display the contents of the keyword buffer
;
SHWKEY:	DISPLAY	<Keywords:>						00,2,E
	MOV	#KEYFDB,R0			; R0 ->	field descriptor block
	MOV	#LINBUF,R5			; R5 ->	buffer
	CALL	FLD.OU				;	output contents
	RETURN					;	done
;
$$XPOS:	.WORD	0				; WND.BL XPOS entry
KEYFDB:	.WORD	1				; ascii field
	.WORD	70.				; 70 characters in field
	.WORD	0				; offset from SOR to field
	.WORD	10.,2.				; X/Y cordinates of field
	.WORD	0				; check word
;

.SBTTL	Primitive - "OUTIT"	...	output error messages
;
OUTIT:	MOVB	(R1)+,R0				; fetch
	BEQ	1000$					; <NULL> -> skip
	CALL	CON.CO					; output R0
	BR	OUTIT					; loop
1000$:	INC	R1					; ensure that R1 is ..
	BIC	#1,R1					; .... even
	RTS	R1					; all done
;	

.SBTTL	Primitive - "ABORT"	...	abort program execution
;
ABORT:	.PRINT	#7000$			;	id program
	.PRINT	R1			;	tell why aborting
	.PRINT	#7100$			;	terminate message
	.EXIT				;	Terminate program
;
.nlist	bin
7000$:	.ASCII	<15><12>|INSKEY-fatal-|<200>
7100$:	.ASCIZ	|!|
.even
.list	bin

.SBTTL	Data Structures
;
;
$$FORM:	.WORD	FORM$$			; address user template
PAGE$$:	.WORD	1,1			; replaces PAGE$$ in FEDMNG module
F.MTCH:	.ASCII	/DDDDD/<200>		; number matchs (MTHSUM/MTHNXT) ASCII
NUMKEY:	.WORD	0			; number keys searched for (MATCH)
MTHCNT:	.WORD	0			; number matchs (MTHSUM/MTHNXT) Binary
MTHPNT:	.WORD	0			; pointer to last matching record
TARSIZ:	.WORD	0			; size of target string
ONSCRN:	.WORD	0,0			; record on screen; scolling flag
DBSENT:	.WORD	0			; number entries in database
PRFTAB:	.WORD	0			; address of profile table
;
	. = START			; overlay initiazation code
;	*********
;
LINBUF:	.BLKB	200			; input buffer
..TARG:	.BLKB	100			; Target to be found
..RECN:	.BLKW	1			; database record number for index
;
;
.END	START
