Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE	UTLTOP - TOP-LEVEL CODE OF RMSUTL
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:
;
;	UTLTOP contains top-level code and globals for 
;	RMSUTL.
;
; ENVIRONMENT:	User mode?
;
; AUTHOR: Anwar Uddin, CREATION DATE: 1980
;
; MODIFIED BY:
;
;	Ron Lusk, 3-Feb-84 : VERSION 2.0
;
;  71   -	Put copyright notice in RMSUTL.EXE
; 423	-	Clean up for version 2.0 of RMS.
; 430	-	Remove conversion tables; they're in RMSM2 now
; 434	-	RMSUTL does not just do indexed files
; 435	-	Create RMSM2 format statements
; 455	-	Use RMSM2 for all output.  Change ER$BUG code to
;		output message and additional monitor/RMS info.
;
;	Ron Lusk, 6-Mar-85 : VERSION 3.0
;
; 562	-	Call UTLSET to initialize RMS.  The first time,
;		UTLSET will merge in RMS-SINGLE-SECTION.EXE,
;		save the RMS entry vector word, and create some
;		PDVs; a SAVE command will then save RMSUTL.EXE.
;		Then, on subsequent runs, UTLSET will use the
;		SDVEC% JSYS to tell the monitor to use the RMS
;		internal to RMSUTL.  This overcomes problems
;		arising from RMSUTL's expectations of finding
;		RMS in section 0, when RMS v3 has moved to a
;		non-zero section.
;--
SEARCH	RMSMAC,RMSINT
$PROLOG(UTL)
SEARCH	CMDPAR

LOC 137		;VERSION #
$VERS

; THIS MODULE CONTAINS THE TOP-LEVEL CODE FOR RMSUTL:
; THE CALL TO PARSE$ AND THE CMD PROCESSORS C.*.
;
; IT ALSO CONTAINS ALL THE GLOBAL DATA FOR RMSUTL.

; $E - MACRO TO ALLOCATE RMS FILE ENTITY-FIELD DESCRIPTOR
;
;	FULNAM = TEXT FOR DISPLAY OF THIS FLD
;	BLK = PREFIX ON ITS $BLOCK DEFINITION
;	NAME = THE SUFFIX ON ITS $BLOCK ENTRY
;	VALPFX = IF SYMBOLIC VALS APPLY TO THIS FLD, PREFIX OF THEIR NAMES
;	VALUE = LIST OF LEGAL VALS... SYMBOL ASSUMED = TO TEXT TO DISPLAY
;
DEFINE	$E (FULNAM,BLK,NAME,VALPFX,VALUE),<
	ZZ==0
	IRP	VALUE,<ZZ==ZZ+1>		;COUNT # OF VALUES
	IFNDEF	E.'NAME,<E.'NAME::>
	BLK'$'NAME(PB)				;;BYTE PTR TO FIELD
	XWD	ZZ,F.'NAME			;COUNT,,TYPE OF DATA
	XWD	0,[ASCIZ/FULNAM/]		;PTR TO NAME OF FIELD FOR PRINTING
	IRP	VALUE,<XWD  [ASCIZ/VALUE/],VALPFX'$'value>
	>

DEFINE $SH(FLD$)<<E%'FLD$_9>>	;;KLUDGE TO SET TYP/FLAG AT SAME TIME

; MISCEL VALUES
;
FB$ALL==FB$ALL			;GET+PUT+DEL+TRN+UPD
SZ%RBUF==^D160			;ROOM FOR TWO FULL LINES
UT%DBAD==:UT%EMP!UT%PCH		;NEEDED IN BK$GET (BLISS ROUTINE)

; BKT TYPES (DONE THIS WAY SO THEY CAN REFFED IN BLISS)
;
BTY%CLOB==:BTY%CLOB			;BKT CLOBBED
BTY%IDX==:BTY%IDX			;INDEX BKT
BTY%PRIM==:BTY%PRIM			;UDR BKT
BTY%SEC==:BTY%SEC			;SEC DATA BKT

SUBTTL	DATA VARIABLES FOR RMSUTL

SZ%STK==400

$IMPURE
	
$DATA	(STACK,SZ%STK)
$DATA	(TXTBUF,SZ%RBUF/5)		;RPT FILE BUFFER

$GDATA	(BUF$K1,^D256/4)		;SPACE FOR ARBIT KEY VALUE
$GDATA	(BUF$K2,^D256/4)		;SPACE FOR ARBIT KEY VALUE
$GDATA	(BYTYPE)			;[455] FILE BYTE TYPE FOR RMSM2
$GDATA	(CU.BKT)			;CURRENT BUCKET NO.
$GDATA	(CU.KRF)			;CURRENT INDEX(KEY OF REF)
$GDATA	(CU.REC)			;RFA OF CURRENT RECORD
$GDATA	(CU.HREC)			;HI BNDARY OF SCAN
$GDATA	(CU$ENT)			;LAST ENTRY RET BY BK$ID OR BK$ENT
$GDATA	(CU.ID)				;ID OF LAST ENTRY REFFED IN BKT
$GDATA	(CU.NRP)			;NRP OF LAST REC SUCC RET BY US.NEXT (FOR BUS)
$GDATA	(CU.RST,^D14)			;PTR TO BLK OF RST DATA FOR CURR REC
$GDATA	(CU$TYPE)			;CURRENT BKT'S TYPE (BK$GET COMPUTES)
$GDATA	(FAB)				;ADDR OF FAB BLK FOR RMS FILE
$GDATA	(FST)				;FST FOR FROM FAB (USED BY SIZEOF...)
$GDATA	(KDB)				;KEY DESCRIPTOR BLOCK FOR CURR KEY
$GDATA	(KSIZB)				;BYTES IN CURR KEY
$GDATA	(KSIZW)				;WORDS IN CURR KEY
$GDATA	(KTYPE)				;[455] KEY TYPE FOR RMSM2 OUTPUT
$GDATA	(NRP$AD)			;PTR TO RSTNRP
$GDATA	(OUTRAB)			;ADDR OF RAB FOR REPORT FILE
$GDATA	(PATH)				;PTR TO INDEX PATH TAKEN ON KEY ACC
$GDATA	(RAB)				;ADDR OF RAB BLK FOR RMS FILE
$GDATA	(RST)				;INTERN VERS OF RAB
$GDATA	(SCANNING)			;SET IF VERIF/UNCLUT (SEE RC$FIND)
$GDATA	(SC$CASE)			;CTL UTLVFY PROCESSING
$GDATA	(STCINA)			;MOVST TABLE FOR FILE TYPE TO ASCII
$GDATA	(STCAIN)			;CONV ASCII TO INTERNAL FORM
$GDATA	(STFILL)			;FILL CHAR FOR FILE BYTES
$GDATA	(STRIPT,3)			;[455] STRING WITH FILE BYTE SIZE IN IT
$GDATA	(TEXTBP)			;BP INTO RPT FILE BUFFER
$GDATA	(TTYRAB)			;ADDR OF RAB FOR TTY REPORT FILE
$GDATA	(UTLFLG)			;FLAG WORD
$GDATA	(V$ACC)				;-1 SAYS ACCESS BY ALL 2NDARY KEYS
					;0 SAYS DONT ACC AT ALL
$GDATA	(V$ERR)				;CNT OF INCONSIS DETECTED BY UTLVFY
$GDATA	(V$FIX)				;-1 SAYS YES, 0 SAYS NO
$GDATA	(V$PREQ)			;PROGRESS DISPLAY FREQ DESIRED BY USER

SYN	$GDATA,DCL$GL			;DATA FOR RMSMES
DC$MES
DC$MS2					;[423] Data for RMSMS2
$PURE

SMNCPY:	ASCIZ\

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

\ ;[71]

SUBTTL	ERROR MESSAGES


UTLAFF::ASCIZ\?UTLAFF access path to bucket clobbered or bucket not part of specified index\
UTLBND::ASCIZ\?UTLBND Current bucket not a data bucket\
UTLBNF::ASCIZ\?UTLBNF bucket not in file\
UTLBNI::ASCIZ\?UTLBNI bucket not part of specified index\
UTLCAE::ASCIZ\?UTLCAE cannot access entries when invalid bucket header\
UTLCIE::ASCIZ\? ^A\
UTLDAI::ASCIZ\%UTLDAI data fields after the 16th ignored\
UTLDBC::ASCIZ\[A data bucket is already current]\
UTLDSV::ASCIZ\%UTLDSV datafield shorter than value\
UTLDXP::ASCIZ\?UTLDXP datafield extends past end of record\
UTLENA::ASCIZ\?UTLENA LAST-ENTRY not applicable unless current index is 0\
UTLENB::ASCIZ\?UTLENB entry ^1^A not in bucket\
UTLEPC::ASCIZ\?UTLEPC RMS file empty or prolog CHANGEd (re-open file)\
UTLFAO::ASCIZ\?UTLFAO a report file already open\
UTLFIE::ASCIZ\%UTLFIE file is empty\
UTLFNA::ASCIZ\?UTLFNA file does not have that area\
UTLFNI::ASCIZ\?UTLFNI file does not have that index\
UTLFNO::ASCIZ\?UTLFNO file not open\
UTLIBS::ASCIZ\?UTLIBS invalid byte size for file\
UTLIDF::ASCIZ\%UTLIDF inconsistencies detected in file\
UTLIFP::ASCIZ\?UTLIFP invalid field for POINTER record\
UTLINB::ASCIZ\?UTLINB ID ^1^A not in bucket\
UTLIOF::ASCIZ\?UTLIOF invalid option for file organization\
UTLIPX::ASCIZ\?UTLIPX invalid primary XAB\
UTLISC::ASCIZ\?UTLISC invalid syntax in command\
UTLIUE::ASCIZ\?UTLIUE internal utility error\
UTLIVF::ASCIZ\?UTLIVF invalid value in field\
UTLKIB::ASCIZ\?UTLKIB keys have inconsistent byte sizes\
UTLNAD::ASCIZ\?UTLNAD name already defined\
UTLNBL::ASCIZ\[Next bucket is leftmost]\
UTLNCR::ASCIZ\?UTLNCR no current record\
UTLNLR::ASCIZ\?UTLNLR no last record\
UTLNNK::ASCIZ\?UTLNNK ^A not known\					;A440
UTLNOO::ASCIZ\?UTLNOO RMS file not open for output\
UTLNOP::ASCIZ\?UTLNOP RMS file not open for patching\
UTLNPS::ASCIZ\?UTLNPS no position specified for datafield\
UTLNRF::ASCIZ\?UTLNRF not an RMS file\				;M434
UTLNRW::ASCIZ\?UTLNRW no record within records-to-use range\
UTLPKC::ASCIZ\?UTLPKC primary key can't change\
UTLPNE::ASCIZ\?UTLPNB page ^1 not start of bucket OR ^A clobbered OR not part of index ^A\
UTLPNI::ASCIZ\[Page ^1 not start of bucket OR ^A clobbered OR not part of index ^A]\
UTLPNO::ASCIZ\?UTLPNO current position in index not occupied\
UTLPPE::ASCIZ\?UTLPPE page ^1 past end of file\
UTLRAO::ASCIZ\?UTLRAO RMS file already open\
UTLRBC::ASCIZ\[Root bucket is already current]\
UTLRNF::ASCIZ\?UTLRNF record ^R not found\
UTLRNX::ASCIZ\?UTLRNX current record no longer exists\
UTLRSR::ASCIZ\?UTLRSR /RECORD-SIZE required for files with FIXED format\
UTLSEN::ASCIZ\?UTLSEN specified entry not in bucket\
UTLSIN::ASCIZ\?UTLSIN specified ID not in bucket\
UTLSNF::ASCIZ\%UTLSNF starting record not found -- using 1st in bucket\
UTLSRK::ASCIZ\[Current record was set to first with matching key]\
UTLSTL::ASCIZ\?UTLSTL subscript too large\
UTLTFU::ASCIZ\?UTLTFU name table full -- no more DEFINEs allowed\
UTLTMS::ASCIZ\?UTLTMS too many segments in the key\
UTLURF::ASCIZ\^A because of unexpected RMS status code: ER$^A (^2)\	;M440
UTLUSR::ASCIZ\[Unable to set up current record]\
UTLVEX::ASCIZ\?UTLVEX valid entry may not be expunged\
UTLWTN::ASCIZ\?UTLWTN ^A is wrong type of name\
UTLXND::ASCIZ\?UTLXND XAB not defined\
UTLXRF::ASCIZ\^A because ^A\						;M440
;
; VERIFY MESSAGES
;
UTLAKF::ASCIZ\Access by key ^1 failed for ^R^A\
UTLAKM::ASCIZ\		also^LAccess by key ^1 may fail for ^R [Fixable if so]\
UTLASB::ASCIZ\[Aborting scan of current bucket]^L\
UTLASK::ASCIZ\[Aborting scan of key ^1 -- data bucket chain contains loop]\
UTLBCL::ASCIZ\ Data bucket clutter	^1%\
UTLBNC::ASCIZ\Data bucket at page ^1 points at page ^1 but succeeding index entry does not\
UTLCRS::ASCIZ\[Changing to /NOFIX scan because of following inconsistency]\
UTLERL::ASCIZ\[Empty RFA list for ^R]\
UTLNMR::ASCIZ\No matching data record for RFA ^1 (^R) of ^R^A\
UTLPNV::ASCIZ\Page ^1 not start of bucket OR ^A clobbered OR not part of index ^1\
UTLSSC::ASCIZ\[Space scan of key ^1 complete]^L Data bucket fullness	^1%\
UTLVCM::ASCIZ\[VERIFY of key ^1 complete -- ^1 records scanned]\
UTLVEF::ASCIZ\^A for ^R^A\
UTLVEM::ASCIZ\^A for ^R\
UTLVPR::ASCIZ\[Progress Checkpoint at key "^S"]\

SUBTTL	SYMBOLIC RMS ERROR CODES

; $RMERR - ALLOCATE ONE OR MORE ENTRIES IN ERR STATUS VECTOR
;
DEFINE $RMERR(SFX$)<
	IRP <SFX$>,<$SET(ER$'SFX$-ER$MIN,ASCIZ/SFX$/)>
>

SZ%RME==ER$MAX-ER$MIN+1

RMEVEC::
$INIT	(RME)
$RMERR (<AID,ALQ,ANI>)
$RMERR (<BKS,BKZ,BLN,BSZ,BUG>)
$RMERR (<CCF,CCR,CDR,CEF,CGJ,CHG,COD,COF,CUR>)
$RMERR (<DAN,DEL,DEV,DFL,DLK,DME,DTP,DUP>)
$RMERR (<EDQ,EOF>)
$RMERR (<FAB,FAC,FEX,FLG,FLK,FNA,FNC,FNF,FOP,FSI,FSZ,FUL>)
$RMERR (<IAL,IAN,IBC,IBO,IBS,IFI,IFL,IMX,IOP,IRC,ISI>)
$RMERR (JFN)
$RMERR (<KBF,KEY,KRF,KSZ>)
$RMERR	(LSN)
$RMERR (<MRN,MRS>)
$RMERR (<NEF,NLG,NPK,NXT>)
$RMERR (<ORD,ORG>)
$RMERR (<PEF,PLG,POS,PRV>)
$RMERR (QPE)
$RMERR <RAB,RAC,RAT,RBF,REF,RER,REX,RFA,RFM,RLK,RNF,RNL,ROP,RRV,RSA,RSD,RSZ,RTB>
$RMERR (<SEQ,SIZ>)
$RMERR (<TRE,TRU>)
$RMERR (<UBF,UDF>)
$RMERR (VER)
$RMERR (WER)
$RMERR (<XAB,XCL>)
$ENDINIT

SUBTTL	$E DESCRIPTORS FOR FILE PROLOG

FPGTAB::
	$E	(AREA-COUNT,FP,ARC)
	$E	(AREA-OFFSET,FP,ARO)
	$E	(BUCKET-SIZE,FP,BKS)
	$E	(BYTE-SIZE,FP,BSZ)
	$E	(KEY-COUNT,FP,KYC)
	$E	(KEY-OFFSET,FP,KYO)
	$E	(MAX-RECORD-NUM,FP,MRN)
	$E	(ORGANIZATION,FP,ORG,FB,<SEQUENTIAL,RELATIVE,INDEXED>)
		FB$IND==FB$IDX
	$E	(PAGES-IN-FILE,FP,PIF)
	$E	(RECORD-ATTR,FP,RAT,FB,<BLOCKED>)
		FB$BLO==FB$BLK
	$E	(RECORD-FORMAT,FP,RFM,FB,<VARIABLE,ASCII,LSA,FIXED>)
		FB$ASC==FB$STM
	$E	(RECORD-SIZE,FP,MRS)

	Z			; END OF TABEL

; FLAGS FOR FIELDS IN FILE PROLOG

F.BSZ==DT%DEC			;FROM FAB
F.BKS==DT%DEC
F.MRS==DT%DEC
F.MRN==DT%DEC
F.ORG==DT%SYV
F.RAT==DT%SYB
F.RFM==DT%SYV

F.ARO==DT%DEC			;ONLY IN PROLOG
F.ARC==DT%DEC
F.KYO==DT%DEC
F.KYC==DT%DEC
F.PIF==DT%DEC

SUBTTL	XAB-BASED FLD TYPES & $E DESCRIPTOR FOR FILE AREA

ARETAB::				;AREA DESC
	$E	(BUCKET-SIZE,AD,BKZ)
	Z			;END OF TABLE

F.BKZ==DT%DEC

INDTAB::				;INDEX DESC
	$E	(LEVELS	,KD,LVS)
	$E	(NEXT-KEY,KD,NKP)
	$E	(ROOT-PAGE,KD,ROOT)

	$E	(ATTRIBUTES,KD,KYA,XB,<CHANGEABLE,DUPLICATES>)
		XB$CHA==XB$CHG
	$E	(DATA-AREA,KD,DAN)
	$E	(DATA-FILL,KD,DFL)
	$E	(DATA-TYPE,KD,DTP,XB,<EBCDIC,SIXBIT,ASCII,IN4,IN8,UN4,AS8,PACKED,FL1,FL2,GFLOATING>)
		XB$ASC==XB$STG
	$E	(INDEX-AREA,KD,IAN)
	$E	(INDEX-FILL,KD,IFL)
	$E	(KEY-NAME,KD,KNM)
	$E	(KEY-OF-REF,KD,REF)
	$E	(POS1,KD,POSIT)
	$E	(POS2,KD,PS1)
	$E	(POS3,KD,PS2)
	$E	(POS4,KD,PS3)
	$E	(POS5,KD,PS4)
	$E	(POS6,KD,PS5)
	$E	(POS7,KD,PS6)
	$E	(POS8,KD,PS7)
	$E	(SIZ1,KD,SIZE)
	$E	(SIZ2,KD,SZ1)
	$E	(SIZ3,KD,SZ2)
	$E	(SIZ4,KD,SZ3)
	$E	(SIZ5,KD,SZ4)
	$E	(SIZ6,KD,SZ5)
	$E	(SIZ7,KD,SZ6)
	$E	(SIZ8,KD,SZ7)
	Z

; FLAGS FOR FIELDS IN INDEX DESCRIPTOR

F.LVS==DT%DEC			;ONLY IN IDB
F.NKP==DT%DEC
F.ROOT==$SH(BKT)!DT%DEC

F.AID==DT%DEC			;FROM KEY XAB
F.DAN==DT%DEC
F.DFL==DT%DEC
F.DTP==DT%SYV
F.IAN==DT%DEC
F.IFL==DT%DEC
F.KNM==DT%STR
F.KYA==DT%SYB
F.POSIT==$SH(ARY)!$SH(DIZ)!DT%DEC
F.SIZE==$SH(ARY)!DT%DEC
F.PS1==$SH(INV)!DT%DEC
F.PS2==$SH(INV)!DT%DEC
F.PS3==$SH(INV)!DT%DEC
F.PS4==$SH(INV)!DT%DEC
F.PS5==$SH(INV)!DT%DEC
F.PS6==$SH(INV)!DT%DEC
F.PS7==$SH(ARL)!$SH(INV)!DT%DEC
F.SZ1==$SH(INV)!DT%DEC
F.SZ2==$SH(INV)!DT%DEC
F.SZ3==$SH(INV)!DT%DEC
F.SZ4==$SH(INV)!DT%DEC
F.SZ5==$SH(INV)!DT%DEC
F.SZ6==$SH(INV)!DT%DEC
F.SZ7==$SH(ARL)!$SH(INV)!DT%DEC
F.REF==DT%DEC

SUBTTL	$E DESCRIPTORS FOR BUCKET HEADR IN INDEXED FILE

BUCTAB::
	$E	(AREA-NUMBER,IB,ANO)
	$E	(ATTRIBUTES,IB,IBA,IB,<ROOT,RIGHTMOST>)		;BUCKET HEADER
	$E	(LAST-ID,IB,LID)
	$E	(LEVEL	,IB,LEVEL)
	$E	(NEXT-BUCKET,IB,NBP)
	$E	(NEXT-ID,IB,NID)
	$E	(TYPE	,IB,IBT,IB,<DATA,INDEX>)
	$E	(WORDS-IN-USE,IB,WIU)
	Z			;END OF TABLE

; FLAGS FOR FIELDS IN BUCKET

F.ANO==DT%DEC
F.IBA==DT%SYB
F.IBT==DT%SYV
F.LEVEL==DT%DEC
F.LID==DT%DEC
F.NBP==$SH(BKT)!DT%DEC
F.NID==DT%DEC
F.WIU==DT%DEC

SUBTTL	$E DESCRIPTORS FOR RECORD HEADERS

SRHTAB::			;SEQ/REL DATA RECORD HEADER
;	$E	(ATTRIBUTES,IR,ORA)
;	$E	(RECORD-SIZE,IR,ORS)
;	Z

IXHTAB::				;HDR OF ISAM INDEX ENTRY
	$E	(ATTRIBUTES,IR,IRA,IR,<DELETED,POINTER,HIKEY,KEEP>)
	$E	(DOWN-POINTER,IR,DBP)
	Z
ISHTAB::				;HDR OF SIDR
	$E	(ID-OF-ENTRY,IR,RID)
	$E	(WORDS-IN-ENTRY,IR,SRS)
	Z
IFHTAB::				;HDR OF FIX LEN ISAM UDR (RRV TOO)
	$E	(ATTRIBUTES,IR,IRA,IR,<DELETED,POINTER,HIKEY,KEEP>)
	$E	(ID-OF-ENTRY,IR,RID)
	$E	(RFA-OF-ENTRY,IR,RFA)
	Z
IVHTAB::				;HDR OF VAR LEN ISAM UDR
	$E	(ATTRIBUTES,IR,IRA,IR,<DELETED,POINTER,HIKEY,KEEP>)
	$E	(ID-OF-ENTRY,IR,RID)
	$E	(RFA-OF-ENTRY,IR,RFA)
	$E	(BYTES-IN-ENTRY,IR,IRS)
	Z

; FIELD PROPERTIES FOR RECORD HDRS

F.DBP==$SH(BKT)!DT%DEC			;DOWN PAGE
F.IRA==$SH(RRV)!DT%SYB
F.IRS==DT%DEC				;SIZE OF INDEX-FILE RECS
F.ORA==DT%SYB
F.ORS==DT%DEC				;SIZE OF SIMPLE RECS (SEQ/REL)
F.RFA==$SH(RRV)!DT%RFA
F.RID==$SH(ID)!$SH(RRV)!DT%DEC
F.SRS==DT%DEC				;SIZE OF SIDR

E.SKV==:SP%SKV				;UTLCMD EXPECTS EXTERNALS OF THIS FORM
E.IKV==:SP%IKV
E.RFEL==:SP%RFA
E.POS==:SP%POS
E.SIZ==:SP%SIZ

SUBTTL	INITIALIZED STORAGE FOR EACH TYPE OF ARG BLK

FLDINI::
	$INIT	(UF)
	$SET	(UF.BID,DA$TYP)		;SO COMPAT WITH ARGBLKS
	$SET	(UF.BLN,SZ%UF)		;SO COMPAT WITH ARGBLKS
	$ENDINIT
FABINI::
	FAB$B
	F$SHR	0			;RMSUTL DOES NO SHARING
	F$ORG	FB$SEQ
	F$BSZ	0
	FAB$E
RABINI::
	RAB$B
	R$MBF	^D10			;USE A FAIR # FOR PERF
	RAB$E
XKINI::
	XAB$B	(KEY)
	X$DTP	XB$STG
	XAB$E
	REPEAT <SZ%XK>,<0>		;KEY XAB SUFFIX (UNBND NAMES)
XAINI::
	XAB$B	(ALL)
	XAB$E
XDINI::
	XAB$B	(DAT)
	XAB$E
XSINI::
	XAB$B	(SUM)
	XAB$E

SUBTTL	INITIALIZED DATA STRUCTURES FOR REPORT FILE(STREAM ASCII)

FAA1::
	FAB$B
	F$FAC	FB$PUT
	F$FNA	[ASCIZ/TTY:/]		;USE TTY:  AS DEFAULT
	F$SHR	0
	F$JFN	0
	F$ORG	FB$SEQ
	F$MRS	0
	F$BSZ	7
	F$RFM	FB$STM
	FAB$E

RAA1::
	RAB$B
	R$RAC	RB$SEQ
	RAB$E

SUBTTL	TOP-LEVEL CODE

$SCOPE	(TOP-LEVEL)
$LREG	(PB)				;BASE REGISTER USED IN $E MACROS

$MAIN	(RMSUTL,CMDFAIL,<IOWD SZ%STK,STACK>)
;
;	Do some initialization
;
	SKIPE	.JBREN##	;REENTER ADDR ALREADY SET?
	JRST	START		;YES, FINISH THE REENTER
	$CALL	UTLSET##	;[562] SET UP RMSUTL WITH RMS
	$RMS			;INIT RMS
	$CALL	M.INIT		;INIT MEM MGR
	$CALL	P$INIT		;INIT PARSER
	$COPY	OV.ACT,I RP$PUT	;SET UP ACTION ROUTINE ADDR FOR FULL BUF
	$COPX	OV.LEFT,SZ%RBUF	;CHARS IN RPT BUF
	MOVE	T1,[POINT 7,TXTBUF]	;RE-INIT BUF PTR
	MOVEM	T1,OV.DSIG		;RESET FOR NEXT CALL
	SETZM	TXT$CC		;START WITH CLEAN SLATE IN RPT BUF
	$CALL	RP.INIT		;INIT REPORT FILE (OPEN DFAU DEV=TTY)
LALL
	$CALLB	(TX$SET,<<[[EXP <POINT 7,TXTBUF>,SZ%RBUF]]>,<[RPOUT]>,<[RP$PUT]>>)
XALL				;Set up RMSMS2			;A433
	$COPY	.JBREN,I RMSUTL	;START AT USUAL PLACE TO RE-INIT STK
START:
	SETZM	SCANNING	;PRESUME NOT SCANNING CMD
	$CALL	CS.GET		;INSURE PROPER CURRENCY ENVIR IN PLACE
	MOVEI	T1,PAR.SZ	;# OF WDS IN PARSE BLK
	MOVEI	T2,UTLCMD##	;PT TO PARSE BLK
	$CALL	PARSE$		;DO ACTU PARSING
	JUMPT	L$IFX
	  MOVE	T1,PRT.FL(T2)	;GET THE FLAGS
	  TXNE	T1,P.ENDT	;END OF TAKE?
	  JRST	START		;YES
	  $CALLB TX$OUT,<PRT.EM(T2),[UTLCIE]>	;[455] CMD INPUT ERR, DISP PRVIDED TXT
	  JRST	START
	$ENDIF
	$P	(KEYW)		;GET THE COMMAND-NAME TOKEN
	CASES	T1,MX%		;DISPATCH TO COMMAND PROCESSOR

;	TOP-LEVEL ERROR HANDLER
;

CMDFAIL:
	$EH	(CMDFAIL)
	JRST	START
BUGERR::				;CHK FOR RMS BUG EXIT
	$FETCH	T2,STS,(T1)		;GET RET CODE
	CAIE	T2,ER$BUG		;IS IT RMS BUG?
	POPJ	P,			;NO, RESUME
	JRST	RIEBUG			;[455] YES
INTERR::				;INTERNAL ERROR WHILE IN BLISS
	$FETCH	T2,STS,(T1)		;GET RET CODE
	CAIN	T2,ER$BUG		;IS IT RMS BUG?
	JRST	RIEBUG			;[455] YES, GENERATE RMS MSG
	$CHKERR	(?UTLIUE internal utility error)
	ERRU	(IUE)			;SHOULD BE UNREACHABLE
BARFEX::
	$CALL	SY.EXIT			;RET TO EXEC
	JRST	.-1			;AND DONT ALLOW RE-ENTER
;
; Come here in case of an RMS internal error
;
; This code is a crock, and is heavily dependent on the location
; of text in RMS.  If the STV value is a possible monitor error
; code, then output it as such.  Otherwise, assume that the
; error code is the address of an ASCIZ string with more information
; for the user.  Of course, if the code is 0, don't use either.
;
; Note at RIEN20 (RMS Internal Error, Not TOPS-20) that there is
; an AOS.  The value returned in STV by RMS points to a word with
; the ER$BUG value followed by an ASCIZ string.  We want the ASCIZ
; string address, so we bump the argument to skip over the ER$BUG word.
;
RIEBUG:	$FETCH	T2,STV,(T1)		;[455] GET STV
	JUMPE	T2,RIENFI		;[455] NO FURTHER INFORMATION
	PUSH	P,T2			;[455] SAVE IT - WE'LL USE IT
	CAIG	T2,.ERMAX+600000	;[455] POSSIBLE MONITOR ERROR?
	CAIGE	T2,600000		;[455] ...
	  JRST	RIEN20			;[455] NOT THE 20 - USE RMS INFO
RIEMON:	PUSH	P,[MONTXT]		;[455] PRINT MONITOR ERROR INFO
	JRST	RIETYP			;[455] PRINT MESSAGE

RIENFI:	PUSH	P,[NOINFO]		;[455] PRINT USELESS MESSAGE
	JRST	RIETYP			;[455] AND LET IT WARN THE USER

RIEN20:	AOS	(P)			;[455] POINT AT RMS ERROR MESSAGE
	PUSH	P,[NONMON]		;[455] PRINT RMS'S INFORMATION
RIETYP:	PUSHJ	P,TX$OUT		;[455] PRINT MESSAGE
	JRST	BARFEX			;[455] DIE

MONTXT:	ASCIZ\?RMS internal error detected:  ^J.\
NONMON:	ASCIZ\?RMS internal error detected:  ^A.\
NOINFO:	ASCIZ\?RMS internal error detected.\

	

SUBTTL	RMSUTL DISPATCH CODE

$CASE	(%CHANGE)
	$CALL	C.CHANGE
	JRST	START
$CASE	(%CLOSE)
	$CALL	C.CLOSE		;GO DO THE REAL WORK
	JRST	START
$CASE	(%DEFINE)
	$CALL	C.DEFINE	;GO DO THE REAL WORK
	JRST	START
$CASE	(%DELETE)
	$CALL	C.DELETE
	JRST	START
$CASE	(%DISPLAY)
	$CALL	C.DISPLAY	;GO DO THE REAL WORK
	JRST	START
$CASE	(%EXIT)
	$CALL	C.EXIT		;GO DO THE REAL WORK
	JRST	START
$CASE	(%FIX)
	$CALL	C.FIX		;GO DO THE REAL WORK
	JRST	START
$CASE	(%HELP)
	$CALL	C.HELP		;GO DO THE REAL WORK
	JRST	START
$CASE	(%INFORMATION)
	$CALL	C.INFORMATION	;GO DO THE REAL WORK
	JRST	START
$CASE	(%OPEN)
	$CALL	C.OPEN		;GO DO THE REAL WORK
	JRST	START		;START OVER
$CASE	(%REDEF)
	$CALL	C.REDEF
	JRST	START
$CASE	(%SET)
	$CALL	C.SET		;GO DO THE REAL WORK
	JRST	START
$CASE	(%SPACE)
	$CALL	C.SPACE		;GO DO THE REAL WORK
	JRST	START
$CASE	(%TAKE)
	JRST	START
$CASE	(%UNCLUT)
	$CALL	C.UNCLUT
	JRST	START
$CASE	(%VERIFY)
	$CALL	C.VERIFY
	JRST	START

$ENDMAIN


$PROC (RPOUT)
;
; RPOUT - PUT RMSM2 OUTPUT TO REPORT FILE
;
	MOVEI	T1,SZ%RBUF			;Get size of buffer	 ;A433
	SUB	T1,DSTCC			; - chars left 		 ;A433
	MOVEM	T1,TXT$CC			;store it for RP$PUT	 ;A433
	$CALL	RP$PUT				;put it out		 ;A433
	RETT					;and return		 ;A433
$ENDPROC

$PROC	(RP$PUT)
;
; RP$PUT - WRITE OUT RPT BUF & RESET PARAMS
;
RPPUT:
	SKIPN	T1,TXT$CC		;OUTPUT WHAT'S THERE
	$SKIP				;YES, THERE IS SOMETHING
		SETZM	TXT$CC		;INDIC ALL WRITTEN OUT
		MOVE	T2,OUTRAB	;GET PTR TO RPT FILE RAB
		$STORE	T1,RSZ,(T2)	;PUT AWAY LEN
		$PUT	@OUTRAB		;DO RMS CALL
		$CHKERR (?UTLUOP unable to output to report file)
	$ENDIF
	MOVE	T1,[POINT 7,TXTBUF]	;RE-INIT BUF PTR
	MOVEM	T1,OV.DSIG		;RESET FOR NEXT CALL
	RETT

$ENTRY	(RP$TTY)
;
; RP$TTY - PUTS OUTPUT TO TTY IMMED
;
	MOVE	T1,OUTRAB
	CAMN	T1,TTYRAB			;IT IS GOING TO TTY?
	JRST	RPPUT				;YES
	RETT

$ENDPROC
$ENDSCOPE(TOP-LEVEL)
END	RMSUTL