Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/utluse.mac
There are 6 other files named utluse.mac in the archive. Click here to see a list.
TITLE UTLUSE
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:
;
; UTLUSE contains routines to support the bucket- and
; record-to-use clause functions of RMSUTL.
;
; ENVIRONMENT: User mode?
;
; AUTHOR: Anwar Uddin, CREATION DATE: 1980
;
; MODIFIED BY:
;
; Ron Lusk, 3-Feb-84 : VERSION 2.0
;
; 423 - Clean up for version 2.0 of RMS.
; 430 - Set up to initialize for SEQ/REL files
; 432 - Open empty Seq/Rel files w/o errors
; 434 - Parse Seq/Rel record-to-use clause
; 455 - Use TX$OUT (from RMSM2) rather than TX$TOUT (from RMSMES)
; for all message output. Also, fix bug in US.IDX caused
; by "SET INDEX n BUCKET root-of-n" command.
;--
SEARCH RMSMAC,RMSINT
$PROLOG(UTL)
; THIS MODULE SUPPORTS THE BUCKET & RECORD-TO-USE CLAUSE AND RELATED STUFF
; IT PARSES THE RESPECTIVE CLAUSES & DOES THE I/O NECES TO LOC THE DESIRED DATA
$SCOPE (TOP-LEVEL)
$LREG (PB) ;PTR TO CURR RAB
$LREG (FLAGS) ;FLAG REG, SEE US%
; PARSE STATUS FLAGS
;
US%LOW==1B35 ;"LOWEST" SEEN
US%HI==1B34 ;"HIGHEST" SEEN
US%1K==1B33 ;JUST ONE KEY SPECIFIED
US%FND==1B32 ;FOUND-KEY SPEC
$IMPURE
$DATA (EQHREC) ;-1 = US.NEXT SHOULD SUCC ON CU.HREC
;0 = US.NEXT SHOULD 1ST FAIL ON HREC
$DATA (RSTEMP,^D14) ;SPACE FOR RST INFO
$DATA (TS.BP) ;BP FOR TEST VALUE (OR NUMERIC VAL)
$DATA (TS.LEN) ;# OF CHARS IN IT
$DATA (TS.OPR) ;THE TEST TO PERFORM
$DATA (TS.SYM) ;PTR TO UF. NODE OF "FOR" VAR
$PURE
ASCLE: ASCIZ/<=/ ; > IN CASE MACRO GETS CONFUSED
; THESE REGISTERS ARE SPECIFICALLY ORDERED FOR USAGE BY THE
; EXTENDED INSTRUCTION SET
;
$REG (T.SLEN,T1) ;SOURCE STR LEN
$REG (T.SBP,T2) ;SOURCE STR BP
$REG (T.ARG,T3) ;PTR TO VALUE OF ARGUMENT
$REG (T.DLEN,T4) ;DEST STR LEN
$REG (T.DBP,T5) ;DEST STR BP
SUBTTL VALUE PROCESSING TO SUPPORT USE CLAUSES
$SCOPE (VALUE PROCESSING)
$LOCALS
$WORD (IDXTOO) ;ON IF IDX PART OF RFA SPEC
$WORD (RFAVAL) ;VALUE OF RFA COMPUTED
$WORD (TEMPST,2) ;TEMP STRING PTR
$WORD (XTINST) ;THE SELECTED EIS OPTION
$WORD (XTFILL,2) ;THE FILL CHARACTER FOR THE MOVE/COMPARE
$ENDLOC
$PROC (CM.OPR,<SORCSP,DESTSP,OPRCOM>)
;
; CM.OPR - COMPARE SRC STRING TO DEST STRING
; ARGUMENTS:
; NOTES:
; INTEGERS CAN BE PASSED USING FULL-WORD BYTE PTRS
MOVE T1,@OPRCOM(AP) ;PREPARE TO SET COMPARE INST
CAMN T1,[ASCIZ/=/]
MOVE T2,[CMPSE] ;STRINGS EQUAL?
CAMN T1,[ASCIZ/#/]
MOVE T2,[CMPSN] ;NOT = ?
CAMN T1,[ASCIZ/>=/]
MOVE T2,[CMPSGE] ;GTR THAN OR = ?
CAMN T1,[ASCIZ/>/]
MOVE T2,[CMPSG] ;GTR THAN?
CAMN T1,[ASCIZ/<=/]
MOVE T2,[CMPSLE] ;LESS THAN OR = ?
CAMN T1,[ASCIZ/</]
MOVE T2,[CMPSL] ;LESS THAN?
MOVEM T2,XTINST(P) ;STORE INST
DMOVE T.SLEN,@SORCSP(AP) ;GET SOURCE DATA
DMOVE T.DLEN,@DESTSP(AP) ;GET DEST DATA
$ENDARG
EXCH T.SLEN,T.SBP ;ORIENT FOR EXTEND
EXCH T.DLEN,T.DBP ;DITTO
$COPY XTFILL(CF),STFILL,TAP ;SETUP FILL CHAR
MOVEM TAP,XTFILL+1(CF) ;FOR BOTH STRINGS
EXTEND T.SLEN,XTINST(CF) ;DO THE COMPARE
RETF ;COMPARE FAILED
RETT
$ENDPROC
$WORD (XTNTAB,2) ;OPCODE, TABLE, & FILE
$ENDLOC
$PROC (CP.STR,<SORCSP,DESTSP,TABCNV,FILLCH>)
;
; CP.STR - COPIES THE SPEC STRING, CONVERTING BYTES IN NECES
; ARGUMENTS:
; SORCSP = STRING PTR TO SOURCE (BP FOLL BY LEN)
; DESTSP = STRING PTR TO COPY TO
; TABCNV = MOVST TABLE TO USE OR 0
; FILLCH = FILL CHAR IF DEST LONGER, REQUIRED ONLY IF DLEN NOT 0
MOVEI T.ARG,@TABCNV(AP) ;GET TABLE TO USE (IF APPLIC)
DMOVE T.SLEN,@SORCSP(AP) ;MATER SRC INFO
EXCH T.SLEN,T.SBP ;EXTEND WANTS BP/LEN BACKWARDS
DMOVE T.DLEN,@DESTSP(AP) ;DITTO DEST
EXCH T.DLEN,T.DBP ; DONE
JUMPN T.DLEN,L$JUMP ;DEFAULT TO INPUT LEN?
MOVEM T.SLEN,T.DLEN ;YES
SETZM XTFILL(P) ;MAKE FILL KNOWN VAL FOR CONSIS
JRST L$IFX
$JUMP ;NO, MAY NEED FILL CHAR
$COPY XTFILL(P),@FILLCH(AP),TAP ;COPY FILL CHAR
$ENDIF
$ENDARG
SKIPN T.ARG ;TRANSLATING
SKIPA T.ARG,[MOVSLJ] ;NO, PLAIN COPY
HRLI T.ARG,(MOVST) ;YES, MERGE TABLE & OPCODE
MOVEM T.ARG,XTINST(CF) ;PERMANIZE
EXTEND T.SLEN,XTINST(CF) ;DO THE COPY
$NOSKIP ;SHORTER DEST
$CALLB TX$OUT,<[UTLDSV##]> ;[455] DAT FLD SHORTER THAN VALUE
$ENDIF
RETT ;DONE
$ENDPROC
$PROC (CP.RFA)
;
; CP.RFA - EAT RFA FROM CMD LINE, VERIFY THAT IT POINTS AT ENTRY
; RETURNS:
; T1 = VALUE OF RFA SPEC ON CMD LINE
SETZM IDXTOO(CF) ;INDIC USER RFA
RFAMRG:
$P (NUM) ;PICK UP BKT OF RFA
MOVEM T1,RFAVAL(CF) ;STORE IN RFA
$P (TOK) ;PICK UP SLASH
$P (NUM) ;PICK UP ID
HRLM T1,RFAVAL(CF) ;FINISH BUILDING RFA
SKIPL T1,IDXTOO(CF) ;INDEX THERE TOO?
$SKIP ;YES, PICK IT UP
$P (NUM) ;GOT IT
MOVEM T1,CU.KRF ;PERMANIZE IT
$ENDIF
$CALLB M$KDB,<T1> ;SET TO 0 OR SPECIFIED INDEX
JUMPE T1,L$ERRU(FNI) ;BAD KREF IF JUMP
HRRZ T1,RFAVAL(CF) ;GET BKT NUM BACK
$CALLB BK$UP,<T1> ;MAKE SURE RFA'S BKT OK
JUMPL T1,L$UNW ;OOPS
$CALLB RC$RFA,<RFAVAL(CF)> ;FIND ENTRY BY RFA
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$ERRU(RNF,RFAVAL(CF)) ;OOPS
$CALLB M$KDB,<CU.KRF> ;RESTOR CURR KREF (IF IDXTOO, IS REDUND)
RETT <RFAVAL(CF)> ;WITH RFA FROM CMD LINE
$ENTRY (CP.XFA)
;
; CP.XFA - PARSE RFA, INCLUDING ITS INDEX
;
SETOM IDXTOO(CF) ;SET FLAG TO INDIC PARSING INDEX
JRST RFAMRG
$ENDPROC
$PROC (CP.TOK,<STDEST>)
;
; CP.TOK - COPY CMD LINE STRING DIRECTLY TO BUF$K1 USING BP INFO IN STRIPT
; ARGUMENTS:
; STDEST = ADDR TO COPY STRING TO
; RETURNS:
; TRUE, WITH CONVERTED STRING AT STDEST & STRING PTR IN T1/T2
; FALSE, COPY NOT DONE
; NOTES:
; STRIPT/STPLEN POINT TO COPIED STRING ON SUCCESSFUL RETURN
MOVEI T1,@STDEST(AP) ;PLACE TO COPY TO
$ENDARG
HRRM T1,STRIPT ;MERGE INTO BP
MOVEI T1,21 ;KLUDGE A REF TO .CMQST
$CALL P$STR ;RET BP/LEN
JUMPF L$RET ;TRANS RET FAILURE
DMOVEM T1,TEMPST(CF) ;PASS IT HERE
MOVEM T2,STRIPT+1 ;DEST SAME LEN
$CALL CP.STR,<TEMPST(CF),STRIPT,@STCAIN,STFILL>
;COPY TO INTERNAL FMT
DMOVE T1,STRIPT ;RET STRING PTR INFO FOR DEST
RETT
$ENDPROC
$ENDSCOPE(VALUE PROCESSING)
SUBTTL PROCESS THE bucket-to-use CLAUSE
$PROC (US.BKT)
;
; US.BKT - PROCESS A BKT TO USE CLAUSE, STARTING WITH OPTION KEYWORD
; FORMAT:
; DATA-LEVEL!DOWN!ENTRY n!LAST-USED!NEXT!ROOT n!UP
; OUTPUT:
; SETS CU.* AS APPROPRIATE
$CALL P$KEYW ;PICK UP BKT OPTION
JUMPF L$RET ;TRANSIT RET FAILURE
CASES T1,MX%STB ;SET TO BKT OPTIONS
$CASE (STB%DATA)
$CALLB BK$DATA,<CU.BKT> ;GO TO DATA-LEVEL
JUMPLE T1,L$UNW ;OOPS
MOVEM T1,CU.BKT
RETT ;DONE
$CASE (STB%DOWN)
$P (NUM) ;GET ENTRY TO USE
$CALLB BK$DOWN,<CU.BKT,T1> ;GO DOWN
JUMPLE T1,L$UNW ;OOPS
MOVEM T1,CU.BKT
RETT ;DONE
$CASE (STB%LAST) ;USE LAST RECORD
HRRZ T1,CU.NRP ;GET BKT PAGE OF CU.REC FROM RIGHT IDX
JUMPE T1,L$ERRU(NLR) ;NO LAST REC
MOVEM T1,CU.BKT ;MAKE IT CURR BKT
RETT
$CASE (STB%NEXT)
$CALLB BK$NEXT,<CU.BKT> ;GO NEXT
JUMPLE T1,L$UNW ;OOPS
MOVEM T1,CU.BKT
RETT ;DONE
$CASE (STB%ROOT)
$CALLB BK$ROOT,<CU.KRF> ;GET ROOT
JUMPL T1,L$UNW ;OOPS
CAMN T1,CU.BKT ;ALREADY AT ROOT?
JRST SEBRBC ;YES
MOVEM T1,CU.BKT ;SET BKT NUM
RETT ;DONE
$CASE (STB%UP)
$CALLB BK$UP,<CU.BKT> ;GO UP
JUMPL T1,L$UNW ;OOPS
JUMPE T1,SEBRBC ;ROOT ALREADY?
MOVEM T1,CU.BKT
RETT ;DONE
SEBRBC:
$CALLB TX$OUT,<[UTLRBC##]> ;[455]
RETT
$ENDPROC
SUBTTL INDEX-LEVEL ROUTINES
$SCOPE (USE-INDEX)
$LREG (FLIM) ;FIND LIMIT
$PROC (US.IDX)
;
; US.IDX - SET INDEX TO USE
; NOTES:
; SET INDEX n BUCKET m!ROOT!RFA a/b
$P (NUM) ;GET KRF
MOVEM T1,CU.KRF ;SAVE IT
$CALLB M$KDB,<CU.KRF> ;INSURE VALID
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$ERRU(FNI) ;NOPE
$P (KEYW) ;GET OPTION
CASES T1,MX%SIL ;DISPATCH TO IT
$CASE (SIL%BUC) ;BUCK (AT PAGE) N
$P (NUM) ;GET PAGE #
MOVEM T1,CU.BKT ;SET BKT
$CALLB BK$GQI,<CU.BKT> ;READ IN THIS BKT (QUIETLY)
JUMPLE T1,L$UNW ;OOPS
SKIPN CU$TYPE ;CLOBBED BKT?
JRST SILUSR ;YES, DONT SET CURR REC
$CALLB BK$UP,<CU.BKT> ;TRY TO VERIFY IDX/BKT RELAT
JUMPL T1,L$UNW ;PROB BAD BKT/IDX COMB
JUMPG T1,L$IFX ;IS ROOT, MAKE SURE RIGHT ONE
$CALLB BK$ROOT,<CU.KRF> ;GET ROOT VIA KREF
CAME T1,CU.BKT ;MATCH?
ERRU (BNI) ;BKT NOT PART OF SPECIFIED INDEX
$ENDIF
HRRZ T2,CURRBD ;[455] GET ADDRESS OF CURRENT BUCKET
LOAD T2,IB$LEV(T2) ;[455] ARE WE AT DATA LEVEL?
JUMPE T2,L$IFX ;YES, DONE ALREADY
$CALLB BK$DATA,<CU.BKT> ;RET NEW BKT
JUMPLE T1,L$UNW ;OOPS
$CALLB BK$GET,<T1> ;GET DATA BKT RETURNED
JUMPLE T1,L$UNW ;OOPS
SKIPN CU$TYPE ;CLOBBED BKT?
JRST SILUSR ;YES, DONT SET CURR REC
$ENDIF
$CALLB BK$ENT,<[1]> ;PICK UP 1ST ENTRY OF THIS BKT
JUMPL T1,L$UNW ;OOPS
JUMPE T1,SILUSR ;JUMP IF BKT EMPTY
SKIPN CU.KRF ;SIDR PTR?
$SKIP ;YES
LOAD T4,IR$SRS(T1) ;WDS IN SIDR
ADDI T4,SZ%ISH-1(T1) ;PT TO LAST WD OF SIDR
MOVE T3,KSIZW ;SET PTR PAST KEY
ADDI T3,IR$SKEY(T1) ;AND HDR
SILSLP:
SKIPE T2,0(T3) ;PICK UP SIDR PTR
JRST L$IFX ;ONE THERE, USE IT
CAME T3,T4 ;REACHED LAST WD OF SIDR YET?
AOJA T3,SILSLP ;NO, COMPARE NXT RFA
SILUSR:
SETZM CU.REC ;CLEAR CURR REC
$CALLB TX$OUT,<[UTLUSR##]> ;[455] UNABLE TO SET CURR REC
RETT ;OTHER STUFF SET
$NOSKIP
LOAD T2,IR$RFA(T1) ;UDR RFA WRD
$ENDIF
MOVEM T2,CU.REC ;USE THIS TO SET SEQ POS
$CALL SILSEQ ;USE ENTRY TO DET KEYVAL AND SEQ POS
JUMPF SILUSR ;CANT SET CURR REC
RETT
$CASE (SIL%RFA) ;RFA BKT/ID
$CALL CP.RFA ;GET RFA FROM CMD LINE (SETS CU.REC)
MOVEM T1,CU.REC ;PASS ENTRY ADDR
$CALL SILSEQ ;SET SEQ POS IN INDEX
JUMPF L$ERRU(RNF,CU.REC) ;CANT FIND REC
HRRZ T1,@NRP$AD ;PICK UP BKT FROM RSTNRP
MOVEM T1,CU.BKT
RETT
$CASE (SIL%ROOT)
$CALL US.INIT
RETT
$UTIL (SILSEQ)
;
; SILSEQ - SET SEQ POS IN INDEX
; RETURNS:
; TRUE IF A RECORD LOCATED (CU.REC MAY BE RESET)
; FALSE IF NO REC FOUND
; NOTES:
; CU.REC MAY BE RFA OR RRV ON ENTRY TO SILSEQ
MOVE PB,RAB ;SET RAB PTR
MOVEI T2,RB$KGE!RB$NRP ;KEY-GTR & SET NRP
$STORE T2,ROP,(PB) ;PUT IT IN RAB
$CALLB M$KUDR,<[BUF$K1],CU.REC>;PUT APPROP KEY OF REC IN KEY BUF
JUMPL T1,L$UNW ;ROUTINE BOMBED
JUMPE T1,L$RETF ;NON-EX REC, NO KEY TO DRIVE PROC
TLNN T1,-1 ;REC DELETED?
JRST SISQAPX ;YES, FIND 1ST WITH MATCHING KEY
MOVEM T1,CU.REC ;SAVE PHYS RFA
MOVEI T2,RB$KEY ;DO KEY ACCESS
$STORE T2,RAC,(PB) ;PUT IT IN RAB
$CALLB RC$FIND ;DO THE KEY FIND
JUMPLE T1,L$RETF ;CANT SET ANYTHING
MOVEI FLIM,^D100 ;GUARD AGAINST LOTS OF DUPS & S-U DEL
MOVEI T2,RB$SEQ ;DO SEQ ACCESS
$STORE T2,RAC,(PB) ;PUT IT IN RAB
JRST SISQL1 ;SKIP SEQ FND 1ST TIME
SISQLP:
$CALLB RC$FIND ;MOVE TO NEXT POS
JUMPLE T1,SISQAPX ;CANT DO IT, SO SET TO 1ST WITH KEY
SISQL1:
CAMN T1,CU.REC ;MATCH CMD ARG?
RETT ;YES, "NORMAL" SUCCESS
SOJG FLIM,SISQLP ;HIT SAFETY LIM? FALL THRU IF DID
SISQAPX:
MOVEI T2,RB$KEY ;DO KEY ACCESS
$STORE T2,RAC,(PB) ;PUT IT IN RAB
$CALLB RC$FIND ;DO THE KEY FIND
JUMPLE T1,L$RETF ;CANT SET ANYTHING
MOVEM T1,CU.REC ;YES, HAVE TO BE SATISFIED WITH THIS
$CALLB TX$OUT,<[UTLSRK##]> ;[455] SET CURR REC TO 1ST WITH KEY
RETT ;"DEGRADED" SUCCESS
$ENDUTIL
$ENDPROC
$ENDSCOPE(USE-INDEX)
SUBTTL ENVIR INITS PERFORMED WHEN FILE OPENED
$PROC (US.INIT)
;
; US.INIT - INIT ALL CURRENCY INDICATORS
;
MOVE T2,FAB ;GET FAB PTR
$FETCH T1,ORG,(T2) ;GET FILE TYPE
CASES T1,FB$IDX ;[430] DISPATCH ON ORGANIZATION
$CASE (FB$SEQ) ;[430] SEQUENTIAL ORGANIZATION
MOVE PB,RAB ;[430] GET RAB
MOVEI T1,RB$SEQ ;[430] SEQUENTIAL ACCESS
$STORE T1,RAC,(PB) ;[430] ...
$GET <(PB)> ;[430] GET FIRST RECORD
$FETCH T1,STS,(PB) ;[432] CHECK STATUS
CAIL T1,ER$MIN ;[432] ...
JRST L$IFX ;[432] ERROR - SKIP NORMAL RETURN
$FETCH T1,RFA,(PB) ;[432] NO ERROR - RETURN NORMALLY
MOVEM T1,CU.REC ;[432] SAVE RFA OF CURRENT RECORD
RETT ;[432] RETURN
$ENDIF ;[432]
CAIE T1,ER$EOF ;[432] END OF FILE?
JRST L$IFX ;[432] NO - SOME OTHER ERROR
SETZM CU.REC ;[432] CLEAR CURRENT RECORD
$FLAGO (UTLFLG,UT%EMP) ;[432] YES - FLAG NO DATA IN FILE
$CALLB TX$OUT,<[UTLFIE##]> ;[455] [432] TELL USER
RETT ;[432] RETURN OK
$ENDIF ;[432]
JRST L$UNW ;[432] QUIT ON OTHER ERRORS
$CASE (FB$REL) ;[430] RELATIVE ORGANIZATION
MOVE PB,RAB ;[430] GET RAB
MOVEI T1,RB$SEQ ;[430] SEQUENTIAL ACCESS
$STORE T1,RAC,(PB) ;[430] ...
$GET <(PB)> ;[430] GET FIRST RECORD
$FETCH T1,STS,(PB) ;[432] CHECK STATUS
CAIL T1,ER$MIN ;[432] ...
JRST L$IFX ;[432] ERROR - SKIP NORMAL RETURN
$FETCH T1,RFA,(PB) ;[432] NO ERROR - RETURN NORMALLY
MOVEM T1,CU.REC ;[432] SAVE RFA OF CURRENT RECORD
RETT ;[432] RETURN
$ENDIF ;[432]
CAIE T1,ER$EOF ;[432] END OF FILE?
JRST L$IFX ;[432] NO - SOME OTHER ERROR
SETZM CU.REC ;[432] CLEAR CURRENT RECORD
$FLAGO (UTLFLG,UT%EMP) ;[432] YES - FLAG NO DATA IN FILE
$CALLB TX$OUT,<[UTLFIE##]> ;[455] [432] TELL USER
RETT ;[432] RETURN OK
$ENDIF ;[432]
JRST L$UNW ;[432] QUIT ON OTHER ERRORS
$CASE (FB$IDX)
$CALLB BK$ROOT,<CU.KRF> ;GET ROOT
JUMPL T1,L$UNW ;OOPS
MOVEM T1,CU.BKT ;TENTA SET BKT NUM
JUMPG T1,L$IFX ;EMPTY IDX?
$FLAGO(UTLFLG,UT%EMP) ;INDIC NO DATA IN FILE
$CALLB TX$OUT,<[UTLFIE##]> ;[455]
;FILE EMPTY (PROLOG CMDS STILL ALLOWED)
RETT
$ENDIF
$CALL US.LOHI,<CU.KRF> ;SET CU.REC
RETT
$CASF
ERRU (IUE)
$ENDPROC
SUBTTL ROUTINE TO GET NEXT RECORD SATISFYING RECS-TO-USE
$SCOPE (RECNEXT)
$LOCALS
$WORD (CURFND) ;PHYS RFA OF JUST GOTTEN REC
$WORD (GETBP,2) ;STRING PTR FOR FLD IN GET BUF
$ENDLOC
$PROC (US.NEXT)
;
; US.NEXT - FINDS RECS & VALIDATES AGAINST END BOUND & "FOR" IF APPLIC
; ARGUMENTS:
; RMS PTS AT CURRENT RECORD IN RIGHT INDEX
; RETURNS:
; FALSE WHEN PAST SCAN RANGE
; TRUE WHEN REC FOUND, WITH REC IN $GET BUFFER & T1 = ITS RFA
;
MOVE T1,FAB ;[434] CHECK ORGANIZATION
$FETCH T1,ORG,(T1) ;[434] ...
CAIN T1,FB$IDX ;[434] INDEXED?
JRST RNEXIX ;[434] YES - PROCEED
SKIPLE EQHREC ;[434] HAVE WE BEEN HERE?
RETF ;[434] YES - RETURN
AOS EQHREC ;[434] FLAG THAT WE'VE BEEN HERE
MOVE PB,RAB ;[434] $GET DESIRED RECORD
MOVEI T1,RB$RFA ;[434] USE RFA
$STORE T1,RAC,(PB) ;[434] ...
MOVE T1,CU.REC ;[434] GET RECORD SPECIFIED
$STORE T1,RFA,(PB) ;[434] ...
$GET <(PB)> ;[434] $GET IT
$CHKERR (<(PB)>) ;[434] CHECK FOR ERRORS
$FETCH T1,RFA,(PB) ;[434] GET RFA SO WE CAN RETURN IT
RETT T1 ;[434] RETURN WITH RFA IN T1
RNEXIX: MOVE PB,RAB ;MATER ARGBLK PTR
MOVEI T1,RB$SEQ ;INSURE SEQ OPERATION
$STORE T1,RAC,(PB) ;DONE
RNEXLP:
SKIPLE EQHREC ;LAST CALL SET DONE COND?
RETF ;YES (IN LOOP IN CASE FOR-WHICH FAILED)
$CALLB RC$GET ;GET PHYS RFA OF FND REC
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$RETF ;HIT EOF
MOVEM T1,CURFND(CF) ;SAV FOR RET
CAME T1,CU.HREC ;HIT END CHK
$SKIP ;YES, SEE TYPE OF EXIT
SKIPL EQHREC ;MATCH MEAN SUCC?
RETF ;NO, (1ST KEY PAST)
MOVMS EQHREC ;YES, INDIC PAST HI NOW
$ENDIF
SKIPN T5,TS.SYM ;IS THERE A TEST PHRASE?
JRST RNEXIT ;NO, SO DONE
$FETCH T4,RBF,(PB) ;SEE WHERE REC PUT
HLL T4,STRIPT ;PRESUME STRING, GET BP INFO
LOAD T1,UF.TYP(T5) ;GET DAT TYPE
CAIL T1,DFT%DEC ;NUMERIC?
HRLI T4,444400 ;USE FULL WORD BP
LOAD T1,UF.POS(T5) ;GET OFFSET IN REC (WD OR BYT AS APPRO)
ADJBP T1,T4 ;PT AT FLD LOC IN REC'S BUFF
MOVEM T1,GETBP(CF) ;PASS THIS
$COPY GETBP+1(CF),UF.SIZ(T5) ;GET SIZE OF FLD TO DRIVE CMP
$CALL CM.OPR,<GETBP(CF),TS.BP,TS.OPR>
;DO COMPARE, NOTE THAT NUMERIC FLDS
; SIMPLY COMPARED AS FULL WD BYTES
JUMPF RNEXLP ;DIDNT CONFORM, CONTINUE SCAN
RNEXIT:
MOVE T1,@NRP$AD ;SAVE NRP OF THIS REC (FOR BUSE L-R)
MOVEM T1,CU.NRP ;PERMANIZE IT
RETT CURFND(CF) ;A MATCH, RET WITH PHYS ADDR OF REC
$ENDPROC
$ENDSCOPE(RECNEXT)
SUBTTL PARSING THE records-to-use CLAUSE
; FORMAT OF RECS-TO-USE CLAUSE
;
; KEY n1 (FROM) value1 (TO) value2
; (AND) field1 op value3
; RELATIVE-REC-NO signed1 (TO) signed2
;
; LAST-ENTRY
;
; IN CURRENCY BASED CMDS (EG. DISPLAY, CHANGE), THE RULES ARE:
; (1) OMITTING N1 CAUSES CURR KEY OF REFERENCE
; (2) IF VALUE2 IS OMITTED, VALUE2 IS SET TO VALUE1
; (3) IF V2 OMITTED AND V1=LOWEST, THEN V2 SET TO LOWEST KEY VALUE IN INDEX
; (4) S1 AND S2 RELATIVE TO CURR RECORD
; (5) IF S2 IS OMITTED, JUST ONE RECORD IS IDENTIFIED
; (6) FOR CLAUSE IS OPTIONAL
;
; IN SCANNING CMDS (EG. VERIFY)
; (1) N1 IS REQUIRED, BUT V1 AND V2 MAY BOTH BE OMITTED -- LOWEST TO HIGHEST ASSUMED
; (2) THE FOR CLAUSE IS N/A
; (3) S1 TO S2 IS N/A
; (4) THE OTHER RULES ARE THE SAME
; COMMON OUTPUTS:
; FALSE = FAILED TO FIND THE CLAUSE
; CU.HREC SET TO CU.REC & EQHREC SET
; TRUE = FOUND THE CLAUSE.
; CU.REC HAS RFA OF RECORD SPEC BY <value1>
; CU.HREC HAS:
; RFA OF REC PAST HI KEY VAL
; RFA OF S2 AND EQHREC SET
; 0 (IE. RNF or EOF)
; KDB IN RMS'S SPACE SETUP, KRF IN RAB SETUP
$SCOPE(US.REC)
$LOCALS
$WORD (H.KBUF) ;PTR TO HI KEY
$WORD (H.KLEN) ;IT LEN IN CHARS
$WORD (L.KBUF) ;PTR TO LOW KEY
$WORD (L.KLEN) ;ITS LEN IN CHARS
$WORD (RELKEY) ;KEY FOR RELATIVE FIND [434]
$ENDLOC
$PROC (US.REC)
;
; US.REC - PARSES ENTIRE RECS-TO-USE CLAUSE
; ARGUMENTS:
; CURR PDB IS 1ST WORD OF CLAUSE, IF CLAUSE PRESENT
; NOTES:
; IT IS THE CALLER'S RESPONSIBILITY TO PERMANIZE AN ENVIRONMENT
; AT THE END OF A SUCCESSFUL CMD.
; $COPY XXX,I BUF$-- ISNT USED BECAUSE BUF$-- ARE EXTERNAL
MOVE T1,UTLFLG ;GET FLAGS
TXNE T1,UT%EMP!UT%PCH ;EMPTY FILE OR PROL CHANGED?
ERRU (EPC) ;YES TO EITHER
MOVE PB,RAB ;INIT RAB PTR
SETZM EQHREC ;RETURN RFA PAST
SETZM FLAGS ;CLEAR PARSE FLAGS
SETZM TS.SYM ;CLEAR "FOR" VAR
$FETCH T1,FAB,(PB) ;[434] GET FILE ORGANIZATION
$FETCH T1,ORG,(T1) ;[434] ...
CAIN T1,FB$IDX ;[434] INDEXED ORGANIZATION
JRST USRECI ;[434] ...
CAIN T1,FB$REL ;[434] RELATIVE ORGANIZATION
JRST USRECR ;[434] ...
JRST USRECS ;[434] SEQUENTIAL ORGANIZATION
USRECI: $CALL P$KEYW ;RUSE PRESENT?
JUMPT L$IFX ;YES, IF JUMP
SKIPGE SCANNING ;SCANNING-CLASS CMD?
RETF ;YES, CURR REC IRRELEV
JRST USCURR ;NO, SET CURR REC UP AS REC RANGE
$ENDIF
CASES T1,MX%RTU ;DISPATCH TO APPROP OPT
$ENTRY (US.CURR)
;
; US.CURR - SET RANGE TO CURR REC
;
MOVE T1,UTLFLG ;GET FLAGS
TXNE T1,UT%EMP!UT%PCH ;EMPTY FILE OR PROL CHANGED?
ERRU (EPC) ;YES TO EITHER
USCURR:
SKIPN T1,CU.REC ;SETUP TO PROC CURR REC -- IF 1
ERRU (NCR) ;OOPS, NO CURR REC
MOVEM T1,CU.HREC ;PROC ONLY CURR REC
SETOM EQHREC ;SET FLAG TO INDIC CU.HREC IN BNDS
$CALLB RC$REL,<[CU.RST],[0]> ;SETUP ENVIR FOR SEQ OPERATIONS
JUMPLE T1,L$UNW
RETF ;INDIC NO RUSE CLAUSE
$CASE (RTU%LAST) ;LAST ENTRY
SKIPE CU.KRF ;ENTRY IRRELEV UNLESS PRIM KEY
ERRU (ENA) ;L-E N/A UNL CURR IDX 0
HRLZ T1,CU.ID ;GET LAST ENT REFFED
JUMPE T1,L$ERRU(NRW) ;NO LAST ENTRY APPLICABLE
;BKT NOT REF YET OR IDX BKT CURR
HRR T1,CU.BKT ;AND P# OF ITS BKT
MOVE T2,RAB ;GET RAB PTR
$STORE T1,RFA,(T2) ;PREP RFA FIND
MOVEI T1,RB$RFA ;DO RFA ACCESS
$STORE T1,RAC,(T2) ;PUT IT AWAY
$CALLB RC$FIND ;FIND IT
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$ERRU(NRW) ;COULDNT FIND IT
MOVEM T1,CU.REC ;SET IT
MOVEM T1,CU.HREC ;INDIC 1-REC RANGE
SETOM EQHREC ;...(LAST = CU.HREC)
RETT ;DONE
$CASE (RTU%REL) ;REL REC-NO
SKIPN CU.REC ;REC TO DRIVE OFF OF?
ERRU (NCR) ;NO CURR REC
$P (NUM) ;GET <signed1>
MOVEM T1,L.KLEN(CF) ;SAVE ARG TO COMPUTE RFA
$CALL P$NUM ;GET <SIGNED2>
SKIPT ;2ND NUM?
SETOM T1 ;INDIC NO HREC
MOVEM T1,H.KLEN(CF) ;SAVE HI BND OFFSET
CAMGE T1,L.KLEN(CF) ;NULL RANGE?
JUMPGE T1,L$ERRU(NRW) ;YES, IF NO HI BND DOESNT APPLY
SETOM EQHREC ;TELL US.NEXT TO SUC ON HREC
$CALLB RC$REL,<[CU.RST],L.KLEN(CF)> ;GET START OF RANGE
JUMPL T1,L$UNW ;JUMP IF PROB (MSG ALR TYPED)
JUMPE T1,L$ERRU(NRW) ;NO RECORD IDENTIFIED
MOVEM T1,CU.REC ;PERMANIZE IT
MOVEM T1,CU.HREC ;DEFAULT LAST RFA IN RANGE
SKIPGE T1,H.KLEN(CF) ;A HI BND?
$SKIP ;YES
SUBM T1,L.KLEN(CF) ;GET RELAT DIST
$CALLB M$RSTCOP,<RST,[RSTEMP]> ;PREP TO RESTOR AFTER RC$REL
$CALLB RC$REL,<[RSTEMP],L.KLEN(CF)>
;COMPUTE RFA FROM CURREC & REC OFFSET
JUMPL T1,L$UNW ;RET TO CMD PROC IF PROBLEM
MOVEM T1,CU.HREC ;LAST RFA IN RANGE
$CALLB RC$REL,<[RSTEMP],[0]> ;RESTORE LOW BND
JUMPL T1,L$UNW ;RET TO CMD PROC IF PROBLEM
JUMPE T1,L$ERRU(IUE) ;SHOULD BE IMPOS
$ENDIF
JRST RUSTST ;CHK "FOR" NOW
$CASE (RTU%KEY) ;KEY-VALUE RANGE
$CALL P$NUM ;WHAT ABOUT KEY-OF-REF?
JUMPF L$IFX
MOVEM T1,CU.KRF ;TENTA RESET KRF
$CALLB M$KDB,<T1> ;SET KDB, RMS'S KDB, & RAB KRF
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$ERRU(FNI) ;INVALID KEY SPECIFIED
$ENDIF
JRST RFMERG ;PICK UP FROM CLAUSE
;[434]
; Process relative file record to use clause: the keyword
; will be one of
;
; CURRENT-RECORD
; KEY
; RELATIVE-RECORD-NUMBER
; RFA
;
USRECR: $CALL P$KEYW ; Get the keyword
JUMPF URCURR ; CRLF same as current record
CASES T1,MX%RRL ; Dispatch to operation
$CASE (RRL%CUR)
URCURR: SKIPN T1,CU.REC ; If no current record, return error
ERRU (NCR) ; "No Current Record"
MOVEM T1,CU.HREC ; For consistency with indexed usage
RETT
$CASE (RRL%KEY)
$P (NUM) ; Get the record key
MOVEM T1,RELKEY ; Save in the record buffer
MOVEI T1,RELKEY ; Point RAB at buffer
$STORE T1,KBF,(PB) ; ...
MOVEI T1,RB$KEY ; Keyed $FIND
$STORE T1,RAC,(PB) ; ...
$FIND <(PB)> ; ...
CAIL T2,ER$MIN ; Check for error
ERRU (NRW) ; Assume record not found
$FETCH T1,RFA,(PB) ; Get the RFA
MOVEM T1,CU.REC ; Store it
MOVEM T1,CU.HREC ; ...
RETT ; Return
$CASE (RRL%REL)
$P (NUM) ; Get the number of recs to advance
MOVEM T1,T3 ; ...
MOVEI T1,RB$SEQ ; Sequential $FIND
$STORE T1,RAC,(PB) ; ...
RLRELP: $FIND <(PB)> ; Find the next record
CAIL T2,ER$MIN ; Check for error
ERRU (NRW) ; Assume record not found somehow
SOJG T3,RLRELP ; Loop
$FETCH T1,RFA,(PB) ; Get the RFA
MOVEM T1,CU.REC ; Store it
MOVEM T1,CU.HREC ; ...
RETT
$CASE (RRL%RFA)
$P (NUM) ; Get the record RFA
$STORE T1,RFA,(PB) ; ...
MOVEI T1,RB$RFA ; RFA $FIND
$STORE T1,RAC,(PB) ; ...
$FIND <(PB)> ; ...
CAIL T2,ER$MIN ; Check for error
ERRU (NRW) ; Assume record not found
$FETCH T1,RFA,(PB) ; Get the RFA
MOVEM T1,CU.REC ; Store it
MOVEM T1,CU.HREC ; ...
RETT ; Return
;[434]
; Process sequential file record to use clause: the keyword
; will be one of
;
; CURRENT-RECORD
; RELATIVE-RECORD-NUMBER
; RFA
;
USRECS: $CALL P$KEYW ; Get the keyword
JUMPF L$CASE(RSQ%CUR) ; CRLF same as current record
CASES T1,MX%RSQ ; Dispatch to operation
$CASE (RSQ%CUR)
SKIPN T1,CU.REC ; If no current record, return error
ERRU (NCR) ; "No Current Record"
MOVEM T1,CU.HREC ; For consistency with indexed usage
RETT
$CASE (RSQ%REL)
$P (NUM) ; Get the number of recs to advance
MOVEM T1,T3 ; ...
MOVEI T1,RB$SEQ ; Sequential $FIND
$STORE T1,RAC,(PB) ; ...
SQRELP: $FIND <(PB)> ; Find the next record
CAIL T2,ER$MIN ; Check for error
ERRU (NRW) ; Assume record not found somehow
SOJG T3,SQRELP ; Loop
$FETCH T1,RFA,(PB) ; Get the RFA
MOVEM T1,CU.REC ; Store it
MOVEM T1,CU.HREC ; ...
RETT
$CASE (RSQ%RFA)
$P (NUM) ; Get the record RFA
$STORE T1,RFA,(PB) ; ...
MOVEI T1,RB$RFA ; RFA $FIND
$STORE T1,RAC,(PB) ; ...
$FIND <(PB)> ; ...
CAIL T2,ER$MIN ; Check for error
ERRU (NRW) ; Assume record not found
$FETCH T1,RFA,(PB) ; Get the RFA
MOVEM T1,CU.REC ; Store it
MOVEM T1,CU.HREC ; ...
RETT ; Return
$ENTRY (US.FROM,<KRF>)
;
; US.FROM - PROCESS FROM CLAUSE OF REC-TO-USE
; ARGUMENTS:
; KRF = THE KEY OF REFERENCE TO GUIDE COMPUTATION
; RETURNS:
; WITH CU.REC/CU.HREC SETUP UNLESS KRF TOO LARGE
; NOTES:
; IF NO FROM CLAUSE, SETS CU.REC/CU.HREC FOR LOW TO HI
MOVE T1,@KRF(AP) ;MATER KRF
$ENDARG
$CALLB M$KDB,<T1> ;INSURE VALID
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$RETF ;BAD KEY VAL
MOVE PB,RAB ;INIT RAB PTR
SETZM EQHREC ;RETURN RFA PAST
SETZM FLAGS ;INIT RECTUSE ENVIR
SETZM TS.SYM ;CLEAR "FOR" VAR
RFMERG:
SETZM STRIPT+1 ;USE SRC STRING LENS
$CALL P$KEYW ;LOWEST ?
JUMPF L$IFX ;NO. MUST BE QUOTED STRING
TXO FLAGS,US%LOW ;LOWEST SPECIFIED
JRST RUSTO ;PROCESS (TO) PART
$ENDIF
$CALL CP.TOK,<BUF$K1> ;GET STRING FROM CMD LINE
JUMPT L$IFX ;JUMP IF LOWER BND SPEC
TXO FLAGS,US%LOW!US%HI ;FOR KEY N, ASSUME LOW/HI
JRST RUSRFA ;CALC RFA'S
$ENDIF
DMOVEM T1,L.KBUF(CF) ;SAVE BP & CHAR LEN OF STRING
RUSTO:
$CALL P$KEYW ;KEYWORD AFTER (TO)?
JUMPF L$IFX ;NO, CHK FOR STRING
CAIN T1,RUH%HI ;HI-EST SPEC?
TXO FLAGS,US%HI ;YES, SCAN TO HIGHEST
CAIN T1,RUH%FOU ;FOUND-KEY SPEC?
TXO FLAGS,US%FND ;YES
JRST RUSRFA ;CALC RFA'S OF BNDS
$ENDIF
$CALL CP.TOK,<BUF$K2> ;GET STRING FROM CMD LINE
JUMPF RUS.1K ;JUMP IF ABSENT
DMOVEM T1,H.KBUF(CF) ;PASS BP & CHAR LEN OF STRING
TXNE FLAGS,US%LOW ;"LOWEST" SPEC?
$SKIP ;NO
$CALL CM.OPR,<L.KBUF(CF),H.KBUF(CF),ASCLE>
;IS 1ST LE 2ND?
JUMPF L$ERRU(NRW) ;NO, IF JUMP
$ENDIF
JRST RUSRFA ;CALC BNDS
RUS.1K: ;ONLY V1 SPECIFIED
TXO FLAGS,US%1K ;TELL RUSRFA
JRST RUSRFA
SUBTTL We are now ready to FIND the records.
$ENTRY (US.LOHI,<KRF>)
;
; US.LOHI - RET RFA'S FOR LOWEST/HIGHEST OF SPECIFIED KEY
; ARGUMENTS:
; KRF = KEY OF REF FOR WHICH BNDS TO BE CALC-ED
; RETURNS:
; LO/HI BNDS SET UNLESS BAD KEY #
MOVE T5,@KRF(AP)
$ENDARG
$CALLB M$KDB,<T5> ;INSURE VALID
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$RETF ;KRF TOO LARGE
MOVE PB,RAB ;INIT RAB PTR
SETZM EQHREC ;RETURN RFA PAST
LOADX FLAGS,US%LOW!US%HI ;SET DESIRED BNDS
SETZM TS.SYM ;CLEAR "FOR" VAR
RUSRFA:
TXNN FLAGS,US%LOW ;STILL NO KEY INF SET?
$SKIP ;YES, CONV "LOWEST" TO KEY
SETZM BUF$K1 ;PUT NULS IN BUFF
$COPY L.KLEN(CF),I 1 ;DO GENERIC SRCH ON 1 NUL
$ENDIF
MOVEI T1,RB$KEY ;KEY ACCESS
$STORE T1,RAC,(PB)
LOADX T1,RB$KGE!RB$RAH!RB$NRP ;KEY GTR FND & SET PHYS RFA
$STORE T1,ROP,(PB)
MOVEI T1,BUF$K1 ;GET BUF PTR
$STORE T1,KBF,(PB)
MOVE T1,L.KLEN(CF) ;& ITS LEN
$STORE T1,KSZ,(PB)
$CALLB RC$FIND ;Actually FIND it.
JUMPL T1,L$UNW ;OOPS
JUMPE T1,L$ERRU(NRW) ;NO RECORD IDENTIFIED
MOVEM T1,CU.REC ;SAVE FIRST RFA
$CALLB M$RSTCOP,<RST,[RSTEMP]> ;PREP TO RESTOR AFTER KGT FIND
RUSRF2: ;FIND <string2> or HIGHEST rec.
TXNN FLAGS,US%FND!US%1K ;JUST A VALUE1?
$SKIP ;YES
TXNN FLAGS,US%LOW!US%FND ;WAS IT "LOWEST" OR "FND-KEY"?
$SKIP1 ;YES, GET KEY FROM RECORD
$CALLB M$KUDR,<[BUF$K2],[0]> ;SETUP KEY, KBF, KSZ
JUMPL T1,L$UNW ;OOPS
JRST RUFGTR ;DO THE FIND
$NOSK1 ;NO, KVAL ON CMD LINE
MOVEI T1,BUF$K1 ;PT TO SAME PLACE
MOVE T2,L.KLEN(CF) ;SAME LEN ALSO
JRST L$IFX
$ENDIF(1)
$NOSKIP ;TWO KEYS
SETZM CU.HREC ;PRESUME "HIGHEST"
TXNE FLAGS,US%HI ;IS IT?
JRST RUSTST ;YES, CHK ON "FOR" NOW
MOVEI T1,BUF$K2 ;GET BUF PTR
MOVE T2,H.KLEN(CF) ;& ITS LEN
$ENDIF
$STORE T1,KBF,(PB)
$STORE T2,KSZ,(PB)
RUFGTR:
LOADX T1,RB$KGT!RB$RAH!RB$NRP ;KEY GTR FND & SET PHYS RFA
$STORE T1,ROP,(PB)
$CALLB RC$FIND ;Actually FIND it.
JUMPL T1,L$UNW ;OOPS
MOVEM T1,CU.HREC ;SAVE 2ND RFA
CAMN T1,CU.REC ;EMPTY KEY RANGE?
ERRU (NRW) ;YES, TELL USER
$CALLB RC$REL,<[RSTEMP],[0]> ;RESTORE LOW BND
JUMPE T1,L$ERRU(IUE) ;SHOULD BE IMPOS
JUMPL T1,L$UNW ;RET TO CMD PROC IF PROBLEM
; JRST RUSTST ;PROC "(AND) TEST" NOW
SUBTTL PARSE "AND FLD OPR VAL" PHRASE OF RECS-TO-USE
RUSTST:
$CALL P$FLD ;SEE IF "TEST" PHRASE
JUMPF L$RETT ;NO, JUST RET IMMED
$CALL P$PREV ;DO ALL WORK IN SY.CHK
$CALL SY.CHK,<DA$TYP> ;PICK UP FLD
MOVEM T1,TS.SYM ;SAVE PTR TO ITS SYMBOL BLK
$P (TOK) ;PICK UP THE OPERATOR
MOVE T3,TK.VAL(T1) ;GET ASCIZ OPR
AND T3,[37777B13] ;GET RID OF TRAILING CRUFT
MOVEM T3,TS.OPR ;PUT IT AWAY
MOVE T2,TS.SYM ;GET SYM PTR BACK
LOAD T1,UF.TYP(T2) ;GET DATA TYPE
CAIGE T1,DFT%DEC ;NUMERIC?
JRST RUFSTR ;NO
RUFNUM:
$P (NUM) ;PICK UP NUMBER
MOVEM T1,BUF$K1 ;YES, PUT IT AWAY
MOVE T1,[444400,,BUF$K1] ;TREAT AS FULL WD BYTE
MOVEI T2,1 ;...LEN OF 1
DMOVEM T1,TS.BP ;PUT PTR AWAY
RETT ;DONE
RUFSTR: ; ??? PRESUME DAT TYP MATCHES FILE BSZ
$CALL CP.TOK,<BUF$K1> ;COP A STRING TOK TO BUF$K1
DMOVEM T1,TS.BP ; DONE
RETT
$ENDPROC(US.REC)
$ENDSCOPE(US.REC)
$ENDSCOPE(TOP-LEVEL)
END