Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/utltop.mac
There are 11 other files named utltop.mac in the archive. Click here to see a list.
TITLE	UTLTOP - TOP-LEVEL CODE OF RMSUTL
SUBTTL	A. UDDIN
SEARCH	RMSMAC,RMSINT,CMDPAR
$PROLOG(UTL)

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	(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	(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,2)			;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

$PURE

SUBTTL	ERROR MESSAGES

$FMT	(UTLAFF,<?UTLAFF access path to bucket clobbered or bucket not part of specified index>)
$FMT	(UTLBND,<?UTLBND Current bucket not a data bucket>)
$FMT	(UTLBNF,<?UTLBNF bucket not in file>)
$FMT	(UTLBNI,<?UTLBNI bucket not part of specified index>)
$FMT	(UTLCAE,<?UTLCAE cannot access entries when invalid bucket header>)
$FMT	(UTLCIE,<? ,-CA%ASZ>)
$FMT	(UTLDBC,<[A data bucket is already current]>)
$FMT	(UTLDAI,<%UTLDAI data fields after the 16th ignored>)
$FMT	(UTLDSV,<%UTLDSV datafield shorter than value>)
$FMT	(UTLDXP,<?UTLDXP datafield extends past end of record>)
$FMT	(UTLENA,<?UTLENA LAST-ENTRY not applicable unless current index is 0>)
$FMT	(UTLENB,<?UTLENB entry ,-CA%NUM, not in bucket>)
$FMT	(UTLEPC,<?UTLEPC RMS file empty or prolog CHANGEd (re-open file)>)
$FMT	(UTLFAO,<?UTLFAO a report file already open>)
$FMT	(UTLFIE,<%UTLFIE file is empty>)
$FMT	(UTLFNI,<?UTLFNI file does not have that index>)
$FMT	(UTLFNA,<?UTLFNA file does not have that area>)
$FMT	(UTLFNO,<?UTLFNO file not open>)
$FMT	(UTLIBS,<?UTLIBS invalid byte size for file>)
$FMT	(UTLIDF,<%UTLIDF inconsistencies detected in file>)
$FMT	(UTLIFP,<?UTLIFP invalid field for POINTER record>)
$FMT	(UTLINB,<?UTLINB ID ,-CA%NUM,-CA%ASZ, not in bucket>)
$FMT	(UTLIPX,<?UTLIPX invalid primary XAB>)
$FMT	(UTLISC,<?UTLISC invalid syntax in command>)
$FMT	(UTLIVF,<?UTLIVF invalid value in field>)
$FMT	(UTLIUE,<?UTLIUE internal utility error>)
$FMT	(UTLIOF,<?UTLIOF invalid option for file organization>)
$FMT	(UTLKIB,<?UTLKIB keys have inconsistent byte sizes>)
$FMT	(UTLNAD,<?UTLNAD name already defined>)
$FMT	(UTLNCR,<?UTLNCR no current record>)
$FMT	(UTLNBL,<[Next bucket is leftmost]>)
$FMT	(UTLNLR,<?UTLNLR no last record>)
$FMT	(UTLNNK,<?UTLNNK ,-CA%ASZ, not known>)
$FMT	(UTLNOO,<?UTLNOO RMS file not open for output>)
$FMT	(UTLNOP,<?UTLNOP RMS file not open for patching>)
$FMT	(UTLNPS,<?UTLNPS no position specified for datafield>)
$FMT	(UTLNRW,<?UTLNRW no record within records-to-use range>)
$FMT	(UTLNRF,<?UTLNRF not an RMS indexed file>)
$FMT	(UTLPKC,<?UTLPKC primary key can't change>)
$FMT	(UTLPNO,<?UTLPNO current position in index not occupied>)
$FMT	(UTLPNE,<?UTLPNB page ,-CA%NUM, not start of bucket OR ,-CA%ASZ, clobbered OR not part of index ,-CA%NUM>)
$FMT	(UTLPNI,<[Page ,-CA%NUM, not start of bucket OR ,-CA%ASZ, clobbered OR not part of index ,-CA%NUM,]>)
$FMT	(UTLPPE,<?UTLPPE page ,-CA%NUM, past end of file>)
$FMT	(UTLRAO,<?UTLRAO RMS file already open>)
$FMT	(UTLRBC,<[Root bucket is already current]>)
$FMT	(UTLRNF,<?UTLRNF record ,-CA%RFA, not found>)
$FMT	(UTLRNX,<?UTLRNX current record no longer exists>)
$FMT	(UTLRSR,<?UTLRSR /RECORD-SIZE required for files with FIXED format>)
$FMT	(UTLSEN,<?UTLSEN specified entry not in bucket>)
$FMT	(UTLSIN,<?UTLSIN specified ID not in bucket>)
$FMT	(UTLSNF,<%UTLSNF starting record not found -- using 1st in bucket>)
$FMT	(UTLSRK,<[Current record was set to first with matching key]>)
$FMT	(UTLSTL,<?UTLSTL subscript too large>)
$FMT	(UTLTFU,<?UTLTFU name table full -- no more DEFINEs allowed>)
$FMT	(UTLTMS,<?UTLTMS too many segments in the key>)
$FMT	(UTLURF,<-CA%ASZ, because of unexpected RMS status code: ER$,-CA%ASZ,/,-CA%OCT>)
$FMT	(UTLUSR,<[Unable to set up current record]>)
$FMT	(UTLVEX,<?UTLVEX valid entry may not be expunged>)
$FMT	(UTLWTN,<?UTLWTN ,-CA%ASZ, is wrong type of name>)
$FMT	(UTLXRF,<-CA%ASZ, because ,-CA%ASZ>)
$FMT	(UTLXND,<?UTLXND XAB not defined>)

; VERIFY MESSAGES
;
$FMT	(UTLAKF,<Access by key ,-CA%NUM, failed for ,-CA%RFA,-CA%ASZ>)
$FMT	(UTLAKM,<		also
Access by key ,-CA%NUM, may fail for ,-CA%RFA, [Fixable if so]>)
$FMT	(UTLASB,<[Aborting scan of current bucket],-CA%CRLF>)
$FMT	(UTLASK,<[Aborting scan of key ,-CA%NUM, -- data bucket chain contains loop]>)
$FMT	(UTLBCL,< Data bucket clutter	,-CA%NUM,%>)
$FMT	(UTLBNC,<Data bucket at page ,-CA%NUM, points at page ,-CA%NUM, but succeeding index entry does not>)
$FMT	(UTLCRS,<[Changing to /NOFIX scan because of following inconsistency]>)
$FMT	(UTLERL,<[Empty RFA list for ,-CA%RFA,]>)
$FMT	(UTLNMR,<No matching data record for RFA ,-CA%NUM, (,-CA%RFA,) of ,-CA%RFA,-CA%ASZ>)
$FMT	(UTLPNV,<Page ,-CA%NUM, not start of bucket OR ,-CA%ASZ, clobbered OR not part of index ,-CA%NUM>)
$FMT	(UTLSSC,<[Space scan of key ,-CA%NUM, complete]
 Data bucket fullness	,-CA%NUM,%>)
$FMT	(UTLVCM,<[VERIFY of key ,-CA%NUM, complete -- ,-CA%NUM, records scanned]>)
$FMT	(UTLVEF,<-CA%ASZ, for ,-CA%RFA,-CA%ASZ>)
$FMT	(UTLVEM,<-CA%ASZ, for ,-CA%RFA>)
$FMT	(UTLVPR,<[Progess Checkpoint at key ",-CA%STP,"]>)

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>)
		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	MOVST CONVERSION TABLES

A.TO.S::	;ASCII TO SIXBIT CONVERSION

XWD	000074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400000
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	000074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400074,400074
XWD	400000,000001
XWD	400002,400003
XWD	400004,400005
XWD	400006,400007
XWD	400010,400011
XWD	400012,400013
XWD	400014,400015
XWD	400016,400017
XWD	000020,400021
XWD	400022,400023
XWD	400024,400025
XWD	400026,400027
XWD	400030,400031
XWD	000032,400033
XWD	400034,400035
XWD	400036,000037
XWD	000040,400041
XWD	400042,400043
XWD	400044,400045
XWD	400046,400047
XWD	400050,400051
XWD	400052,400053
XWD	400054,400055
XWD	400056,400057
XWD	400060,400061
XWD	400062,400063
XWD	400064,400065
XWD	400066,400067
XWD	400070,400071
XWD	400072,000073
XWD	400074,000075

XWD	400076,400077
XWD	000074,400041
XWD	400042,400043
XWD	400044,400045
XWD	400046,400047
XWD	400050,400051
XWD	400052,400053
XWD	400054,400055
XWD	400056,400057
XWD	400060,400061
XWD	400062,400063
XWD	400064,400065
XWD	400066,400067
XWD	400070,400071
XWD	400072,000073
XWD	400074,000075
XWD	400074,400074

S.TO.A::	;SIXBIT TO ASCII

XWD	400040,400041
XWD	400042,400043
XWD	400044,400045
XWD	400046,400047
XWD	400050,400052
XWD	400052,400053
XWD	400054,400055
XWD	400056,400057
XWD	400060,400061
XWD	400062,400063
XWD	400064,400065
XWD	400066,400067
XWD	400070,400071
XWD	400072,400073
XWD	400074,400075
XWD	400076,400077
XWD	400100,400101
XWD	400102,400103
XWD	400104,400105
XWD	400106,400107
XWD	400110,400111
XWD	400112,400113
XWD	400114,400115
XWD	400116,400117
XWD	400120,400121
XWD	400122,400123
XWD	400124,400125
XWD	400126,400127
XWD	400130,400131
XWD	400132,400133
XWD	400134,400135
XWD	400136,400137

E.TO.A::	;EBCDIC TO ASCII

XWD	300000,700001
XWD	700002,700003
XWD	700024,700011
XWD	700016,700177
XWD	700134,700134
XWD	700134,700013
XWD	700014,700134
XWD	700134,700134
XWD	300134,700134
XWD	700134,700034
XWD	700021,700015
XWD	700010,700026
XWD	700134,700031
XWD	700032,700134
XWD	700134,700134
XWD	700134,700134
XWD	300036,700035
XWD	700037,700134
XWD	700020,700012
XWD	700027,700033
XWD	700134,700134
XWD	700030,700134
XWD	700134,700005
XWD	700006,700007
XWD	300134,700134
XWD	700134,700134
XWD	700022,700023
XWD	700017,700004
XWD	700134,700134
XWD	700134,700134
XWD	700134,700025
XWD	700134,700134
XWD	400040,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134

XWD	700134,700056
XWD	700074,700050
XWD	700053,700174
XWD	300046,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700041,700044
XWD	700052,700051
XWD	700073,700136
XWD	700055,700057
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700054
XWD	700045,700137
XWD	700076,700077
XWD	300134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700140
XWD	700072,700043
XWD	700100,700047
XWD	700075,700042
XWD	300134,400141
XWD	400142,400143
XWD	400144,400145
XWD	400146,400147
XWD	400150,400151
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	300134,400152
XWD	400153,400154
XWD	400155,400156
XWD	400157,400160
XWD	400161,400162
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	300134,700176
XWD	400163,400164
XWD	400165,400166
XWD	400167,400170
XWD	400171,400172
XWD	700134,700134
XWD	700134,700133
XWD	700134,700134
XWD	300134,700134
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134

XWD	700134,700134
XWD	700134,700134
XWD	700134,700135
XWD	700134,700134
XWD	300173,400101
XWD	400102,400103
XWD	400104,400105
XWD	400106,400107
XWD	400110,400111
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	300175,400112
XWD	400113,400114
XWD	400115,400116
XWD	400117,400120
XWD	400121,400122
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	300134,700134
XWD	400123,400124
XWD	400125,400126
XWD	400127,400130
XWD	400131,400132
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134
XWD	300060,700061
XWD	700062,700063
XWD	700064,700065
XWD	700066,700067
XWD	700070,700071
XWD	700134,700134
XWD	700134,700134
XWD	700134,700134

A.TO.E::	;ASCII TO EBCDIC

XWD	000000,400001
XWD	400002,400003
XWD	400067,400055
XWD	400056,400057
XWD	400026,400005
XWD	400045,400013
XWD	400014,400025
XWD	400006,400066
XWD	000044,400024
XWD	400064,400065
XWD	400004,400075
XWD	400027,400046
XWD	400052,400031
XWD	400032,400047
XWD	400023,400041
XWD	400040,400042
XWD	400100,000132
XWD	400177,400173
XWD	400133,400154
XWD	400120,400175
XWD	400115,400135
XWD	400134,400116
XWD	400153,400140
XWD	400113,400141
XWD	000360,400361
XWD	400362,400363
XWD	400364,400365
XWD	400366,400367
XWD	400370,400371
XWD	000172,400136
XWD	400114,400176
XWD	400156,000157
XWD	000174,400301
XWD	400302,400303
XWD	400304,400305
XWD	400306,400307
XWD	400310,400311
XWD	400321,400322
XWD	400323,400324
XWD	400325,400326
XWD	400327,400330
XWD	400331,400342
XWD	400343,400344
XWD	400345,400346
XWD	400347,400350
XWD	400351,000255

XWD	400340,000275
XWD	400137,400155
XWD	000171,400201
XWD	400202,400203
XWD	400204,400205
XWD	400206,400207
XWD	400210,400211
XWD	400221,400222
XWD	400223,400224
XWD	400225,400226
XWD	400227,400230
XWD	400231,400242
XWD	400243,400244
XWD	400245,400246
XWD	400247,400250
XWD	400251,000300
XWD	400117,000320
XWD	400241,400007

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
	$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)
	$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$TOUT,<[UTLCIE],PRT.EM(T2)>	;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	BARFEX			;YES
INTERR::				;INTERNAL ERROR WHILE IN BLISS
	$FETCH	T2,STS,(T1)		;GET RET CODE
	CAIN	T2,ER$BUG		;IS IT RMS BUG?
	JRST	BARFEX			;YES, LET RMS GENERATED MSG SUFFICE
	$CHKERR	(?UTLIUE internal utility error)
	ERRU	(IUE)			;SHOULD BE UNREACHABLE
BARFEX::
	$CALL	SY.EXIT			;RET TO EXEC
	JRST	.-1			;AND DONT ALLOW RE-ENTER

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	(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