Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 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