Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/rmsrsu.b36
There are 6 other files named rmsrsu.b36 in the archive. Click here to see a list.
%TITLE 'R S E T U P -- initiate record operation'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE rsetup (IDENT = '2.0'
) =
BEGIN
GLOBAL BIND! 3 . 0 ( )
rsetv = 3^24 + 0^18 + 536; ! Edit date: 14-Dec-84
!+
!
!
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 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.
!
!
!
! FUNCTION: THIS MODULE IS USED ONLY TO INITIATE THE PROCESSING
! OF A RECORD OPERATION ( E.G. GET, PUT,... ). IT IS CALLED
! AT THE BEGINNING OF EACH SUCH OPERATION IN ORDER TO CHECK
! FOR ERRORS AND TO SET UP THE RELEVANT DATA STRUCTURE POINTERS.
! IT EXISTS AS A SELF-CONTAINED MODULE TO ALLOW IT TO BE PLACED
! ANYWHERE IN ORDER TO MINIMIZE PAGE FAULTS.
!
! AUTHOR: S. BLOUNT
!
!
!
! REVISION HISTORY:
!
! EDIT DATE WHO PURPOSE
! ==== ==== ==== =======
!
! 1 21-JUL-76 SB ADD FSETUP /SB
! 2 22-DEC-76 SB CHANGE ER$IOP TO ER$FAC
! 3 16-MAY-77 SB DELETE CHECK FOR KBF ERROR
! 4 21-JUN-77 SB MAKE RSETUP NOT CHECK ERRORS IF FACBIT=TRUE
!
! *************************************************
! * *
! * NEW REVISION HISTORY *
! * *
! *************************************************
!
! PRODUCT MODULE SPR
! EDIT EDIT QAR DESCRIPTION
! ====== ====== ===== ===========
!
!
! ***** END OF REVISION HISTORY *****
!
! ***** BEGIN VERSION 2 DEVELOPMENT *****
!
!
! PRODUCT MODULE SPR
! EDIT EDIT QAR DESCRIPTION
! ====== ====== ===== ===========
!
! 301 300 XXXXX SUPPORT EXTENDED ADDRESSING.
!
! 400 400 xxxxx Clean up BLISS code (RL,22-Apr-83)
! 401 401 xxxxx Fix CBD initialization (RL, 1-May-83)
! 403 403 Add Stream RFA access
!
! 536 536 Change range check for RAC
!
!
!-
REQUIRE 'RMSREQ';
%SBTTL 'RSETUP - setup for record verb'
GLOBAL ROUTINE rsetup (facbit) : NOVALUE =
! RSETUP
! ======
!
! THIS ROUTINE PERFORMS ALL SET UP REQUIRED FOR EACH
! RECORD-RELATED VERB.
!
! INPUT:
! FACBIT = FILE-ACCESS BIT TO CHECK
! (IF FACBIT = TRUE, THEN ANY FAC VALUE IS TO
! BE ACCEPTED, AND NO ERROR CHECKS ON RAC, ETC.
! ARE TO BE DONE)
!
! OUTPUT:
! <NO VALUE RETURNED>
!
! NOTES:
!
! 1. ON AN ERROR, THIS ROUTINE WILL EXIT DIRECTLY TO USER.
!+
!
! THIS ROUTINE CHECKS THE FOLLOWING THINGS:
!
! 1. RAB MUST BE PROPERLY STRUCTURED
! A. BLOCK-CODE VALID
! 2. RECORD-ACCESS VALUE IS LEGAL FOR FILE AND DEVICE
! 3. OPERATION WAS GIVEN IN FAC FIELD
! 4. UNUSED OPTIONS ARE 0
! 5. KBF NOT 0 IF KEY ADDRESSING
! 6. RFA ADDRESSING IS USED ONLY FOR RMS DISK FILES
!
!
!-
BEGIN
REGISTER
errorcode, ! Keep code here
rabptr : REF $Rab_decl, ! For speed, !m536
fstptr : REF $Rms_Fst, ! use registers !m536
rstptr : REF $Rms_Rst; ! !m536
LABEL
errchk;
TRACE ('RSETUP');
errorcode = 0; ! Clear this variable
errorblock (rab); ! All errors go to RAB
rabptr = .rab; ! Set up registers
!+
! Beginning of block which will check for errors.
! The first error which is found will cause an exit
! to the end of the block.
!-
errchk :
BEGIN
IF .rabptr [blocklength] LSS v1rabsize ! RAB right length?
THEN
(LEAVE errchk WITH errorcode = er$bln);
IF .rabptr [blocktype] NEQ rabcode ! Really a RAB?
THEN
(LEAVE errchk WITH errorcode = er$rab);
IF (fab = .rab [rabfab, 0]) EQL 0 ! Check FAB pointer
THEN
(LEAVE errchk WITH errorcode = er$ifi); ! Bad FAB pointer
fab = .fab OR .blksec; ! Get global address of FAB
IF (fstptr = .fab [fabifi, 0]) EQL 0 ! File not open?
THEN
(LEAVE errchk WITH errorcode = er$ifi); ! Afraid so
IF .fstptr [flink] EQL .fstptr ! Anything connected?
THEN
(LEAVE errchk WITH errorcode = er$isi); ! Not connected
rstptr = .rabptr [rabisi, 0]; ! Get ISI
IF (.fstptr [blocktype] NEQ fstcode) OR (.rstptr [blocktype] NEQ rstcode)
THEN
(LEAVE errchk WITH errorcode = er$isi); ! Bad ISI
!+
! Set up the global pointers.
!-
fst = .fstptr; ! Store IFI (FST address)
rst = .rstptr; ! Store ISI (RST address)
cbd = .rstptr + rstcbdoffset; ! Current bucket descriptor
![401] Fix CBD initialization
!+
! If this is a $DISCONNECT (i.e., FACBIT=TRUE),
! then we don't want to do any checks on the content
! of the RAB fields such as RAC, etc.
!-
IF .facbit NEQ true
THEN
BEGIN ! Do these error checks
IF .rabptr[rab$b_rac] GTR rab$k_bft ! Invalid access code !m536
THEN
( LEAVE errchk WITH errorcode = Rms$_Rac );
%IF 0
%THEN
!+
! Check that file is not in an undefined state.
! **This code is dis-abled currently***
!-
IF (.fstptr [fstflags] AND flgundef) NEQ 0 ! Unused bits
THEN
(LEAVE errchk WITH errorcode = er$udf);
!+
! This next check will be eliminated for now ( speed )
!-
IF (.rabptr [rabrop, 0] AND ropunused) NEQ 0 ! Unused bits
THEN
(LEAVE errchk WITH errorcode = er$iro);
%FI
IF (.fstptr [fstfac] AND .facbit) EQL 0 ! Legal file access requested?
THEN
(LEAVE errchk WITH errorcode = er$fac); ! Check for FAC bit
CASE .rabptr [rab$b_rac] !
FROM rab$k_seq TO rab$k_bft OF ! Check various things !m536
SET
[OUTRANGE, INRANGE] :
( LEAVE errchk WITH errorcode = Rms$_Rac ); ! Bad access
[Rab$k_Seq,
Rab$k_Tra] : !a536
0; ! Sequential: No checks here
[Rab$k_Blk, ! Block Mode !a536vv
Rab$k_Bft] :
BEGIN
0
%( Test removed
IF ( .Fst[Fst$b_Fac] AND (Fab$m_Bio+Fab$m_Bro) ) EQL 0
THEN
( LEAVE errchk WITH errorcode = Rms$_Rac );
)%
END; !a536^^
[Rab$k_Key] :
BEGIN ! Key access : Check key buffer
IF (fileorg LSS fab$k_Rel) ! Key access to seq files
AND (NOT fixedlength) ! is only legal for !m567
THEN ! fixed length records
( LEAVE errchk WITH errorcode = Rms$_Rac );
END;
[Rab$k_Rfa] :
BEGIN ! RFA access
![401] ASCII check removed
IF (dasd EQL false) ! Non-disk?
AND (.Fst[Fst$v_Remote] EQL false) ! non-remote !a577
THEN
(LEAVE errchk WITH errorcode = er$rac)
END;
TES
END
END;
!+
! Did we find an error?
!-
IF .errorcode NEQ 0 THEN usererror (.errorcode);
!+
! Check to see if the last operation was successful.
!-
IF NOT success THEN rst [rstlastoper] = 0; ! If not, don't remember it
clearsuccess; ! Clear flag
RETURN
END; ! End routine RSETUP
%SBTTL 'FSETUP - setup for file operation'
GLOBAL ROUTINE fsetup : NOVALUE =
! FSETUP
! ======
! ROUTINE TO SET UP FOR FILE OPERATIONS.
! THIS ROUTINE IS USED FOR FILE OPERATIONS TO SET UP
! POINTERS TO THE RELEVANT INTERNAL BLOCKS, AND TO
! CHECK THAT THE USER IS ACCESSING A VALID FILE, ETC.
! THIS ROUTINE DOES NOT CHECK IF THE FILE-STATUS TABLE
! IS CORRECT, BECAUSE $OPEN/$CREATE DO NOT REQUIRE THIS.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
BEGIN
REGISTER
errorcode;
TRACE ('FSETUP');
errorblock (fab); ! Errors go to the FAB
errorcode = 0; ! Init error code
!+
! Check if this is a FAB
!-
IF .fab [blocktype] NEQ fabcode THEN errorcode = er$fab;
IF .fab [blocklength] NEQ v1fabsize THEN errorcode = er$bln;
IF (fst = .fab [fabifi, 0]) EQL 0 THEN errorcode = er$ifi;
!+
! Check for errors
!-
IF .errorcode NEQ 0
THEN
BEGIN
usrsts = .errorcode; ! Store error code
usrret () ! Return to user
END;
RETURN
END; ! End routine FSETUP
END
ELUDOM