Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/utlact.mac
There are 6 other files named utlact.mac in the archive. Click here to see a list.
TITLE	UTLACT - RECORD-LEVEL & MISCELLANEOUS CMD PROCESSING
SUBTTL	A. UDDIN/RL


;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1980, 1986.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
;	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
;	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
;	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
;	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
;	SOFTWARE IS HEREBY TRANSFERRED.
;
;	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
;	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
;	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;


;++
; FACILITY:	RMSUTL
;
; ABSTRACT:
;
;	UTLACT performs record-level (and some other) command
;	processing.
;
; ENVIRONMENT:	User mode?
;
; AUTHOR: Anwar Uddin, CREATION DATE: 1980
;
; MODIFIED BY:
;
;	Ron Lusk,  3-Feb-84: VERSION 2.0
;
;  71   -	Put copyright notice in binary
; 423	-	Clean up for version 2.0 of RMS.
; 430	-	Finish initial sequential/relative work
; 433	-	Add new datatypes
; 434	-	Display Seq/Rel RFAs correctly
; 455	-	Use RMSM2 routines for all TTY:/report output
;--

SEARCH	 RMSMAC,RMSINT


$PROLOG(UTL)


; DECLARATIONS

$SCOPE	(TOP-LEVEL)
$LREG	(PB)			;PTR TO CURR RMS ARG BLK
$LREG	(RF)			;PTR TO CURR RMS FLD DESC
$LOCALS
 $WORD	(CNVTAB)			;MOVST TABLE TO USE
 $WORD	(DVALPT,3)			;[455] STR/WD PTR TO DAT FLD WITHIN ITS REC
 $WORD	(FNDSOM)			;ON IF US.NEXT RET SUCC AT LEAST ONCE
 $WORD	(RECEND)			;LAST WD OF REC
 $WORD	(RECLEN)			;# OF BYTES IN REC
$ENDLOC
SZ%DRV==20				;FOR CHANGE/DISP, MAX DATFLDS/CMD LINE
$IMPURE

SMNCPY:	ASCIZ\

	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1980, 1986.
	ALL RIGHTS RESERVED.

\ ;[71]

$DATA	(CINBKT)			;INIT CURRENT BUCKET NO.
$DATA	(CINKRF)			;INIT CURRENT INDEX(KEY OF REF)
$DATA	(CINREC)			;INIT RFA OF CURRENT RECORD
$DATA	(CINTYPE)			;TYPE OF BKT
$DATA	(DRV,SZ%DRV)			;DATAFIELD-NAME REFERENCE VECTOR
$DATA	(ENTLIM)			;HI ENTRY OF RANGE
$DATA	(ENTNUM)			;;NUMBER OF BKT ENTRY
					;I.E; INDEX number!BUCKET number etc
$DATA	(VRV,SZ%DRV)			;CHANGE-VALUE REF VECTOR
SUBTTL	REPORT FMT STATEMENTS & DATA

$PURE
COMMENT @
HDRAREA:[$FMT(,<AREA ,-CA%NUM>)]
HDRBUC:	[$FMT(,<BUCKET'S PAGE:	,-CA%NUM>)]
HDRCNX: [$FMT(,<Changing ,-CA%NUM>)] 	      ; FOR DECIMAL RFA (SEQ/REL) ;A434
HDRCHA:	[$FMT(,<Changing ,-CA%RFA>)]
HDRDAF:	[$FMT(,<-CA%STP,:,-CA%ASZ,-CA%NOCR>)]	; : PLUS RIGHT NUM OF TABS
HDRDEL:	[$FMT(,<Deleting ,-CA%RFA>)]
HDRENT:	[$FMT(,<ENTRY ,-CA%NUM,  (starts at W,-CA%NUM,)>)]
HDRFIL:	[$FMT(,<FILE PARAMETERS>)]
HDRIDX:	[$FMT(,<INDEX ,-CA%NUM>)]
HDRRNX:	[$FMT(,<RECORD'S RFA:	,-CA%NUM>)]	; Display seq/rel RFAs    ;A434
HDRREC:	[$FMT(,<RECORD'S RFA:	,-CA%RFA>)]
HDRRRV:	[$FMT(,<RECORD'S RFA:	,-CA%RFA, (,-CA%RFA,)>)]
HDRSAE:	[$FMT(,<RFAs:	,-CA%NOCR>)]
HDRVAL:	[$FMT(,<-CA%ASZ,:	,-CA%NOCR>)]

DABFMT:					;FMT STATS FOR RMS FLD DAT TYPES
					;MUST BE ORD ACCORD TO DT% BLK
VALDEC:	[$FMT(,<-CA%NUM>)]		;ALSO NUM DATA
	[$FMT(,<-CA%DT>)]
VALOCT:	[$FMT(,<-CA%OCT>)]		;ALSO NUM DATA
VALRFA:	[$FMT(,<-CA%RFA>)]
VALASZ:	[$FMT(,<-CA%ASZ>)]
	[$FMT(,<-CA%OCT>)]
VALFLO:	[$FMT(,<-CA%FLO>)]

VALARY:	[$FMT(,<-CA%ASZ,:		,-CA%NUM>)]
VALASP:	[$FMT(,<-CA%ASZ,+,-CA%NOCR>)]
VALCMD:	[$FMT(,<-CA%CRLF,RMSUTL,-CA%ASZ,-CA%ASZ>)]
VALINV:	[$FMT(,<-CA%OCT,	% Invalid value in field -- octal value shown>)]
VALSAE:	[$FMT(,<	,-CA%RFA,-CA%NOCR>)]
VALSTP:	[$FMT(,<-CA%STP>)]

KEYVAL:	[ASCIZ/KEY-VALUE/]

GTROPR:	[ASCIZ/>/]
@
;
;Format strings for RMSM2						;a433
;
DABDEC:	[ASCIZ/^1/]			;Decimal number			;a433
DABOCT:	[ASCIZ/^2/]			;Octal number			;a433
DABDAT:	[ASCIZ/^D/]			;Date				;a433
DABFLO: [ASCIZ/^F/]			;Floating			;a433
DABDOU: [ASCIZ/^E/]			;Double				;a433
DABGFL: [ASCIZ/^G/]			;G-Floating			;a433
DABPAC:	[ASCIZ/^P/]			;Packed				;a433
DABLON:	[ASCIZ/^8/]			;Long integer			;a433
DABUNS: [ASCIZ/^U/]			;Unsigned Integer		;a433
HDRAREA:[ASCIZ \AREA ^1\]
HDRBUC:	[ASCIZ \BUCKET'S PAGE:	^1\]
HDRCNX: [ASCIZ \Changing ^1\] 	      ; FOR DECIMAL RFA (SEQ/REL) ;A434
HDRCHA:	[ASCIZ \Changing ^R\]
HDRDAF:	[ASCIZ \^B:^A^N\]	; : PLUS RIGHT NUM OF TABS
HDRDEL:	[ASCIZ \Deleting ^R\]
HDRENT:	[ASCIZ \ENTRY ^1  (starts at W^1)\]
HDRFIL:	[ASCIZ \FILE PARAMETERS\]
HDRIDX:	[ASCIZ \INDEX ^1\]
HDRRNX:	[ASCIZ \RECORD'S RFA:	^1\]	; Display seq/rel RFAs    ;A434
HDRREC:	[ASCIZ \RECORD'S RFA:	^R\]
HDRRRV:	[ASCIZ \RECORD'S RFA:	^R (^R)\]
HDRSAE:	[ASCIZ \RFAs:	^N\]
HDRVAL:	[ASCIZ \^A:	^N\]

DABFMT:					;FMT STATS FOR RMS FLD DAT TYPES
					;MUST BE ORD ACCORD TO DT% BLK
VALDEC:	[ASCIZ \^1\]		;ALSO NUM DATA
	[ASCIZ \^D\]
VALOCT:	[ASCIZ \^2\]		;ALSO NUM DATA
VALRFA:	[ASCIZ \^R\]
VALASZ:	[ASCIZ \^A\]
	[ASCIZ \^2\]
VALFLO:	[ASCIZ \^F\]

VALARY:	[ASCIZ \^A:		^1\]
VALASP:	[ASCIZ \^A+^N\]
VALCMD:	[ASCIZ \^LRMSUTL^A^A\]
VALINV:	[ASCIZ \^2	% Invalid value in field -- octal value shown\]
VALSAE:	[ASCIZ \	^R^N\]
VALSTP:	[ASCIZ \^S\]

KEYVAL:	[ASCIZ/KEY-VALUE/]

GTROPR:	[ASCIZ/>/]
SUBTTL	PROCESS THE CHANGE COMMAND

$SCOPE	(CHANGE)
$LREG	(CDF)				;CURR DATA FLD
$LREG	(CVAL)				;VAL BEING CHANGED TO
$LREG	(CATT)				;CURR BLK'S ATTRIBUTES FLD
$LOCALS
 $WORD	(CNVFILL)			;FILL CHAR TO USE IF CVALBP SHORTER
 $WORD	(CVALBP,2)			;STR PTR FOR DATA VAL TO CHANGE FLD TO
 $WORD	(NUMCDF)			;# OF DATFLDS BEING CHANGED
 $WORD	(NID)				;NEXT ID FOR CURR BKT
$ENDLOC

$PROC	(C.CHANGE)
;
; C.CHANGE - CHANGE FIELDS IN THE RMSFILE ENTITIES.
;	ENTITIES ARE:
;			PROLOG-DATA
;			BUCKET
;			<datafield-name>
;	FIRST CHECK IF ENVIRONMENT HSA BEEN ESTABLISHED

	$CALL	P$KEYW			;KEYWORD OPTION?
	JUMPF	CHA.DF
	CASES 	T1,MX%CHA
$CASE	(CHA%PRO)
	MOVE	T5,UTLFLG
	TXNN	T5,UT%PAT		;OPEN FOR PATCHING?
	ERRU	(NOP)
	$FLAGO	(UTLFLG,UT%PCH)		;INDIC PROL CHANGED
	$CALL	PROLCASE		;SETUP PTR TO DESIRED BLK IN PROLOG
	SETZM	CATT			;[%45] INDIC PROLOG BY NO ATTR
	JRST	CHABLP			;CHANGE 1 OR MORE ARGBLK VALS
$CASE	(CHA%BUC)
	MOVE	T5,UTLFLG
	TXNN	T5,UT%PAT		;OPEN FOR PATCHING?
	ERRU	(NOP)
	$CALL	CBKCASE			;POSITION TO SPEC LOC IN BKT
	LOAD	CATT,IR$IRA(PB)		;[%45] GET ATTR FOR LATER TEST
;	JRST	CHABLP			;CHANGE 1 OR MORE ARGBLK VALS
CHABLP:
	$P	(KEYW)			;GET FLD TO CHANGE
	JUMPN	T1,L$IFX		;JUMP IF SYSTEM FLD
		TXNE	CATT,IR$POINT	;[%45(USE CATT)] RRV?
		ERRU	(IFP)		;INV FLD FOR PTR REC
		$CALL	SY.CHK,<DA$TYP>	;PICK UP DATFLD NAME
		MOVEM	T1,RF		;SAVE PTR TO ITS DESCRIPTOR
		MOVE	T2,FAB		;GET FAB PTR
		$FETCH	T1,RFM,(T2)	;GET REC FMT TO DET HDR SIZE
		CAIE	T1,FB$FIX	;FIXED FMT?
		$SKIP1			;YES
		  MOVEI T5,SZ%IFH	;ADD IN HDR FOR FIXED
		  $FETCH T1,MRS,(T2)	;WAY TO GET LEN IN FIXED CASE
		  JRST	L$IFX(1)
		$NOSK1			;NO
		  MOVEI T5,SZ%IVH	;ADD IN HDR FOR VAR
		  LOAD T1,IR$IRS(PB)	;WAY TO GET VAR LEN
		$ENDIF(1)
		MOVEM	T1,RECLEN(CF)	;PERMANIZE IT
		ADD	T5,PB		;PT DIRECTLY TO UDR
		$CALL	CHUSVAL,<0(T5)>	;MODIFY USER FLD
		JRST	CHABLE		;CHK FOR MORE FLDS
	$ENDIF
	MOVEM	T1,RF			;SET PTR TO FLD DESCRIPTOR
	TXNN	CATT,IR$POINT		;[%45(USE CATT)] RRV?
	$SKIP				;YES, CHK THE FLD
		LOAD	T1,RF.FLAG(RF)	;GET FLAGS
		TXNN	T1,E%RRV	;FLD PART OF RRV?
		ERRU	(IFP)		;NO
	$ENDIF
	CAILE	RF,MX%SPEC		;SPECIAL CASE FLD?
	$SKIP				;YES
		$CALL	CHASPEC		;TAKE CARE OF IT
		JRST	CHABLE
	$ENDIF
	$CALL	CHABVAL			;COPY THE VALUE
CHABLE:
	$CALL	P$COMMA			;MORE FLDS TO CHANGE?
	JUMPT	CHABLP			;YES IF JUMP
	$CALLB	BK$PUT,<[1]>		;DONE, WRITE THE BKT OUT
	JRST	CHEXIT			;FORCE ALL ELSE OUT TOO
CHA.DF:
	MOVE	T5,UTLFLG		;ENVIRONMENT ESTABLISHED?
	TXNN	T5,UT%OUT		;OPEN FOR OUTPUT?
	ERRU	(NOO)
	SETZM	FNDSOM(CF)		;NO RECS CHANGED YET
	SETZM	CDF			;ARRAY 1:SZ%DRV
CDF1LP:
	ADDI	CDF,1			;PT TO NEXT ELEM
	$CALL	SY.CHK,<DA$TYP>		;READ ONE IN
	CAIG	CDF,SZ%DRV		;BEYOND END OF LIST?
	MOVEM	T2,DRV-1(CDF)		;NO,  SAVE SYMTAB ENT IN DATFLD VECTOR
	$CALL	P$NFLD			;EAT VALUE TOKEN
	CAIG	CDF,SZ%DRV		;MAKE OOB CHK AGAIN
	MOVEM	T2,VRV-1(CDF)		;STILL IN BNDS
	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	CDF1LP			;NO, DO DISPLAY WORK
	CAIG	CDF,SZ%DRV		;HAVE TO WASTE SOME?
	$SKIP				;YES
		MOVEI	CDF,SZ%DRV	;REDUCE TO SZ%DRV
		$CALLB	TX$OUT,<[UTLDAI##]>	;GIVE WARNING
	$ENDIF
	MOVNM	CDF,NUMCDF(CF)		;FOR RESETTING CDF
	MOVE	T2,RAB			;GET RAB PTR
	$FETCH	PB,UBF,(T2)		;GET ADDR OF $GET BUFFER

	$CALL	US.REC			;PARSE RECORD-RANGE
CDF2LP:					;DISPLAY EACH RECORD
	HRLZ	CDF,NUMCDF(CF)		;SETUP AOBJ FOR GOING THRU DRV
	$CALL	US.NEXT			;SEE IF MORE TO PROCESS
	JUMPF	CDEXIT			;ALL DONE
	MOVE	T2,FAB			;[A434] PRINT RFA BY ORGANIZATION
	$FETCH	T2,ORG,(T2)		;[A434] ...
	CAIN	T2,FB$IDX		;[A434] ...
	 JRST	CDF2L2			;[A434] 
	TT$OUT	(HDRCNX,T1)		;[A434] PRINT DECIMAL RFA
	JRST	CDF2L3			;[A434]
CDF2L2:	TT$OUT	(HDRCHA,T1)		;[A434] PRINT INDEXED RFA
CDF2L3:	SETOM	FNDSOM(CF)		;[A434] SOMETHING BEING CHANGED
CDF2IN:
	MOVE	T2,DRV(CDF)		;GET PTR TO DESC OF FIELD TO DISPLAY
	MOVE	RF,DD.VAL(T2)		;GO FROM SYMTAB TO FLD DESCRIPTOR
	MOVE	T1,VRV(CDF)		;GET PTR INTO PDB ARRAY
	$CALL	P$SETU			;SET CURR POS TO THAT
	MOVE	T2,RAB			;GET PTR TO RAB
	$FETCH	T1,RSZ,(T2)		;GET REC LEN
	MOVEM	T1,RECLEN(CF)		;PERMANIZE IT
	$CALL	CHUSVAL,<0(PB)>		;NOW EAT & STORE THE VALUE
	AOBJN	CDF,CDF2IN		;PROC EACH FLD
	$UPDATE	@RAB			;PROCESS THE CHANGE
	$CHKERR	(?UTLUCR unable to change record,CDF2LP)
	JRST	CDF2LP
CDEXIT:
	SKIPL	FNDSOM(CF)		;ANY RECS WITHIN?
	ERRU	(NRW)			;NO

CHEXIT:
	$FLUSH	@RAB			;INSURE RMS FILE UPTODATE
	$CHKERR	(?UTLUCP unable to checkpoint file)
	RETT
$ENDPROC
SUBTTL	ROUTINES FOR PUTTING (CHANGED) VALUES AWAY

$UTIL	(CBKCASE)
;
; CBKCASE - LOCATE THE OBJECT BEING CHANGED
;
	$P	(KEYW)			;GET LOC IDENTIFIED
	CASES	T1,MX%CHG
$CASE	(CHG%HEA)
	$CALLB	BK$GET,<CU.BKT>		;LOCATE HDR TO PROC
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,PB			;PERMANIZE HDR PTR
	RETURN
$CASE	(CHG%ENT)
	$CALLB	BK$GOK,<CU.BKT>		;LOCATE BKT & INSURE HDR NOT CLOB
	JUMPLE	T1,L$UNW		;OOPS
	$COPY	NID(CF),IB$NID(T1)	;SAVE NID FOR IN-BNDS CHK
	$P	(NUM)			;PICK UP ENT NUM
	$CALLB	BK$ENT,<T1>		;LOCATE SPEC ENT
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(SEN)
	MOVEM	T1,PB			;PT TO IDENTIFIED ENTRY
	RETURN
$CASE	(CHG%ID)
	$CALLB	BK$GOK,<CU.BKT>		;LOCATE BKT & INSURE HDR NOT CLOB
	JUMPLE	T1,L$UNW		;OOPS
	$COPY	NID(CF),IB$NID(T1)	;SAVE NID FOR IN-BNDS CHK
	$P	(NUM)			;PICK UP ENT NUM
	$CALLB	BK$ID,<T1>		;LOCATE SPEC ENT
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(SIN)
	MOVEM	T1,PB			;PT TO IDENTIFIED ENTRY
	RETURN
$ENDUTIL
$UTIL	(CHABVAL)
;
; CHABVAL - PARSE VAL & CHANGE FLD IDENT BY RF AND PB TO THAT VAL
;
	SETZM	CVAL			;START WITH CLEAN SLATE
	LOAD	T1,RF.TYP(RF)		;SEE WHAT KIND OF VALUE FOLLOWS
	CASES	T1,MX%DT		;DISPATCH OFF IT
$CASE	(DT%DEC)			;DECIMAL VALUE
$CASE	(DT%OCT)			;OCTAL VALUE
	$CALL	P$NFLD			;PICK VALUE AND STORE VERBATIM
	MOVE	CVAL,TK.VAL(T2)		;GET THE PARSED VAL
	LOAD	T1,RF.FLAG(RF)		;GET FLD'S FLAGS
	TXNN	T1,E%ID			;ID FLD?
	$SKIP				;YES
		CAML	CVAL,NID(CF)	;IN RANGE?
		ERRU	(IVF)		;NO
	$ENDIF
	LOAD	T1,RF.FLAG(RF)		;GET FLD'S FLAGS
	TXNN	T1,E%BKT		;BKT #?
	$SKIP				;YES
		$CALLB	BK$CHK,<CVAL>	;LOCATE BKT & INSURE HDR NOT CLOB
		JUMPLE	T1,L$UNW	;OOPS
	$ENDIF
	DPB	CVAL,RF.BP(RF)		;PUT IT AWAY
	RETURN
$CASE	(DT%RFA)			;EAT RFA
	$CALL	CP.RFA			;GET RFA FROM CMD LINE
	DPB	T1,RF.BP(RF)		;PUT IT AWAY
	RETURN
$CASE	(DT%SYV)			;SYMBOLIC VALUE
$CASE	(DT%SYB)			;SYMBOLIC BITS
	$P	(KEYW)			;GET SYM VALUE SPECIFIED
	IOR	CVAL,T1			;MERGE IN VALUE
	$CALL	P$TOK			;CHK FOR PLUS
	JUMPT	L$IFX			;NO PLUS? THEN END OF SWITCH
	  DPB	CVAL,RF.BP(RF)		;STORE AWAY ACCUM VAL
	  RETURN			;CHK FOR EOL
	$ENDIF
	JRST	L$CASE(DT%SYB)		;GET NEXT VALUE
$CASF
	ERRU	(IUE)			;INTERNAL ERROR
$ENDUTIL

$UTIL	(CHASPEC)
;
; CHASPEC - CHANGE A SPECIAL RMS FIELD (VARIABLE IN SOME WAY)
;
	CASES	RF,MX%SPEC
$CASE	(SP%RFA)			;RFA ARRAY ELEMENT
	$P	(NUM)			;PICK UP ARR ELEM
	MOVEI	RF,SZ%ISH-1(T1)		;START WITH SIDR HDR + ARR ELEM SUBSCR
	ADD	RF,KSIZW		;ADD IN KEY SIZE IN WORDS
	ADD	RF,PB			;CONV FROM OFFSET TO ADDR
	LOAD	T1,IR$SRS(PB)		;GET SIZE OF SIDR
	ADDI	T1,SZ%ISH(PB)		;PT TO 1 WD PAST END
	CAMG	T1,RF			;IS RFA N IN BNDS?
	ERRU	(STL)			;NO
SPECRFV:
	$CALL	P$KEYW			;CHK FOR NIL
	SETZM	T1			;PRESUME "NIL"
	SKIPT				;WAS NIL SPEC?
	$CALL	CP.RFA			;NO, GET RFA VAL
	MOVEM	T1,0(RF)		;PUT IT AWAY
	RETURN
$CASE	(SP%POS)			;KDB SEG POSITIONS
	MOVEI	RF,E.POSI##		;GET DESC FOR POS FLD
	JRST	SPECSEG
$CASE	(SP%SIZ)			;DITTO SIZE
	MOVEI	RF,E.SIZE##		;GET DESC FOR SIZE FLD
SPECSEG:
	$P	(NUM)			;GET ARRAY ELEM
	CAILE	T1,8			;VALID SEG #?
	ERRU	(STL)			;NO, SUBSCR TOO LARG
	SUBI	T1,1			;ADJ SUBSCR TO 0 TO 7
	IMULI	T1,SZ%RF		;GET OFFSET TO DESCR FOR SPEC ARR ELEM
	ADD	RF,T1			;CONV DESC OFFS TO ADDR
	$P	(NUM)			;PICK UP NEW VALUE
	DPB	T1,RF.BP(RF)		;PUT IT AWAY
	RETURN
$CASE	(SP%SKV)			;SIDR KEY VALUE
	MOVEI	T1,SZ%ISH(PB)		;PT TO KEYVAL IN SIDR
	JRST	SPECKV			;REST OF KEYVAL STUFF LOC INDEP
$CASE	(SP%IKV)			;IDX ENTRY KEY VALUE
	MOVEI	T1,SZ%IXH(PB)		;PT TO KEYVAL IN IDX ENT
SPECKV:
	HLL	T1,STRIPT		;SET UP BP INFO
	MOVE	T2,KSIZB		;GET KEY SIZE
	DMOVEM	T1,DVALPT(CF)		;SAVE IN-REC STR PTR TO FLD BEING CHGED
	MOVEI	T1,21			;KLUDGE UP REF TO .CMQST
	$P	(STR)			;EAT IT
	DMOVEM	T1,CVALBP(CF)
	$CALL	CP.STR,<CVALBP(CF),DVALPT(CF),@STCAIN,STFILL>
	RETURN
$CASF
	ERRU	(IUE)			;OOPS
$ENDUTIL
$UTIL	(CHUSVAL,<RECVAL>)
;
; CHUSVAL - PARSE USER DATA VALUE & CHANGE SPECIFIED DATFLD
; ARGUMENTS:
;	RECVAL = THE USER REC TO CHANGE
; NOTES:
;	RF PTS TO DESCRIPTOR OF FLD BEING CHANGED
	MOVEI	T2,@RECVAL(AP)		;MATER PTR TO UDR
	MOVE	T3,RECLEN(CF)		;GET SIZE OF REC
	HRRM	T2,STRIPT		;MAKE BP
	ADJBP	T3,STRIPT		;COMPUTE LAST WD OF REC
	HRRZM	T3,RECEND(CF)		;ISOLATE IT
	LOAD	T1,UF.TYP(RF)		;GET DAT TYPE BEING EATEN
	CASES	T1,MX%DFT		;DISPATCH
$CASE	(DFT%DEC)			;DECIMAL NUMBER
$CASE	(DFT%OCT)			;OCTAL NUMBER
	LOAD	T4,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T4,T2			;POINT TO FIELD
	MOVEM	T4,DVALPT(CF)		;SAVE POINTER

	$P	(NUM)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	MOVE	T4,DVALPT(CF)
	MOVEM	T1,(T4)			;STORE RESULT
	RETURN
$CASE	(DFT%DOU)							;A433
	LOAD	T1,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T1,T2			;POINT TO FIELD
	MOVEM	T1,DVALPT(CF)		;SAVE POINTER

	$P	(FLD)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	HRLI	T1,10700		;MAKE BYTE POINTER TO 2ND WORD OF BLK

	PUSH	P,T1			;ASCII BYTE PTR
	PUSH	P,DVALPT(CF)		;DEST ADDR
	PUSHJ	P,CVTZD##		;MAKE D-FLOATING
	ADJSP	P,-2			;FLUSH ARGS
	JUMPE	T1,[ERRU (DXP)]		;DID IT FIT? ERROR IF NOT
	RETURN
$CASE	(DFT%FLO)			;FLOATING NUMBER		;A433
	LOAD	T3,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T3,T2			;POINT TO FIELD
	MOVEM	T3,DVALPT(CF)		;SAVE POINTER

	$P	(FLOT)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	MOVE	T3,DVALPT(CF)		;
	MOVEM	T1,(T3)			;STORE RESULT
	RETURN
$CASE	(DFT%GFL)
	LOAD	T1,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T1,T2			;POINT TO FIELD
	MOVEM	T1,DVALPT(CF)		;SAVE POINTER

	$P	(FLD)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	HRLI	T1,10700		;MAKE BYTE POINTER TO 2ND WORD OF BLK

	PUSH	P,T1			;ASCII BYTE PTR
	PUSH	P,DVALPT(CF)		;DEST ADDR
	PUSHJ	P,CVTZG##		;MAKE G-FLOATING
	ADJSP	P,-2			;FLUSH ARGS
	JUMPE	T1,[ERRU (DXP)]		;DID IT FIT? ERROR IF NOT
	RETURN
$CASE	(DFT%LON)
	LOAD	T1,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T1,T2			;POINT TO FIELD
	MOVEM	T1,DVALPT(CF)		;SAVE POINTER

	$P	(FLD)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	HRLI	T1,10700		;MAKE BYTE POINTER TO 2ND WORD OF BLK

	PUSH	P,T1			;ASCII BYTE PTR
	PUSH	P,DVALPT(CF)		;DEST ADDR
	PUSHJ	P,CVTZL##		;MAKE DOUBLE INTEGER
	ADJSP	P,-2			;FLUSH ARGS
	JUMPE	T1,[ERRU (DXP)]		;DID IT FIT? ERROR IF NOT
	RETURN
$CASE	(DFT%UNS)							;A433
	LOAD	T1,UF.POS(RF)		;GET WORD TO POSITION TO
	ADD	T1,T2			;POINT TO FIELD
	MOVEM	T1,DVALPT(CF)		;SAVE POINTER

	$P	(FLD)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	HRLI	T1,10700		;MAKE BYTE POINTER TO 2ND WORD OF BLK

	PUSH	P,T1			;ASCII BYTE PTR
	PUSH	P,DVALPT(CF)		;DEST ADDR
	PUSHJ	P,CVTZU##		;MAKE UNSIGNED INTEGER
	ADJSP	P,-2			;FLUSH ARGS
	JUMPE	T1,[ERRU (DXP)]		;DID IT FIT? ERROR IF NOT
	RETURN
$CASE	(DFT%FIL)			;FILE BYTES
	HLL	T2,STRIPT		;GET FILE-BYTE INFO
	MOVE	T3,STCAIN		;GET TABLE PTR
	MOVE	T4,STFILL		;GET PRESET FILL CHAR
	JRST	CHUSTR			;COMPUTE ADDR
$CASE	(DFT%AS)			;ASCII DATA
	HRLI	T2,440700		;ASCII BYTES
	SETZM	T3			;NO TABLE FOR ASCII
	MOVEI	T4,40			;ASCII BLANK
	JRST	CHUSTR			;STRING MERGE
$CASE	(DFT%SIX)			;SIXBIT DATA
	HRLI	T2,440600		;SIXBIT BYTES
	MOVEI	T3,A.TO.S		;CONV FROM ASCII
	MOVEI	T4,0			;SIXBIT BLANK
	JRST	CHUSTR			;STRING MERGE
$CASE	(DFT%EBC)			;EBCDIC DATA
	HRLI	T2,441100		;EBCDIC BYTES
	MOVEI	T3,A.TO.E		;CONV FROM ASCII
	MOVEI	T4,100			;EBCDIC BLANK
	JRST	CHUSTR			;STRING MERGE
$CASE	(DFT%PAC)			;PACKED DECIMAL			  ;A433
	HRLI	T2,441100		;9-BIT BYTES (WITH 2 NIBBLES PER)
	LOAD	T1,UF.POS(RF)		;GET BYTE TO POSITION TO
	ADJBP	T1,T2			;POINT TO FIELD
	MOVEM	T1,DVALPT(CF)		;SAVE POINTER

	$P	(FLD)			;EAT IT
	;THIS RETURNS THE ADDRESS OF A PARSE BLOCK
	;THE ATOM PARSED BEGINS IN THE SECOND WORD OF THE BLOCK
	HRLI	T1,10700		;MAKE BYTE POINTER TO 2ND WORD OF BLK

	PUSH	P,T1			;ASCII BYTE PTR
	PUSH	P,DVALPT(CF)		;DEST BYTE PTR
	LOAD	T2,UF.SIZ(RF)		;FIELD LEN
	PUSH	P,T2			;
	PUSHJ	P,CVTZP##		;MAKE PACKED DECIMAL
	ADJSP	P,-3			;FLUSH ARGS
	JUMPE	T1,[ERRU (DXP)]		;DID IT FIT? ERROR IF NOT
	RETURN

CHUSTR:
	DMOVEM	T3,CNVTAB(CF)		;PREP TO PASS CNV TAB & FILL CH
	LOAD	T1,UF.POS(RF)		;SELECT BYTE TO POSIT TO
	ADJBP	T1,T2			;POSIT TO RIGHT BYTE
	MOVEM	T1,DVALPT(CF)		;SAVE IN-REC STR PTR TO FLD BEING CHGED
	$CALL	FITCHK			;DOES FLD FIT?
	MOVEM	T1,DVALPT+1(CF)		;RET LEN (POSSIB TRUNC)
	MOVEI	T1,21			;KLUDGE UP REF TO .CMQST
	$P	(STR)			;EAT IT
	DMOVEM	T1,CVALBP(CF)
	$CALL	CP.STR,<CVALBP(CF),DVALPT(CF),@CNVTAB(CF),CNVFILL(CF)>
					;COPY STRING INTO REC
	RETURN
$ENDUTIL
$ENDSCOPE(CHANGE)
SUBTTL	PROCESS DELETE COMMAND

$PROC	(C.DELETE)
;
; C.DELETE - DELETE ENTRIES IN A BUCKET
;	     DELETE RECORDS
; SYNTAX:
;	DELETE (what is identified by) BUCKET (AND) ENTRY n1!ID n2
;	DELETE (what is identified by) RECORD (AND) records-to-use

	$P	(KEYW)		;BUCKET OR RECORD?
	CASES	T1,MX%DEL
$CASE	(DEL%BUC)		;** DELETE BUCKET
	MOVE	T5,UTLFLG
	TXNN	T5,UT%PAT		;OPEN FOR PATCHING?
	ERRU	(NOP)
	$CALLB	BK$GOK,<CU.BKT>	;READ IN CURRENT BKT
	JUMPLE	T1,L$UNW	;ERROR
	MOVEM	T1,PB		;SAVE RETURNED ADDR
	SETZM	CU.ID		;LAST-ENTRY CANT BE DELETED
	$CALL	DELBOP		;PROCESS BUCKET SUB-OPTIONS
	$CALLB	BK$PUT,<[1]>	;UPDATE BUCKET
	RETT

$CASE	(DEL%REC)		;** DELETE RECORD
	MOVE	T5,UTLFLG	;ENVIRONMENT ESTABLISHED?
	TXNN	T5,UT%OUT	;OPEN FOR OUTPUT?
	ERRU	(NOO)
	SETZM	FNDSOM(CF)		;INDIC NO RECS DEL YET
	$CALL	US.REC
DELREC:
	$CALL	US.NEXT			;$GET RECORD THAT SATISFIES CRITERIA
	JUMPF	L$IFX
		TT$OUT	(HDRDEL,T1)	;INDIC REC BEING PROCESSED
		SETOM	FNDSOM(CF)	;INDIC RANGE NOT NULL
		$DELETE	@RAB		;$DELETE IT.
		$CHKERR	(?UTLUDR unable to delete record,DELREC)
		JRST	DELREC
	$ENDIF
	SKIPL	FNDSOM(CF)		;ANY RECS FND?
	ERRU	(NRW)			;NO
	$FLUSH	@RAB			;INSURE RMS FILE UPTODATE
	$CHKERR	(?UTLUCP unable to checkpoint file)
	RETT
$ENDPROC
SUBTTL	ROUTINES FOR DELETE BUCKET ENTRIES

$UTIL	(DELBOP)
;
; PARSE THE "ENTRY n1! ID n2" PART OF THE COMMAND 
; AND PROCESS IT.
;
;	ON ENTRY PB CONTAINS ADDR OF BUCKET

	$P	(KEYW)		;ENTRY OR ID?
	CASES	T1,MX%DLT

$CASE	(DLT%ENT)
DELENT:
	$CALL	P$NUM		;GET ENTRY NUMBER
	MOVEM	T1,ENTNUM
	$CALLB	BK$ENT,<ENTNUM>	;GET ENTRY ADDR.
	JUMPL	T1,L$UNW	;T1 HAS ADDR OF ENTRY	
	JUMPG	T1,L$JUMP
		$CALLB	TX$OUT,<ENTNUM,[UTLENB##]>
		JRST	L$IFX
	$JUMP
		$CALLB BK$DENT,<CU.BKT,PB,T1>
	$ENDIF
;	$CALL	P$COMMA		;MORE ENTRIES?
;	JUMPT	DELENT		
	RETURN

$CASE	(DLT%ID)
DELID:
	$CALL	P$NUM			;GET ID NUMBER
	MOVEM	T1,ENTNUM
	$CALLB	BK$ID,<ENTNUM>		;GET ADDR OF ENTRY HAVING THE GIVEN ID
	JUMPL	T1,L$UNW
	JUMPG	T1,L$JUMP
		$CALLB	TX$OUT,<ENTNUM,[[0]],[UTLINB##]>
					;[[0]] TO SUPPRESS RANGE PHRASE
		JRST	L$IFX
	$JUMP
		$CALLB	BK$DENT,<CU.BKT,PB,T1>	;GO DELETE IT & RECLAIM SPACE
	$ENDIF
;	$CALL	P$COMMA
;	JUMPT	DELID
	RETURN
$ENDUTIL
SUBTTL	PROCESS DISPLAY COMMAND

$SCOPE	(DISPLAY)
$LREG	(CDF)				;CURR VAL/FLD TO DISPLAY (AOBJ PTR USU)
$LREG	(VAL)				;FLD VALUE
$LOCALS
 $WORD	(BKTADR)			;ADDR OF CURR BKT
 $WORD	(ERRPT)				;PTR TO $FMT FOR DI BK E/I
 $WORD	(NUMDDF)			;COUNT OF DATFLDS IN DISPLAY LIST
 $WORD	(RANGERR)			;PTR TO ASCIZ RANGE ERR PHRASE
 $WORD	(RANGOK)			;TRUE IF RANGE HAS VALID START BND
 $WORD	(SUB)				;ADDR OF "ENTRY" SUBR TO USE
$ENDLOC

$PROC	(C.DISPLAY)
;
; C.DISPLAY - DISPLAY FIELDS IN THE RMS FILE ENTITIES.
;
; SYNTAX:
;
;	DISPLAY (VALUE OF) PROLOG-DATA (FOR) FILE fld-list!AREA n1!KEY n2 fld-list
;	DISPLAY (VALUE OF) BUCKET (FOR) ENTRY n-list!ID  n-list!HEADER
;	DISPLAY (VALUE OF) DATA (OF RECORDS IDENTIFIED BY) records-to-use
;	DISPLAY (VALUE OF) datafield-list (OF RECORDS IDENTIFIED BY) records-to-use
;
; END OF SYNTAX
;
;

	MOVE	T5,UTLFLG
	TXNN	T5,UT%FOP		;RMS FILE OPENED?
	ERRU	(FNO)			;NO. ERROR
	TXNN	T5,UT%RFO		;EXPLICT RPT FILE?
	$SKIP				;YES, OUTPUT CMD TEXT
		RP$OUT(VALCMD,<GTROPR,PDBPAG##>)
	$ENDIF
	SETZM	FNDSOM(CF)		;INIT TO NOTH DISP YET

	$CALL	P$KEYW			;GET TOKEN FOR TYPE OF DISPLAY
	JUMPF	DISDF			;NOT A TOKEN. MUST BE DATAFIELD NAME
	CASES	T1,MX%DSP

$CASE	(dsp%BUC)			;** DISPLAY BUCKET
	MOVE	T2,FAB			;CHECK IF OPERATION IS LEGAL.
	$FETCH	(T1,ORG,(T2))
	CAIE	T1,FB$IDX
	ERRU	(IOF)			;NO, NOT IDX FILE

	$EH				;TRAP ERRS AT THIS LEVEL
	$CALL	P$CFM			;DISP ENTIRE BKT?
	JUMPF	L$IFX
		$CALL	DIBHDR		;START WITH HDR
		SETOM	FNDSOM(CF)	;INDIC HDR OUTPUT
		$CALL	DIBEALL		;DISPLAY ENTRIES
		JRST	DISDON		;DONE
	$ENDIF
	$CALL	DBKCASE			;DO CASE STAT FOR BKT OPTION
	JRST	DISDON

$CASE	(DSP%PRO)			;** DISPLAY FILE PROLOG
	$CALL	P$CFM			;EOL SAYS DISP ENTIRE PROL
	JUMPF	L$IFX
		$CALL	DIPFIL		;DISP ENTIRE FILE-LEVEL PROLOG
		MOVE	T2,FAB		;CHK HOW MUCH IN PROL
		$FETCH	T1,ORG,(T2)
		CAIE	T1,FB$IDX
		JRST	DISDON		;NOT IDX FILE
		$CALL	DIPAALL		;DISP AREAS
		$CALL	DIPKALL		;DISP KEYS
		JRST	DISDON
	$ENDIF
	$CALL	DPRCASE			;DO CASE STAT FOR PROLOG OPTION
	JRST	DISDON

$CASE	(DSP%DAT)			;** DISPLAY RECORD DATA
	MOVE	PB,RAB			;SET CURR BLK
	$CALL	US.REC			;PARSE records-to-use CLAUSE
					;(IF NOT THERE SAYS RANGE TO CURR REC)
DRECLP:						;DISPLAY ENTIRE RECS
	$CALL	DDANXT			;DISP HDR FOR NEXT REC
	JUMPF	DISREX			;ALL DONE
	$FETCH	T1,UBF,(PB)		;GET REC LOCATION
	$FETCH	T2,RSZ,(PB)		;GET REC SIZE (IN BYTES)
	MOVE	T3,BYTYPE		;[455] GET DATATYPE
	HRRM	T1,STRIPT		;SET ADDR OF REC
	MOVEM	T2,STRIPT+1		;SET LEN
	MOVEM	T3,STRIPT+2		;[455] STORE DATATYPE
	RP$OUT	(HDRVAL,[[ASCIZ/DATA-IN-RECORD/]])
	RP$OUT	(VALSTP,<[STRIPT]>)	;[455] TYPE VALUE OUT
	JRST	DRECLP
DISDF:					;Display Datafield-names
;
; DATFLD DISPLAY HAPPENS IN TWO STEPS DDF1LP COPIES EACH FLD DESC TO DRV
; DDF2LP USES US.NEXT TO SCAN THE REC RANGE AND DISPLAY THE DESIRED VALS/REC

	MOVE	PB,RAB			;SETUP CURR ARGBLK
	SETZM	CDF			;ARRAY 1:SZ%DRV
DDF1LP:
	ADDI	CDF,1			;PT TO NEXT ELEM
	$CALL	SY.CHK,<DA$TYP>		;READ ONE IN
	CAIG	CDF,SZ%DRV			;BEYOND END OF LIST?
	MOVEM	T2,DRV-1(CDF)		;NO,  SAVE SYMTAB ENT IN DATFLD VECTOR
	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	DDF1LP			;NO, DO DISPLAY WORK
	CAIG	CDF,SZ%DRV		;HAVE TO WASTE SOME?
	$SKIP				;YES
		MOVEI	CDF,SZ%DRV	;REDUCE TO SZ%DRV
		$CALLB	TX$OUT,<[UTLDAI##]>	;GIVE WARNING
	$ENDIF
	MOVNM	CDF,NUMDDF(CF)		;FOR RESETTING CDF

	$CALL	US.REC			;PARSE RECORD-RANGE
DDF2LP:					;DISPLAY EACH RECORD
	HRLZ	CDF,NUMDDF(CF)		;SETUP AOBJ FOR GOING THRU DRV
	$CALL	DDANXT			;DISP HDR FOR NEXT REC
	JUMPF	DISREX			;ALL DONE
DDF2IN:
	MOVE	T5,DRV(CDF)		;GET PTR TO DESC OF FIELD TO DISPLAY
	MOVE	RF,DD.VAL(T5)		;GO FROM SYMTAB TO FLD DESCRIPTOR
	$CALL	SY.WID,<DD.NAM(T5),[16]>;SETUP STRING PTR WITH MAX LEN OF 14
	;
	; T1 now holds a 7-bit pointer to the symbol.
	; T2 contains the symbol length.
	; T3 points to an ASCIZ string of <TAB>s to fill properly.
	;
	RP$OUT	(HDRDAF,<T1,T2,T3>)	;[455] OUTPUT FLD NAME
	$CALL	DDAVAL			;DISPLAY DATA VALUE
	AOBJN	CDF,DDF2IN		;PROC EACH FLD
	JRST	DDF2LP

DISREX:
	SKIPL	FNDSOM(CF)		;ANY RECS WITHIN?
	ERRU	(NRW)			;NO
DISDON:					; COMMON EXIT !!!
	$CALL	RP$PUT			;EMPTY RPT BUFFER
	$FLUSH	@OUTRAB			;INSURE REPORT FILE UPTODATE
	$CHKERR	(?UTLUCP unable to checkpoint file)
	RETT
$ENDPROC
SUBTTL	ROUTINES FOR DISPLAY-PROLOG

$UTIL	(DPRCASE)
;
; DPRCASE - PARSE THE OPT-DEP PART OF DISP PROL & DO DISPLAY
;
	$CALL	PROLCASE	;PARSE PROLOG LOC & SET PTR TO IT
	CASES	T1,MX%DS
$CASE	(DS%ARE)		;** DISPLAY AREA DESCRIPTOR
	MOVEI	RF,ARETAB		;SETUP FIELD TABLE
	RP$OUT	(HDRAREA,ENTNUM)	;OUTPUT HDR
	JRST	DPRGO			;DO REAL WORK
$CASE	(DS%KEY)			;** DISPLAY KEY DESCRIPTOR 
	MOVEI	RF,INDTAB		;APPR.FIELD TABLE
	RP$OUT	(HDRIDX,ENTNUM)		;OUTPUT HDR
	JRST	DPRGO			;DO REAL WORK
$CASE	(DS%FIL)			;** DISPLAY  FILE DESCRIPTOR
	MOVEI	RF,FPGTAB		;APPR.FIELD TABLE
	RP$OUT	(HDRFIL)		;OUTPUT HDR
DPRGO:					;DO ACTU WORK
	$CALL	P$CFM			;DF LIST?
	JUMPF	L$IFX			;YES, IF JUMP
		$CALL	DABALL
		RETURN
	$ENDIF
	$CALL	DABLST			;GO DISPLAY INDIVIDUAL FIELDS
	RETURN
$ENDUTIL
$UTIL	(DIPAALL)
;
; DIPAALL - DISPLAY ALL AREA BLKS IN PROLOG
;
	SETZM	ENTNUM			;START WITH AREA 0
DPAALP:
	$CALLB	BK$ADB,<ENTNUM>		;LOOK FOR THIS AREA
	JUMPL	T1,L$UNW
	JUMPE	T1,L$RET		;EXIT IF SEEN ALL AREAS
	MOVEM	T1,PB			;PERMANIZE PTR TO DATA TO DISP
	RP$CRLF				;PRECEDE WITH BLANK LINE
	RP$OUT	(HDRAREA,ENTNUM)	;OUTPUT HDR
	MOVEI	RF,ARETAB		;SETUP FLD TABLE
	$CALL	DABALL			;DISPLAY THE FLDS
	AOS	ENTNUM			;MOVE TO NEXT 1
	JRST	DPAALP			; & GIVE IT A TRY
$ENDUTIL

$UTIL	(DIPFIL)
;
; DIPFIL - DISPLAY ALL FILE-LEVEL FLDS IN PROLOG
;
	$CALLB	BK$PROL			;GET PTR TO DESIRED IDB
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,PB			;PTR TO REQUESTED IDB
	MOVEI	RF,FPGTAB		;APPR.FIELD TABLE
	RP$OUT	(HDRFIL)		;OUTPUT HDR
	$CALL	DABALL			;DO ACTU DISPLAYS
	RETURN
$ENDUTIL

$UTIL	(DIPKALL)
;
; DIPKALL - DISPLAY ALL KEY BLKS IN PROLOG
;
	SETZM	ENTNUM			;START WITH AREA 0
DPKALP:
	$CALLB	BK$IDB,<ENTNUM>		;LOOK FOR THIS KEY
	JUMPL	T1,L$UNW
	JUMPE	T1,L$RET		;EXIT IF SEEN ALL KEYS
	MOVEM	T1,PB			;PERMANIZE PTR TO DATA TO DISP
	RP$CRLF				;PRECEDE WITH BLANK LINE
	RP$OUT	(HDRIDX,ENTNUM)		;OUTPUT HDR
	MOVEI	RF,INDTAB		;SETUP FLD TABLE
	$CALL	DABALL			;DISPLAY THE FLDS
	AOS	ENTNUM			;MOVE TO NEXT 1
	JRST	DPKALP			; & GIVE IT A TRY
$ENDUTIL
SUBTTL	ROUTINES FOR DISPLAY-BKT

$UTIL	(DBKCASE)
;
; DBKCASE - PARSE THE OPT-DEP PART OF DISP BKT & DO DISPLAY
;
	$P	(KEYW)			;GET OPTION KEYWORD
	CASES	T1,MX%DIS
$CASE	(DIS%KEY)
	SETZM	ENTNUM			;PREP TO LOOP THRU BKT'S ENTRIES
	$COPY	DVALPT+1(CF),KSIZB	;SET LEN OF BKT STRING
	$COPY	DVALPT(CF),STRIPT	;GET BP INFO
	$CALL	CP.TOK,<BUF$K1>		;INTERNALIZE STRING IN STRIPT/BUF$K1
	JUMPF	L$ERRU(ISC)		;ILLEG SYNTAX
	$CALLB	BK$GOK,<CU.BKT>		;READ IN CURR BKT
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,BKTADR(CF)		;TO DISPLAY (STARTS AT Wn)
DBKKLP:
	AOS	ENTNUM			;GET NEXT ENTRY
	$CALLB	BK$ENT,<ENTNUM>		;GET NEXT ENTRY
	JUMPL	T1,L$UNW		;OOPS
	JUMPE	T1,L$ERRU(SEN)		;GIVE ERR IF SEARCHED ENTIRE BKT
	MOVEM	T1,PB			;SAVE PTR TO ENTRY
	$CALLB	M$KLOC,<[BUF$K2],T1,CU$TYPE>
					;LOCATE (& COPY IF NECES) ITS KEY STRING
	JUMPLE	T1,L$UNW		;OOPS
	HRRM	T1,DVALPT(CF)		;PUT AWAY ADDR OF KEY STRING
	$CALL	CM.OPR,<STRIPT,DVALPT(CF),@GTROPR>
					;SEE IF CMD KEY STILL GTR BKT ENT?
	JUMPT	DBKKLP			;JUMP IF YES
	$CALL	DIBENT			;NO, PUT IT OUT
	RETURN
$CASE	(DIS%LAST)
	SETZM	ENTNUM			;PREP TO LOOP THRU BKT'S ENTRIES
	$CALLB	BK$GOK,<CU.BKT>		;READ IN CURR BKT
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,BKTADR(CF)		;TO DISPLAY (STARTS AT Wn)
DBKLLP:
	AOS	ENTNUM			;GET NEXT ENTRY
	$CALLB	BK$ENT,<ENTNUM>		;GET NEXT ENTRY
	JUMPL	T1,L$UNW		;OOPS
	JUMPG	T1,DBKLLP			;JUMP IF END NOT FND YET
	SOSG	ENTNUM			;GET BACK TO LAST ENTRY
	ERRU	(SEN)			;CANT, EMPTY BKT
	$CALLB	BK$ENT,<ENTNUM>		;GET LAST ENTRY BACK
	JUMPLE	T1,L$ERRU(IUE)		;SHOULDNT HAPPEN
	MOVEM	T1,PB			;SAVE PTR TO ENTRY
	$CALL	DIBENT			;NO, PUT IT OUT
	RETURN
$CASE	(DIS%HEA)			;DISPLAY HDR
	$CALL	DIBHDR			;DISPLAY HDR
	RETURN
$CASE	(DIS%ENT)			;ENTRY NUM LIST
	MOVEI	T1,BK$ENT##		;CALL INDIRECT
	MOVEI	T2,UTLENB##		;PTR TO ERR MSG
	JRST	DBKENT
$CASE	(DIS%ID)			;PROCESS ID NUM LIST
	MOVEI	T1,BK$ID##		;CALL INDIRECT
	MOVEI	T2,UTLINB##		;PTR TO ERR MSG
DBKENT:
	MOVEM	T1,SUB(CF)		;SAVE ROUTINE ADDR TO CALL
	MOVEM	T2,ERRPT(CF)		;SAVE IT
	$CALLB	BK$GOK,<CU.BKT>		;READ IN CURR BKT
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,BKTADR(CF)		;SAVE BKT ADDR TO COMPUTE ENTRY OFFSETS
DBKELP:
	$P	(NUM)			;PICK UP NEXT ENT NUM
	MOVEM	T1,ENTNUM		;SAVE IT
	MOVEM	T1,RANGOK(CF)		;KEEP AROUND UNTIL RANGE SHOWN OK
	$CALL	P$NUM			;LOOK FOR UPPPER BND
	MOVEI	T2,[ASCIZ/'s range/]	;PRESUME THERE IS
	JUMPT	L$IFX			;JUMP IF THERE IS
		MOVE	T1,ENTNUM	;NO, USE LOWER BND AS UPPER BND
		MOVEI	T2,[0]		;NO RANGE PHRASE
	$ENDIF
	MOVEM	T1,ENTLIM		;PERMANIZE UPPER BND
	MOVEM	T2,RANGERR(CF)		;PERMANIZE PTR TO RANGE ERR TEXT
DBKELI:
	$CALLB	@SUB(CF),<ENTNUM>,1	;FIND IT IN CURR BKT
	JUMPL	T1,L$UNW		;EXIT IF MSG ALR OUTPUT
	JUMPE	T1,L$IFX		;BAD ENTRY IF JUMP
		MOVEM	T1,PB		;PT AT THE ENTRY
		$CALL	DIBENT		;DISP ENTRY REGARDLESS OF BKT TYPE
		SETOM	RANGOK(CF)	;AT LEAST ONE VALID ENTRY SEEN IN RANGE
	$ENDIF
	AOS	T1,ENTNUM		;MOVE TO NEXT ELEM
	CAMG	T1,ENTLIM		;EXHAUSTED RANGE?
	JRST	DBKELI			;NO, STAY IN INNER LOOP
	SKIPGE	RANGOK(CF)		;EMPTY RANGE?
	$SKIP				;YES
		SKIPGE	FNDSOM(CF)	;IN MIDDLE?
		RP$CRLF			;YES, SEP BY CRLF
		SETOM	FNDSOM(CF)	;INDIC SOMETHING OUTPUT
		$CALLB TX$OUT,<RANGOK(CF),RANGERR(CF),ERRPT(CF)>
	$ENDIF
	$CALL	P$COMMA			;MORE ENTRIES?
	JUMPT	DBKELP			;YES IF JUMP
	RETURN
$ENDUTIL
$UTIL	(DIBHDR)
;
; DIBHDR - DISP ALL OF BKT HDR
;
	$CALLB	BK$GET,<CU.BKT>		;READ IN CURR BKT
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,PB			;ASSUME HEADER FOR NOW
	MOVEM	T1,BKTADR(CF)		;SAVE BKT ADDR TO COMPUTE ENTRY OFFSETS
	RP$OUT	(HDRBUC,CU.BKT)	;OUTPUT HDR
	MOVEI	RF,BUCTAB	;GET TABLE OF FLDS
	$CALL	DABALL		;YES, START WITH HEADER
	RETURN
$ENDUTIL

$UTIL	(DIBEALL)
;
; DIBEALL - DISP ALL BKT ENTRIES
;
	SKIPE	CU$TYPE			;CLOBBED BKT?
	$SKIP				;YES
		TT$OUT ([UTLCAE##])	;CANT ACC ENTS OF CLOB BKT
		RETURN
	$ENDIF
	SETZM	ENTNUM			;LOOP THRU ENTRIES
DBEALP:
	AOS	ENTNUM			;PT TO NEXT ENTRY
	$CALLB	BK$ENT,<ENTNUM>		;PICK UP THIS 1
	JUMPL	T1,L$UNW		;ABORTED
	JUMPE	T1,L$RET		;END OF LOOP
	MOVEM	T1,PB			;PT AT CURR ENTRY
	$CALL	DIBENT			;PROC ARB ENT
	JRST	DBEALP			;GET ANOTHER
	RETURN
$ENDUTIL
$UTIL	(DIBENT)
;
; DIBENT - DIS BKT ENTRY
; ARGUMENTS:
;	PB = ADDRESS OF ENTRY
; NOTES:
;	USES LEVEL IN BKT HDR & KEY OF REF TO DET TYPE OF ENTRY: UDR, SIDR, IDX

	SKIPGE	FNDSOM(CF)		;IN MIDDLE?
	RP$CRLF				;YES, SEP BY CRLF
	SETOM	FNDSOM(CF)		;INDIC SOMETHING OUTPUT

	MOVE	T5,BKTADR(CF)		;GET ADDR OF BKT
	SUBM	PB,T5			;COMPUTE ENTRY'S OFFSET
	RP$OUT	(HDRENT,<CU$ENT,T5>)	;OUTPUT ENTRY'S OFFSET
	MOVE	T1,CU$TYPE		;GET BKT TYPE
	CASES	T1,MX%BTY
$CASE	(BTY%PRIM)			;PRIMARY
	$COPY	CU.ID,IR$RID(PB)	;SETUP ID OF LAST REF ENTRY
	MOVEI	RF,IVHTAB		;VAR HDR IN INDEX FILE
	LOAD	T1,IR$IRA(PB)		;CHK IF SHORT HDR
	MOVE	T2,FAB			;GET FAB ADDR
	$FETCH	T2,RFM,(T2)		;CHK IF VAR OR FIXED
	TXNN	T1,IR$POINT		;IS IT RRV?
	CAIN	T2,FB$FIX		;IS IS FIXED?
	MOVEI	RF,IFHTAB		;YES TO EITHER, USE "SHORT" HDR
	$CALL	DABALL			;DISPLAY THE ENTRY
	LOAD	T1,IR$IRA(PB)		;CHK IF SHORT HDR
	TXNE	T1,IR$POINT		;IS IT JUST PTR REC?
	RETURN				;YES, NO KEY VAL TO PRINT
	$CALLB	M$KUDR,<[BUF$K2],PB>	;COPY KEY FROM UDR TO BUFFER
	JUMPLE	T1,L$UNW		;OOPS
	MOVEI	T1,BUF$K2		;GET PTR TO KEY VAL
	HRRM	T1,STRIPT		;PUT IT AWAY
	$COPY	STRIPT+1,KSIZB		;COPY LENGTH
	$COPY	STRIPT+2,KTYPE		;[455] COPY KEY DATA TYPE
	RP$OUT	(HDRVAL,KEYVAL)
	RP$OUT	(VALSTP,<[STRIPT]>)	;[455] OUTPUT THE KEY
	RETURN
$CASE	(BTY%SEC)			;SECONDARY
	MOVEI	RF,ISHTAB		;GET SIDR HDR
	$CALL	DABALL			;PUT OUT FIXED PART
	MOVEI	T1,IR$SKEY(PB)		;GET PTR TO KEY VAL
	HRRM	T1,STRIPT		;PUT IT AWAY
	$COPY	STRIPT+1,KSIZB		;COPY LENGTH
	$COPY	STRIPT+2,KTYPE		;[455] COPY DATATYPE
	RP$OUT	(HDRVAL,KEYVAL)
	RP$OUT	(VALSTP,<[STRIPT]>)	;[455] OUTPUT THE KEY
	MOVEI	CDF,IR$SKEY(PB)		;GET PTR TO KEY BACK
	ADD	CDF,KSIZW		;HOP PAST IT
	LOAD	T2,IR$SRS(PB)		;GET SIDR LEN IN WDS
	SUB	T2,KSIZW		;TOT-KEY= # OF RFA'S
	MOVNS	T2			;PREP TO MAKE AOBJ
	HRL	CDF,T2			;CDF NOW AOBJ TO SIDR RFA'S
	RP$OUT	HDRSAE			;HDR FOR RFA VECTOR
DBESLP:
	RP$OUT	(VALSAE,0(CDF))		;PUT OUT SIDR ARRAY ELEM
	AOBJN	CDF,DBESLP
	RP$CRLF				;PUT OUT CRLF
	RETURN
$CASE	(BTY%IDX)			;INDEX
	MOVEI	RF,IXHTAB		;GET IDX ENTRY HDR
	$CALL	DABALL			;PUT OUT FIXED PART
	MOVEI	T1,IR$XKEY(PB)		;GET PTR TO KEY VAL
	HRRM	T1,STRIPT		;PUT IT AWAY
	$COPY	STRIPT+1,KSIZB		;COPY LENGTH
	$COPY	STRIPT+2,KTYPE		;[455] COPY DATATYPE
	RP$OUT	(HDRVAL,KEYVAL)
	RP$OUT	(VALSTP,<[STRIPT]>)	;[455] OUTPUT THE KEY
	RETURN
$CASF
	ERRU	(IUE)
$ENDUTIL
SUBTTL	GENERAL ROUTINES TO DISPLAY RMS FIELDS

$UTIL	(DABLST)
;
; DABLST - PARSE FLD LIST TO EOL, DISPLAYING VALUES
;
DABLLP:
	$P	(KEYW)
	MOVEM	T1,RF		;FIELD DESCRIPTOR
	$CALL	DABVAL		;DISPLAY ONE VALUE
	$CALL	P$COMMA		;MORE IN LIST?
	JUMPF	L$RET		;NO
	JRST	DABLLP		;YES
$ENDUTIL

$UTIL	(DABALL)
;
; DABALL - DISPLAY ALL THE FIELDS IN AN ARGBLK
;
DABALP:
	SKIPN	0(RF)		;THRU?
	RETURN			;YES
	$CALL	DABVAL		;PUT OUT CURR VALUE
	LOAD	T1,RF.CNT(RF)	;GET VAR LEN SIZ
	ADDI	RF,SZ%RF(T1)	;GET TO NEXT EF
	JRST	DABALP		;CHECK FOR MORE
$ENDUTIL
$UTIL	(DABVAL)
;
; DABVAL - DISPLAY THE CURRENTLY IDENTIFIED ARGBLK FIELD
;
	LOAD	T1,RF.FLAG(RF)		;SEE IF ARRAY
	TXNE	T1,E%INV		;INVISIBLE?
	RETURN				;YES, JUST RET IMMED
	TXNE	T1,E%ARY		;IS IT?
	JRST	ARYVAL			;YES
	LDB	VAL,RF.BP(RF)		;GET THE VALUE
	CAIE	RF,IVHTAB		;SUPER KLUDGE TO ZAP INTERN BIT
	CAIN	RF,IFHTAB		;DITTO
	TXZ	VAL,IR$I1		;DONT TELL USER IF THIS ON
	LOAD	T2,RF.TYP(RF)		;PICK UP TYPE OF CURR RF
	CAIE	T2,DT%SYV		;SHOW SYM VALS OF 0
	TXNE	T1,E%DIZ		;PUT OUT 0 ANYWAY?
	SKIPA				;YES TO EITHER
	JUMPE	VAL,L$RET		;SKIP NULL VALUES
	RP$OUT	(HDRVAL,RF.NAM(RF))	;PUT OUT XXX:#
	LOAD	T1,RF.TYP(RF)		;PICK UP TYPE OF CURR RF
	CASES	T1,MX%DT		;DISPATCH ON DATA TYPE

$CASE	(DT%DATE)
$CASE	(DT%DEC)
$CASE	(DT%OCT)
$CASE	(DT%RFA)
$CASE	(DT%SYA)
$CASE	(DT%STR)
	RP$OUT	(DABFMT(T1),VAL)	;PUT OUT THE SIMPLE CASES
	RETURN

$CASE	(DT%SYB)
	LOAD	T1,RF.CNT(RF)	;GET NUM OF SYM OPTS
	MOVNS	T1		;MAKE NEG
	HRLI	T1,SZ%RF(RF)	;GET TO WHERE SYM WDS STORED
	MOVSM	T1,CDF		;NOW AOBJ PTR TO SYM VALS
DSYBLP:
	LOAD	T1,SYV.VL(CDF)		;GET CURR SYM'S VAL
	TDZN	VAL,T1			;IS CURR VAL SUBSET OF ACTU VALUE?
	$SKIP				;YES
	  LOAD	T5,SYV.NM(CDF)		;GET PTR OF NAME
	  MOVE	T4,VALASZ		;PRESUME LAST 1
	  SKIPE	VAL			;MORE OPTIONS TO PUT OUT
	  MOVE	T4,VALASP		;ASZ+ (MORE BITS)
  	  RP$OUT (T4,T5)			;PUT OUT SYM VAL
	  JUMPE	VAL,L$RET		;ALL BITS ACCOUNTED FOR
	$ENDIF
	AOBJN	CDF,DSYBLP		;CHK NEXT SYM
	RP$OUT	(VALINV,VAL)		;INVALID VALUE IN FIELD
	RETURN
$CASE	(DT%SYV)
	LOAD	T1,RF.CNT(RF)	;GET NUM OF SYM OPTS
	MOVNS	T1		;MAKE NEG
	HRLI	T1,SZ%RF(RF)	;GET TO WHERE SYM WDS STORED
	MOVSM	T1,CDF		;NOW AOBJ PTR
DSYVLP:
	LOAD	T1,SYV.VL(CDF)		;GET CURR SYM'S VAL
	CAME	T1,VAL			;DOES ACTU VALUE MATCH?
	$SKIP				;YES
	  LOAD	T5,SYV.NM(CDF)		;GET PTR OF NAME
	  RP$OUT (VALASZ,T5)		;PUT OUT SYM VAL
	  RETURN
	$ENDIF
	AOBJN	CDF,DSYVLP		;CHK NEXT SYM
	RP$OUT	(VALINV,VAL)		;INVALID VALUE IN FIELD
	RETURN
$CASF
	ERRU	(IUE)			;SHOULDNT HAPPEN

ARYVAL:
	LDB	T4,RF.BP(RF)		;GET CURR VALUE
	LOAD	T1,RF.FLAG(RF)		;THIS LAST ENTRY?
	TXNN	T1,E%DIZ		;PUT OUT EVEN IF 0
	JUMPE	T4,L$IFX		;NOTHING
	  RP$OUT  (VALARY,<RF.NAM(RF),T4>)
	$ENDIF
	LOAD	T1,RF.FLAG(RF)		;THIS LAST ENTRY?
	TXNE	T1,E%ARL		;CHK FLAG
	RETURN				;YES
	ADDI	RF,SZ%RF		;GET TO NEXT
	JRST	ARYVAL			;NO. PROC ANOTHER

$ENDUTIL
SUBTTL	ROUTINES TO DISPLAY USER RECORDS

$UTIL	(DDANXT)
;
; DDANXT - FIND NEXT REC & DISPLAY HDR LINE
; RETURNS:
;	TRUE IF THERE IS A NEXT REC, FALSE OTHERWISE
	$CALL	US.NEXT			;FIND NEXT REC
	JUMPF	L$RET			;TRANS RET FAILURE
	MOVEM	T1,VAL			;PRESERVE RFA
	SKIPGE	FNDSOM(CF)		;IN MIDDLE?
	RP$CRLF				;YES, SEP BY CRLF
	SETOM	FNDSOM(CF)		;INDIC SOMETHING OUTPUT
	MOVE	T2,RAB			;GET RAB PTR
	$FETCH	T1,RSZ,(T2)		;GET REC LEN
	MOVEM	T1,RECLEN(CF)		;PERMANIZE IT
	$FETCH	T1,FAB,(T2)		;[A434] GET FAB
	$FETCH	T1,ORG,(T1)		;[A434] GET ORGANIZATION
	$FETCH	T3,RFA,(T2)		;GET LOGICAL RFA OF REC
	CAIN	T1,FB$IDX		;[A434] INDEXED?
	  JRST	L$IFX			;[A434] YES - SKIP SEQ/REL STUFF
	  RP$OUT(HDRRNX,VAL)		;[A434] SHOW RFA OF CURRENT RECORD
	  RETT				;[A434] RETURN
	$ENDIF
	CAMN	T3,VAL			;IS THERE RRV FOR THIS REC?
	$SKIP				;YES
		RP$OUT(HDRRRV,<VAL,T3>)	;SHOW RFA & RRV OF CURR REC
		JRST	L$IFX
	$NOSKIP
		RP$OUT(HDRREC,VAL)	;SHOW RFA OF CURR REC
	$ENDIF
	RETT
$ENDUTIL
$UTIL	(DDAVAL)
;
; DDAVAL - DISPLAY THE CURRENTLY IDENTIFIED DATAFIELD
;
	$FETCH	T1,UBF,(PB)		;GET REC LOCATION
	MOVE	T3,RECLEN(CF)		;GET SIZE OF REC
	HRRM	T1,STRIPT		;MAKE BP
	ADJBP	T3,STRIPT		;COMPUTE LAST WD OF REC
	HRRZM	T3,RECEND(CF)		;ISOLATE IT
	LOAD	TAP,UF.TYP(RF)		;GET DATA TYPE TO USE
	CASES	TAP,MX%DFT
$CASE	(DFT%FIL)			;FILE BYTES
	HLL	T1,STRIPT		;GET FILE-BYTE INFO
	MOVE	T2,BYTYPE		;[455] GET FILE BYTE DATATYPE
	MOVEM	T2,DVALPT+3(CF)		;[455] STORE DATATYPE
	JRST	DDAVSTR			;COMPUTE ADDR
$CASE	(DFT%AS)			;ASCII DATA
	HLL	T1,STRIPT		;ASCII BYTES			;M433
	MOVEI	T2,DT%ASC		;[455] SETUP DATATYPE
	JRST	DDAVSTR			;STRING MERGE
$CASE	(DFT%SIX)			;SIXBIT DATA
	HRLI	T1,440600		;SIXBIT BYTES
	MOVEI	T2,DT%SIX		;[455] SETUP DATATYPE
	JRST	DDAVSTR			;STRING MERGE

$CASE	(DFT%PAC)			;PACKED DECIMAL			;A433
	HRLI	T1,441100		;9-BIT BYTES			;A433
	LOAD	T2,UF.POS(RF)		;GET POSITION IN RECORD		;A433
	ADJBP	T2,T1			;POINT TO IT			;A433
	MOVEM	T2,DVALPT(CF)		;				;A433
	$CALLB	TX$RPT,<T2,DABPAC>	;TYPE VALUE OUT			;A433
	RETURN				;DONE				;A433

$CASE	(DFT%EBC)			;EBCDIC DATA
	HRLI	T1,441100		;EBCDIC BYTES
	MOVEI	T2,DT%EBC		;[455] SETUP DATATYPE
	JRST	DDAVSTR			;STRING MERGE
DDAVSTR:
	MOVEM	T2,DVALPT+2(CF)		;[455] SAVE DATATYPE
	LOAD	T2,UF.POS(RF)		;SELECT BYTE TO POSIT TO
	ADJBP	T2,T1			;POSIT TO RIGHT BYTE
	MOVEM	T2,DVALPT(CF)
	$CALL	FITCHK			;DOES FLD FIT?
	MOVEM	T1,DVALPT+1(CF)		;RET LEN (POSSIB TRUNC)
	MOVEI	T3,DVALPT(CF)		;RESOLVE CF
	RP$OUT	(VALSTP,<T3>)		;[455] TYPE VALUE OUT
	RETURN
$CASE	(DFT%DEC)			;INTEGER
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC
	$CALL	FITCHK			;DET IF FLD FITS
	RP$OUT	(VALDEC,@DVALPT(CF))	;OUTPUT IT
	RETURN
$CASE	(DFT%FLO)			;FLOATING NUM
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC
	$CALL	FITCHK			;DET IF FLD FITS
	RP$OUT	(VALFLO,@DVALPT(CF))	;OUTPUT IT
	RETURN
$CASE	(DFT%DOU)			;DOUBLE FLOATING NUM		  ;A433
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD		  ;A433
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC		  ;A433
	$CALLB	TX$RPT,<T1,DABDOU>					  ;A433
	RETURN
$CASE	(DFT%GFL)			;G-FLOATING NUM			  ;A433
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD		  ;A433
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC		  ;A433
	$CALLB	TX$RPT,<T1,DABGFL>					  ;A433
	RETURN								  ;A433

$CASE	(DFT%LON)			;LONG INTEGER			  ;A433
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD		  ;A433
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC		  ;A433
	$CALLB	TX$RPT,<T1,DABLON>					  ;A433
	RETURN								  ;A433

$CASE	(DFT%UNS)			;UNSIGNED INTEGER		  ;A433
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD		  ;A433
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC		  ;A433
	$CALLB	TX$RPT,<(T1),DABUNS>					  ;A433
	RETURN								  ;A433

$CASE	(DFT%OCT)			;OCTAL NUMBER
	$INCR	T1,UF.POS(RF)		;LOCATE SPECIFIED FIELD
	MOVEM	T1,DVALPT(CF)		;PERMANIZE FLD LOC
	$CALL	FITCHK			;DET IF FLD FITS
	RP$OUT	(VALOCT,@DVALPT(CF))	;OUTPUT IT
	RETURN
$ENDUTIL

$ENDSCOPE(DISPLAY)
SUBTTL	FIX COMMAND

$PROC	(C.FIX)
;
; C.FIX - FIX RFA-LIST, CALLS VR$SCAN TO FIX THE SPECIFIED RECORDS
;
	MOVE	T5,UTLFLG
	TXNN	T5,UT%OUT		;OPEN FOR OUTPUT?
	ERRU	(NOO)
	TXNN	T5,UT%RFO		;EXPLICT RPT FILE?
	$SKIP				;YES, OUTPUT CMD TEXT
		RP$OUT(VALCMD,<GTROPR,PDBPAG##>)
	$ENDIF
	SETOM	V$FIX			;SET FIX MODE
	SETOM	V$PREQ			;INDIC PROGRESS IRRELEV
	$COPY	SC$CASE,I SC%VER	;A FIXING VERIFY
	MOVE	PB,RAB			;GET RAB PTR
	$EH	(FIX.LE)		;TRAP FAILURE RETURNS AT THIS LEVEL
FIX.LP:
	$CALL	CP.XFA			;EAT RFA & IDX (SET CU.KRF) FROM CMD LIN
	JUMPF	FIX.LE			;ABORT CURR BUT STILL CHK FOR MORE RFA'S
	SKIPE	CU.KRF			;IF PRIM KEY, T1 COULD BE PTR ENTRY
	$SKIP				;YES, CONV RRV TO PHYS RFA IF NECES
		$STORE	T1,RFA,(PB)	;NOW CALL RC$FIND, T1 MAY IDENT PTR ENT
		MOVEI	T1,RB$RFA	;DO RFA ACCESS OF COURSE
		$STORE	T1,RAC,(PB)	; PUT ACC MODE IN RAB
		$CALLB	RC$FIND		;FIND PHYS ADDR OF REC
		JUMPL	T1,FIX.LE	;OOPS, SKIP TO NEXT RFA
		JUMPE	T1,L$ERRU(IUE)	;CP.XFA SUCC IMPLIES T1=0 IMPOS
	$ENDIF
	SETOM	V$ACC			;PRESUM K 0 (SO ACC 2NDARY KEYS)
	SKIPE	CU.KRF			;IS IT PRIM KEY?
	SETZM	V$ACC			;NO
	$CALLB VR$SCAN,<T1,[-1]>	;SCAN 1 REC
	$FLUSH	@RAB			;INSURE RMS FILE UPTODATE
	$CHKERR	(?UTLUCP unable to checkpoint file)
	$CALL	RP$PUT			;CLEAN UP
	$FLUSH	@OUTRAB			;INSURE REPORT FILE UPTODATE
	$CHKERR	(?UTLUCP unable to checkpoint file)
FIX.LE:
	$CALL	P$COMMA			;MORE RFA'S
	JUMPT	FIX.LP			;YES IF JUMP
	RETT
$ENDPROC
SUBTTL	HELP COMMAND

$PROC	(C.HELP)
	$CALLB	TX$OUT,<[HLPMSG],[[ASCIZ\^A\]]>
	RETT

HLPMSG:

ASCIZ	?The RMSUTL commands are:
CHANGE		changes values in the specified entry or record
CLOSE		closes the currently opened RMS or REPORT file
DEF AREA	creates and names an area description
DEF DATA	creates datafields in a record
DEF FILE	creates an RMS file with specified attributes
DEF KEY		creates and names a key description
DELETE		deletes the specified entry or record
DISPLAY		outputs the specified fields to the REPORT file
EXIT		returns to the EXEC (you may CONTINUE)
FIX		completes $UPDATE, $PUT, $DELETE for specified records
HELP		outputs a brief description of RMSUTL
INFO		describes current environment and names you have DEFINEd
OPEN		opens the specified RMS or REPORT file
REDEFINE	gives new attributes to DEFINEd name
SET		changes the current environment
SPACE		computes space-usage within a file
TAKE		executes the RMSUTL commands in the specified file
UNCLUTTER	eliminates POINTER records and deleted records from RMS file
VERIFY		determines if a file is internally consistent

If no REPORT file is open, report data is output to TTY:.
?

$ENDPROC
SUBTTL	PROCESS THE SET COMMAND

$PROC	(C.SET)
;
; C.SET - CHANGE THE CURRENT ENVIRONMENT
;
; THE CURRENT ENVIRONMENT IS CONTROLLED BY THE FOLLOWING
;	BUCKET
;	RECORD
;	KEY OF REF

	MOVE	T5,UTLFLG
	TXNN	T5,UT%FOP		;IS FILE OPEN?
	ERRU	(FNO)			;NO
	TXNE	T5,UT%EMP!UT%PCH	;IS FILE EMPTY OR PROLOG CHANGED?
	ERRU	(EPC)			;YES

	$P	(KEYW)
	CASES	T1,MX%SET
$CASE	(SET%IND)
	$CALL	US.IDX			;SET INDEX AND FRIENDS
	SETZM	CU.ID			;NEW BKT MEANS NO CURR ENT
	JRST	CSNEW
$CASE	(SET%BUC)
	$CALL	US.BKT			;FIND OUT WHICH BKT TO DISPLAY
	SETZM	CU.ID			;NEW BKT MEANS NO CURR ENT
	$CALL	SETBKT			;SET CINBKT & DET STATE OF BKT
	RETT

$CASE	(SET%REC)
	$CALL	US.REC			;FIND REC TO MAKE CURRENT
	$CALL	US.NEXT			;LOCATE 1ST SATISFYING REC
	JUMPF	L$ERRU(NRW)		;OOPS
	MOVEM	T1,CU.REC		;NEW CURRENT RECORD
	MOVE	T1,CINKRF		;CHK INIT KRF
	CAMN	T1,CU.KRF		;HAS IT CHANGED?
	JRST	CSNEW			;NO, SET NEW ENVIR
	SETZM	CU.ID			;NEW BKT MEANS NO CURR ENT
	HRRZ	T1,@NRP$AD		;USE PAGE OF NEW CURR REC IN ITS IDX
	MOVEM	T1,CU.BKT		;DONE
	JRST	CSNEW

$ENTRY	(CS.GET)
;
; CS.GET - INSURE CURR ENVIR PROP SET UP
;
	MOVE	T1,UTLFLG		;GET STATUS FLAGS
	TXNN	T1,UT%EMP!UT%PCH	;IS FILE EMPTY OR PROL CHANGED?
	TXNN	T1,UT%FOP		;IS FILE NOT OPEN?
	RETT				;YES TO 1 OR MORE, SO NO CONTEXT TO SET
	$COPY	CU$TYPE,CINTYPE
	$COPY	CU.REC,CINREC
	$COPY	CU.BKT,CINBKT
	$COPY	CU.KRF,CINKRF,T1
	JUMPL	T1,L$RETT		;NOT AN INDEXED FILE
	MOVE	T2,RAB			;GET REC DATA
	$STORE	T1,KRF,(T2)		;INSURE CORRECT
	$CALLB	M$KDB,<CU.KRF>		;SET KDB & FRIENDS
	RETT

$ENTRY	(CS.NEW)
;
; CS.NEW - PERMANIZE THE CURRENT ENVIR
;
CSNEW:
	MOVE	T2,FAB			;[430] GET FILE ORGANIZATION
	$FETCH	T1,ORG,(T2)		;[430] ...
	CASES	T1,FB$IDX		;[430] DISPATCH ON ORGANIZATION

$CASE	(FB$SEQ)			;[430] SEQUENTIAL ORGANIZATION
	$CALLB	M$RSTCOP,<RST,[CU.RST]>	;[430] UPDATE RST DATA FOR CURRENT REC
	$COPY	CINREC,CU.REC		;[430] ...
	RETT				;[430] RETURN

$CASE	(FB$REL)			;[430] RELATIVE ORGANIZATION
	$CALLB	M$RSTCOP,<RST,[CU.RST]>	;[430] UPDATE RST DATA FOR CURRENT REC
	$COPY	CINREC,CU.REC		;[430] ...
	RETT				;[430] RETURN

$CASE	(FB$IDX)			;[430] INDEXED ORGANIZATION
	$CALL	SETBKT			;SET CURR BKT INFO
	$CALLB	M$RSTCOP,<RST,[CU.RST]>	;UPDATE RST DATA FOR CURR REC
	$COPY	CINREC,CU.REC
	$COPY	CINKRF,CU.KRF
	RETT
$CASF					;[430]
	ERRU	(IUE)			;[430]


$UTIL	(SETBKT)			;VER BKT OK & SET CINBKT
	MOVE	T1,UTLFLG		;GET STATUS FLAGS
	TXNN	T1,UT%EMP!UT%PCH	;EMPTY OR PROL CHANGED?
	$SKIP				;YES
		SETZM	CINBKT		;SET TO DEFINED VAL
		SETZM	CINTYPE		;DITTO
		RETURN
	$ENDIF
	$CALLB	BK$GET,<CU.BKT>		;TELL USER IF CLOBBERED
	JUMPLE	T1,L$UNW		;FILE SCREWED UP
	$COPY	CINBKT,CU.BKT		;SET CURR BKT
	$COPY	CINTYPE,CU$TYPE		;SET TYPE OF CURR BKT
	RETURN
$ENDUTIL
$ENDPROC
SUBTTL	SCANNING COMMANDS

$SCOPE	(SCANNING)
$LOCALS
 $WORD	(ALLVER)			;ON IF VERIFYING ALL KEYS
$ENDLOC

SC%VER==:0				;FOR THIS WAY FOR BLISS ACCESS
SC%SPACE==:1
SC%UNCL==:2

$PROC	(C.SCAN)
;
$ENTRY	(C.SPACE)
;
; C.SPACE - CHK SPACE USAGE BY KEY
;
;	SPACE KEY N record-range
;
	$COPY	SC$CASE,I SC%SPACE	;SET SPACE-USAGE OPTION
	JRST	VERMRG

$ENTRY	(C.UNCL)
;
; C.UNCL - CLEAN UP RFAS AND DELETED RECS WHILE DOING VER K 0
;
	SETOM	SCANNING		;INDIC SCANNING CMD
	SETZM	ALLVER(CF)		;VERIFYING ONLY ONE KEY
	$COPY	SC$CASE,I SC%UNCL	;SET FOR UTLVFY
	$CALL	SCANFC,<UT%OUT>		;FILE MUST BE OPEN FOR OUTPUT
	$CALL	US.FROM,<[0]>		;PROC FROM CLAUSE (SET L TO H IF NONE)
	JRST	VSWOPT			;PROC SWITS
;
$ENTRY	(C.VERIFY)
;
; C.VERIFY - PARSE COMMAND LINE FOR VERIFY & CALL THE VR$SCAN
;
;	VERIFY KEY N record-range /NOACCESS /NOFIX /PROGRESS:N
;
	$COPY	SC$CASE,I SC%VER	;INDIC VERIFY CMD
VERMRG:
	SETOM	SCANNING		;INDIC SCANNING CMD
	$CALL	SCANFC,<UT%FOP>		;MAKE CONSIS CHK
	$P	(KEYW)			;PICK UP VERIFY OPTION
	CASES	T1,MX%VER

VEREXIT:				;COMMON EXIT FOR SCAN CMDS
	SKIPN	V$ERR			;ANY ERRS?
	RETT				;NO
	MOVE	T1,OUTRAB		;RPT OUTPUT DEST
	CAME	T1,TTYRAB		;SAME AS TTY?
	$SKIP				;YES
		TT$OUT([[0]])		;PUT OUT CRLF
	$ENDIF
	TT$OUT	([UTLIDF##])		;YES, TELL USER
	RETT
$CASE	(VER%ALL)			;VERIFY ALL KEYS
	SETOM	ALLVER(CF)		;PRESUME VERIF ALL KEYS
	$CALL	US.LOHI,<[0]>		;SET 1ST BNDS
	JRST	VSWOPT
$CASE	(VER%KEY)			;VERIFY PARTIC KEY
	SETZM	ALLVER(CF)		;ASSUME 1 KEY
	$P	(NUM)			;PICK UP KEY NUM
	MOVEM	T1,CU.KRF		;MAKE IT PASSABLE
	$CALL	US.FROM,<CU.KRF>	;PROC FROM CLAUSE
	JUMPF	L$ERRU(FNI)		;OOPS
	JRST	VSWOPT
$CASE	(VER%SEC)			;VERIF 2NDARY KEYS
	SETOM	ALLVER(CF)		;PRESUME VERIF ALL KEYS
	$CALL	US.LOHI,<[1]>		;SET 1ST BNDS
	JUMPF	L$ERRU(FNI)		;OOPS
VSWOPT:					;SET VERIFY OPTIONS
	SETZM	V$ERR			;INIT VERIFY ERR CNT
	SETZM	V$FIX			;ASSUME NOT FIXING PROBLEMS
	MOVE	T1,UTLFLG		;GET FLAG WORD
	TXNE	T1,UT%OUT		;OPEN FOR OUTPUT?
	SETOM	V$FIX			;YES, DEFAULT TO FIX MODE
	$COPY	V$PREQ,I ^D10000	;DEFAULT PROGESS DISP FREQ
	MOVE	T2,RAB			;MATER PTR TO RAB
	$FETCH	T1,KRF,(T2)		;GET KEY OF REF
	SETOM	V$ACC			;PRESUME PRIM KEY
	SKIPE	T1			;PRIMARY KEY?
	SETZM	V$ACC			;NO, SO ACC SIDR'S N/A
VSW.LP:
	$CALL	P$SWIT			;GET A SWITCH
	JUMPT	L$IFX			;JUMP IF MORE SWITS
	 VERALP:
	  $CALLB VR$SCAN,<CU.REC,CU.HREC>	;DO THE REAL WORK
	  $CALL	RP$PUT			;CLEAN UP
	  $FLUSH @OUTRAB		;STUFF WRITTEN TO RPT FILE
	  $CHKERR (?UTLUCP unable to checkpoint file)
	  SKIPL	ALLVER(CF)		;DONE IF DOING JUST 1 KEY
	  JRST	VEREXIT			;YES, RET TO TOP-LEVEL
	  MOVE	T2,RAB			;MATER RAB PTR
	  $FETCH T1,KRF,(T2)		;USE RET VAL AS NEXT KEY
	  AOS	T5,T1			;GET NEXT KREF
	  $CALL	US.LOHI,<T5>		;GET BNDS FOR NEXT KEY
	  JUMPF	VEREXIT			;PAST HI KEY
	  SETZM	V$ACC			;CANT BE PRIM KEY NEXT ITER
	  RP$CRLF			;SEP NEXT KEY'S OUTPUT
	  JRST	VERALP			;DO ANOTHER KEY
	$ENDIF
	CASES	T1,MX%VSW		;DISPATCH
$CASE	(VSW%ACC)			;/NOACCESS (FAST PRIM KEY VERIFY)
	SETZM	V$ACC			;TURN OFF
	JRST	VSW.LP
$CASE	(VSW%FIX)			;/NOFIX
	SETZM V$FIX			;INSURE FIX-MODE OFF
	JRST	VSW.LP
$CASE	(VSW%PR)			;/PROGRESS
	$P	(NUM)			;GET PROGRESS CNT
	MOVEM	T1,V$PREQ		;SAVE IT
	JRST	VSW.LP
$UTIL	(SCANFC,<OPCHK>)
;
; SCANFC - SCAN FILE CHKS
; ARGUMENTS:
;	OPCHK = OPEN FLAGS TO CHK (IMMED)
	MOVE	T3,UTLFLG		;GET FLAG WORD
	TXNN	T3,UT%FOP		;IS FILE OPEN?
	ERRU	(FNO)			;NO TO EITHER
	TXNE	T3,UT%EMP!UT%PCH	;IS FILE EMPTY OR PROLOG CHANGED?
	ERRU	(EPC)			;YES
	TRNN	T3,@OPCHK(AP)		;FILE OPEN FOR OUTPUT IF NECES?
	ERRU	(NOO)			;NO
	MOVE	T2,FAB			;MATER PTR TO FAB
	$FETCH	(T1,ORG,(T2))		;GET ORG
	CAIE	T1,FB$IDX		;IS IT INDEX FILE?
	ERRU	(IOF)			;NO
	TXNN	T3,UT%RFO		;EXPLICT RPT FILE?
	$SKIP				;YES, OUTPUT CMD TEXT
		RP$OUT(VALCMD,<GTROPR,PDBPAG##>)
	$ENDIF
	RETURN
$ENDUTIL
$ENDPROC
$ENDSCOPE(SCANNING)
SUBTTL	ROUTINES NEEDED BY MULTIPLE CMDS

$UTIL	(FITCHK)
;
; FITCHK - DETS IF FLD IDENT BY RF BITS IN CURR REC
; ARGUMENTS:
;	DVALPT(CF) = START (WD OR BP AS APPROP) OF FLD TO CHK
; RETURNS:
;	T1 = IF STRING, SIZE TO USE  (OR DOES ERRU(DXP))
	MOVE	T4,DVALPT(CF)		;GET PTR TO FLD
	LOAD	T1,UF.SIZ(RF)		;GET FIELD SIZE
	LOAD	T2,UF.TYP(RF)		;GET DAT TYPE BEING EATEN
	CAIGE	T2,DFT%INT		;NUMERIC?
	$SKIP				;YES
		ADDI	T1,-1(T4)	;COMPUTE ADDR OF LAST WD IN FLD
		CAMLE	T1,RECEND(CF)	;IN BNDS?
		ERRU	(DXP)		;OOPS PAST END OF REC
		RETURN			;OK, FITS
	$ENDIF
FITSTR:
	MOVE	T2,STRIPT		;GET FILE-BYTES INFO
	XOR	T2,T4			;GET CUTE, DET IF BYTE SIZES SAME
	TLNE	T2,7700			;IF BITS MATCHED UP, THEN SIZES SAME
	$SKIP				;YES, ALLOW TRUNCATION
		LOAD	T3,UF.POS(RF)	;GET POS
		CAML	T3,RECLEN(CF)	;BEGIN OF FLD PAST END?
		ERRU	(DXP)		;YES
		ADD	T3,T1		;SEE WHERE FLD EXTENDS
		SUB	T3,RECLEN(CF)	;GET DIFF BETW END OF FLD & ACTU REC LEN
		JUMPLE	T3,L$IFX	;JUMP IF NO TRUNC NECES
		SUB	T1,T3		;TRUNCATE BY AMT OF OVFLOW
		JRST	L$IFX
	$NOSKIP				;SIZES DIFFER, BE LESS FORGIVING
		ADJBP	T1,T4		;GET TO END OF FLD
		HRRZS	T1		;ISOL ENDING WD OF FLD
		CAMLE	T1,RECEND(CF)	;DOES IT FIT?
		ERRU	(DXP)		;NO
		LOAD	T1,UF.SIZ(RF)	;GET SIZE BACK
	$ENDIF
	RETURN				;WITH SIZE TO USE
$ENDUTIL

$UTIL	(PROLCASE)
;
; PROLCASE - LOCATE THE SPECIFIED SECTION OF THE PROLOGUE
; RETURNS:
;	T1 = PROLOGUE KEYWORD CASE
;	PB IS SET TO ADDR OF SPECIFIED SEC
; NOTES:
;	CURRENT TOKEN TO PARSE SHOULD BE PROLOGUE SECTION IDENTIFIER

	$P	(KEYW)		;GET OPTION KEYWORD
	MOVEM	T1,RF		;MISUSE RF BECAUSE THIS VAL USED TO COMPUTE IT
	CASES	T1,MX%DS
$CASE	(DS%ARE)		;** DISPLAY AREA DESCRIPTOR
	MOVE	T2,FAB		;CHECK IF OPERATION IS LEGAL
	$FETCH	T1,ORG,(T2)
	CAIE	T1,FB$IDX
	ERRU	(IOF)		;NO, NOT IDX FILE

	$P	(NUM)
	MOVEM	T1,ENTNUM		; SAVE AREA NUMBER TO DISPLAY
	$CALLB	BK$ADB,<ENTNUM>		;GET ADDR OF DESIRED ADB
	JUMPL	T1,L$UNW
	JUMPE	T1,L$ERRU(FNA)		;FILE DOESNT HAVE THAT AREA
	MOVEM	T1,PB			;PTR TO REQUESTED AREA
	RETURN	<RF>			;DONE
$CASE	(DS%KEY)			;** DISPLAY KEY DESCRIPTOR 
	MOVE	T2,FAB			;CHECK IF OPERATION IS LEGAL
	$FETCH	T1,ORG,(T2)
	CAIE	T1,FB$IDX
	ERRU	(IOF)			;NO, NOT IDX FILE

	$P	(NUM)			;GET INDEX NUMBER
	MOVEM	T1,ENTNUM		;SAVE IT
	$CALLB	BK$IDB,<ENTNUM>		;GET PTR TO DESIRED IDB
	JUMPL	T1,L$UNW
	JUMPE	T1,L$ERRU(FNI)		;FILE DOESNT HAVE THAT INDEX
	MOVEM	T1,PB			;PTR TO REQUESTED IDB
	RETURN	<RF>			;DONE
$CASE	(DS%FIL)			;** DISPLAY  FILE DESCRIPTOR
	$CALLB	BK$PROL			;GET PTR TO PROLOGUE
	JUMPLE	T1,L$UNW		;OOPS
	MOVEM	T1,PB			;PERMANIZE PTR TO PROLOGUE
	RETURN	<RF>			;DONE
$ENDUTIL

$ENDSCOPE	(TOP-LEVEL)

END