Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_1of2_bb-x128c-sb
-
10,7/galaxy/catlog/catrms.mac
There are no other files named catrms.mac in the archive.
TITLE CATRMS - RMS-10 INTERFACE TO CATLOG
SEARCH RMSINT,CATPRM
CATDEF (CATRMS)
ENTRY R$INIT
; SYMBOLS UNIQUE TO RMS THAT CALLERS MAY CARE ABOUT. SAVES THEM HAVING
; TO USE RMSINT
INTERN ER$RNF,ER$DUP,SU$DUP,ER$CHG,ER$COF,ER$EOF,ER$FNF,ER$PRV
INTERN ER$RSZ,ER$RTB
; SPECIAL AC DEFINITIONS
F==13 ;CURRENT FAB
R==14 ;CURRENT RAB
SUBTTL RMS-10 DATA STRUCTURES
; FAB
FAB: FAB$B ;INITIALIZE A FAB
F$BSZ ^D9 ;FILE BYTE SIZE
F$BKS ^D5 ;BUCKET SIZE FOR FILE
F$FAC <FB$PUT!FB$GET!FB$DEL!FB$UPD> ;ACCESS TYPE
F$FNA CATFNM ;ASCIZ FILE NAME
F$FOP FB$CIF ;CREATE IF NOT FOUND
F$MRS <.CTMAX*4> ;MAX RECORD (RECORD) SIZE
F$ORG FB$IDX ;INDEXED MODE
F$RFM FB$VAR ;VARIABLE LENGTH RECORDS
F$SHR FB$NIL ;NO SHARING
F$XAB XABA1 ;FIRST XAB
FAB$E ;END OF FAB
; RAB
RAB: RAB$B ;INITIALIZE THE RAB
R$FAB FAB ;FAB ADDRESS
R$KRF 0 ;DEFAULT KEY OF REF IS PRI INDEX
R$MBF ^D8 ;ALLOW SOME REASONABLE # OF BUFFERS
R$PAD 0 ;PAD CHAR
RAB$E ;END OF RAB
; XAB FOR AREA 1 (VOLUME-SET NAME)
XABA1: XAB$B ALL ;ALLOCATION
X$AID 1 ;NAME INDEX
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA2 ;NEXT XAB
XAB$E ;END OF XAB
; XAB FOR AREA 2 (VOLUME-SET NAME SECONDARY DATA BUCKETS)
XABA2: XAB$B ALL ;ALLOCATION
X$AID 2 ;NAME SIDRS
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA3 ;NEXT XAB
XAB$E ;END OF XAB
; XAB FOR AREA 3 (SECONDARY VOLUME-SET NAME INDEX)
XABA3: XAB$B ALL ;ALLOCATION
X$AID 3 ;NAME INDEX
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA4 ;NEXT XAB
XAB$E ;END OF XAB
; XAB FOR AREA 4 (PPN SECONDARY DATA BUCKETS)
XABA4: XAB$B ALL ;ALLOCATION
X$AID 4 ;PPN SIDRS
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA5 ;NEXT XAB
XAB$E ;END OF XAB
;XAB FOR AREA 5 (PPN SECONDARY INDEX)
XABA5: XAB$B ALL ;ALLOCATION
X$AID 5 ;PPN INDEX
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA6 ;NEXT XAB
XAB$E ;END OF XAB
;XAB FOR AREA 6 (USER NAME SECONDARY DATA BUCKETS)
XABA6: XAB$B ALL ;ALLOCATION
X$AID 6 ;USER NAME SIDRS
X$BKZ 1 ;BUCKET SIZE
X$NXT XABA7 ;NEXT XAB
XAB$E ;END OF XAB
;XAB FOR AREA 7 (USER NAME SECONDARY INDEX)
XABA7: XAB$B ALL ;ALLOCATION
X$AID 7 ;USER NAME INDEX
X$BKZ 1 ;BUCKET SIZE
X$NXT XABK0 ;FIRST KEY
XAB$E ;END OF XAB
; XAB FOR KEY 0
; THIS (PRIMARY) KEY IS THE VSN *PLUS* THE CATALOG DEVICE TYPE FIELD
XABK0: XAB$B KEY ;KEY
X$REF 0 ;THIS IS THE PRIMARY KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 0 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$IAN 1 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$NXT XABK1 ;NEXT XAB
X$POS <<.CTVSN*4>-1> ;OFFSET TO VSN
X$SIZ <VSNSZC+1> ;SIZE OF VSN (BYTES)
XAB$E ;END OF XAB
; XAB FOR KEY 1
; THIS (SECONDARY) KEY IS THE VSN *ONLY*
XABK1: XAB$B KEY ;KEY
X$REF 1 ;THIS IS THE SECOND KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 2 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$FLG XB$DUP ;ALLOW DUPLICATES
X$IAN 3 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$NXT XABK2 ;NEXT KEY
X$POS <.CTVSN*4> ;OFFSET TO VSN
X$SIZ VSNSZC ;SIZE OF VSN (BYTES)
XAB$E ;END OF XAB
;THIS KEY IS THE VOLUME SET OWNER (PPN)
XABK2: XAB$B KEY ;KEY
X$REF 2 ;THIS IS THE THIRD KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 4 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$FLG XB$DUP!XB$CHG ;ALLOW DUPLICATES AND CHANGES
X$IAN 5 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$NXT XABK3 ;NEXT KEY
X$POS <.CTVUS*4> ;OFFSET TO PPN
X$SIZ 4 ;SIZE OF PPN (BYTES)
XAB$E ;END OF XAB
;THIS KEY IS THE USER NAME
XABK3: XAB$B KEY ;KEY
X$REF 3 ;THIS IS THE FOURTH KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 6 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$FLG XB$DUP!XB$CHG ;ALLOW DUPLICATES AND CHANGES
X$IAN 7 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$POS <.CTVNM*4> ;OFFSET TO USER NAME
X$SIZ NAMSZC ;SIZE OF USER NAME (BYTES)
XAB$E ;END OF XAB
CATFNM: BLOCK <<<4+1+6+1+3+1+6+1+6+1>+3>/4> ;SPACE FOR ASCIZ CATALOG FILE NAME
SUBTTL RMS-10 INTERFACE INITIALIZATION
; INITIALIZE RMS-10 INTERFACE
; CALL: PUSHJ P,R$INIT
R$INIT::SETOM SAVFLG ;INIT AC SAVE ROUTINES
PUSHJ P,ENTX ;SWITCH CONTEXTS
JRST .POPJ1 ;RETURN FOR NOW
SUBTTL OPEN CATALOG FILE
; CALL: PUSHJ P,R$OCAT
R$OCAT::PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
MOVE T1,G$QSTR## ;DEVICE
SKIPE DEBUGW ;DEBUGGING?
SKIPA T1,['DSK '] ;YES, GET DEBUGGING DEVICE AND SKIP
SKIPA T2,[[ITEXT (^P/G$SPPN##/)]] ;NO, GET ITEXT FOR PPN
MOVEI T2,[ITEXT ()] ;YES, GET NULL ITEXT
$TEXT (<-1,,CATFNM>,<^W/T1/:CATLOG.SYS^I/0(T2)/^0>) ;CREATE NAME STRING
PUSHJ P,OPNCOM ;OPEN THE FILE
POPJ P, ;FAILED
PUSHJ P,CLSCOM ;NOW CLOSE THE FILE
POPJ P, ;SHOULDN'T FAIL
PUSHJ P,OPNFIX ;FIX UP FILE PROTECTION AND STATUS WORD
; PJRST OPNCOM ;ENTER COMMON CODE
OPNCOM: $CREATE 0(F) ;OPEN THE FILE
PUSHJ P,ERRCKF ;CHECK FOR ERRORS
POPJ P, ;FAILED
PUSHJ P,OPNBLK ;INIT FILOP, L/E/R, AND PATH BLOCKS
$CONNEC 0(R) ;SET UP AN IO STREAM
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
PUSHJ P,DOLOA ;SET LOAD MODE IF REQUESTED
JFCL ;IGNORE ERRORS
PUSHJ P,UPDFIX ;SEE IF PREVIOUS UPDATE NEEDS FIXING UP
POPJ P, ;IT DID AND IT FAILED
JRST .POPJ1 ;RETURN
; INITIALIZE FILOP, LOOKUP/ENTER/RENAME, AND PATH BLOCKS
; MUST BE CALLED AFTER A SUCCESSFUL $CREATE OR $OPEN
OPNBLK: MOVE T1,[FFZBEG,,FFZBEG+1] ;SET UP BLT
SETZM FFZBEG ;CLEAR FIRST WORD
BLT T1,FFZEND-1 ;CLEAR STORAGE
; NOW GET FILESPEC ON OPENED CHANNEL
OPNBL1: MOVE T1,[2,,T2] ;SET UP UUO AC
$FETCH T2,JFN,0(F) ;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
HRLZS T2 ;PUT IN LH
HRRI T2,.FOFIL ;FILOP. UUO FUNCTION CODE
MOVE T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
FILOP. T1, ;READ FILESPEC
POPJ P, ;RETURN
; LOAD FILOP BLOCK
OPNBL2: MOVEI T1,FFFOP ;POINT TO BLOCK
MOVE T2,[FO.PRV!FO.ASC+.FORED] ;PRIV'ED, ASSIGN CHANNEL, READ
MOVEM T2,.FOFNC(T1)
MOVE T2,[UU.PHS+.IODMP] ;PHYSICAL DUMP MODE I/O
MOVEM T2,.FOIOS(T1)
MOVE T2,FFFIL+.FOFDV ;DEVICE NAME
MOVEM T2,.FODEV(T1)
MOVEI T2,FFLKP ;LOOKUP/ENTER/RENAME BLOCK
MOVEM T2,.FOLEB(T1)
; LOAD LOOKUP/ENTER/BLOCK
OPNBL3: MOVEI T1,FFLKP ;POINT TO BLOCK
MOVEI T2,.RBMAX ;LENGTH
MOVEM T2,.RBCNT(T1)
MOVEI T2,FFPTH ;PATH BLOCK
MOVEM T2,.RBPPN(T1)
MOVE T2,FFFIL+.FOFFN ;FILE NAME
MOVEM T2,.RBNAM(T1)
MOVE T2,FFFIL+.FOFEX ;EXTENSION
MOVEM T2,.RBEXT(T1)
; LOAD PATH BLOCK
OPNBL4: MOVE T1,[-<.PTMAX-.PTPPN>,,FFPTH+.PTPPN] ;POINT TO BLOCK
MOVEI T2,FFFIL+.FOFPP ;POINT TO RETURNED FILESPEC
OPNBL5: MOVE T3,(T2) ;GET A WORD
MOVEM T3,(T1) ;PUT A WORD
AOS T2 ;ADVANCE POINTER
AOBJN T1,OPNBL5 ;LOOP
SETOM FFFLG ;INDICATE GOODNESS
POPJ P, ;RETURN
; FIX UP THE FILE PROTECTION AND STATUS WORD
; MUST BE CALLED AFTER OPNBLK/CLOSE SEQUENCE
OPNFIX: $FETCH T1,FAC,0(F) ;GET THE DESIRED ACCESS MODE
TXNE T1,FB$PUT ;DID WE ASK FOR WRITE ACCESS?
SKIPN FFFLG ;YES--WAS CALL TO OPNBLK SUCCESSFUL?
POPJ P, ;NOPE
MOVE T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
FILOP. T1, ;LOOKUP THE FILE
POPJ P, ;SHOULDN'T FAIL
MOVE T1,FFFOP+.FOFNC ;GET FUNCTION WORD
TDZ T1,[-1-FO.CHN] ;KEEP ONLY THE CHANNEL
TDO T1,[FO.PRV+FO.UOC+.FORNM] ;USE ALREADY OPENED CHANNEL FOR RENAME
MOVEM T1,FFFOP+.FOFNC ;UPDATE FUNCTION WORD
MOVEI T1,FFREN ;POINT TO RENAME BLOCK
HRLM T1,FFFOP+.FOLEB
MOVE T1,[FFLKP,,FFREN] ;SET UP BLT
BLT T1,FFREN+.RBMAX-1 ;COPY
MOVE T1,[%LDSSP] ;ASK MONITOR FOR SYS:*.SYS CODE
GETTAB T1, ;SO
MOVSI T1,(157B8) ;DEFAULT
LSH T1,-33 ;POSITION
DPB T1,[POINTR (FFREN+.RBPRV,RB.PRV)] ;STORE
MOVEI T1,RP.ABU ;CAUSE FILE TO ALWAYS BE BACKED UP
IORM T1,FFREN+.RBSTS ; TO TAPE REGARDLESS OF ACCESS DATE
MOVE T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
FILOP. T1, ;RENAME THE FILE
JFCL ;IGNORE ERRORS HERE
MOVE T1,[1,,T2] ;SET UP UUO AC
MOVE T2,FFFOP+.FOFNC ;GET FUNCTION WORD
TDZ T2,[-1-FO.CHN] ;KEEP ONLY THE CHANNEL
HRRI T2,.FOREL ;NEW FUNCTION
FILOP. T1, ;RELEASE THE CHANNEL
JFCL ;???
POPJ P, ;DONE
SUBTTL CLOSE CATALOG FILE
; CALL: PUSHJ P,R$CCAT
R$CCAT::PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
; JRST CLSCOM ;ENTER COMMON CODE
; COMMON CLOSE CODE
CLSCOM: $CLOSE 0(F) ;CLOSE THE FILE
PUSHJ P,ERRCKF ;CHECK UP ON IT
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN GOODNESS
SUBTTL DELETE A RECORD
; CALL: MOVE AC1, [CATALOG DEVICE TYPE,,ADDRESS OF VSN]
; PUSHJ P,R$DELE
R$DELE::PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
; COMMON DELETE CODE
DELCOM: MOVE T2,ARGS ;GET CALLER'S VSN POINTER
DELCO1: HRLI T2,(POINT 7,0) ;MAKE A SOURCE POINTER
MOVE T3,[POINT 9,TMPVSN] ;POINT TO A SCRATCH BUFFER
HLRZ T1,ARGS ;GET DEVICE TYPE
IDPB T1,T3 ;STUFF IN TEMP NAME
PUSHJ P,CVTNM1 ;COPY THE STRING
DELCO2: MOVEI T1,0 ;PRIMARY KEY
MOVEI T2,VSNSZC+1 ;EXACT MATCH
PUSHJ P,SETFND ;SET UP FIND
$FIND 0(R) ;NOW POSITION TO THAT RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
POPJ P, ;FAILED
$DELETE 0(R) ;TOSS THE RECORD
PUSHJ P,ERRCKR ;SEE IF WE DELETED IT
POPJ P, ;FAILED
$FLUSH 0(R) ;FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN
SUBTTL GET A RECORD
; HERE TO SET UP THE RMS CALL FOR A SEARCH
; CALL: MOVE AC1, FLAG+ADDRESS OF BUFFER
; MOVE AC2, <CATALOG DEVICE TYPE,,ADDRESS OF VSN>
; PUSHJ P,R$GET
; FLAG = 1B0 MEANING GET NEXT RECORD
R$GET:: PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
; JRST GETCOM ;ENTER COMMON CODE
GETCOM: MOVEI T1,.CTMAX ;GET MAXIMUM LENGTH OF RECORD
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
HRRZ T1,ARGS ;GET BUFFER ADDRESS
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
PUSHJ P,SRHSET ;SET UP SEARCH
POPJ P, ;RETURN IF DONE
PUSHJ P,SETFND ;SET UP FIND
$FETCH T1,ROP,0(R) ;FETCH THE CURRENT OPTIONS
MOVX T2,1B0 ;GET SIGN BIT
TDNE T2,ARGS ;WANT NEXT VSN RETURNED?
TXO T1,RB$KGT ;YES, SET FETCH NEXT RECORD FLAG
$STORE T1,ROP,0(R) ;SAVE FLAGS
$GET 0(R) ;READ SPECIFIED RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
POPJ P, ;FAILED
MOVE T1,ARGS ;FETCH BUFFER ADDRESS
PUSHJ P,CNVI2E ;CONVERT RECORD TO EXTERNAL FORMAT
HLRZ T1,ARGS+1 ;GET DEVICE TYPE
JUMPE T1,.POPJ1 ;RETURN IF NOTHING SPECIFIC
MOVE T2,ARGS ;FETCH BUFFER ADDRESS
LOAD T2,.CTVFL(T2),CT.TYP ;GET DEVICE TYPE
CAME T1,T2 ;SAME DEVICE TYPE?
JRST SRHRNF ;NO, ACT LIKE END
JRST .POPJ1 ;RETURN
; SEARCH SET UP
; CALL: PUSHJ P,SRHSET
;
; ON RETURN, T1 HAS KEY NUMBER AND T2 LENGTH OF KEY IN BYTES
SRHSET: HLRZ T1,ARGS+1 ;GET DEVICE TYPE
MOVE T2,ARGS+1 ;GET CALLER'S VSN POINTER
HRLI T2,(POINT 7,0) ;MAKE A SOURCE POINTER
MOVE T3,[POINT 9,TMPVSN] ;POINT TO A SCRATCH BUFFER
SKIPE T1 ;SKIP DEVICE TYPE IF NOT SPECIFIED
IDPB T1,T3 ;STUFF DEVICE TYPE IN TEMP NAME
PUSHJ P,CVTNM1 ;COPY THE STRING
HLRZ T1,ARGS+1 ;GET DEVICE TYPE AGAIN
JUMPN T1,SRHSE1 ;JUMP IF TYPE SPECIFIED
MOVEI T1,1 ;SECONDARY KEY
MOVEI T2,VSNSZC ;EXACT MATCH
JRST .POPJ1 ;READY TO FIND
SRHSE1: MOVEI T1,0 ;PRIMARY KEY
MOVEI T2,VSNSZC+1 ;EXACT MATCH
JRST .POPJ1 ;READY TO FIND
; HERE IF NO SEARCH WILL BE DONE. MAKE IT LOOK LIKE A STANDARD
; RMS "RECORD NOT FOUND" ERROR.
SRHRNF: MOVEI T1,ER$RNF ;CODE FOR RECORD NOT FOUND
MOVEI T2,0 ;STATUS
$STORE T1,STS,0(R) ;SET STATUS
$STORE T2,STV,0(R) ;AND STATUS VALUE
POPJ P, ;RETURN
;SETFND - SET UP A $FIND
;
;T1/ KEY OF REFERENCE
;T2/ # OF BYTES
;TMPVSN/KEY TO MATCH
SETFND: $STORE T1,KRF,0(R) ;STORE WHICH KEY TO USE
MOVEI T1,TMPVSN ;BUFFER ADDRESS
$STORE T1,KBF,0(R) ;STORE KEY BUFFER ADDRESS
$STORE T2,KSZ,0(R) ;STORE KEY SIZE
MOVEI T1,RB$KEY ;KEYED ACCESS
$STORE T1,RAC,0(R) ;SET
$FETCH T1,ROP,0(R) ;FETCH THE CURRENT OPTIONS
TXZ T1,RB$KGE!RB$KGT ;MATCH SHOULD BE EQUAL
$STORE T1,ROP,0(R) ;PUT THEM BACK (AND RETURN TO CALLER)
POPJ P, ;DONE
;CVTNM1 - CONVERT VOLUME-SET NAME TO DIFFERENT BYTE SIZE
;CALL: T2/ SOURCE STRING POINTER
; T3/ DESTINATION STRING POINTER
; PUSHJ P,CVTNM1
CVTNM1: MOVEI T4,VSNSZC ;MAX LENGTH OF VOLUME-SET NAME
CVNLUP: SKIPE T1,T2 ;IF NOT OFF END,
ILDB T1,T2 ;FETCH GIVEN NAME
SKIPN T1 ;DONE?
SETZ T2, ;YES, MAKE SURE FILLED WITH ZEROS
PUSHJ P,CVTCAS ;DO CASE CONVERSION
IDPB T1,T3 ;COPY INTO KEY
SOJG T4,CVNLUP ;LOOP IF NOT
POPJ P, ;RETURN
; CASE CONVERSION
; "UPCASE" ANY 7 BIT CHARS.
CVTCAS: CAIL T1,"A"+40 ;CONVERT
CAILE T1,"Z"+40 ; LOWER
CAIL T1,"A"+240 ; CASE TO
CAILE T1,"Z"+240 ; UPPER CASE
POPJ P, ;NOTHING TO CONVERT
SUBI T1," " ;OK, DO THE CONVERSION
POPJ P, ;RETURN
;CONVERT RECORD FROM INTERNAL TO EXTERNAL FORMAT
;CALL: T1/ ADDRESS OF RECORD
; PUSHJ P,CNVI2E
CNVI2E: MOVSS .CTVFL(T1) ;SWAP THE FLAGS WORD INTO EXTERNAL FORMAT
MOVSI T2,.CTVSN(T1) ;COPY THE VSN TO TEMPORARY STORAGE
HRRI T2,TMPVSN
BLT T2,TMPVSN+VSNSIZ-1 ;SIZE IN INTERNAL FORMAT
LOAD T2,.CTVFL(T1),CT.FEL ;GET ENTRY LENGTH
SUBI T2,.CTVSN+VSNSIZ ;NUMBER OF WORDS TO MOVE DOWN
MOVSI T3,.CTVSN+VSNSIZ(T1) ;WHERE IT COMES FROM
HRRI T3,.CTVSN+VSNLEN(T1) ;WHERE IT GOES TO
ADDI T2,.CTVSN+VSNLEN-1(T1) ;COMPUTE END OF BLT
BLT T3,VSNSIZ-VSNLEN(T2) ;MOVE THE RECORD DOWN
MOVE T2,[POINT 9,TMPVSN] ;SOURCE POINTER
MOVEI T3,.CTVSN(T1) ;DESTINATION
HRLI T3,(POINT 7) ;7-BIT BYTES
PJRST CVTNM1 ;CONVERT THE VSN AND RETURN
;CONVERT RECORD FROM EXTERNAL TO INTERNAL FORMAT
;CALL: T1/ ADDRESS OF RECORD
; PUSHJ P,CNVE2I
CNVE2I: MOVSI T2,.CTVSN(T1) ;COPY THE VSN TO TEMPORARY STORAGE
HRRI T2,TMPVSN
BLT T2,TMPVSN+VSNLEN-1 ;EXTERNAL LENGTH
LOAD T2,.CTVFL(T1),CT.FEL ;GET ENTRY LENGTH BEFORE SWAP
MOVSS .CTVFL(T1) ;SWAP THE FLAGS WORD INTO INTERNAL FORMAT
HRLI T2,400000-1-<.CTVSN+VSNLEN>(T2) ;NUMBER OF WORDS TO MOVE -1
ADDI T2,-1(T1) ;MAXIMUM SOURCE ADDRESS
POP T2,VSNSIZ-VSNLEN(T2) ;MOVE A WORD DOWN
JUMPL T2,.-1 ;LOOP UNTIL REMAINDER OF ENTRY MOVED
MOVE T2,[POINT 7,TMPVSN] ;SOURCE
MOVEI T3,.CTVSN(T1) ;DESTINATION
HRLI T3,(POINT 9) ;9-BIT BYTES
PJRST CVTNM1 ;CONVERT THE VSN AND RETURN
SUBTTL PUT A RECORD
; CALL: MOVE AC1, ADDRESS OF USER BUFFER
; PUSHJ P,R$PUT
R$PUT:: PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
; JRST PUTCOM ;ENTER COMMON CODE
; COMMON PUT CODE
PUTCOM: MOVE T1,ARGS ;GET CALLER'S ARGUMENT
PUSHJ P,SETHDR ;SET UP THE RECORD HEADER
PUTCO1: $PUT 0(R) ;PUT THE RECORD IN THE FILE
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
$FLUSH 0(R) ;FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN
; SETHDR - SETS UP THE RMS RECORD HEADER AND RAB GIVEN THE USER ARGS
; CALL: MOVE T1, BUFFER ADDRESS
; PUSHJ P,SETHDR
SETHDR: MOVSI T2,(T1) ;POINT TO USER ARGUMENT
HRRI T2,RECORD ;POINT TO INTERNAL RECORD BLOCK
LOAD T3,.CTVFL(T1),CT.FEL ;GET LENGTH OF THIS ENTRY
BLT T2,RECORD-1(T3) ;COPY
MOVEI T2,RECORD ;FROM NOW ON, WE'LL USE INTERNAL BLOCK
$STORE T2,RBF,0(R) ;STORE BUFFER ADDRESS
LOAD T2,.CTVFL(T1),CT.FEL ;GET LENGTH OF THIS ENTRY
ADDI T2,VSNSIZ-VSNLEN ;ADD EXCESS VSN LENGTH
IMULI T2,^D4 ;MAKE SIZE INTO BYTES
$STORE T2,RSZ,0(R) ;TELL RMS HOW MUCH TO WRITE
MOVEI T2,RB$KEY ;KEYED ACCESS
$STORE T2,RAC,0(R) ;TELL RMS
MOVEI T1,RECORD ;POINT AT OUR INTERNAL BLOCK
PJRST CNVE2I ;CONVERT ENTRY TO INTERNAL FORMAT AND RETURN
SUBTTL UPDATE A RECORD
; UPDATE THE LAST RECORD READ
; CALL: MOVE AC1, ADDRESS OF USER BUFFER
; PUSHJ P,R$UPDA
R$UPDA::PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
; JRST UPDCOM ;ENTER COMMON CODE
; COMMON UPDATE CODE
UPDCOM: MOVEI T1,.CTMAX ;GET LENGTH OF RECORD
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
MOVEI T1,TEMP ;POINT TO TEMP RECORD STORAGE
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
MOVEI T2,.CTVSN(T1) ;AND TARGET VSN FROM RECORD
HRLI T2,(POINT 7,0) ;MAKE A SOURCE POINTER
MOVE T3,[POINT 9,TMPVSN] ;POINT TO A SCRATCH BUFFER
LOAD T1,.CTVFL(T1),CT.TYP ;GET CATALOG DEVICE TYPE
IDPB T1,T3 ;STORE AS FIRST CHARACTER OF BLOCK
PUSHJ P,CVTNM1 ;COPY THE STRING
MOVEI T1,0 ;PRIMARY KEY
MOVEI T2,VSNSZC+1 ;EXACT MATCH
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;READ SPECIFIED RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
POPJ P, ;MUST BE THERE
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
PUSHJ P,SETHDR ;SET UP HEADERS
LOAD T1,RECORD+.CTVFL,<CT.FEL_^D18> ;GET LENGTH OF RECORD TO UPDATE
LOAD T2,TEMP+.CTVFL,<CT.FEL_^D18> ;GET LENGTH OF RECORD ON DISK
CAIN T1,(T2) ;UPDATE OF SAME SIZE?
JRST UPDCO3 ;YES--THAT'S EASY
; JRST UPDCO1 ;NO, MORE WORK
;RMS is too dumb to handle an update where the record size changes.
;We must do the update in a number of steps to assure consistancy of
;the catalog across crashes during an update:
; 1) Insert updated entry with sign bit of VSN set
; 2) Delete original entry
; 3) Insert updated entry with correct VSN
; 4) Delete temporary entry
;When the catalog file is first opened, UPDFIX is called to complete
;any update procedure in progress. Check that routine for more info.
UPDCO1: MOVX T1,1B0 ;GET THE SIGN BIT
IORM T1,RECORD+.CTVSN ;SET FOR FUTURE REFERENCES
PUSHJ P,PUTCO1 ;INSERT THE RECORD
POPJ P, ;ERROR
LOAD T1,RECORD+.CTVFL,<CT.TYP_-^D18> ;GET THE DEVICE TYPE
HRLM T1,ARGS ;SAVE FOR DELCO1
MOVE T2,ARGS ;GET ARGUMENT POINTER
MOVEI T2,.CTVSN(T2) ;POINT AT VSN IN ARGUMENT
PUSHJ P,DELCO1 ;DELETE THE ORIGINAL RECORD
POPJ P, ;ERROR
MOVX T1,1B0 ;GET THE SIGN BIT
ANDCAM T1,RECORD+.CTVSN ;CLEAR IN THE "REAL" RECORD
PUSHJ P,PUTCO1 ;INSERT THE NEW UPDATED RECORD
POPJ P, ;ERROR
MOVX T1,<1B0_-^D9> ;GET THE SIGN BIT IN THE CORRECT PLACE
IORM T1,TMPVSN ;MAKE UP THE BOGUS VSN NAME
PUSHJ P,DELCO2 ;DELETE THE TEMPORARY RECORD
POPJ P, ;ERROR
JRST UPDCO4 ;FINISH UP
UPDCO3: $UPDATE 0(R) ;REPLACE THE RECORD IN THE FILE
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
UPDCO4: $FLUSH 0(R) ;FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN
;Complete any update in progress when system/CATLOG crashed.
; 1) Look for any records with VSN having bit 400 set.
; If none found, no update was in progress.
; 2) Delete the original record (may fail)
; 3) Insert temporary record without bit 400.
; 4) Delete temporary record.
UPDFIX: MOVEI S1,VSNSIZ ;CLEAR OUT THE AREA
MOVEI S2,TMPVSN
PUSHJ P,.ZCHNK##
MOVX T1,1B0 ;GET SIGN BIT
MOVEM T1,TMPVSN ;LOOK FOR ANY RECORD WITH SIGN BIT SET
MOVEI T1,.CTMAX ;GET MAXIMUM LENGTH OF RECORD
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
MOVEI T1,RECORD ;WHERE TO STORE RECORD
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
MOVEI T1,1 ;SECONDARY KEY
MOVEI T2,VSNSZC ;EXACT MATCH
PUSHJ P,SETFND ;SET UP FOR FIND
$FETCH T1,ROP,0(R) ;FETCH THE CURRENT OPTIONS
TXO T1,RB$KGT ;FETCH NEXT VSN
$STORE T1,ROP,0(R) ;SAVE FLAGS
$GET 0(R) ;READ SPECIFIED RECORD
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
JRST .POPJ1 ;ASSUME RECORD NOT FOUND, NO UPDATE IN PROGRESS
MOVE T2,[POINT 9, RECORD+.CTVSN] ;SOURCE STRING
MOVE T3,[POINT 9, TMPVSN] ;DESTINATION
LOAD T1,RECORD+.CTVFL,<CT.TYP_-^D18> ;GET DEVICE TYPE
IDPB T1,T3 ;STUFF IN TEMP NAME
PUSHJ P,CVTNM1 ;COPY THE STRING
PUSHJ P,DELCO2 ;DELETE ORIGINAL RECORD
JFCL ;MAY FAIL, ORIGINAL MAY HAVE BEEN DELETED
MOVX T1,1B0 ;GET THE SIGN BIT
ANDCAM T1,RECORD+.CTVSN ;CLEAR IN THE "REAL" RECORD
PUSHJ P,PUTCO1 ;INSERT THE NEW UPDATED RECORD
POPJ P, ;ERROR
MOVX T1,<1B0_-^D9> ;GET THE SIGN BIT IN THE CORRECT PLACE
IORM T1,TMPVSN ;MAKE UP THE BOGUS VSN NAME
PUSHJ P,DELCO2 ;DELETE THE TEMPORARY RECORD
POPJ P, ;ERROR
JRST UPDCO4 ;FINISH UP
SUBTTL SET RMS-SPECIFIC OPTIONS
; BIT FIDDLER'S DELIGHT
; CALL: MOVE AC1, OPTION-NUMBER
; MOVE AC2, VALUE
; PUSHJ P,R$SOPT
R$SOPT::PUSHJ P,ENT ;SWITCH TO RMS CONTEXT
DMOVE T1,ARGS ;GET CALLER'S ARGUMENTS
SKIPL T1 ;RANGE
CAILE T1,OPTMAX ; CHECK
POPJ P, ;NO
PJRST @OPTTAB(T1) ;CALL FUNCTION-SPECIFIC PROCESSOR
OPTTAB: IFIW .POPJ ;(0) CATCH RANDOM CALLERS
IFIW SETLOA ;(1) SET/CLEAR THE RMS "LOAD" MODE BIT
IFIW GETFBE ;(2) GET LAST FAB ERROR
IFIW GETRBE ;(3) GET LAST RAB ERROR
IFIW GETFIL ;(4) GET ADDRESS OF RETURNED FILESPEC BLOCK
OPTMAX==<.-OPTTAB>-1 ;MAX LEGAL OPTION
; FUNCTION 1 - SET/CLEAR LOAD FLAG
;
; T2/ 0 - SET NORMAL MODE, RECORDS WILL BE PLACED REGARDLESS OF FILL FACTORS
; 1 - SET LOAD MODE, FILL FACTOR WILL DETERMINE RECORD PLACEMENT
; MAY BE CALLED ANY TIME, REMAINS AS SET UNTIL CHANGED.
; SHOULD BE SET TO 1 WHEN MASS INSERTIONS ARE BEING DONE. SUCH INSERTIONS
; SHOULD BE SORTED BY PPN TO MAXIMIZE BENEFIT.
SETLOA: MOVEM T2,LOAFLG ;SAVE THE REQUESTED STATUS
DOLOA: JUMPE R,.POPJ ;JUMP IF NO STREAM OPEN
$FETCH T1,ROP,0(R) ;GET CURRENT ROP FIELD
SKIPN LOAFLG ;LOAD MODE?
TXZA T1,RB$LOA ;NO, TELL RMS
TXO T1,RB$LOA ;YES, TELL RMS
$STORE T1,ROP,0(R) ;RETURN RESULT
JUMPE F,.POPJ ;JUMP IF NO FAB
$FETCH T1,FOP,0(F) ;GET CURRENT FOP FIELD
SKIPN LOAFLG ;LOAD MODE?
TXZA T1,FB$DFW ;NO, TELL RMS
TXO T1,FB$DFW ;YES, TELL RMS
$STORE T1,FOP,0(F) ;RETURN RESULT
JRST .POPJ1 ;OK
; FUNCTION 2 - GET FAB ERROR STATUS
GETFBE: JUMPE F,.POPJ ;ERROR IF NO FAB
$FETCH T1,STS,0(F) ;GET STATUS
$FETCH T2,STV,0(F) ;AND STATUS VALUE
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;SUCCESS
; FUNCTION 3 - GET RAB STATUS
GETRBE: JUMPE R,.POPJ ;ERROR IF NO RAB
$FETCH T1,STS,0(R) ;GET STATUS
$FETCH T2,STV,0(R) ;AND STATUS VALUE
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;SUCCESS
; FUNCTION 4 - GET ADDRESS OF RETURNED FILESPEC BLOCK
GETFIL: MOVE T1,[2,,T2] ;SET UP UUO AC
$FETCH T2,JFN,0(F) ;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
HRLZS T2 ;PUT IN LH
HRRI T2,.FOFIL ;FILOP. UUO FUNCTION CODE
MOVE T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
FILOP. T1, ;READ FILESPEC
POPJ P, ;RETURN
MOVEI T1,.FOFMX ;LENGTH OF BLOCK
MOVEI T2,FFFIL ;POINT TO BLOCK
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;RETURN
;HERE AFTER EACH RMS OPERATION TO SEE IF THERE WAS AN ERROR
;RETURNS CPOPJ/CPOPJ1, IN EITHER CASE THE STS IS IN T1, THE STV IN T2.
ERRCKF: SKIPA T1,F ;POINT TO FAB AGAIN
ERRCKR: MOVE T1,R ;OR THE RAB
$FETCH T2,STV,0(T1) ;GET STATUS VALUE
$FETCH T1,STS,0(T1) ;AND ACTUAL STATUS
CAIGE T1,ER$MIN ;AN ERROR?
AOS (P) ;NO
POPJ P, ;RETURN
; CONTEXT SWITCH TO RMS CONTEXT
; THIS IS A CO-ROUTINE THAT MAY NOT BE CALLED RECURSIVELY
; TO SAVE 'N' SETS OF ACS.
; CALL: PUSHJ P,ENT
; ALL
ENTX: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
SETZB F,R ;NO FAB OR RAB
JRST ENTCOM ;ENTER COMMON CODE
; CATALOG FILE
ENT: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
MOVEI F,FAB ;POINT TO FAB
MOVEI R,RAB ;POINT TO RAB
; JRST ENTCOM ;ENTER COMMON CODE
; COMMON ENTRY/EXIT CODE
ENTCOM: DMOVE T1,SAVACS+1 ;GET CALLER'S ARGUMENTS
DMOVEM T1,ARGS ;SAVE
MOVE T1,SAVACS+P ;GET OLD PDL POINTER
XMOVEI T1,@0(T1) ;GET CALLER'S ADDRESS
MOVE 0,T1 ;COPY ADDRESS
MOVE T1,SAVACS+T1 ;RELOAD T1
PUSHJ P,@0 ;CALL THE CALLER
TDZA T1,T1 ;INDICATE FALSE RETURN
HRROI T1,-1 ;INDICATE TRUE RETURN
MOVEM T1,SAVACS+0 ;SAVE IN AC 0
DMOVE T1,ARGS ;GET RESULTS
DMOVEM T1,SAVACS+1 ;STORE FOR CALLER
MOVE 0,[SAVACS+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,SAVACS+0 ;RELOAD AC 0
POP P,(P) ;PRUNE STACK
SETOM SAVFLG ;RESET CONTEXT FLAG
POPJ P, ;RETURN
SAVACS: BLOCK 20 ;AC STORAGE
SAVFLG: BLOCK 1 ;NON-ZERO IF ACS SAVED
ARGS: BLOCK 2 ;CALLER'S ARGUMENTS
TMPVSN: BLOCK VSNSIZ+1 ;TEMP STG FOR UP-CASED USER NAME STRING(ASCIZ)
LOAFLG: BLOCK 1 ;"LOAD MODE" FLAG
RECORD: BLOCK .CTMAX ;INTERNAL RECORD BLOCK
TEMP: BLOCK .CTMAX ;ANOTHER INTERNAL RECORD FOR UPDATES
; FILE FIXUP STORAGE
FFZBEG:! ;START OF BLOCK TO ZERO
FFFLG: BLOCK 1 ;NON-ZERO IF CALL TO OPNBLK SUCCESSFUL
FFFIL: BLOCK .FOFMX ;RETURNED FILESPEC BLOCK
FFFOP: BLOCK .FOMAX ;FILOP BLOCK
FFPTH: BLOCK .PTMAX ;PATH BLOCK
FFLKP: BLOCK .RBMAX+1 ;LOOKUP BLOCK
FFREN: BLOCK .RBMAX+1 ;RENAME BLOCK
FFZEND:! ;END OF BLOCK TO ZERO
RMS$$G::BLOCK 3K ;3 PAGES FOR RMS GLOBAL DATA
END