Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/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