Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/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/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 MOVST CONVERSION TABLES
REPEAT 0,< ;[430] Remove 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
> ;[430] Remove tables
REPEAT 0,< ;[430] Remove tables
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
> ;[430] Remove tables
REPEAT 0,< ;[430] Remove tables
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
> ;[430] Remove tables
REPEAT 0,< ;[430] Remove tables
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
> ;[430] Remove tables
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