Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/rmscnc.b36
There are 6 other files named rmscnc.b36 in the archive. Click here to see a list.
%TITLE 'C O N E C T   -- $CONNECT, $DISCONNECT routines'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE conect (IDENT = '3.0(572)'
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 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:	RMS
!
! ABSTRACT:
!
!	CONECT contains all routinew which process the
!	$CONNECT and $DISCONNECT macros in RMS-20.
!
! ENVIRONMENT:	User mode, interrupts deferred until JSYS return.
!
! AUTHOR: Ron Lusk , CREATION DATE: 15-Mar-83
!
! MODIFIED BY:
!
!	Ron Lusk, 9-May-83 : VERSION 2
! 401	-   $CONNECT - don't worry about multiple RABs when
!	    FB$SMU is set in FAC field (RMS edit 404).
!       Andrew Nourse - May 84 : Version 3
! 501	- Put in code for remote $Connect and $Disconnect
! 502   - Change over to new standard names
! 524   - Call dynamic library for funny files
! 565	- (RL) Return STV from FFF call
! 572   - (DR) Set BSZ and TYP in FST (in case changed since open)
!--

!
! TABLE OF CONTENTS
!
!
!	$CONNECT	- processor for $CONNECT macro
!	$DISCONNECT	- processor for $DISCONNECT macro
!	DCNTRAB		- disconnect a single RAB stream
!
!
! INCLUDE FILES:
!

REQUIRE 'rmsreq';

!
! MACROS:
!
!   None.
!
! EQUATED SYMBOLS:
!

GLOBAL BIND
    cnctv = 3^24 + 0^18 + 560;			! Module edit number

!
! OWN STORAGE:
!
!   None.
!
! EXTERNAL REFERENCES:
!
!
EXTERNAL ROUTINE
    F$Connect,
    F$Disconnect,
    CncM11: NOVALUE,
    DscM11: NOVALUE;
%SBTTL '$CONNECT -- establish a record stream'

GLOBAL ROUTINE $connect (rablock, errorreturn) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine processes the $CONNECT macro.
!
! FORMAL PARAMETERS
!
!	RABLOCK	    -	User's Record Access Block
!	    FAB	    -	Associated File Access Block
!	    KRF	    -	Key of Reference (Indexed files
!			only)
!	    MBF	    -	Multi-buffer count
!	    RAC	    -	Record access
!	    ROP	    -	Record options
!		EOF -	$CONNECT to End-of-file
!	    STS	    -	Status code (returned)
!	    ISI	    -	Internal stream identifier
!			(address of Record Status Table)
!
!	ERRORRETURN -	Address of user's error routine
!
! IMPLICIT INPUTS
!
!	?
!
! ROUTINE VALUE:
!
!	None, yet not NOVALUE.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN
!+
!   **** Flow of $CONNECT routine ****
!
!   1. Get FAB address from RAB and check it;
!   2. Check for errors
!   3. Set up RST
!   4. If remote, call Dap$Connect to do the connect on the remote system
!   5. Return Stream-ID to user
!-

    LOCAL
	fileid;

    rmsentry ($connect);
!+
!   Fetch the address of the user's RAB
!   and error address.
!-
    rab = .rablock;				! Get address of RAB
    erradr = .errorreturn;			! And user error address
    errorblock (rab);				! Errors go to RAB
!+
!   Check for valid RAB code and size.
!-

    IF .rab [blocktype] NEQ rabcode THEN usererror (er$rab);

    IF .rab [blocklength] NEQ v1rabsize THEN usererror (er$bln);

!+
!   Fetch file-id from RAB.
!-
    fab = .rab [rabfab, 0];			! Get FAB address

    IF .fab EQL 0 THEN usererror (er$ifi);	! Bad FAB pointer

    fab = .fab OR .blksec;			! Get address in section
    fst = .fab [fabifi, 0];			! Convert IFI to FST address

    IF .fst EQL 0				! File open?
    THEN
	usererror (er$ifi);			! No

    IF (.fst [blocktype] NEQ fstcode)		! Is FST a real FST?
    THEN
	usererror (er$ifi);


!+
! In case user wants to change the bytesize, move it to the FST from the FAB.
! The remote system will not see this change!!!
!-

    Fst[Fst$h_Bsz] = .Fab[Fab$v_Bsz];                                !m572

!+
! In case the user wants to change the TYPE declaration of the file,
! move it to the FST from the TYP block
! The remote system will not see this change!!!
!-
        BEGIN                                                             !m577
        BIND Nclass=UClass( .fab );

        IF NClass NEQ 0
        THEN Fst[Fst$h_File_Class] = NClass
        ELSE IF .Fst[Fst$h_File_Class] EQL 0
             THEN Fst[Fst$h_File_Class] = Typ$k_Ascii
        END;

!+
!   Check now to be sure that the RB$EOF option
!   bit is being used correctly. This option is
!   valid only for Sequential files (including ASCII/LSA).
!-

    IF (appendoption NEQ 0)			!
    THEN 					!

	IF (fileorg GTR orgseq)			!
	THEN 					! There is an error
	    usererror (er$pef);			!

!+
!   Note that there is no check here for a zero ISI
!   field in the user's RAB.  Although this may seem
!   like a logical thing to check for, it would mean
!   that RMS-20 would have to clear the ISI field
!   whenever the RAB was disconnected.  This is fine
!   for a $DISCONNECT macro, but it couldn't be done
!   on a $CLOSE. Therefore, the ISI field is
!   overwritten if non-zero on a $CONNECT.
!-

!+
!   Check for remoteness,
!   If file is remote, do a remote connect with DAP
!-
    IF .fst [fst$v_remote]						!a501 
    THEN                                                                !a501 
        BEGIN                                                           !a501 
        !+
        !   Allocate core for the RST.
        !-
        IF (rst = gmem (rstsize)) EQL false		     ! Get core !a501
        THEN                                                            !a501 
            returnstatus (er$dme);                                      !a501
        rst[rst$h_bid]=rst$k_bid;                                       !a501 
        rst[rst$h_bln]=rst$k_bln;                                       !a501
        rst[rst$v_remote] = 1;                                          !a501
        rst[rst$a_fst]=.fst;						!a501
        Dap$Connect ( .rab, .erradr );                                  !M557
        END                                                             !a501
    ELSE                                                                !a501
        BEGIN
        !+
        !   If we are connecting multiple streams, then we
        !   must insure that write access is not being used
        !   if the file is only for exclusive access. This
        !   is because multiple streams must be interlocked
        !   from each other just as different processes are
        !   also interlocked.  Thus, if we are not locking
        !   (i.e., FAC=SHR=FB$GET or SHR=FB$NIL), then we
        !   must check that we are only reading the file.
        !-

        IF (.fst [flink] NEQ .fst) AND 		   ! If stream active	!M404
            ((.fab [fabfac, 0] AND fb$smu) EQL 0)  !  and not doing SMU !A404
        THEN
            BEGIN
            IF (( NOT locking) AND iomode) OR 	!  Read/Write without locking
                (asciifile) OR (mta)            !  or non-rms file or tape
            THEN
                usererror (er$ccr)		! Only one stream is allowed
            END;

        !+
        !   Set up a record status table.
        !-

        setrst ();
        END;  ! Local file setup

!+
!   Place the address of the user's buffer into
!   the "record-buffer address" field so that the
!   first record insertion will operate correctly.
!-
    rab [rabrbf, 0] = .rab [rabubf, 0];
    rab [rabisi, 0] = .rst;			! Return stream-id
    setsuccess;					! We were successful

!+
!   Do file-type specific processing, if any
!-
    IF .Fst[Fst$h_File_Class] LSS 0                                     !a524vv
    THEN
        BEGIN
        F$Connect( .Rab );

	usrstv = .rab [rab$h_stv];		! Return STV value	!A565
        IF NOT $Rms_Status_Ok( .Rab )
        THEN Usererror( .Rab[Rab$h_Sts] );
        END                                                             !a524^^
    ELSE
        IF .Fst[Fst$h_File_Class] EQL Typ$k_Macy11      ! Check for MACY11
        THEN
            CncM11();                                                   !a567

    usrret ()					! Return to user
    END;					! End of $CONNECT
%SBTTL '$DISCONNECT -- end a record stream'

GLOBAL ROUTINE $disconnect (rablock, errorreturn) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	$DISCONNECT processes the $DISCONNECT macro.
!
! FORMAL PARAMETERS
!
!	RABLOCK	    -	Address of user's Record Access Block
!	    ISI	    -	Internal stream identifier (the address
!			of the related Record Status Table)
!	    STS	    -	Status code returned by routine
!
!	ERRORRETURN -	Address of user's error routine
!
! IMPLICIT INPUTS
!
!	?
!
! ROUTINE VALUE:
!
!	None, yet not NOVALUE.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN
    rmsentry ($disconnect);
    rab = .rablock;				! Fetch RAB address
    erradr = .errorreturn;			! And user error address
    errorblock (rab);				! Status goes to RAB
!+
!   Perform normal set-up operations just like any
!   other record operation. However, pass RSETUP a
!   value of TRUE so that the FAC access check
!   will always succeed.
!-
    rsetup (true);				! Set up RST, FST, etc.
    !
    !   Disconnect a single record stream.
    !
    IF .fst [fst$v_remote]              				!a501 
    THEN                                                                !a501 
        BEGIN
        LOCAL rstlen;

        !+
        !   Disconnect on the remote system
        !-
        dap$disconnect ( .rab, .erradr );				!a501 

        !+
        !   Remove RST from FST chain.
        !-
        delink (rst);				! Unlink RST
        !+
        !   Release core used by RST
        !-
        rstlen = .rst [blocklength];
        pmem (.rstlen,                  ! Block size
               rst);                    ! Block pointer
        END
    ELSE                                                                !a501 
        dcntrab ();                             ! Process the RAB
    usrret ()					! Return to user
    END;					! End of $DISCONNECT
%SBTTL 'DCNTRAB -- disconnect a record stream'

GLOBAL ROUTINE dcntrab =

!++
! FUNCTIONAL DESCRIPTION:
!
!	DCNTRAB $DISCONNECTs a single RAB from a file.  This
!	routine is called once by the $DISCONNECT processor
!	and possibly several times by the $CLOSE processor,
!	one for each defined record stream.
!
! FORMAL PARAMETERS
!
!	None.
!
! IMPLICIT INPUTS
!
!	?
!
! ROUTINE VALUE:
!
!	None, yet not NOVALUE.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	temp,
	oureofbyte,				! The EOF as we know it
	bfdptr : REF BLOCK,			!
	bufferpage,				! First page of
						!   contiguous buffers
	buffersize,				! Size (in pages) of
						!   each record buffer
	keybuffsize,				! Size of key buffer
	keybuffadr;				! Address of key buffer

    						!   (indexed only)
    TRACE ('DCNCTRAB');

    !+
    ! If this is a foreign file type (i.e. handled by FFF)
    ! Then call the FFF
    !-

    IF .fst[fst$h_file_class] LSS 0                                     !a524
    THEN 
	BEGIN					! 			!A565
	F$Disconnect( .Rab );			!			!A524
	usrstv = .rab [rab$h_stv];		! Return STV value	!A565
	END 					! 			!A565
    ELSE
        BEGIN
        IF .fst[fst$h_file_class] EQL Typ$k_Macy11      ! Check macy11
        THEN DscM11();                                                  !a567 
        END;
!+
!   We now must insure that all locked records for the stream
!   have been unlocked.  There is a very easy way of doing
!   this...issue a DEQ JSYS to unlock all records for the
!   stream.  However, if there are no locked records, this is an
!   unnecessary overhead.  Therefore, for Sequential/Relative
!   files, we will check the DLOCKED bit in the RST; for
!   Indexed files, we will check to see if there is a current
!   bucket.  In either case, all locked records will be unlocked.
!-
    !
    !   Unlock any locked record.
    !

    IF datalocked
    THEN
    !
    !	We must unlock all locked records/buckets in the file.
    !
	$callos (er$edq, (loffall (.rst)));	! Unlock everything

    !
    !   Set up the current buffer descriptor pointer.
    !
    cbd = .rst + rstcbdoffset;			! Get pointer to current bucket
!+
!   For indexed files, flush the current bucket and the key buffer.
!-

    IF idxfile
    THEN 					! We must flush the key buffer
	BEGIN
	releascurentbkt;
	keybuffsize = .fst [fstkbfsize];	! Get size of buffer
	keybuffadr = .rst [rstkeybuff];		! And its address

	IF .keybuffsize NEQ 0			! Free buffer space if non-zero
	THEN
	    pmem (.keybuffsize, keybuffadr)

	END;

    flubuf ();					! Put out all updated buffers
!+
!   Release all buffers used by record stream.
!-
    buffersize = 				! Get size of each buffer
    .fst [fstbufsiz]*.rst [rstbfdcount];
    bfdptr = bfdoffset;				! Get pointer to first buffer
    bufferpage = .bfdptr [bfdbpage];		! And page number of first one
    ppage (.bufferpage, 			! Page number
	.buffersize, 				! Page count
	true);					! Destroy page
!+
!   Fetch our EOF byte number and start to compare it.
!
!   NOTE: For LSA files,  HYBYTE and EOFBYTE are in
!   words, not chars.
!-
    oureofbyte = .rst [rsthybyte];

    IF sequenced THEN oureofbyte = (.oureofbyte + 4)/5;

    temp = (.rst [rstflags] AND flgtrunc);	! Truncate flag for ADJEOF

    IF (rmsfile) AND 				! RMS file (only PMAPs done)
	(.oureofbyte NEQ 0) OR 			! Been updated?
	(.temp NEQ 0)				! Or ...we did a $TRUNCATE
    THEN 					! We may have to update
    						!   the EOF pointer
	adjeof (.fst [fstjfn], .oureofbyte, .temp);

!+
!   Remove RST from FST chain.
!-
    delink (rst);				! Unlink RST
!+
!   Release core used by RST
!-
    temp = .rst [blocklength];
    pmem (.temp, 				! Block size
	rst);					! Block pointer
    RETURN true;
    END;					! End of DCNTRAB

END						! End of Module CONECT

ELUDOM