.TITLE	LOCFLD	... locate entry for specified field in RTD
.IDENT	/310583/
.ENABL	LC
;
;
;	Written by	Ray Di Marco
;			1-Oct-82
;
;
;	Version		011082/03
;
;
;-----------------------------------------------------------------------------
;
;
; This module contains the code for the DBSMNG library routine LOCFLD; the
; routine is used to locate the entry for a specified FIELD in a DBSMNG
; Record Descriptor Table. Registers R0/R1 are used for argument passing; all
; registers other than R1 are preserved through the routine.
;
; At entry R0 must point to the start of the RDT to be searche; R1 must hold
; the address of the .ASCIZ string that is the name of the field to be
; searched for. The string may be terminated by either a <NULL> or <200>
; byte. On exit, the 'C' flag is set if the field entry could not be located;
; if the 'C' flag is clear R1 holds the address of the FDT entry for the
; specified field.
;
;	Notes	1) leading spaces in the field name string are ignored
;		2) the routine looks for an exact match first; if this
;		   fails it will look for an approximate match.
;

.SBTTL	Modifications
;
; 3-Feb-83	change approximate match code @2000$ so that compensates
;		for lower/upper case diffrences.
; 31-May-83	correct logic error in @2000$ that caused stack to be
;		corrupted and a Trap to 4!
;

.SBTTL	Declarations
;
;
.MCALL	.PUSH,.POP			;	stacking macros
;
;
.GLOBL	LOCFLD				; 	module entry
;
;
	ENTSIZ	= 40			;	size of field FDT entry
;
;
;
	.PSECT	CODE			; 	open code section
;	------	----
;
;

.SBTTL	Routine - "LOCFLD"	...	locate FDT in table @R0 for field @R1
;
;
; At entry R0 points to a RDT; we are to locate the entry for the field
; whose name was passed in R1 (in ASCIZ format). Start by saving registers
; and deleteing leading spaces from field name.
;
LOCFLD:	.PUSH	<R2,R3,R4,R5>		;	save work registers
100$:	CMPB	(R1)+,#40		;	have a leading space?
	BEQ	100$			;	 yes -> trim it
	DEC	R1			; R1 ->	start target
	TSTB	(R1)			;	@EOS?
	BLE	7100$			;	 yes -> abort
;
;
; Search though RDT to see if can locate a field whose name matchs the
; target (@R1) exactly; if do skip to 7000$.
;
	MOV	2(R0),R3		; R3 ->	RDT
	MOV	4(R0),R2		; R2 =	number fields to check
1000$:	MOV	R1,R5			; R5 ->	target
	TST	10(R3)			;	valid field (ie Y<>0)?
	BEQ	1700$			;	 no -> skip
	MOV	22(R3),R4		; R4 ->	field name
1400$:	CMPB	(R5)+,(R4)+		;	match?
	BNE	1700$			;	 no -> skip
1500$:	TSTB	(R5)			;	@EOS of target?
	BGT	1400$			;	 no -> loop
	TSTB	(R4)			;	@EOS of FIELD?
	BLE	7000$			;	 yes -> skip, perfect match
1700$:	ADD	#ENTSIZ,R3		; R3 ->	next entry
	SOB	R2,1000$		;	loop time
;

;
; Search though RDT to see if can locate a field whose name matchs the
; target (@R1) approximately; if do skip to 7000$, else 7100$.
;
	MOV	2(R0),R3		; R3 ->	RDT
	MOV	4(R0),R2		; R2 =	number fields to check
2000$:	MOV	R1,R5			; R5 ->	target
	TST	10(R3)			;	valid field (ie Y<>0)?
	BEQ	2710$			;;	 no -> skip
;
	MOV	22(R3),R4		; R4 ->	field name
	.PUSH	<R0,R1>			;	save
2400$:	MOVB	(R5)+,R0		; R0 =	target
	CMP	R0,#140			;	insure
	BLO	2410$			;	 upper
	BIC	#^C137,R0		;	  case
2410$:	MOVB	(R4)+,R1		; R1 =	field name
	CMP	R1,#140			;	insure
	BLO	2411$			;	 upper
	BIC	#^C137,R1		;	  case
2411$:	CMP	R0,R1			;	match?
	BNE	2700$			;	 no -> skip
2500$:	TSTB	(R5)			;	@EOS?
	BGT	2400$			;	 no -> loop
	.POP	<R1,R0>			;	restore
	BR	7000$			;	skip -> perfect match
2700$:	.POP	<R1,R0>			;	restore
;
2710$:	ADD	#ENTSIZ,R3		; R3 ->	next entry
	SOB	R2,2000$		;	loop time
	BR	7100$			;	abort, have failed
;
;
; Use 7000$ for sucess, and 7100$ for failure exit.
;
7000$:	MOV	R3,R1			; R1 ->	FDT that matched
	TST	(PC)+			;	clear fail flag
7100$:	SEC				;	set fail flag
	.POP	<R5,R4,R3,R2>		;	restore
	RETURN				;	bye
.END