Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/utluse.mac
There are 6 other files named utluse.mac in the archive. Click here to see a list.
TITLE	UTLUSE
SUBTTL	A. UDDIN
SEARCH	RMSMAC,RMSINT
$PROLOG(UTL)

; THIS MODULE SUPPORTS THE BUCKET & RECORD-TO-USE CLAUSE AND RELATED STUFF
; IT PARSES THE RESPECTIVE CLAUSES & DOES THE I/O NECES TO LOC THE DESIRED DATA

$SCOPE	(TOP-LEVEL)
$LREG	(PB)				;PTR TO CURR RAB
$LREG	(FLAGS)				;FLAG REG, SEE US%

; PARSE STATUS FLAGS
;
US%LOW==1B35				;"LOWEST" SEEN
US%HI==1B34				;"HIGHEST" SEEN
US%1K==1B33				;JUST ONE KEY SPECIFIED
US%FND==1B32				;FOUND-KEY SPEC

$IMPURE
$DATA	(EQHREC)			;-1 = US.NEXT SHOULD SUCC ON CU.HREC
					;0 = US.NEXT SHOULD 1ST FAIL ON HREC
$DATA	(RSTEMP,^D14)			;SPACE FOR RST INFO
$DATA	(TS.BP)				;BP FOR TEST VALUE (OR NUMERIC VAL)
$DATA	(TS.LEN)			;# OF CHARS IN IT
$DATA	(TS.OPR)			;THE TEST TO PERFORM
$DATA	(TS.SYM)			;PTR TO UF. NODE OF "FOR" VAR

$PURE
ASCLE:	ASCIZ/<=/			; > IN CASE MACRO GETS CONFUSED

; THESE REGISTERS ARE SPECIFICALLY ORDERED FOR USAGE BY THE
; EXTENDED INSTRUCTION SET
;
$REG	(T.SLEN,T1)				;SOURCE STR LEN
$REG	(T.SBP,T2)				;SOURCE STR BP
$REG	(T.ARG,T3)				;PTR TO VALUE OF ARGUMENT
$REG	(T.DLEN,T4)				;DEST STR LEN
$REG	(T.DBP,T5)				;DEST STR BP

SUBTTL	VALUE PROCESSING TO SUPPORT USE CLAUSES

$SCOPE	(VALUE PROCESSING)
$LOCALS
 $WORD	(IDXTOO)				;ON IF IDX PART OF RFA SPEC
 $WORD	(RFAVAL)				;VALUE OF RFA COMPUTED
 $WORD	(TEMPST,2)				;TEMP STRING PTR
 $WORD	(XTINST)				;THE SELECTED EIS OPTION
 $WORD	(XTFILL,2)				;THE FILL CHARACTER FOR THE MOVE/COMPARE
$ENDLOC

$PROC	(CM.OPR,<SORCSP,DESTSP,OPRCOM>)
;
; CM.OPR - COMPARE SRC STRING TO DEST STRING
; ARGUMENTS:
; NOTES:
;	INTEGERS CAN BE PASSED USING FULL-WORD BYTE PTRS

	MOVE	T1,@OPRCOM(AP)			;PREPARE TO SET COMPARE INST
	CAMN	T1,[ASCIZ/=/]
	MOVE	T2,[CMPSE]			;STRINGS EQUAL?
	CAMN	T1,[ASCIZ/#/]
	MOVE	T2,[CMPSN]			;NOT = ?
	CAMN	T1,[ASCIZ/>=/]
	MOVE	T2,[CMPSGE]			;GTR THAN OR = ?
	CAMN	T1,[ASCIZ/>/]
	MOVE	T2,[CMPSG]			;GTR THAN?
	CAMN	T1,[ASCIZ/<=/]
	MOVE	T2,[CMPSLE]			;LESS THAN OR = ?
	CAMN	T1,[ASCIZ/</]
	MOVE	T2,[CMPSL]			;LESS THAN?
	MOVEM	T2,XTINST(P)			;STORE INST

	DMOVE	T.SLEN,@SORCSP(AP)		;GET SOURCE DATA
	DMOVE	T.DLEN,@DESTSP(AP)		;GET DEST DATA
	$ENDARG
	EXCH	T.SLEN,T.SBP			;ORIENT FOR EXTEND
	EXCH	T.DLEN,T.DBP			;DITTO
	$COPY	XTFILL(CF),STFILL,TAP		;SETUP FILL CHAR
	MOVEM	TAP,XTFILL+1(CF)		;FOR BOTH STRINGS
	EXTEND	T.SLEN,XTINST(CF)		;DO THE COMPARE
	  RETF					;COMPARE FAILED
	RETT
$ENDPROC

  $WORD	(XTNTAB,2)			;OPCODE, TABLE, & FILE
$ENDLOC

$PROC	(CP.STR,<SORCSP,DESTSP,TABCNV,FILLCH>)
;
; CP.STR - COPIES THE SPEC STRING, CONVERTING BYTES IN NECES
; ARGUMENTS:
;	SORCSP = STRING PTR TO SOURCE (BP FOLL BY LEN)
;	DESTSP = STRING PTR TO COPY TO
;	TABCNV = MOVST TABLE TO USE OR 0
;	FILLCH = FILL CHAR IF DEST LONGER, REQUIRED ONLY IF DLEN NOT 0
	MOVEI	T.ARG,@TABCNV(AP)		;GET TABLE TO USE (IF APPLIC)
	DMOVE	T.SLEN,@SORCSP(AP)		;MATER SRC INFO
	EXCH	T.SLEN,T.SBP			;EXTEND WANTS BP/LEN BACKWARDS
	DMOVE	T.DLEN,@DESTSP(AP)		;DITTO DEST
	EXCH	T.DLEN,T.DBP			; DONE
	JUMPN	T.DLEN,L$JUMP			;DEFAULT TO INPUT LEN?
		MOVEM	T.SLEN,T.DLEN		;YES
		SETZM	XTFILL(P)		;MAKE FILL KNOWN VAL FOR CONSIS
		JRST	L$IFX
	$JUMP					;NO, MAY NEED FILL CHAR
		$COPY	XTFILL(P),@FILLCH(AP),TAP	;COPY FILL CHAR
	$ENDIF
	$ENDARG
	SKIPN	T.ARG				;TRANSLATING
	SKIPA	T.ARG,[MOVSLJ]			;NO, PLAIN COPY
	HRLI	T.ARG,(MOVST)			;YES, MERGE TABLE & OPCODE
	MOVEM	T.ARG,XTINST(CF)		;PERMANIZE
	EXTEND	T.SLEN,XTINST(CF)		;DO THE COPY
	  $NOSKIP				;SHORTER DEST
		$CALLB TX$TOUT,<[UTLDSV##]>	;DAT FLD SHORTER THAN VALUE
	  $ENDIF
	RETT					;DONE
$ENDPROC

$PROC	(CP.RFA)
;
; CP.RFA - EAT RFA FROM CMD LINE, VERIFY THAT IT POINTS AT ENTRY
; RETURNS:
;	T1 = VALUE OF RFA SPEC ON CMD LINE

	SETZM	IDXTOO(CF)		;INDIC USER RFA
RFAMRG:
	$P	(NUM)			;PICK UP BKT OF RFA
	MOVEM	T1,RFAVAL(CF)		;STORE IN RFA
	$P	(TOK)			;PICK UP SLASH
	$P	(NUM)			;PICK UP ID
	HRLM	T1,RFAVAL(CF)		;FINISH BUILDING RFA
	SKIPL	T1,IDXTOO(CF)		;INDEX THERE TOO?
	$SKIP				;YES, PICK IT UP
		$P	(NUM)		;GOT IT
		MOVEM	T1,CU.KRF	;PERMANIZE IT
	$ENDIF
	$CALLB	M$KDB,<T1>		;SET TO 0 OR SPECIFIED INDEX
	JUMPE	T1,L$ERRU(FNI)		;BAD KREF IF JUMP
	HRRZ	T1,RFAVAL(CF)		;GET BKT NUM BACK
	$CALLB	BK$UP,<T1>		;MAKE SURE RFA'S BKT OK
	JUMPL	T1,L$UNW		;OOPS
	$CALLB	RC$RFA,<RFAVAL(CF)>	;FIND ENTRY BY RFA
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(RNF,RFAVAL(CF))	;OOPS
	$CALLB	M$KDB,<CU.KRF>		;RESTOR CURR KREF (IF IDXTOO, IS REDUND)
	RETT	<RFAVAL(CF)>		;WITH RFA FROM CMD LINE

$ENTRY	(CP.XFA)
;
; CP.XFA - PARSE RFA, INCLUDING ITS INDEX
;
	SETOM	IDXTOO(CF)		;SET FLAG TO INDIC PARSING INDEX
	JRST	RFAMRG
$ENDPROC

$PROC	(CP.TOK,<STDEST>)
;
; CP.TOK - COPY CMD LINE STRING DIRECTLY TO BUF$K1 USING BP INFO IN STRIPT
; ARGUMENTS:
;	STDEST = ADDR TO COPY STRING TO
; RETURNS:
;	TRUE, WITH CONVERTED STRING AT STDEST & STRING PTR IN T1/T2
;	FALSE, COPY NOT DONE
; NOTES:
;	STRIPT/STPLEN POINT TO COPIED STRING ON SUCCESSFUL RETURN

	MOVEI	T1,@STDEST(AP)		;PLACE TO COPY TO
	$ENDARG
	HRRM	T1,STRIPT		;MERGE INTO BP
	MOVEI	T1,21			;KLUDGE A REF TO .CMQST
	$CALL	P$STR			;RET BP/LEN
	JUMPF	L$RET			;TRANS RET FAILURE
	DMOVEM	T1,TEMPST(CF)		;PASS IT HERE
	MOVEM	T2,STRIPT+1		;DEST SAME LEN
	$CALL	CP.STR,<TEMPST(CF),STRIPT,@STCAIN,STFILL>
					;COPY TO INTERNAL FMT
	DMOVE	T1,STRIPT		;RET STRING PTR INFO FOR DEST
	RETT
$ENDPROC
$ENDSCOPE(VALUE PROCESSING)

SUBTTL	PROCESS THE bucket-to-use CLAUSE

$PROC	(US.BKT)
;
; US.BKT - PROCESS A BKT TO USE CLAUSE, STARTING WITH OPTION KEYWORD
; FORMAT:
;	DATA-LEVEL!DOWN!ENTRY n!LAST-USED!NEXT!ROOT n!UP
; OUTPUT:
;	SETS CU.* AS APPROPRIATE
	$CALL	P$KEYW			;PICK UP BKT OPTION
	JUMPF	L$RET			;TRANSIT RET FAILURE
	CASES	T1,MX%STB		;SET TO BKT OPTIONS
$CASE	(STB%DATA)
	$CALLB	BK$DATA,<CU.BKT>	;GO TO DATA-LEVEL
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,CU.BKT
	RETT				;DONE
$CASE	(STB%DOWN)
	$P	(NUM)			;GET ENTRY TO USE
	$CALLB	BK$DOWN,<CU.BKT,T1>	;GO DOWN
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,CU.BKT
	RETT				;DONE
$CASE	(STB%LAST)			;USE LAST RECORD
	HRRZ	T1,CU.NRP		;GET BKT PAGE OF CU.REC FROM RIGHT IDX
	JUMPE	T1,L$ERRU(NLR)		;NO LAST REC
	MOVEM	T1,CU.BKT		;MAKE IT CURR BKT
	RETT
$CASE	(STB%NEXT)
	$CALLB	BK$NEXT,<CU.BKT>	;GO NEXT
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,CU.BKT
	RETT				;DONE
$CASE	(STB%ROOT)
	$CALLB	BK$ROOT,<CU.KRF>	;GET ROOT
	JUMPL	T1,L$UNW		;OOPS
	CAMN	T1,CU.BKT		;ALREADY AT ROOT?
	JRST	SEBRBC			;YES
	MOVEM	T1,CU.BKT		;SET BKT NUM
	RETT				;DONE
$CASE	(STB%UP)
	$CALLB	BK$UP,<CU.BKT>		;GO UP
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,SEBRBC		;ROOT ALREADY?
	MOVEM	T1,CU.BKT
	RETT				;DONE
SEBRBC:
	$CALLB TX$TOUT,<[UTLRBC##]>
	RETT
$ENDPROC

SUBTTL	INDEX-LEVEL ROUTINES

$SCOPE	(USE-INDEX)
$LREG	(FLIM)				;FIND LIMIT

$PROC	(US.IDX)
;
; US.IDX - SET INDEX TO USE
; NOTES:
;	SET INDEX n BUCKET m!ROOT!RFA a/b
	$P	(NUM)			;GET KRF
	MOVEM	T1,CU.KRF		;SAVE IT
	$CALLB	M$KDB,<CU.KRF>		;INSURE VALID
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(FNI)		;NOPE
	$P	(KEYW)			;GET OPTION
	CASES	T1,MX%SIL		;DISPATCH TO IT
$CASE	(SIL%BUC)			;BUCK (AT PAGE) N
	$P	(NUM)			;GET PAGE #
	MOVEM	T1,CU.BKT		;SET BKT
	$CALLB	BK$GQI,<CU.BKT>		;READ IN THIS BKT (QUIETLY)
	JUMPLE	T1,L$UNW		;OOPS
	SKIPN	CU$TYPE			;CLOBBED BKT?
	JRST	SILUSR			;YES, DONT SET CURR REC
	$CALLB	BK$UP,<CU.BKT>		;TRY TO VERIFY IDX/BKT RELAT
	JUMPL	T1,L$UNW		;PROB BAD BKT/IDX COMB
	JUMPG	T1,L$IFX		;IS ROOT, MAKE SURE RIGHT ONE
		$CALLB BK$ROOT,<CU.KRF>	;GET ROOT VIA KREF
		CAME	T1,CU.BKT	;MATCH?
		ERRU	(BNI)		;BKT NOT PART OF SPECIFIED INDEX
	$ENDIF
	LOAD	T2,IB$LEV(T1)		;AT DATA LEVEL?
	JUMPE	T2,L$IFX		;YES, DONE ALREADY
		$CALLB BK$DATA,<CU.BKT>	;RET NEW BKT
		JUMPLE	T1,L$UNW	;OOPS
		$CALLB	BK$GET,<T1>	;GET DATA BKT RETURNED
		JUMPLE	T1,L$UNW	;OOPS
		SKIPN	CU$TYPE		;CLOBBED BKT?
		JRST	SILUSR		;YES, DONT SET CURR REC
	$ENDIF
	$CALLB	BK$ENT,<[1]>		;PICK UP 1ST ENTRY OF THIS BKT
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,SILUSR		;JUMP IF BKT EMPTY
	SKIPN	CU.KRF			;SIDR PTR?
	$SKIP				;YES
		LOAD	T4,IR$SRS(T1)	;WDS IN SIDR
		ADDI	T4,SZ%ISH-1(T1)	;PT TO LAST WD OF SIDR
		MOVE	T3,KSIZW	;SET PTR PAST KEY
		ADDI	T3,IR$SKEY(T1)	;AND HDR
	SILSLP:
		SKIPE	T2,0(T3)	;PICK UP SIDR PTR
		JRST	L$IFX		;ONE THERE, USE IT
		CAME	T3,T4		;REACHED LAST WD OF SIDR YET?
		AOJA	T3,SILSLP	;NO, COMPARE NXT RFA
	SILUSR:
		SETZM	CU.REC		;CLEAR CURR REC
		$CALLB TX$TOUT,<[UTLUSR##]>;UNABLE TO SET CURR REC
		RETT			;OTHER STUFF SET
	$NOSKIP
		LOAD	T2,IR$RFA(T1)	;UDR RFA WRD
	$ENDIF
	MOVEM	T2,CU.REC		;USE THIS TO SET SEQ POS
	$CALL	SILSEQ			;USE ENTRY TO DET KEYVAL AND SEQ POS
	JUMPF	SILUSR			;CANT SET CURR REC
	RETT
$CASE	(SIL%RFA)			;RFA BKT/ID
	$CALL	CP.RFA			;GET RFA FROM CMD LINE (SETS CU.REC)
	MOVEM	T1,CU.REC		;PASS ENTRY ADDR
	$CALL	SILSEQ			;SET SEQ POS IN INDEX
	JUMPF	L$ERRU(RNF,CU.REC)	;CANT FIND REC
	HRRZ	T1,@NRP$AD		;PICK UP BKT FROM RSTNRP
	MOVEM	T1,CU.BKT
	RETT
$CASE	(SIL%ROOT)
	$CALL	US.INIT
	RETT

$UTIL	(SILSEQ)
;
; SILSEQ - SET SEQ POS IN INDEX
; RETURNS:
;	TRUE IF A RECORD LOCATED (CU.REC MAY BE RESET)
;	FALSE IF NO REC FOUND
; NOTES:
;	CU.REC MAY BE RFA OR RRV ON ENTRY TO SILSEQ
	MOVE	PB,RAB			;SET RAB PTR
	MOVEI	T2,RB$KGE!RB$NRP	;KEY-GTR & SET NRP
	$STORE	T2,ROP,(PB)		;PUT IT IN RAB
	$CALLB	M$KUDR,<[BUF$K1],CU.REC>;PUT APPROP KEY OF REC IN KEY BUF
	JUMPL	T1,L$UNW		;ROUTINE BOMBED
	JUMPE	T1,L$RETF		;NON-EX REC, NO KEY TO DRIVE PROC
	TLNN	T1,-1			;REC DELETED?
	JRST	SISQAPX			;YES, FIND 1ST WITH MATCHING KEY
	MOVEM	T1,CU.REC		;SAVE PHYS RFA 
	MOVEI	T2,RB$KEY		;DO KEY ACCESS
	$STORE	T2,RAC,(PB)		;PUT IT IN RAB
	$CALLB	RC$FIND			;DO THE KEY FIND
	JUMPLE	T1,L$RETF		;CANT SET ANYTHING

	MOVEI	FLIM,^D100		;GUARD AGAINST LOTS OF DUPS & S-U DEL
	MOVEI	T2,RB$SEQ		;DO SEQ ACCESS
	$STORE	T2,RAC,(PB)		;PUT IT IN RAB
	JRST	SISQL1			;SKIP SEQ FND 1ST TIME
SISQLP:
	$CALLB	RC$FIND			;MOVE TO NEXT POS
	JUMPLE	T1,SISQAPX		;CANT DO IT, SO SET TO 1ST WITH KEY
SISQL1:
	CAMN	T1,CU.REC		;MATCH CMD ARG?
	RETT				;YES, "NORMAL" SUCCESS
	SOJG	FLIM,SISQLP		;HIT SAFETY LIM? FALL THRU IF DID
SISQAPX:
	MOVEI	T2,RB$KEY		;DO KEY ACCESS
	$STORE	T2,RAC,(PB)		;PUT IT IN RAB
	$CALLB	RC$FIND			;DO THE KEY FIND
	JUMPLE	T1,L$RETF		;CANT SET ANYTHING
	MOVEM	T1,CU.REC		;YES, HAVE TO BE SATISFIED WITH THIS
	$CALLB	TX$TOUT,<[UTLSRK##]>	;SET CURR REC TO 1ST WITH KEY
	RETT				;"DEGRADED" SUCCESS
$ENDUTIL
$ENDPROC
$ENDSCOPE(USE-INDEX)

SUBTTL	ENVIR INITS PERFORMED WHEN FILE OPENED

$PROC	(US.INIT)
;
; US.INIT - INIT ALL CURRENCY INDICATORS
;
	MOVE	T2,FAB			;GET FAB PTR
	$FETCH	T1,ORG,(T2)		;GET FILE TYPE
	CASES	T1,FB$IDX
$CASE	(FB$IDX)
	$CALLB	BK$ROOT,<CU.KRF>	;GET ROOT
	JUMPL	T1,L$UNW		;OOPS
	MOVEM	T1,CU.BKT		;TENTA SET BKT NUM
	JUMPG	T1,L$IFX		;EMPTY IDX?
		$FLAGO(UTLFLG,UT%EMP)	;INDIC NO DATA IN FILE
		$CALLB TX$TOUT,<[UTLFIE##]>
					;FILE EMPTY (PROLOG CMDS STILL ALLOWED)
		RETT
	$ENDIF
	$CALL	US.LOHI,<CU.KRF>		;SET CU.REC
	RETT
$CASF
	ERRU	(IUE)
$ENDPROC

SUBTTL	ROUTINE TO GET NEXT RECORD SATISFYING RECS-TO-USE

$SCOPE	(RECNEXT)
$LOCALS
 $WORD	(CURFND)			;PHYS RFA OF JUST GOTTEN REC
 $WORD	(GETBP,2)			;STRING PTR FOR FLD IN GET BUF
$ENDLOC

$PROC	(US.NEXT)
;
; US.NEXT - FINDS RECS & VALIDATES AGAINST END BOUND & "FOR" IF APPLIC
; ARGUMENTS:
;	RMS PTS AT CURRENT RECORD IN RIGHT INDEX
; RETURNS:
;	FALSE WHEN PAST SCAN RANGE
;	TRUE WHEN REC FOUND, WITH REC IN $GET BUFFER & T1 = ITS RFA
	MOVE	PB,RAB			;MATER ARGBLK PTR
	MOVEI	T1,RB$SEQ		;INSURE SEQ OPERATION
	$STORE	T1,RAC,(PB)		;DONE
RNEXLP:
	SKIPLE	EQHREC			;LAST CALL SET DONE COND?
	RETF				;YES (IN LOOP IN CASE FOR-WHICH FAILED)
	$CALLB	RC$GET			;GET PHYS RFA OF FND REC
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$RETF		;HIT EOF
	MOVEM	T1,CURFND(CF)		;SAV FOR RET
	CAME	T1,CU.HREC		;HIT END CHK
	$SKIP				;YES, SEE TYPE OF EXIT
		SKIPL	EQHREC		;MATCH MEAN SUCC?
		RETF			;NO, (1ST KEY PAST)
		MOVMS	EQHREC		;YES, INDIC PAST HI NOW
	$ENDIF
	SKIPN	T5,TS.SYM		;IS THERE A TEST PHRASE?
	JRST	RNEXIT			;NO, SO DONE
	$FETCH	T4,RBF,(PB)		;SEE WHERE REC PUT
	HLL	T4,STRIPT		;PRESUME STRING, GET BP INFO
	LOAD	T1,UF.TYP(T5)		;GET DAT TYPE
	CAIL	T1,DFT%DEC		;NUMERIC?
	HRLI	T4,444400		;USE FULL WORD BP
	LOAD	T1,UF.POS(T5)		;GET OFFSET IN REC (WD OR BYT AS APPRO)
	ADJBP	T1,T4			;PT AT FLD LOC IN REC'S BUFF
	MOVEM	T1,GETBP(CF)		;PASS THIS
	$COPY	GETBP+1(CF),UF.SIZ(T5)	;GET SIZE OF FLD TO DRIVE CMP
	$CALL	CM.OPR,<GETBP(CF),TS.BP,TS.OPR>
					;DO COMPARE, NOTE THAT NUMERIC FLDS
					; SIMPLY COMPARED AS FULL WD BYTES
	JUMPF	RNEXLP			;DIDNT CONFORM, CONTINUE SCAN
RNEXIT:
	MOVE	T1,@NRP$AD		;SAVE NRP OF THIS REC (FOR BUSE L-R)
	MOVEM	T1,CU.NRP		;PERMANIZE IT
	RETT	CURFND(CF)		;A MATCH, RET WITH PHYS ADDR OF REC
$ENDPROC
$ENDSCOPE(RECNEXT)

SUBTTL	PARSING THE records-to-use CLAUSE

; FORMAT OF RECS-TO-USE CLAUSE
;
;	KEY n1 (FROM) value1 (TO) value2
;					(AND) field1 op value3
;	RELATIVE-REC-NO signed1 (TO) signed2
;
;	LAST-ENTRY
;
; IN CURRENCY BASED CMDS (EG. DISPLAY, CHANGE), THE RULES ARE:
; (1) OMITTING N1 CAUSES CURR KEY OF REFERENCE
; (2) IF VALUE2 IS OMITTED, VALUE2 IS SET TO VALUE1
; (3) IF V2 OMITTED AND V1=LOWEST, THEN V2 SET TO LOWEST KEY VALUE IN INDEX
; (4) S1 AND S2 RELATIVE TO CURR RECORD
; (5) IF S2 IS OMITTED, JUST ONE RECORD IS IDENTIFIED
; (6) FOR CLAUSE IS OPTIONAL
;
; IN SCANNING CMDS (EG. VERIFY)
; (1) N1 IS REQUIRED, BUT V1 AND V2 MAY BOTH BE OMITTED -- LOWEST TO HIGHEST ASSUMED
; (2) THE FOR CLAUSE IS N/A
; (3) S1 TO S2 IS N/A
; (4) THE OTHER RULES ARE THE SAME

; COMMON OUTPUTS:
;	FALSE = FAILED TO FIND THE CLAUSE
;		CU.HREC SET TO CU.REC & EQHREC SET
;	TRUE = FOUND THE CLAUSE.
;		CU.REC HAS RFA OF RECORD SPEC BY <value1>
;		CU.HREC HAS:
;			RFA OF REC PAST HI KEY VAL
;			RFA OF S2 AND EQHREC SET
;			0 (IE. RNF or EOF)
;		KDB IN RMS'S SPACE SETUP, KRF IN RAB SETUP

$SCOPE(US.REC)
$LOCALS
  $WORD	(H.KBUF)			;PTR TO HI KEY
  $WORD	(H.KLEN)			;IT LEN IN CHARS
  $WORD	(L.KBUF)			;PTR TO LOW KEY
  $WORD	(L.KLEN)			;ITS LEN IN CHARS
$ENDLOC

$PROC	(US.REC)
;
; US.REC - PARSES ENTIRE RECS-TO-USE CLAUSE
; ARGUMENTS:
;	CURR PDB IS 1ST WORD OF CLAUSE, IF CLAUSE PRESENT
; NOTES:
;	IT IS THE CALLER'S RESPONSIBILITY TO PERMANIZE AN ENVIRONMENT
;	AT THE END OF A SUCCESSFUL CMD.
;	$COPY XXX,I BUF$-- ISNT USED BECAUSE BUF$-- ARE EXTERNAL

	MOVE	T1,UTLFLG		;GET FLAGS
	TXNE	T1,UT%EMP!UT%PCH	;EMPTY FILE OR PROL CHANGED?
	ERRU	(EPC)			;YES TO EITHER
	MOVE	PB,RAB			;INIT RAB PTR
	SETZM	EQHREC			;RETURN RFA PAST
	SETZM	FLAGS			;CLEAR PARSE FLAGS
	SETZM	TS.SYM			;CLEAR "FOR" VAR

	$CALL	P$KEYW			;RUSE PRESENT?
	JUMPT	L$IFX			;YES, IF JUMP
		SKIPGE	SCANNING	;SCANNING-CLASS CMD?
		RETF			;YES, CURR REC IRRELEV
		JRST	USCURR		;NO, SET CURR REC UP AS REC RANGE
	$ENDIF

	CASES	T1,MX%RTU		;DISPATCH TO APPROP OPT

$ENTRY	(US.CURR)
;
; US.CURR - SET RANGE TO CURR REC
;
	MOVE	T1,UTLFLG		;GET FLAGS
	TXNE	T1,UT%EMP!UT%PCH	;EMPTY FILE OR PROL CHANGED?
	ERRU	(EPC)			;YES TO EITHER
USCURR:
	SKIPN	T1,CU.REC		;SETUP TO PROC CURR REC -- IF 1
	ERRU	(NCR)			;OOPS, NO CURR REC
	MOVEM	T1,CU.HREC		;PROC ONLY CURR REC
	SETOM	EQHREC			;SET FLAG TO INDIC CU.HREC IN BNDS
	$CALLB	RC$REL,<[CU.RST],[0]>	;SETUP ENVIR FOR SEQ OPERATIONS
	JUMPLE	T1,L$UNW
	RETF				;INDIC NO RUSE CLAUSE

$CASE	(RTU%LAST)				;LAST ENTRY
	SKIPE	CU.KRF			;ENTRY IRRELEV UNLESS PRIM KEY
	ERRU	(ENA)			;L-E N/A UNL CURR IDX 0
	HRLZ	T1,CU.ID		;GET LAST ENT REFFED
	JUMPE	T1,L$ERRU(NRW)		;NO LAST ENTRY APPLICABLE
					;BKT NOT REF YET OR IDX BKT CURR
	HRR	T1,CU.BKT		;AND P# OF ITS BKT
	MOVE	T2,RAB			;GET RAB PTR
	$STORE	T1,RFA,(T2)		;PREP RFA FIND
	MOVEI	T1,RB$RFA		;DO RFA ACCESS
	$STORE	T1,RAC,(T2)		;PUT IT AWAY
	$CALLB	RC$FIND			;FIND IT
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(NRW)		;COULDNT FIND IT
	MOVEM	T1,CU.REC		;SET IT
	MOVEM	T1,CU.HREC		;INDIC 1-REC RANGE
	SETOM	EQHREC			;...(LAST = CU.HREC)
	RETT				;DONE
$CASE	(RTU%REL)			;REL REC-NO
	SKIPN	CU.REC			;REC TO DRIVE OFF OF?
	ERRU	(NCR)			;NO CURR REC
	$P	(NUM)			;GET <signed1>
	MOVEM	T1,L.KLEN(CF)		;SAVE ARG TO COMPUTE RFA
	$CALL	P$NUM			;GET <SIGNED2>
	SKIPT				;2ND NUM?
	SETOM	T1			;INDIC NO HREC
	MOVEM	T1,H.KLEN(CF)		;SAVE HI BND OFFSET

	CAMGE	T1,L.KLEN(CF)		;NULL RANGE?
	JUMPGE	T1,L$ERRU(NRW)		;YES, IF NO HI BND DOESNT APPLY
	SETOM	EQHREC			;TELL US.NEXT TO SUC ON HREC
	$CALLB	RC$REL,<[CU.RST],L.KLEN(CF)>	;GET START OF RANGE
	JUMPL	T1,L$UNW		;JUMP IF PROB (MSG ALR TYPED)
	JUMPE	T1,L$ERRU(NRW)		;NO RECORD IDENTIFIED
	MOVEM	T1,CU.REC		;PERMANIZE IT
	MOVEM	T1,CU.HREC		;DEFAULT LAST RFA IN RANGE
	SKIPGE	T1,H.KLEN(CF)		;A HI BND?
	$SKIP				;YES
		SUBM	T1,L.KLEN(CF)	;GET RELAT DIST
		$CALLB	M$RSTCOP,<RST,[RSTEMP]>	;PREP TO RESTOR AFTER RC$REL
		$CALLB	RC$REL,<[RSTEMP],L.KLEN(CF)>
					;COMPUTE RFA FROM CURREC & REC OFFSET
		JUMPL	T1,L$UNW	;RET TO CMD PROC IF PROBLEM
		MOVEM	T1,CU.HREC	;LAST RFA IN RANGE
		$CALLB	RC$REL,<[RSTEMP],[0]>	;RESTORE LOW BND
		JUMPL	T1,L$UNW	;RET TO CMD PROC IF PROBLEM
		JUMPE	T1,L$ERRU(IUE)	;SHOULD BE IMPOS
	$ENDIF
	JRST	RUSTST			;CHK "FOR" NOW
$CASE	(RTU%KEY)			;KEY-VALUE RANGE
	$CALL	P$NUM			;WHAT ABOUT KEY-OF-REF?
	JUMPF	L$IFX
		MOVEM	T1,CU.KRF	;TENTA RESET KRF
		$CALLB	M$KDB,<T1>	;SET KDB, RMS'S KDB, & RAB KRF
		JUMPL	T1,L$UNW	;OOPS
		JUMPE	T1,L$ERRU(FNI)	;INVALID KEY SPECIFIED
	$ENDIF
	JRST	RFMERG			;PICK UP FROM CLAUSE

$ENTRY	(US.FROM,<KRF>)
;
; US.FROM - PROCESS FROM CLAUSE OF REC-TO-USE
; ARGUMENTS:
;	KRF = THE KEY OF REFERENCE TO GUIDE COMPUTATION
; RETURNS:
;	WITH CU.REC/CU.HREC SETUP UNLESS KRF TOO LARGE
; NOTES:
;	IF NO FROM CLAUSE, SETS CU.REC/CU.HREC FOR LOW TO HI

	MOVE	T1,@KRF(AP)		;MATER KRF
	$ENDARG
	$CALLB	M$KDB,<T1>		;INSURE VALID
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$RETF		;BAD KEY VAL
	MOVE	PB,RAB			;INIT RAB PTR
	SETZM	EQHREC			;RETURN RFA PAST
	SETZM	FLAGS				;INIT RECTUSE ENVIR
	SETZM	TS.SYM			;CLEAR "FOR" VAR

RFMERG:
	SETZM	STRIPT+1			;USE SRC STRING LENS
	$CALL	P$KEYW				;LOWEST ?
	JUMPF	L$IFX				;NO. MUST BE QUOTED STRING
		TXO	FLAGS,US%LOW		;LOWEST SPECIFIED
		JRST	RUSTO			;PROCESS (TO) PART
	$ENDIF
	$CALL	CP.TOK,<BUF$K1>			;GET STRING FROM CMD LINE
	JUMPT	L$IFX				;JUMP IF LOWER BND SPEC
		TXO	FLAGS,US%LOW!US%HI	;FOR KEY N, ASSUME LOW/HI
		JRST	RUSRFA			;CALC RFA'S
	$ENDIF
	DMOVEM	T1,L.KBUF(CF)			;SAVE BP & CHAR LEN OF STRING

RUSTO:	
	$CALL	P$KEYW				;KEYWORD AFTER (TO)?
	JUMPF	L$IFX				;NO, CHK FOR STRING
		CAIN	T1,RUH%HI		;HI-EST SPEC?
		TXO	FLAGS,US%HI		;YES, SCAN TO HIGHEST
		CAIN	T1,RUH%FOU		;FOUND-KEY SPEC?
		TXO	FLAGS,US%FND		;YES
		JRST	RUSRFA			;CALC RFA'S OF BNDS
	$ENDIF
	$CALL	CP.TOK,<BUF$K2>			;GET STRING FROM CMD LINE
	JUMPF	RUS.1K				;JUMP IF ABSENT
	DMOVEM	T1,H.KBUF(CF)			;PASS BP & CHAR LEN OF STRING
	TXNE	FLAGS,US%LOW			;"LOWEST" SPEC?
	$SKIP					;NO
		$CALL	CM.OPR,<L.KBUF(CF),H.KBUF(CF),ASCLE>
						;IS 1ST LE 2ND?
		JUMPF	L$ERRU(NRW)		;NO, IF JUMP
	$ENDIF
	JRST	RUSRFA				;CALC BNDS
RUS.1K:						;ONLY V1 SPECIFIED
	TXO	FLAGS,US%1K			;TELL RUSRFA
	JRST	RUSRFA

SUBTTL	We are now ready to FIND the records.

$ENTRY	(US.LOHI,<KRF>)
;
; US.LOHI - RET RFA'S FOR LOWEST/HIGHEST OF SPECIFIED KEY
; ARGUMENTS:
;	KRF = KEY OF REF FOR WHICH BNDS TO BE CALC-ED
; RETURNS:
;	LO/HI BNDS SET UNLESS BAD KEY #

	MOVE	T5,@KRF(AP)
	$ENDARG
	$CALLB	M$KDB,<T5>		;INSURE VALID
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$RETF		;KRF TOO LARGE
	MOVE	PB,RAB			;INIT RAB PTR
	SETZM	EQHREC			;RETURN RFA PAST
	LOADX	FLAGS,US%LOW!US%HI		;SET DESIRED BNDS
	SETZM	TS.SYM			;CLEAR "FOR" VAR

RUSRFA:
	TXNN	FLAGS,US%LOW			;STILL NO KEY INF SET?
	$SKIP					;YES, CONV "LOWEST" TO KEY
		SETZM	BUF$K1			;PUT NULS IN BUFF
		$COPY	L.KLEN(CF),I 1		;DO GENERIC SRCH ON 1 NUL
	$ENDIF
	MOVEI	T1,RB$KEY			;KEY ACCESS
	$STORE	T1,RAC,(PB)
	LOADX	T1,RB$KGE!RB$RAH!RB$NRP		;KEY GTR FND & SET PHYS RFA
	$STORE	T1,ROP,(PB)
	MOVEI	T1,BUF$K1			;GET BUF PTR
	$STORE	T1,KBF,(PB)
	MOVE	T1,L.KLEN(CF)			;& ITS LEN
	$STORE	T1,KSZ,(PB)
	$CALLB	RC$FIND				;Actually FIND it.
	JUMPL	T1,L$UNW			;OOPS
	JUMPE	T1,L$ERRU(NRW)			;NO RECORD IDENTIFIED
	MOVEM	T1,CU.REC			;SAVE FIRST RFA
	$CALLB	M$RSTCOP,<RST,[RSTEMP]>		;PREP TO RESTOR AFTER KGT FIND
RUSRF2:						;FIND <string2> or HIGHEST rec.
	TXNN	FLAGS,US%FND!US%1K		;JUST A VALUE1?
	$SKIP					;YES
		TXNN	FLAGS,US%LOW!US%FND	;WAS IT "LOWEST" OR "FND-KEY"?
		$SKIP1				;YES, GET KEY FROM RECORD
		  $CALLB M$KUDR,<[BUF$K2],[0]>	;SETUP KEY, KBF, KSZ
		  JUMPL T1,L$UNW		;OOPS
		  JRST	RUFGTR			;DO THE FIND
		$NOSK1				;NO, KVAL ON CMD LINE
		  MOVEI	T1,BUF$K1		;PT TO SAME PLACE
		  MOVE	T2,L.KLEN(CF)		;SAME LEN ALSO
		  JRST	L$IFX
		$ENDIF(1)
	$NOSKIP					;TWO KEYS
		SETZM	CU.HREC			;PRESUME "HIGHEST"
		TXNE	FLAGS,US%HI		;IS IT?
		JRST	RUSTST			;YES, CHK ON "FOR" NOW
		MOVEI	T1,BUF$K2		;GET BUF PTR
		MOVE	T2,H.KLEN(CF)		;& ITS LEN
	$ENDIF
	$STORE	T1,KBF,(PB)
	$STORE	T2,KSZ,(PB)
RUFGTR:
	LOADX	T1,RB$KGT!RB$RAH!RB$NRP		;KEY GTR FND & SET PHYS RFA
	$STORE	T1,ROP,(PB)
	$CALLB	RC$FIND				;Actually FIND it.
	JUMPL	T1,L$UNW			;OOPS
	MOVEM	T1,CU.HREC			;SAVE 2ND RFA
	CAMN	T1,CU.REC			;EMPTY KEY RANGE?
	ERRU	(NRW)				;YES, TELL USER
	$CALLB	RC$REL,<[RSTEMP],[0]>		;RESTORE LOW BND
	JUMPE	T1,L$ERRU(IUE)			;SHOULD BE IMPOS
	JUMPL	T1,L$UNW			;RET TO CMD PROC IF PROBLEM
;	JRST	RUSTST				;PROC "(AND) TEST" NOW

SUBTTL	PARSE "AND FLD OPR VAL" PHRASE OF RECS-TO-USE

RUSTST:
	$CALL	P$FLD			;SEE IF "TEST" PHRASE
	JUMPF	L$RETT			;NO, JUST RET IMMED
	$CALL	P$PREV			;DO ALL WORK IN SY.CHK
	$CALL	SY.CHK,<DA$TYP>		;PICK UP FLD
	MOVEM	T1,TS.SYM		;SAVE PTR TO ITS SYMBOL BLK
	$P	(TOK)			;PICK UP THE OPERATOR
	MOVE	T3,TK.VAL(T1)		;GET ASCIZ OPR
	AND	T3,[37777B13]		;GET RID OF TRAILING CRUFT
	MOVEM	T3,TS.OPR		;PUT IT AWAY
	MOVE	T2,TS.SYM		;GET SYM PTR BACK
	LOAD	T1,UF.TYP(T2)		;GET DATA TYPE
	CAIGE	T1,DFT%DEC		;NUMERIC?
	JRST	RUFSTR			;NO
RUFNUM:
	$P	(NUM)			;PICK UP NUMBER
	MOVEM	T1,BUF$K1		;YES, PUT IT AWAY
	MOVE	T1,[444400,,BUF$K1]	;TREAT AS FULL WD BYTE
	MOVEI	T2,1			;...LEN OF 1
	DMOVEM	T1,TS.BP		;PUT PTR AWAY
	RETT				;DONE
RUFSTR:					; ??? PRESUME DAT TYP MATCHES FILE BSZ
	$CALL	CP.TOK,<BUF$K1>		;COP A STRING TOK TO BUF$K1
	DMOVEM	T1,TS.BP		; DONE
	RETT
$ENDPROC(US.REC)
$ENDSCOPE(US.REC)

$ENDSCOPE(TOP-LEVEL)

END