Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/rmsrop.b36
There are 3 other files named rmsrop.b36 in the archive. Click here to see a list.
%TITLE 'RMSROP - RMS-20 DAP File Open Routines'
MODULE RMSROP (                         ! Open a file using DAP
		IDENT = '3(663)'
                %BLISS36(,ENTRY(
                                dap$openfile, !open a remote file (using dap)
                                dap$close,    !close a remote file (using dap)
                                dap$EndAccess,!deaccess remote file (using dap)
                                d$SDisplay    !set display bits by xab chain
                                ))
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 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: DAP/RMS
!
! ABSTRACT:
!     Open a file using DAP if the file is on another system,
!     or using RMS if it is on the same system.
!
! ENVIRONMENT: BLISSNET, RMS, XPORT, Transportable Code.
!
! AUTHOR:	Andrew Nourse, CREATION DATE: 2-Jan-82
!
! RMS Edit:
!
! 663 - Check if DAP tracing is wanted and setup the logfile if so.
! 662 - On sending a CONTINUE(abort) interrupt, completely forget
!	about any previous DAP messages.
! 656 - (GAS, 13-Oct-86) Implement protection XABs.
! 645 - Allow image mode to TOPS-10 systems.
! 644 - Don't forget third argument to dap$get_config.
! 640 - Clear Fst[Fst$a_Nlb] after deallocating the Nlb
! 627 - Set extended Key attribute display bit for remote indexed
!	$Open if partner supports it, even if no user key XAB
!	was supplied.  
! 607 - No longer reset DAP function code to OPEN on CIF $CREATE
! 604 - Fix cleanup on close with more files left.
! 601 - Fill in both nam blocks on $Rename
! 600 - Fix $Change_End, & changing attrs on close
! 571 - Request 3-part name if possible, even if not wildcarded.
! 566 - Handle remote wildcard errors correctly
! 560 - Default to ASCII if RFM = STM or LSA
! 555 - Default to Image for TOPS-20
! Module Edit:
! 24    - Set up CRC stuff
! 23    - Send access complete if access active, not just file open
! 22    - Remove jacket routines and RMS-ify module
! 21    - Put patchable stuff in the plit psect
! 20    - Poor-man's routing now invoked by setting PMRFLG to -1
! 17    - Undefined ASCII to non-stream sets CR only if no other RAT bits set
! 16    - R$OPEN should merge related filespec
!       - R$ERASE should call DAP$NEXTFILESPEC for additional filespecs
! 15    - R$OPEN & R$CREATE continue after signalling RMS$_SUP for remote-only
! 14    - Make R$RESET get rid of link.
! 13    - Have R$RESET check the NEW FILE bit in the FST
! 12    - Send ACCESS COMPLETE(PURGE) as interrupt message
! 11    - Work around IAS wierdnesses
! 10    - Tell RMS that file is stream if using block mode
! 07    - Don't set implied CRLF unless user does not know format
! 06    - Give DD's pointers to each other
! 05    - Make DAP$CLOSE eat entire DATA message also
! 04    - Make DAP$CLOSE eat entire ACCESS COMPLETE message
! 03    - Put in ENTRY points
! 02    - Eat messages in pipe on close
! 01	- The beginning
!--
!
! INCLUDE FILES:
!

!LIBRARY 'RMS';
!LIBRARY 'RMSBLK';
!LIBRARY 'DAP';
REQUIRE 'RMSREQ';
LIBRARY 'BLISSNET';
LIBRARY 'CONDIT';

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
        Dap$Openfile,     !Open a remote file (using DAP)
        Dap$Close,        !Close a remote file (using DAP)
        Dap$EndAccess,    !Deaccess (close/disconnect) remote file (using DAP)
        D$SDisplay;       !Set display bits
!
! MACROS:
!
UNDECLARE %QUOTE type;  ! This causes trouble with BLISSNET keywordmacros !a501

!
! EQUATED SYMBOLS:
!

COMPILETIME Multiple_Filespecs=1;       ![16] On for mult-filespec support

%IF %BLISS(BLISS36)
    %THEN
    %IF %SWITCHES(TOPS20)
        %THEN
            LITERAL Our_Ostype=Dap$k_Tops20;
	    LITERAL Our_Filesys=Dap$k_Filesys_Rms20;                    !m572
	%ELSE                                                           !m572v
            LITERAL Our_Ostype=Dap$k_Tops10;
	    LITERAL Our_Filesys=Dap$k_Filesys_Tops10;                   !m572^
        %FI
        LITERAL Ma_Return = 1;
    %FI

LITERAL FopCloseBits = (Fab$m_Spl OR Fab$m_Scf OR Fab$m_Dlt);           !m600

!
! RUN-TIME FEATURE TESTS:
!

PSECT GLOBAL=$HIGH$;
PSECT OWN=$HIGH$;

GLOBAL
    Pmrflg: INITIAL(0);                 ! Set nonzero for poor-man's routing

GLOBAL
    DAccOpt: INITIAL(0);                ! Set to 8 for CRC checking

OWN VmsSlp: INITIAL(256);               ! Number of bytes VMS is likely to
                                        ! be off in its own BYTLM/buffersize
                                        ! calculation.  We restrict it to
                                        ! less than its own stated max by
                                        ! this amount to keep it from hanging
                                        ! itself.

OWN AcmDrl_Mask: BITVECTOR [ Dap$k_Accomp_Max ]
                 PRESET( [Dap$k_Accomp_Response]=1,     ! RESPONSE
                         [Dap$k_Accomp_Eos]=1,          ! DISCONNECT
                         [Dap$k_Accomp_Change_Begin]=1  ! attr change on close
                       );                                                !d600

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
		D$CTrace: NOVALUE,				!663
		D$ZTrace: NOVALUE,				!663
                D$SetAi,
		D$Strace,					!663
                D$NamAi,
                Dap$Handle,
                Dap$Put_Message,
                Dap$Get_Message,
                Dap$Get_Config,
                Dap$Put_Name,
                Dap$Put_Config,
                Dap$Put_Attributes,
                Dap$Put_Bitvector,
                Dap$Put_Access,
                Dap$Put_Byte,
                Dap$Put_2Byte,
                Dap$Put_Header,
                Dap$Get_Header,
                Dap$Get_Status,
                Dap$Get_2Byte,
                Dap$Get_Attributes,
                Dap$Error_Dap_Rms,
                Dap$Merge,
                Dap$Unget_Header,
                Dap$Size_Bitvector,
                Dap$Get_Byte,
                Dap$Get_Bitvector,
                R$Null,
                UAddr,
                UAPointer,
                Xpn$Signal;
%IF Multiple_Filespecs
%THEN
EXTERNAL ROUTINE Dap$Nextfilespec;
%FI
EXTERNAL FalObj;

EXTERNAL T20bug: BITVECTOR,
         Vmsbug: BITVECTOR,
         Rsxbug: BITVECTOR,
         Rstbug: BITVECTOR,
         Iasbug: BITVECTOR,
         T10bug: BITVECTOR,
         Rtbug:  BITVECTOR,
	 D$GTrace;				! 663
GLOBAL ROUTINE Dap$Openfile (P_Fab: REF $Fab_Decl,
                               Function,
                               P_Nfab: REF $Fab_Decl,
                               Err): =
!++
! FUNCTIONAL DESCRIPTION:
!
!   OPEN/CREATE/... A REMOTE FILE
!
! FORMAL PARAMETERS:
!
!   P_FAB: An RMS FAB with a NODEID embedded in the filespec.
!   FUNCTION: ACCESS message function code (DAP) or 0 to exchange configs only
!             Function OR'ed with Fab$m_Nam for $Parse
!   P_NFAB: New FAB for Rename
!   ERR: Address of error routine or 0
!
! IMPLICIT PARAMETERS:
!
!   FST: addr of FST
!
! COMPLETION CODES:
!
!   RMS codes
!
! SIDE EFFECTS:
!
!  If the link is not already open
!   An NLB is allocated.  Fst[Fst$a_Nlb] will point to it
!   2 $Dap_Descriptor's are allocated, Fst[Fst$a_(I,O)_Dd] point to them
!   A Configuration Xab is allocated. Fst[Fst$a_Config] will point to it
!
!   For ERASE and EXECUTE, the requested operation will have been completed
!   and the above data strucures de-allocated.
!--
    BEGIN
    BIND UFab=.P_Fab: $Fab_Decl,
         Nfab=.P_NFab: $Fab_Decl,          ! New name for rename
         Nam=Uaddr(.UFab[Fab$a_Nam]): $Nam_decl,
         Typ=Uaddr(.UFab[Fab$a_Typ]): $Typ_decl;

    LOCAL Fabsav: VOLATILE REF $Fab_Decl;

    LOCAL P_nlb : REF $xpn_nlb();
    LOCAL accopt: BITVECTOR[35] INITIAL(0),
          display: BITVECTOR[28] INITIAL(0);
    LOCAL P_Cfgblk: REF $XabCfg_Decl;
    LOCAL P_Obuf,
          P_Idd: REF $dap_descriptor,
          P_Odd: REF $dap_descriptor;
    LOCAL class;
    LOCAL errsav: VOLATILE;

    ENABLE dap$handle ( fabsav, errsav ) ;

    IF .err EQL 0 THEN err = r$null ;

    errsav = .err ;
    fabsav = UFab ;                      ! Handler will need this

    IF .Fst[Fst$a_Nlb] EQL 0
    THEN
        BEGIN

        $Xpo_Get_Mem (Units=Dap$k_Buffer_Size %BLISS36(/4), Result=P_Obuf);
                                            ! Allocate Output Buffer

        $Xpo_Get_Mem (Units=Dap$k_Descriptor_Len, Result=P_Odd, Fill=0);
        $Xpn_Desc_Init(Descriptor=.P_Odd, Class=Dynamic_Bounded,
                       Binary_Data=(Dap$k_Buffer_Size,.P_Obuf,Bytes));

        $Xpo_Get_Mem (Units=Dap$k_Descriptor_Len, Result=P_Idd, Fill=0);
        $Xpn_Desc_Init(Descriptor=.P_Idd, Class=Bounded);

        $Xpo_Get_Mem (Units=Nlb$k_Length, Result=P_Nlb, Fill=0); ! Allocate NLB
        $Xpn_Nlb_Init (Nlb=.P_Nlb);

        !Now set up the pointers:
        !
        !   +---------+   +---------+   +---------+
        !   |   FAB   |-->|   FST   |-->| CONFIG  |
        !   +---------+   +----+----+   +---------+
        !            ,----'    V    `-.
        !   +---------+   +---------+ :  
        !   |   IDD   |   |   ODD   | :  
        !   +---------+   +--+------+ :
        !            `--.    V        ;
        !            +-----------+<--'
        !            |    NLB    |
        !            +-----------+
        ! 

        Fst[Fst$a_Nlb]=.P_Nlb;          ! Point the DIB at the NLB
        Fst[Fst$a_I_Dd]=.P_Idd;         !  ... and the input descriptor
        Fst[Fst$a_O_Dd]=.P_Odd;         !  ... and the output descriptor
        Fst[Fst$h_Fop]=.UFab[Fab$h_Fop]; ! Copy the FOP into the FST

        Fst[Fst$v_Accopt]=.DAccopt;     ! Use default accopt   ![24]

        P_Odd[Dap$a_Nlb]=.P_Nlb;        ! Output descriptor points to NLB
        P_Idd[Dap$a_Nlb]=.P_Nlb;        ! Input descriptor ...

        P_Idd[Dap$a_Other_Dd]=.P_Odd;   ![6] DD's should point
        P_Odd[Dap$a_Other_Dd]=.P_Idd;   ![6] to each other

        $Xpo_Get_Mem (Units=Xab$k_CfgLen, Result=P_Cfgblk, Fill=0);
        ! Allocate  config XAB

        $XabCfg_Init( Xab=.P_CfgBlk );  ! Initialize internal Cfg XAB   !a554

        Fst[Fst$a_Config]=.P_Cfgblk;    ! Point the Dib at it

        D$SetAi( .P_Nlb, UFab );         ! Get access info from filespec !m571

        D$NamAi( Nam,
                 .P_Nlb[Nlb$a_Node_Name],
                 .P_Nlb[Nlb$a_User_id],
                 .P_Nlb[Nlb$a_Password],
                 .P_Nlb[Nlb$a_Account]
               );         ! Put it in NAM block if any    !m571

        IF .Function EQL Dap$k_Rename
        THEN
            BEGIN
            BIND NewNam = UAddr(.NFab[Fab$a_Nam]): $Nam_decl;
            IF NewNam NEQ 0
            THEN
                D$NamAi( NewNam,
                         .P_Nlb[Nlb$a_Node_Name],
                         .P_Nlb[Nlb$a_User_id],
                         .P_Nlb[Nlb$a_Password],
                         .P_Nlb[Nlb$a_Account]
                       );         ! Put it in NAM block if any    !a601
            END;
        !++
        ! Open the link
        !--

        IF .P_Nlb[Nlb$v_Open]         ! If link was open, close it       !a566
        THEN $Xpn_Close( Nlb=.P_Nlb, Failure = 0 );

        IF .Pmrflg NEQ 0  ![10] PMRFLG is patched to enable poor-man's routing
        THEN
        $Xpn_Open (Nlb=.P_Nlb, Object=.FalObj, Type=Active,
                   Options=(Wait,Pmr),                  ! ask for PMR
                   Buffer_Size=Dap$k_Buffer_Size,       ! Tell PMR buffer size
                   Timeout = 180, Failure=Xpn$Signal)
        ELSE
        $Xpn_Open (Nlb=.P_Nlb, Object=.FalObj, Type=Active,
                   Option=Wait,
                   Timeout = 180, Failure=Xpn$Signal);


	D$Strace(.P_Nlb[Nlb$a_Node_Name],.P_Nlb[Nlb$h_Jfn]);		!663

        Dap$Put_Config(.P_Odd, Dap$k_Buffer_Size);
        Dap$Put_Message(.P_Odd);          ! Send configuration

        Dap$Get_Config (.P_Idd, .P_Cfgblk, ufab);       ! Get one back    !m644

        ! Workaround VMS BYTLM bug.
        ! If user BYTLM is less than our buffersize, VMS FAL hangs
        ! trying to send a message that is too large.
        ! Currently we set a limit of what the VAX sends us - 256
        IF .Vmsbug[Vms_Bug_Bytlm_Hang]  ! VMS does not check its own limit
        AND (.P_Cfgblk[Xab$b_Ostype] EQL Dap$k_Vms)
        THEN
            BEGIN                   ! Exchange new configurations
            LOCAL Bufsiz;           ! Gets lower of our max or vms's
            Bufsiz=MIN(.P_Cfgblk[Xab$h_Bufsiz]-.Vmsslp, Dap$k_Buffer_Size);

            Dap$Put_Config (.P_Odd,.Bufsiz);
            Dap$Put_Message(.P_Odd);
            Dap$Get_Config(.P_Idd,.P_Cfgblk,ufab);                        !m644
            P_Cfgblk[Xab$h_Bufsiz]=.Bufsiz;        ! Don't forget the slop
            END;
        END
    ELSE
        BEGIN                           ! Set up local pointers
        P_Idd=.Fst[Fst$a_I_Dd];
        P_Odd=.Fst[Fst$a_O_Dd];
        P_Nlb=.Fst[Fst$a_Nlb];
        P_Cfgblk=.Fst[Fst$a_Config];
        END;

    ! The link is now open, and CONFIG messages have been exchanged.
    ! All pointers have been set up

        BEGIN
        BIND Idd=.P_Idd: $Dap_Descriptor,
             Odd=.P_Odd: $Dap_Descriptor,
             Nlb=.P_Nlb: $Xpn_Nlb(),
             Nam=.UFab[Fab$a_Nam]: $Nam_decl,
             Cfgblk=.P_Cfgblk: $XabCfg_Decl;
        LOCAL Fop: BITVECTOR[18];                                        !a573

        ! Remember the function we were trying to do
        Fst[Fst$b_Operation]=.Function<0,8>;                             !m566

        ! Use smaller of local & remote buffer sizes ( but 0 = infinity )
        IF (.Cfgblk[Xab$h_Bufsiz] GTR 0)
        THEN Odd[Dap$h_Message_Length]=
               MIN(.Odd[Dap$h_Message_Length],.Cfgblk[Xab$h_Bufsiz]); ![14]

        !+
        ! Update state bits
        !-
        Fst[Fst$v_Close_Done] = 0;                                !a566

        !+
        ! If the file is already open (because of $PARSE)
        ! then fill in config block if any and return
        !-
                                                                !a571ff
        IF (.Fst[Fst$v_File_Open] AND .Fst[Fst$v_Drj]) ! Already opened
        OR (.Function EQL 0)                           ! or didn't want to
        THEN
            BEGIN
            LOCAL xabcfg: REF $XabCfg_decl;
            xabcfg = UAddr(.UFab[Fab$a_Xab]);
            WHILE .xabcfg NEQ 0
            DO  BEGIN
                IF .xabcfg[Xab$v_Cod] EQL Xab$k_Cfg   ! Return config
                THEN
                    BEGIN               ! Copy non-header portion of config 
                    IF .rmssec EQL 0  
                    THEN $move_words ( Cfgblk+Xab$k_HdrLen,    ! Section 0
                                       .XabCfg+Xab$k_HdrLen,
                                       Xab$k_CfgLen-Xab$k_HdrLen )  
                    ELSE $Rms$Xcopy  ( Cfgblk+Xab$k_HdrLen, ! Section nonzero
                                       .XabCfg+Xab$k_HdrLen,
                                       Xab$k_CfgLen-Xab$k_HdrLen );    
                    EXITLOOP;
                    END
                ELSE xabcfg=UAddr(.xabcfg[Xab$a_Nxt]);
                END;

            Fst[Fst$v_Open_Done] = 1;

            CASE .Function FROM 0 TO Dap$k_Execute OF                   !a577
            SET        ! By NAM block
            [0,
             Dap$k_Open]:  RETURN (UFab[Fab$h_Sts]=Rms$_Suc);
            [Dap$k_Create]: Dap$Close( UFab, Err ); ! Close up before creating
            [Dap$k_Erase]:
                 BEGIN
                 Fst[Fst$v_Dlt] = 1;    ! Set delete-on-close
                 RETURN Dap$Close( UFab, Err ); ! And close it
                 END;
            [Dap$k_Submit]:
                 BEGIN
                 Fst[Fst$v_Scf] = 1;    ! Set delete-on-close
                 RETURN Dap$Close( UFab, Err ); ! And close it
                 END;
            [Dap$k_Rename]:
                 BEGIN
                 Dap$EndAccess( UFab, Dap$k_Accomp_Change_Begin, r$null );
                 RETURN Dap$EndAccess( Nfab, Dap$k_Accomp_Change_End, r$null );
                 END;
            [INRANGE]: ;                 ! nothing special
            [OUTRANGE]: UserError(Rms$_Bug);
            TES;
            END;

        !+
        ! Check for unsupported features
        !-

        ! Block mode is only permissible between homogenous systems
        ! (in our case 36-bit systems)
                                                                         !m645v
        IF .UFab[Fab$v_Bio]                                    ! Block mode and
           AND NOT (.cfgblk[XAB$B_OSTYPE] EQL XAB$K_TOPS20     ! not TOPS-20 or
                    OR .cfgblk[XAB$B_OSTYPE] EQL XAB$K_TOPS10) !     TOPS-10?
        THEN SIGNAL(UFab[Fab$h_Sts]=Rms$_Ons,                            !m645^
                    UFab[Fab$h_Stv]=Dap$k_Mac_Unsupported+Dap$k_Mic_Access_Fac,
                    UFab);

        !+
        ! Get File datatype from TYP block if specified
        ! Default datatype if no TYP block given
        !-

        IF .UFab[Fab$a_Typ] NEQ 0
        THEN Class
               = Fst[Fst$h_File_Class]
               = .BLOCK[UAddr(.UFab[Fab$a_Typ]),Typ$h_Class]             !m566
        ELSE Class=0;

        !+
        !  Default the file class if it was not specified
        !  Default is ASCII unless talking to another 20,
        !  running the RMS FAL, in which case it is IMAGE
        !-

        IF .Class EQL 0 
        THEN
            BEGIN                                                       !a555vv
            IF  (.UFab[Fab$v_Rfm] NEQ Fab$k_Stm) ! not stream            !a560
            AND (.UFab[Fab$v_Rfm] NEQ Fab$k_Lsa) ! not sequenced         !a560
            AND ( (.CfgBlk[Xab$b_FileSys] EQL Our_Filesys)              !m577
                 OR (.CfgBlk[Xab$b_FileSys] EQL Xab$k_Filesys_Tops10) ) !m577
            THEN Class = Typ$k_Image
            ELSE Class = Typ$k_Ascii;         

            Fst[Fst$h_File_Class] = .Class;
            END;                                                        !a555^^

        ! Default the RFM to something reasonable if this is an ASCII file

        IF (.Class EQL Typ$k_Ascii) AND (.UFab[Fab$v_Rfm] EQL Fab$k_Udf)
        THEN
            BEGIN
            CASE .Cfgblk[Xab$b_Ostype]
            FROM 1 TO Dap$k_Ostype_Max OF
            SET
            [Dap$k_Rsts,
             Dap$k_Tops10,
             Dap$k_Tops20,
             Dap$k_Rt11,
             Dap$k_Os8,
             Dap$k_Rts8]:  UFab[Fab$v_Rfm]=Fab$k_Stm;

            [INRANGE]:
                 BEGIN
                 UFab[Fab$v_Rfm]=Fab$k_Var;       ![7] Variable
                 IF .UFab[Fab$h_Rat] EQL 0        ![17] If no record attributes
                 THEN UFab[Fab$v_Cr]=1;            ![7] Set Implied CRLF
                 END;

            [OUTRANGE]: SIGNAL(Rms$_Dpe,
                               Dap$k_Mac_Invalid+Dap$k_Mic_Config_Ostype,
                               UFab);
            TES;
            END;     


        IF .Fst[Fst$v_Access_Active] EQL 0      ! If we are not in the middle
        THEN                                    ! of a wildcard access
            BEGIN
            Fst[Fst$v_Error] = 0;       ! We did not get an error yet     !a566
                                                                          !d573
            !
            ! Send the Attributes message
            !

            Fop = .UFab[Fab$h_Fop];

            ! Clear the close-type FOP bits so IAS doesn't complain
            Fst[Fst$h_Fop] = UFab[Fab$h_Fop]
                           = .UFab[Fab$h_Fop] AND NOT FopCloseBits;       !m600

            Display = Fst[Fst$v_Display]
              = (IF (.Function EQL Dap$k_Open) AND (NOT .UFab[Fab$v_Cif]) !m573
                 THEN 1^Dap$v_Display_Attributes
                 ELSE D$SDisplay( UFab ) ) ;


            Dap$Put_Attributes (Odd, UFab);            ! Send Attributes

            IF .UFab[Fab$v_Cif] THEN UFab[Fab$v_Sup]=0; ![11] CIF overrides SUP

            !
            ! If FOP bit CIF (Create-if) is set, make CREATE into OPEN
            !

!607            IF .UFab[Fab$v_Cif] AND (.Function EQL Dap$k_Create)
!607            THEN Function=Dap$k_Open;

            !
            ! Send the Access message
            !

            Accopt=.Fst[Fst$v_Accopt];

            ! Now see what attributes we want on the access.
            ! We will ask for whatever we have XAB's, etc for.
            Display = D$SDisplay( UFab );                                 !m577

            ! If $Rename, check both FABS and or the bits
            IF .Function EQL Dap$k_Rename                                 !a577
            THEN Display = .Display OR D$Sdisplay( NFab );

            ! If indexed $Open, always request key attributes             !627
            IF (.Function EQL Dap$k_Open)
            AND (.UFab[Fab$v_Org] EQL Fab$k_Idx)
            THEN 
               BEGIN
                    IF .CfgBlk[Xab$v_Key_Definition]
                    THEN Display[Dap$v_Display_Key]=1;
               END;

            Fst[Fst$v_Display] = .Display;                                !a577

            Dap$Put_Access( Odd,
                            UFab,
                            .Function<0,8>,   ! low byte is function code !m566
                            Accopt,
                            Display,
                            Nfab);
            Dap$Put_Message(Odd);
            END;

        SELECT Dap$Get_Header( idd ) OF      ! Peek at next message      !m566v
        SET
        [ALWAYS]:
            Dap$Unget_Header( idd );         ! Put message back

        [Dap$k_Attributes,
         Dap$k_Name]:                        ! We got a file 
            SELECT .Function OF
            SET
            [ALWAYS]:
                Fst[Fst$v_Access_Active] = 1; ! Access in progress

            [Dap$k_Open + Fab$m_Nam,    ! This was really $Parse
             Dap$k_Directory]:                                              !
                BEGIN
                UFab[Fab$h_Fop] = Fst[Fst$h_Fop] = .Fop;                  !a573
                RETURN UFab[Fab$h_Sts]= Rms$_Suc;
                ! Get directory info on SEARCH
                END;
            TES;
        TES;                                                             !m566^

        Dap$Get_Attributes(Idd, UFab);       ! Get returned Attributes

        !+
        ! If remote system changed the file datatype
        ! and it knows about such things
        ! and we did not insist on a particular one, use theirs
        !-
        IF (UClass( UFab ) EQL 0)
        AND (.CfgBlk[Xab$b_Filesys] EQL Xab$k_Filesys_Rms20)
        THEN
            BEGIN
            IF Typ NEQ 0
            THEN Typ[Typ$h_Class] = .Fst[Fst$h_File_Class];
            END;

        !+
        !  $Rename returns an Ack after the first set of attributes
        !  if it was supposed to return attributes for both filespecs
        !  This sets the File_Open bit.  The access complete after
        !  the second set of attributes should clear it, but we will
        !  anyway, just to be sure.
        !-
        IF (.Function EQL Dap$k_Rename) ! If Rename,                     !a577v
        AND .Fst[Fst$v_File_Open]       ! Must be intermediate state
        THEN
            BEGIN
            Dap$Get_Attributes( Idd, NFab ); ! Get attrs for new fab
            Fst[Fst$v_File_Open] = 0;   ! Defensive
            END;                                                         !a577^

        UFab[Fab$h_Fop] = Fst[Fst$h_Fop] = .Fop;                           !a573

        IF (.Fst[Fst$v_Drj] EQL 0)
        AND (.Fst[Fst$v_File_Open] EQL 0)
        THEN
            BEGIN                           ! Close the link & free data strs
            Fst[Fst$v_Access_Active]=0;                                   !m547
            Fst[Fst$v_Open_Done]=0;                                       !a566
            Dap$Close( UFab, .Err );
            END;

        Fst[Fst$v_Open_Done] = .Fst[Fst$v_File_Open];  ! We did an open 

        UFab[Fab$h_Sts]=Rms$_Suc
        END                             ! End of common open code
    END;			!End of DAP$OPENFILE
GLOBAL ROUTINE Dap$Close (P_Fab, Err): =
!++
! FUNCTIONAL DESCRIPTION:
!
!   Close a remote file
!
! FORMAL PARAMETERS:
!
!   P_FAB: Addr of  FAB with a NODEID embedded in the filespec.
!   ERR: Address of error routine
!
! SIDE EFFECTS:
!
!   If there are no more files coming:
!    The link is closed
!    The subsidiary data structures are freed
!   If there is another file (wildcarding), the attributes are read into FAB
!--
    BEGIN
    BIND cmpfunc=( IF .Fst[Fst$v_Error] AND (NOT .Fst[Fst$v_File_Open])
                   THEN Dap$k_Accomp_Skip
                   ELSE Dap$k_Accomp_Command );

    Dap$EndAccess (.P_Fab, cmpfunc, .Err);

    END;
GLOBAL ROUTINE Dap$EndAccess (P_Fab, Function, Err): =
!++
! FUNCTIONAL DESCRIPTION:
!
!   Complete a remote access with an Access Complete message
!
! FORMAL PARAMETERS:
!
!   P_FAB: Addr of  FAB with a NODEID embedded in the filespec.
!   FUNCTION: ACCESS message function code (DAP) or 0 for normal close
!   ERR: Address of error routine
!
! IMPLICIT PARAMETERS:
!
!   FST: Addr of FST
!
! SIDE EFFECTS:
!
!   If there are no more files coming:
!    The link is closed
!    The subsidiary data structures are freed
!   If there is another file (wildcarding), the attributes are read into FAB
!--
    BEGIN
    BIND UFab=.P_Fab: $FAB_DECL;
    BIND UFst=.Fst: $Rms_Fst;                                             !m572
    BIND URst=.UFst[Fst$a_Flink]: $Rms_Rst;! CRC only works with 1 stream !m566
    BIND Odd=.Fst[Fst$a_O_Dd]: $Dap_Descriptor;
    BIND Idd=.Fst[Fst$a_I_Dd]: $Dap_Descriptor;
    BIND Nlb=.Fst[Fst$a_Nlb]: $Xpn_Nlb();
    BIND Cfg=.Fst[Fst$a_Config]: $Xabcfg_Decl;

    LOCAL v;                            ! Temp for returned value
    LOCAL Fabsav: VOLATILE;
    LOCAL Errsav: VOLATILE;

    ENABLE Dap$Handle(Fabsav,Errsav);   ! Setup Condition handler
    Errsav=.Err;
    Fabsav=UFab;                        ! Handler will need this

    IF .err EQL 0 THEN err = r$null ;   ![22] Default to do-nothing routine

    IF UFst EQL 0 THEN RETURN RMS$_IFI; ! If no FST, nothing open         !m572
    IF Nlb EQL 0 THEN RETURN RMS$_IFI;  ! If no NLB, nothing either       !a577

    IF .Function GTR Dap$k_Accomp_Max   ![22] range check
    THEN SIGNAL(Rms$_Bug,
                Dap$k_Mac_Invalid+Dap$k_Mic_AcComp_CmpFunc,
                UFab);

    !+
    ! If last operation failed
    ! Send Continue(Abort) as interupt message,
    ! Then send Accomp
    !-
    IF .UFst[Fst$v_File_Open]                                          !m574
    AND .UFst[Fst$v_Error]
    THEN
        BEGIN
        Odd[Dap$v_Interrupt]=1;

        ! Forget what we were going to send
        Odd[Dap$h_Bytes_Remaining]=16;   ! Max length for interrupt message
        Odd[Dap$a_Data]=CH$PLUS(.Odd[Dap$a_Data],-.Odd[Dap$h_Bytes_Used]);
        Odd[Dap$h_Length] = 0;                            !662
        Odd[Dap$h_Bytes_Used]=0;                          !to data in message

        Init_Message( Odd );
        Odd[Dap$b_Operator]=Dap$k_Continue;
        Dap$Put_Header( Odd );
        Dap$Put_Byte( Odd, Dap$k_Con_Abort );
        Dap$Put_Message( Odd );
        
        END;

    IF (.UFab[Fab$v_Put] EQL 0) AND (.Function EQL Dap$k_Accomp_Purge)
    THEN Function=Dap$k_Accomp_Command; ! Some FAL's interpret purge as
                                        ! erase, even for input files!!

    If .UFst[Fst$v_Access_Active]       ! Send Access complete if active,![23]
    THEN                                ! otherwise don't bother
        BEGIN
        LOCAL Fop: BITVECTOR[42] INITIAL(REP ((%BPUNIT+41)/%BPUNIT) OF (0));
        LOCAL Foplength;

        ! If last try failed, do a skip
        IF .UFst[Fst$v_Error] AND (NOT .UFst[Fst$v_File_Open])
        THEN Function = Dap$k_Accomp_Skip; !m566

        IF .function EQL Dap$k_Accomp_Change_End  ! change attrs on close !a577
        THEN
            BEGIN
            Dap$Put_Attributes( Odd, UFab );
            Dap$Put_Name( Odd, UFab, %REF(1^Dap$k_Nametype_Fsp) );
            END;

        $Dap_Move_Bits ( UFst, Fst$v_, Fop, Dap$v_Fop_,
                         Rwo,Rwc,Pos,Dlk,Lck,
                         Ctg,Sup,Nef,Tmp,Mkd,Dmo,
                         Wck,Rck,Cif,Lko,Sqo,Mxv,Spl,
                         Scf,Dlt,Cbt,Wat,Dfw,Tef,Opf,
                         Drj,Dfw);                                      !m547 

        IF .Iasbug[Ias_Bug_Acm_Fop]     ![11] IAS does not like most fop bits
        AND (.Cfg[Xab$b_Ostype] EQL Dap$k_Ias)
        THEN Fop=(.Fop AND Dap$v_Fop_Spl);

	Foplength=Dap$size_Bitvector(Fop,6,0);

        Init_Message(Odd);
        Odd[Dap$b_Operator]=Dap$k_Access_Complete;

        IF .Function EQL Dap$k_Accomp_Eos       ! $Disconnect             !a557
        THEN Odd[Dap$b_StreamId] = .Rst[Rst$v_StreamId]; ! say which rab

        Odd[Dap$v_Mflags_Length]=1;
        Odd[Dap$h_Length]=.Foplength+1; ! Count length of FOP

        Dap$Put_Header(Odd);
        Dap$Put_Byte(Odd,.Function);    ! COMMAND (normal) or PURGE (punt)

        IF .Foplength NEQ 0             ! Send FOP if needed
        THEN Dap$Put_Bitvector(Odd,Fop,6);

        IF .UFst[Fst$v_Accopt_Crc]      ! Send CRC if needed    !a533
        AND (URst NEQ UFst)             ! And we have an RST    !a533
        THEN Dap$Put_2Byte( Odd, .URst[Rst$h_Checksum] );       !a533

        Dap$Put_Message (Odd);          ! Shove it out

        IF .function EQL Dap$k_Accomp_Change_Begin
        THEN RETURN 0;                  ! No response to change_begin
                                        ! we send attrs & name & change_end

        DO                      ![2] Clean out pipeline
            BEGIN
            v=Dap$Get_Header(Idd);      ! Get response

            SELECT .v OF SET
            [Dap$k_Access_Complete]:
                BEGIN                               ! Yes,
                LOCAL Cmpfunc;
                LOCAL Fop: BITVECTOR[42];

                Cmpfunc=Dap$Get_Byte(Idd);            ![4] Eat rest of message
                IF .Cmpfunc NEQ Dap$k_Accomp_Response ![4] Is it a response
                THEN SIGNAL(Rms$_Dpe,0,UFab);         ![4] Error if not

                IF .Function NEQ Dap$k_Accomp_Eos   ! If not $Disconnect !m511
                THEN
                    BEGIN
                    UFst[Fst$v_File_Open]     =     ! File is not open any more
                    UFst[Fst$v_Error]         =     ! File is not in error
                    UFst[Fst$v_Open_Done]     =     ! File is not open any more
                    UFst[Fst$v_Access_Active] = 0;  ! No access any more
                    UFst[Fst$v_Close_Done]    = 1;  ! File is closed

                    UFst[Fst$v_Drj] = .UFab[Fab$v_Drj]; ! Close link if no drj
                    END;

                IF .Idd[Dap$h_Bytes_Remaining] GTR 0
                THEN
                    BEGIN
                    Dap$Get_Bitvector(Idd,Fop,6);  ![4] Eat FOP field if any

                    %( Ignore FOP we get back                       !d545
                    $Dap_Move_Bits (Fop, Dap$k_Fop_, Fab, Fab$v_,
                                    Rwo,Rwc,Pos,Dlk,Lck,
                                    Ctg,Sup,Nef,Tmp,Mkd,Dmo,
                                    Wck,Rck,Cif,Lko,Sqo,Mxv,Spl,
                                    Scf,Dlt,Cbt,Wat,Dfw,Tef,Opf,
                                    Drj,Dfw);
                    )%

                    END;

                IF .idd[dap$h_length] GTR 0     ! If anything left in message
                THEN                    ! It must be the checksum      !a547 vv
                    BEGIN
                    LOCAL checksum;

                    checksum=dap$get_2byte(idd);   ! Then get checksum field
                    IF (.checksum NEQ .URst[Rst$h_Checksum])
                    AND .UFst[Fst$v_Accopt_Crc] ! If we care
                    THEN SIGNAL( Dap$_Crc );
                    END;                                               !a547 ^^

                EXITLOOP UFab[Fab$h_Sts]=Rms$_Suc;
                END;
            [Dap$k_Name]:
                BEGIN
                !+
                ! We closed the file and got a NAME message for another file.
                ! We flag the access still active
                !-

                UFst[Fst$v_Access_Active]=1;     ! Accessing another file
                UFst[Fst$v_File_Open]=1;         ! which is open
                UFst[Fst$v_Open_Done]=0;         ! but it is not $open'ed yet
                Fst[Fst$v_Close_Done]=1;         ! last file was closed   !a566
                UFst[Fst$v_Error]=0;             ! no error yet
                EXITLOOP Dap$Unget_Header(Idd);  ! Back up for SEARCH
                END;                             
            [Dap$k_Status]:
                BEGIN
                UsrStv = Dap$Get_Status(Idd);  ! End of file or error     !m566
                UsrSts = Dap$Error_Dap_Rms(.UsrStv);                      !m566
                END;                            ! error code

            [Dap$k_Data]: WHILE .Idd[Dap$h_Length] GTR 0 ![2] Eat data
                          DO Dap$Get_Byte(Idd);          ![2] Chomp! Chomp!

            [OTHERWISE]: SIGNAL( Rms$_Dpe,
                                 Dap$k_Mac_Sync+.idd[dap$b_operator],
                                 UFab );
            TES;
            END WHILE .Fst[Fst$v_Access_Active];                 !m577
        END;

    IF ( .UFst[Fst$v_Drj] EQL 0 )      ! Should we keep things open?
    AND ( .AcmDrl_Mask [ .Function ] EQL 0 )
    THEN
        BEGIN
	LOCAL Nlb_Jfn;

	Nlb_Jfn = .Nlb[Nlb$h_Jfn];

        ! Even if there are more files, we don't want to see them.

        Fst[Fst$v_Access_Active] = 0; ! This must be clear for cleanup    !a604

        $Xpn_Close(Nlb=Nlb, Failure=0);  ! Close the link

        $Xpo_Free_Mem(Binary_Data=(Dap$k_Descriptor_Len,Idd));
        $Xpo_Free_Mem(Binary_Data=(Nlb$k_Length,Nlb));    
	Fst[Fst$a_Nlb] = 0;                                               !640
        $Xpo_Free_Mem(Binary_Data=(Dap$k_Buffer_Size %BLISS36(/4),
                           %BLISS36( .(Odd[Dap$a_Data])<0,18>)+1 ),
                           Failure=R$Null
                           );       ! Deallocate output buffer
        $Xpo_Free_Mem(Binary_Data=(Dap$k_Descriptor_Len,Odd));

        IF .D$Gtrace LSS 0 THEN			!663
	   BEGIN
	     D$ZTrace(.Nlb_Jfn);
	     D$CTrace ();			! Close any trace log
	   END;    

        END;

    .v
    END;                ! Dap$EndAccess
GLOBAL ROUTINE D$SDisplay ( P_Fab ) = 
BEGIN
!+
! FUNCTIONAL DESCRIPTION
!
!     See what attributes we want on the access.
!     We will ask for whatever we have XAB's, etc for.
!     Set display bits in FST for access or control msg
!
! FORMAL PARAMETERS:
!
!     P_FAB: Addr of FAB
!
! IMPLICIT PARAMETERS:
!
!     FST: Addr of FST
!
! RETURNED VALUE
!
!     BITVECTOR of DAP display bits
!
!-
BIND UFab=.P_Fab: $Fab_decl;                                            !m577
BIND UFst=.Fst: $Rms_Fst;                                               !m572
BIND CfgBlk=.UFst[Fst$a_Config]: $XabCfg_decl;
LOCAL Xab: REF $XabKey_Decl;
LOCAL Display: BITVECTOR[28] INITIAL(0);
LOCAL nok: INITIAL(0),          ! # of keys                             !a601
      noa: INITIAL(0);          ! # of areas                            !a601

If .UFab[Fab$a_Nam] NEQ 0                                               !m577
THEN
    BEGIN
    Display[Dap$v_Display_Nam]=1; ! File name
    IF .CfgBlk[Xab$v_Display_3_Part_Name]                               !a571
    THEN Display[Dap$v_Display_3_Part_Name]=1; ! Decomposed File name
    END;

Xab=.UFab[Fab$a_Xab];                    ! Search the XAB chain         !m601

IF (  .Xab NEQ 0 )                       ! Minimum buffer address       !a601
AND ( .Xab LSS rms$k_minimum_user_buffer_addr )
THEN UserError( RMS$_XAB );

WHILE .Xab NEQ 0
DO  BEGIN
    Xab=UAddr(.Xab);                    ! Extendify                       !a601

    IF .Xab[Xab$h_Bid] NEQ Xab$k_Bid  ! Is it really an XAB at all?       !a601
    THEN UserError( Rms$_Xab );

    CASE .Xab[Xab$v_Cod] FROM Xab$K_Key TO xab$k_Cod_Max OF               !m601
        SET

        [Xab$k_Key]: BEGIN
                     IF .Xab[Xab$h_Bln] NEQ Xab$k_KeyLen
                     THEN UserError( Rms$_Bln );
                     IF .Xab[Xab$b_Ref] LSS .Nok
                     THEN UserError( Rms$_Ref );
                     Nok = .Xab[Xab$b_Ref] + 1;
                     IF .CfgBlk[Xab$v_Key_Definition]                !m571ff
                     THEN Display[Dap$v_Display_Key]=1;
                     END;

        [Xab$k_All]: BEGIN
                     MAP Xab: REF $XabAll_decl;
                     IF .Xab[Xab$h_Bln] NEQ Xab$k_AllLen
                     THEN UserError( Rms$_Bln );
                     IF .Xab[Xab$b_Aid] LSS .Noa
                     THEN UserError( Rms$_Ref );
                     Noa = .Xab[Xab$b_Aid] + 1;
                     IF .CfgBlk[Xab$v_Allocation]
                     THEN Display[Dap$v_Display_All]=1;
                     END;

        [Xab$k_Dat]: BEGIN
                     IF .Xab[Xab$h_Bln] NEQ Xab$k_DatLen
                     THEN UserError( Rms$_Bln );
                     IF .CfgBlk[Xab$v_Date_Time]
                     THEN Display[Dap$v_Display_Dat]=1;
                     END;

        [Xab$k_Sum]: BEGIN
                     IF .Xab[Xab$h_Bln] NEQ Xab$k_SumLen
                     THEN UserError( Rms$_Bln );
                     IF .CfgBlk[Xab$v_Summary]
                     THEN Display[Dap$v_Display_Sum]=1;
                     END;

        [XAB$K_PRO]: BEGIN
                     IF .xab[XAB$H_BLN] NEQ XAB$K_PROLEN
                     THEN usererror (RMS$_BLN);
                     IF .cfgblk[XAB$V_PROTECTION]
                     THEN display[DAP$V_DISPLAY_PRO]=1;
                     END;
        [INRANGE]:;
        [OUTRANGE]: usererror (RMS$_COD);
        TES;

    Xab=.Xab[Xab$a_Nxt];     ! On to the next one                         !m601

    ! If chain continues, check Minimum buffer address
    IF  ( .Xab NEQ 0 )                                                    !a601
    AND  ( .Xab LSS rms$k_minimum_user_buffer_addr )
    THEN UserError( RMS$_NXT );
    END;

Display[Dap$v_Display_Att]=1;   ! Always get main attributes
.Display                                ! Return the entire bitvector
END;
END            !End of module
ELUDOM