Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/faldap.b36
There are 3 other files named faldap.b36 in the archive. Click here to see a list.
MODULE FALDAP(			!DAP message processing routines unique to FAL
	IDENT='7.0(662) 1-Dec-86'
        %BLISS36(,
                 ENTRY(
                       D$GACC, ! DAP$GET_ACCESS,         ! Get Access message
                       D$GCTL, ! DAP$GET_CONTROL,        ! Get Control message
                       D$GACM, ! DAP$GET_ACCESS_COMPLETE ! Get ACM message
                       D$PACK, ! DAP$PUT_ACK,            ! Build ACK message
                       D$ERRD, ! DAP$ERROR_RMS_DAP,      ! Conv RMS code to DAP
                       D$PSTS, ! DAP$PUT_STATUS          ! Build STATUS message
                       D$PSUC, ! DAP$PUT_SUCCESS         ! success status
                       D$GCNT, ! DAP$GET_CONTINUE        ! Get CONTINUE message
                       D$RETR  ! DAP$RETRY_LAST_OPERATION! Try again
                       ))
	)=
BEGIN

!
!                   COPYRIGHT (c) 1984, 1986 by
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	FAL-20
!
! ABSTRACT:	This is the System-independent part of the DAP protocol.
!
!
! ENVIRONMENT:	TOPS-20, Transportable BLISS DecNet Interface
!
! AUTHOR:	Andrew Nourse, CREATION DATE: 14-Feb-83
! REVISION HISTORY:
!
!  533 - Crc Checking support
!  555 - Fix key field for relative files
!  556 - Add some new error codes
!  557 - Fix multistream access
!  561 - Eat ignorable KEY fields,
!        default class to ASCII if RFM=UDF and MRS=0
!  566 - fix protocol error
!  600 - Send Key & Alloc attrs correctly
!  601 - Add some error codes to translation table.
!  603 - Fix Directory-List sending extra attributes msg.
!  605 - Use new routines for handling RFA's
!  610 - Fix extended KEY attributes, implement KNM sending/receiving,
!	 don't compare checksums if requested to do so but we are
!	 closing and deleting a file.
!  611 - D$PSTS and D$GCTL weren't sending/receiving RFAs correctly.
!  620 - Missing dot in D$GCTL trashed keyed KBF reception. Indexed
!	 $GETs/$PUTs brain-damaged in various ways
!  630 - Fix back-assward code mandated by DAP spec: Read key field
!	 first, then figure out whether its dtp is numeric or string
!	 for final Rab setup.
!  632 - Add more errors to DAP$ERROR_RMS_DAP
!  633 - Make wildcard delete work for PDP-11s.
!  635 - Filenames of the form "FILE.TYPE;0" should work.  More work on
!        renames to make them work from PDP-11 and VMS systems.
!  643 - Always return main attributes even though access msg didnt say to
!        if it is a OPEN, CREATE, or SUBMIT message (used by RT11), and
!        don't put extra acks in directory list if talking pre v7 DAP
!  647 - Remove some code that didn't do anything in DAP$GET_CONTROL
!  662 - Add ER$DUP to D$ERRD.
!--


!
! Conditionals
!

!
! Libraries
!

LIBRARY 'BLISSNET';
LIBRARY 'CONDIT';
REQUIRE 'RMSREQ';

!
! Table of Contents
!
FORWARD ROUTINE
    DAP$GET_ACCESS,                     ! Get Access message
    ACCESS,                             ! Access remote user's file
    FillBlocks,                         ! Fill in Fab & XABs
    DAP$GET_CONTROL,                    ! Get Control message
    dap$generation_check : NOVALUE,     ! Check for "name.type;gen"
    CONTROL,                            ! Access remote user's record
    DAP$GET_ACCESS_COMPLETE,            ! Get Access complete message
    DAP$PUT_ACK: NOVALUE,               ! Build ACK message
    DAP$ERROR_RMS_DAP,                  ! Convert RMS error code to DAP
    DAP$PUT_STATUS: NOVALUE,            ! Build STATUS message
    DAP$PUT_SUCCESS: NOVALUE,           ! Build STATUS message
    DAP$GET_CONTINUE,                   ! Process CONTINUE message
    DAP$RETRY_LAST_OPERATION,           ! Retry the last RMS verb we tried
    DAP$3_PART_NAME: NOVALUE;           ! Send 3-part name if needed
!
! LITERALS
!
LITERAL FTPASSIVE = 1;                  ! This is always passive   !a577
GLOBAL LITERAL RRE$$P = FTPASSIVE;                                 !a577
! Interlock. Makes sure all modules compiled correct variant
! Link error if wrong


%IF %BLISS(BLISS36)
    %THEN 
    %IF %SWITCHES(TOPS20)
        %THEN
        LITERAL
               OUR_OSTYPE=DAP$K_TOPS20,
               OUR_BLOCK_SIZE=512,
               DEVICE_NAME_LENGTH=40,   ! Including punctuation
               DIRECTORY_NAME_LENGTH=41,!
               FILE_NAME_LENGTH=40;     !
        %ELSE
        %ERROR('Not implemented on TOPS-10')
        %FI

    LITERAL
           OUR_FILESYS=DAP$K_RMS20;
    %ELSE %ERROR('Not implemented for 16/32 bit architectures')
    %FI;


!
! External references
!
EXTERNAL ROUTINE Chazac,
                 Chacaz,                                       !630
                 S$Strdt,
                 S$Mount: NOVALUE,
                 Dap$Get_Header,
                 Dap$Unget_Header,
                 Dap$Get,
                 Dap$$Get,
                 Dap$$Get_Attributes,
                 Dap$Get_Byte,
                 Dap$Get_2byte,
                 Dap$Get_Date,
                 Dap$Get_Variable_String,
                 Dap$Get_Longword,
                 Dap$Size_Bitvector,
                 Dap$Get_Bitvector,
                 Dap$Get_Variable_Counted,
                 Dap$Put,
                 Dap$$Put,
                 Dap$Put_Bitvector,
                 Dap$Put_Header,
                 Dap$Put_2byte,
                 Dap$Put_Byte,
                 Dap$Put_String,
                 Dap$Put_Variable_Counted,
                 Dap$Put_Longword,
                 Dap$$Put_Attributes,
                 Dap$Put_Name,
                 Dap$Put_Message,
                 Dap$Unget_Byte,
                 Dap$Eat_Message,
                 Dap$Rfa_Rms_Dap,
                 Dap$Rfa_Dap_Rms,
                 Num_Vb,						! 630
                 Fal$Handle,
                 R$Null,
                 Rms$Signal,
                 UAddr,
                 UAPointer;


EXTERNAL                                                                !a557vv
    FalFab: $Fab_decl,
    FalFst: $Rms_Fst,
    RabVector: BLOCKVECTOR[256,Rab$k_Bln] FIELD( Rab$r_Fields ),
    RstVector: BLOCKVECTOR[256,Rst$k_Bln] FIELD( Rst$r_Fields ),
    Usrbuf: VECTOR[CH$ALLOCATION(dap$k_buffer_size,9)] VOLATILE,
    KeyBuf: VECTOR[255] VOLATILE,                                       !a557^^
    KnmBuf: VECTOR[256] VOLATILE;					!610

!
! MACROS
!
MACRO Dap_Error (Ddesc,Mac,Mic) =
      ( BIND dapcod = Err_Ds (Mac, Mic);
        SIGNAL ( dapcod, Ddesc );
       dapcod )
      %;

!
! Canned Messages   (Global PLITS)
!
GLOBAL BIND ACRMSG=PLIT(CHAR8(DAP$K_ACCESS_COMPLETE,0,
                              DAP$K_ACCOMP_RESPONSE));
GLOBAL D_ACR: $XPN_DESCRIPTOR(BINARY_DATA=(3,ACRMSG,BYTES));

!
! OWN Storage
!

OWN D_NULL: $STR_DESCRIPTOR(STRING=%CHAR(0));

OWN 
   FalXabKey: BLOCKVECTOR[256,Xab$k_Keylen]
              FIELD(XabHdr$r_fields,XabKey$r_fields),
              
   FalXabAll: BLOCKVECTOR[32,Xab$k_Alllen]
              FIELD(XabHdr$r_fields,XabAll$r_fields);
GLOBAL ROUTINE Dap$Get_Access (P_Dd: REF $Dap_Descriptor,
                                 P_Fab: REF $Fab_Decl,
                                 P_Fst: REF $Rms_Fst)=
!++
! FUNCTIONAL DESCRIPTION:
!
!	Process ACCESS message
!
! FORMAL PARAMETERS:
!
!	P_DD: Addr of DAP message descriptor
!       P_FAB: Addr of FAB -- FAB[FAB$A_FNA] must point to 200 character buffer
!       P_Fst: Addr of FST
!
! ROUTINE VALUE:
!
!	DAP Operator code if successful, Signal error otherwise
!
! SIDE EFFECTS:
!
!       The ACCESS Message will have been read.
!       A name message after the ACCESS message will have been read if RENAME
!--
BEGIN				!Digest ACCESS
BIND Idd=.P_Dd: $Dap_Descriptor,
     Odd=.Idd[Dap$A_Other_Dd]: $Dap_Descriptor,
     Fab=.P_Fab: $Fab_Decl,
     Nam=UAddr(.Fab[Fab$a_Nam]): $Nam_decl,
     Fst=.p_Fst: $Rms_Fst;
BIND Config=.Fst[Fst$a_Config]: $XabCfg_Decl;      ! Configuration Xab

LOCAL
    XabTail: REF $XabSum_decl,
    Noa,                                ! Number of areas
    Nok;

OWN
   NEsa: VECTOR[CH$ALLOCATION(255)],
   NRsa: VECTOR[CH$ALLOCATION(255)],
   NNam: $Nam( Esa=CH$PTR(Nesa), Ess=255, Rsa=CH$PTR(NRsa), Rss=255),
   NFna: VECTOR[CH$ALLOCATION(255)],
   NFab: $Fab(Nam=NNam, Fna=CH$PTR(NFna), FOP=<NAM,OFP>, FAC=PUT);       !m635

LOCAL hp_Fab: VOLATILE;
LOCAL hp_Fst: VOLATILE;

ENABLE fal$handle( hp_Fab, hp_Fst );    ! Set up condition handler
hp_Fab=Fab;
hp_Fst=Fst;

SELECTONE Dap$Get_Header(Idd) OF                  ! Munch the header
    SET
    [Dap$k_Access]:
        BEGIN
        LOCAL	Display: BITVECTOR[28],	!DISPLAY field for attributes to return
                Password: VECTOR[CH$ALLOCATION(41)],
                Accfunc,
                Accopt: BITVECTOR[28],
                Fac: BITVECTOR[28],
                Shr: BITVECTOR[28];


        Fst[Fst$b_Operation]=Dap$Get_Byte(Idd);	!OPEN/CREATE/ERASE/RENAME,etc

        Dap$Get_Bitvector(Idd,Accopt,5);	!Access options

        Fst[Fst$v_Accopt] = .Accopt;    ! Save access options !a533

        Dap$Get_Variable_String(Idd,.Fab[Fab$a_Fna],255);
                                !Store remote filespec where FNA points
        dap$generation_check(.fab[fab$a_fna]);                            !a635

        IF .Idd[Dap$h_Length] GTR 0
        THEN
            BEGIN
            Dap$Get_Bitvector(Idd,Fac,3);	   ! FAC (File acce<ss options)
            $Dap_Move_Bits(Fac,Dap$v_Fac_
                           ,Fab,Fab$v_,
                           Put,Get,Del,Upd,Trn,
                           Bio,Bro,App);
            END;

        IF .Idd[Dap$h_Length] GTR 0                 ! SHR
        THEN
            BEGIN
            Dap$Get_Bitvector(Idd,Shr,3);	!Shared operations
            $Dap_Move_Bits(Shr,Dap$v_Fac_,Fab,Fab$v_Shr,  !542
                           Put,Get,Del,Upd,Trn,
                           Bio,Bro,App);
            END;

        ! Get display bits.  Historical DAP feature: if no display menu, and
        ! its an open or create or submit then default to display the main
        ! attributes.  This is still used by RT11.

        IF .Idd[Dap$h_Length] GTR 0                 ! DISPLAY
        THEN Dap$Get_Bitvector(Idd,Display,4)                        !a643v
        ELSE IF .fst[FST$B_OPERATION] EQL DAP$K_OPEN
                 OR .fst[FST$B_OPERATION] EQL DAP$K_CREATE
                 OR .fst[FST$B_OPERATION] EQL DAP$K_SUBMIT             
             THEN display=1;                    ! display the main attributes  
                                                                     !a643^
        !This tells what attributes we should return
        Fst[Fst$v_Display] = .Display;


        IF .Idd[Dap$h_Length] GTR 0                 ! PASSWORD
        THEN Dap$Get_Variable_String(Idd,CH$PTR(Password),40);
        !Password for file access
        ! IGNORE FOR NOW

        ! Get new name for $Rename
        IF .Fst[Fst$b_Operation] EQL Dap$k_Rename
        THEN
            BEGIN
            LOCAL nametype: BITVECTOR[21];
            nnam[NAM$A_RLF] = nam;      ! Set rlf to "old" nam block      !a635

            IF Dap$Get_Header( Idd ) NEQ Dap$k_Name  ! looking for a NAME msg
            THEN Dap_Error(Idd, Dap$k_Mac_Sync, .Idd[Dap$b_Operator] );

            Dap$Get_Bitvector( Idd, nametype, 3);

            IF .nametype[Dap$k_Nametype_Fsp] EQL 0
            THEN Dap_Error(Idd, Dap$k_Mac_Sync, .Idd[Dap$b_Operator] );

            Dap$Get_Variable_String( Idd, CH$PTR(NFna), 255);
            dap$generation_check(CH$PTR(nfna));        !a635
            END;

        ! Try to do the access
        ! This will also fill in all XABs except KEY and ALLOCATION
        ! which may occur in absurdly large numbers

        Access(Fab, NFab, Fst);

        IF .Nam[Nam$v_Wildcard]                     ! If Wildcarded
        THEN Fst[Fst$v_Display_3_Part_Name] = 1;    ! we need 3-part name

        IF .Fst[Fst$v_File_Open]               ! If we opened a file  !m561
        THEN                                   ! Return its attributes
            BEGIN                                  

            !
            ! Set up the appropriate Xabs by the display field
            ! The Date/Time and Summary XABs are already attached
            !

            XabTail = .Fab[Fab$a_Xab];

            WHILE 1 DO
                BEGIN
                IF .XabTail[Xab$v_Cod] EQL Xab$k_Sum
                THEN
                    BEGIN                   ! Find out how many areas & keys
                    nok=.XabTail[Xab$b_Nok];
                    noa=.XabTail[Xab$b_Noa];
                    END;

                IF .XabTail[Xab$a_Nxt] NEQ 0                           !m545
                THEN XabTail=.XabTail[Xab$a_Nxt]
                ELSE EXITLOOP;
                END;

            !
            ! Set up as many Key XABs as needed
            !
                BEGIN
                MAP xabtail: REF $Xabkey_decl;

                INCR krf FROM 0 TO .nok-1      ! Set up enough Key Xabs
                DO
                    BEGIN
                    xabtail[xab$a_nxt] = FalXabKey[.krf,0,0,0,0];
                    xabtail = FalXabKey[.krf,0,0,0,0];

!+ 610
!	Since a $DISPLAY will not update the Knm field unless there is
!	a Knm pointer present, initialize one for each key XAB if not
!	already available.
!-

                    IF .Knmbuf[.krf] EQL 0				!610
                    THEN
                        BEGIN
                        $XPO_GET_MEM( RESULT=KnmBuf[.krf],
                                      UNITS=(40/(%BPVAL/8)),FILL=0);
                        END;

                    $XabKey_Init( Xab=.xabtail,
                                  Knm=.KnmBuf[.krf],
                                  KRef=.krf );
                    END;
                END;                        ! 


            !
            ! Set up as many Allocation XABs as needed
            ! At least 1, the vax requires it!

            noa = MAX( .noa, 1 );                                       !m545

                BEGIN
                MAP xabtail: REF $XabAll_decl;

                INCR aid FROM 0 TO .noa-1      ! Set up enough Area Xabs
                DO
                    BEGIN
                    xabtail[xab$a_nxt] = FalXabAll[.aid,0,0,0,0];
                    xabtail = FalXabAll[.aid,0,0,0,0];
                    $XabAll_Init( Xab=.xabtail,
                                  Aid=.aid );
                    END;
                END;

            xabtail[xab$a_nxt] = 0;     ! This is the end of the chain    !a545

            $Rms_Display( Fab=Fab );   ! Fill in the XABs                 !a545
                                                                          !d566

            Dap$$Put_Attributes(Odd,Fab,Fst);    ! Build attributes & send
            Dap$Put_Ack(Odd);                    ! with an ack
            Dap$Put_Message(Odd);                ! Force it out 
            END
        ELSE                                     ! No file open
            IF .Fst[Fst$v_Access_Active]         ! If access still active
            THEN                                 !  
                BEGIN                            ! 
                Fst[Fst$v_Access_Active] = 0;    ! deactiviate it
                Dap$$Put_Attributes( Odd, Fab, Fst ); ! Build attributes !a574

                IF .Config[Xab$b_Version] GEQ 7  ! If DAP v7 or later
                THEN Dap$Put_Ack(Odd);           ! Put out an ACK to separate

!d635           IF (.Fst[Fst$b_Operation] EQL Dap$k_Rename)              !a577v
!d635           THEN Dap$$Put_Attributes( Odd, NFab, Fst );              !m605

                Dap$Put_String( Odd,D_Acr );     ! Send access complete
                Dap$Put_Message( Odd );          !        response
                END;

!+ 610
!	Now that the access has been successfully completed, release
!	any dynamic blocks pointed to by KnmBuf.  Note that an access which
!	fails will not release this memory here; a subsequent access will
!	reuse it.  
!
!	Unfortunately we must cycle through the entire KNM vector looking
!	for blocks to release, since there could be, e.g., 256 keys only
!	the last of which had a Knm.
!-

        INCR I from 0 to 255
        DO
          BEGIN
          IF .KnmBuf[.i] NEQ 0
          THEN
              BEGIN
              $Xpo_Free_Mem (BINARY_DATA=(40/(%BPVAL/8),.KnmBuf[.i]));
              KnmBuf[.i] = 0;
              END;
          END;

        RETURN Dap$k_Access
        END; ! Process ACCESS message

    [Dap$k_Access_Complete]:
        BEGIN
        BIND URab=RabVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rab_decl;
        BIND URst=RstVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rms_Rst; !a561

        dap$get_access_complete ( idd, Fab, URab, URst )
        END;

    [OTHERWISE]:
        BEGIN
        Dap_Error(Odd,Dap$k_Mac_Sync,.Idd[Dap$b_Operator]);
        RETURN .Idd[Dap$b_Operator]
        END;
    TES
END;  !End of DAP$GET_ACCESS (D$GACC) (process ACCESS message)
ROUTINE Access ( P_Fab: REF $Fab_decl,
                 P_NFab: REF $Fab_decl,
                 P_Fst: REF $Rms_Fst ) =
!++
! FUNCTIONAL DESCRIPTION:
!
!       Perform a file access as requested by remote user
!
! FORMAL PARAMETERS:
!
!       P_FAB:     Address of RMS FAB
!       P_NFAB:    Address of RMS FAB for new name (rename only) or 0
!       P_Fst:     Address of FST
!--
BEGIN
BIND
    Fab=.P_Fab: $Fab_Decl,
    NFab=.P_NFab: $Fab_decl,
    Fst=.P_Fst: $Rms_Fst,
    Nam=UAddr(.Fab[Fab$a_Nam]): $Nam_decl,
    Idd=.Fst[Fst$a_I_Dd]: $Dap_Descriptor,
    Odd=.Fst[Fst$A_O_Dd]: $Dap_Descriptor,
    Typ=.Fab[Fab$a_Typ]: $Typ_Decl,
    Config=.Fst[Fst$a_Config]: $XabCfg_Decl;      ! Configuration Xab

IF .Fst[Fst$h_File_Class] EQL 0           ! Default datatype to ASCII     !m545
THEN Typ[Typ$h_Class] = Fst[Fst$h_File_Class]  ! In typ block
     = Typ$k_Ascii;                       ! in FST                        !m545

!+
!  If the remote is trying for CRLF, or any other carriage control,
!  This will hopefully keep old and stupid software out of trouble.
!  If the file is an RMS file, it will get the reall attributes anyway.
!-

IF ((.Fst[Fst$h_Rat] AND Fab$m_Cr+Fab$m_Ftn+Fab$m_Emb) NEQ 0)           !a545vv
THEN                                                                    !d606
    BEGIN
    Typ[Typ$h_Class] = Fst[Fst$h_File_Class] = Typ$k_Ascii;
    Fst[Fst$h_Bsz] = Fab[Fab$v_Bsz] = 7;
    Fab[Fab$v_Rfm] = Fab$k_Stm;
    Fab[Fab$h_Rat] = 0;
    END;                                                                !a545^^



!+
! Default the byte size if it is still not set
!-
    IF .Fst[Fst$h_Bsz] EQL 0
    THEN Fst[Fst$h_Bsz] = Fab[Fab$v_Bsz] = 7;   ! Default to 7-bit ascii  !m570

!+
! Disbelieve the byte size if it is 8 and the file is ascii
! Unless the system can be expected to know better
!-
    IF ( .Fst[Fst$h_Bsz] EQL 8 )
    AND ( .Fst[Fst$h_File_Class] EQL Typ$k_Ascii )
    AND ( .Config[Xab$b_OsType] NEQ Xab$k_Tops20 )
    THEN Fst[Fst$h_Bsz] = Fab[Fab$v_Bsz] = 7;   ! Force to 7-bit ascii    !m570

!+
!  Do the things we need for wildcarding
!-

SELECT .Fst[Fst$b_Operation] OF
    SET
    [Dap$k_Create,                      ! Output file parse
     Dap$k_Submit]: Fab[Fab$v_Ofp] = 1; !
    [OTHERWISE]:			!610
    Fab[Fab$v_Ofp] = 0;			!610
    TES;

!+
! Mount the structure
!-

S$Mount( .Fab[Fab$a_Fna] );             ! mount structure             !a534

$Rms_Parse( Fab=Fab, Err=Rms$Signal );  ! Parse to get expanded filespec
$Rms_Search( Fab=Fab, Err=Rms$Signal ); ! Search to get first file
Fab[Fab$v_Drj] = Fab[Fab$v_Nam] = 1;    ! Open by Nam Block
                                        ! and do not release JFN

Nam[Nam$v_Cha_Dev] =                                                     !a566v
Nam[Nam$v_Cha_Dir] =
Nam[Nam$v_Cha_Nam] =
Nam[Nam$v_Cha_Ext] = 1;                 ! All new access                 !a566^

IF .Fst[Fst$b_Operation] EQL Dap$k_Directory                             !a570
THEN                                    ! Handle DIRECTORY specially
    BEGIN
    While .Fab[Fab$h_Sts] NEQ Rms$_Nmf DO
        BEGIN
        Fst[Fst$v_Display_3_Part_Name] = 1;     ! Return 3-part name always
        Dap$3_Part_Name( Odd, Fab, Fst );

        FillBlocks();

        ! Build attributes & send

        Dap$$Put_Attributes( Odd, Fab, Fst );  
        IF .Config[Xab$b_Version] GEQ 7  ! If DAP v7 or later           !a643
        THEN Dap$Put_Ack(Odd);           ! Put out an ACK               !m643
        Dap$Put_Message( Odd );

        ! Search for next file

        $Rms_Search( Fab=Fab );
        END;

    Dap$Put_String( Odd,D_Acr );     ! Send access complete              !a603
    Dap$Put_Message( Odd );          !        response                   !a603
    END
ELSE
    Dap$3_Part_Name( Odd, Fab, Fst );  ! Return 3-part name if needed


SELECTONE .fst[fst$b_operation] OF
    SET
    [Dap$k_Open]:      $Rms_Open(Fab=Fab, Err=Rms$Signal);
    [Dap$k_Create]:    BEGIN                                              !m573
                       LOCAL kd: REF $Rms_kdb INITIAL(.Fst[Fst$a_Kdb]);
                       LOCAL ad: REF $Rms_adb[32] INITIAL(.Fst[Fst$a_Adb]);

                       LOCAL XabTail: REF $XabSum_decl
                             INITIAL(.FalFab[Fab$a_Xab]);

                       ! Find end of XAB chain
                       WHILE .XabTail[Xab$a_Nxt] NEQ 0
                       DO XabTail=.XabTail[Xab$a_Nxt];

                       ! Climb through the kdb chain, building key xabs
                       WHILE .kd NEQ 0     ! We have keys defined, tell RMS
                       DO  BEGIN
                           BIND xk = FalXabKey [.kd[Kdb$h_Reference],0,0,0,0]:
                                     $XabKey_decl,
                           keyseg = xk[xab$h_siz0] : VECTOR,
                           segvec = kd[kdb$z_segments] : VECTOR;

                           $XabKey_Init( xab=xk, kref=.kd[Kdb$h_Reference] );

			   xk[Xab$a_Knm]=.Knmbuf[.kd[Kdb$h_Reference]];

                           xk[Xab$v_Dtp]=.kd[Kdb$v_Datatype];
                           xk[Xab$h_Flg]=.kd[Kdb$h_Flags];
                                         
			   xk[Xab$h_dfl]=.kd[Kdb$h_dfl_offset];	!610
			   xk[Xab$h_ifl]=.kd[Kdb$h_ifl_offset];	!610
			   xk[Xab$b_Ian]=.kd[Kdb$b_Ian];	!610
			   xk[Xab$b_Dan]=.kd[Kdb$b_Dan];	!610
			   
                           INCR i from 0 TO 7
                           DO keyseg[.i]=.SegVec[.i];  ! Copy pos/siz pairs

                           xabtail[Xab$a_Nxt]=xk;  ! Continue linked list !m600
                           xabtail=xk;             !
                           kd=.kd[Kdb$a_Nxt];
                           END;

                       IF .ad NEQ 0     ! We have areas defined, tell RMS
                       THEN INCR i FROM 0 TO .ad[Adb$h_Bln]-1 DO
                           BEGIN
                           xabtail[xab$a_nxt] = FalXabAll[.i,0,0,0,0];
                           xabtail = FalXabAll[.i,0,0,0,0];
                           $XabAll_Init( Xab=.xabtail,
                                         Aid=.i,
                                         Bkz=.ad[adb$v_bkz,.i]);
                           END;

                       $Rms_Create(Fab=Fab, Err=Rms$Signal);
                       END;

    [Dap$k_Erase]:     BEGIN            ! Erase wildcarded files        !a633v
                       WHILE 1          ! Note $RMS_Erase doesn'e expunge file
                       DO BEGIN         ! (first 3-part name already output)
                          Dap$$Put_Attributes( Odd, Fab, Fst ); ! Put attr out
                          $RMS_Erase(FAB=fab, ERR=RMS$SIGNAL);  ! Erase file
                          IF .Config[Xab$b_Version] GEQ 7  ! If DAP v7 or later
                          THEN Dap$Put_Ack(Odd);           ! Put out an ACK
                          $RMS_Search(FAB=fab);            ! Get next file
                          IF .fab[FAB$H_STS] EQL RMS$_NMF  ! No more files?
                          THEN EXITLOOP;                   ! yes, finish up
                          Dap$3_Part_Name(Odd, Fab, Fst);  ! Send next name
                          END;                             ! All files deleted
                       DAP$Put_String( Odd,D_Acr );        ! Send access comp
                       Dap$Put_Message( Odd );             !        response
                       END;                                              !a633^

    [Dap$k_Rename]:    BEGIN                                             !a635v
                       BIND nnam = .nfab[FAB$A_NAM] : $NAM_DECL;
                       fab[FAB$V_DRJ] = 0;      ! Release the jfns we get here
                       WHILE 1
                       DO BEGIN
                          nnam[NAM$H_RSL] = 0;  ! Don't let RMS think
                          nnam[NAM$H_ESL] = 0;  !  that there is a RSL or ESL
                          $RMS_Parse(FAB=nfab); ! Let the rename catch errors

                          $RMS_Rename(OLDFAB=fab, NEWFAB=nfab, ERR=RMS$SIGNAL);

                          Dap$$Put_Attributes(Odd, Fab, Fst); ! Old attrib
                          IF .Config[Xab$b_Version] GEQ 7  ! If DAP v7 or later
                          THEN Dap$Put_Ack(Odd);           ! Put out an ACK 
                          Dap$$Put_Attributes(Odd, NFab, Fst); ! New attrib

                          IF .Config[Xab$b_Version] GEQ 7  ! If DAP v7 
                          THEN Dap$Put_Ack(Odd);           ! Put out an ACK 
                          Dap$Put_Message(Odd);
                          $RMS_Parse(FAB=fab);             ! Any more files
                          IF NOT $RMS_Status_ok(fab)       !  to rename?
                          THEN EXITLOOP;                   ! If not, then exit
                          $RMS_Search(FAB=fab);            ! yes, get it
                          Dap$3_Part_Name(Odd, Fab, Fst);  ! Send old name
                          END;
                       DAP$Put_String(Odd, D_Acr);      ! Send access comp
                       Dap$Put_Message(Odd);
                       END;                                              !a635^

    [Dap$k_Submit]:    BEGIN
                       Fab[Fab$v_Scf]=1;        ! Set Submit-on-Close bit
                       $Rms_Create(Fab=Fab, Err=Rms$Signal);
                       END;
    [Dap$k_Execute]:   BEGIN
                       Fab[Fab$v_Scf]=1;        ! Set Submit-on-Close bit
                       $Rms_Open(Fab=Fab, Err=Rms$Signal);
                       $Rms_Close(Fab=Fab, Err=Rms$Signal);
                       END;
    [Dap$k_Directory]: ;                                                !d570
    [OTHERWISE]:       Dap_Error(Odd,Dap$k_Mac_Unsupported,             !a635
                          Dap$k_Mic_Access_Accfunc);                    !a635
                                                                        !d635
    TES;

SELECTONE .fst[fst$b_operation] OF
    SET
    [Dap$k_Open,
     Dap$k_Create,
     Dap$k_Submit]:  Fst[Fst$v_Access_Active]= ! Access is active
                      Fst[Fst$v_File_Open]=1;   ! Remember file is open
    [Dap$k_Execute]:                                               !m635!m572
        BEGIN                                                           !d603
        Fst[Fst$v_Access_Active]=1;     ! Access is active
        Fst[Fst$v_File_Open]=0;         ! No file is open
        END;
    [Dap$k_Rename,                                                       !a635
     Dap$k_Erase,                                                        !a635
     Dap$k_Directory]: BEGIN                                             !m635
                       Fst[Fst$v_File_Open] = 0;      ! File not open    !m635
                       Fst[Fst$v_Access_Active] = 0;  ! Access was ended !m635
                       END;                                              !a635
    TES;


!+
! Copy the file attributes into the FST that FAL uses
!-
Fst[Fst$h_Bsz] = .Fab[Fab$v_Bsz];       ! Use file byte size            !a557vv
Fst[Fst$h_Rfm] = .Fab[Fab$v_Rfm];       ! and record format
Fst[Fst$h_Rat] = .Fab[Fab$h_Rat];       ! and record attributes
Fst[Fst$b_Fac] = .Fab[Fab$h_Fac];       ! and file access
Fst[Fst$h_Fop] = .Fab[Fab$h_Fop];       ! and file access options
Fst[Fst$h_Mrs] = .Fab[Fab$h_Mrs];       ! and maximum record size
Fst[Fst$g_Mrn] = .Fab[Fab$g_Mrn];       ! and maximum record number     !a557^^


.Fab[Fab$h_Sts]                         ! return status
END;
GLOBAL ROUTINE FillBlocks =
!+
! FUNCTIONAL DESCRIPTION
!
!       Fill in the Fabs & XABs for directory
! 
! IMPLICIT INPUTS
!
! FALFAB
!-
BEGIN
BIND
    Fab=FalFab: $Fab_Decl,
    Fst=FalFst: $Rms_Fst,
    Nam=.Fab[Fab$a_Nam]: $Nam_decl,
    Idd=.Fst[Fst$a_I_Dd]: $Dap_Descriptor,
    Odd=.Fst[Fst$A_O_Dd]: $Dap_Descriptor,
    Typ=.Fab[Fab$a_Typ]: $Typ_Decl;

!
! Set up the appropriate Xabs by the display field
! Date/Time and Summary XABs are already attached
!
LOCAL
    xabtail: REF $XABSUM_DECL,
    noa,                                ! Number Of Areas
    nok,
    hp_rab: VOLATILE,
    hp_rst: VOLATILE,
    hp_nlb: VOLATILE;



ENABLE fal$handle (hp_rab, hp_rst, hp_nlb );    ! Enable handler
hp_nlb=.fst[fst$a_nlb];                 ! Set up args for handler


XabTail = .Fab[Fab$a_Xab];

Fab[Fab$h_Fac] = Fab$m_Nil;             ! Nil access, no locking
Fab[Fab$v_Drj] = Fab[Fab$v_Nam] = 1;    ! Keep the jfn, Open by NAM block

$Rms_Open( Fab=Fab );                   ! Try to open file

!
! Loop through the XABs to find the end of the chain
!

WHILE 1 DO
    BEGIN
    IF .XabTail[Xab$v_Cod] EQL Xab$k_Sum
    THEN
        BEGIN       ! Find out how many areas & keys
        nok=.XabTail[Xab$b_Nok];
        noa=.XabTail[Xab$b_Noa];
        END;

    IF .XabTail[Xab$a_Nxt] NEQ 0
    THEN XabTail=.XabTail[Xab$a_Nxt]
    ELSE EXITLOOP;
    END;

!
! Set up as many Key XABs as needed
!
    BEGIN
    MAP xabtail: REF $Xabkey_decl;

    INCR krf FROM 0 TO .nok-1
    DO
        BEGIN
        xabtail[xab$a_nxt]=FalXabKey[.krf,0,0,0,0];
        xabtail = FalXabKey[.krf,0,0,0,0];
        $XabKey_Init( Xab=.xabtail,
                      KRef=.krf );
        END;
    END;                        ! 


!
! Set up as many Allocation XABs as needed
! At least 1, the vax requires it!

noa = MAX( .noa, 1 );

    BEGIN
    MAP xabtail: REF $XabAll_decl;

    INCR aid FROM 0 TO .noa-1
    DO
        BEGIN
        xabtail[xab$a_nxt]=FalXabAll[.aid,0,0,0,0];
        xabtail = FalXabAll[.aid,0,0,0,0];
        $XabAll_Init( Xab=.xabtail,
                      Aid=.aid );
        END;
    END;

xabtail[xab$a_nxt] = 0;     !  End of the chain

IF .Fab[Fab$a_Ifi] NEQ 0                ! If we got the file open
THEN
    BEGIN
    $Rms_Display( Fab=Fab );            ! Fill in the XABs  
    $Rms_Close( Fab=Fab );              ! Close the file again
    END;

Rms$_Suc
END;
GLOBAL ROUTINE Dap$Get_Control(  P_Dd: REF $Dap_Descriptor ) = 
!++
! FUNCTIONAL DESCRIPTION:
!
!	Routine to process a Control message
!
! FORMAL PARAMETERS:
!
!	P_DD:  Addr of DAP descriptor
!  
! IMPLICIT INPUTS:
!
!       RABVEC: This is the vector of RABs that FAL uses
!       RSTVEC: This is the vector of RSTs that FAL uses
!       For both of the above, the StreamId in the message header
!       is used to select the RAB and the RST we want to use
!
! IMPLICIT OUTPUTS:
!
!       RAB and RST: point to the current RAB & RST
!
! ROUTINE VALUE:
!
!	CTLFUNC: the Control function code
!
! SIDE EFFECTS:
!
!	The requested Control function will have been initiated
!
!--
BEGIN
BIND idd=.p_dd: $dap_descriptor;
BIND odd=.p_dd[dap$a_other_dd]: $dap_descriptor;

BIND fab=FalFab: $Fab_decl,                                               !m557
     fst=FalFst: $Rms_Fst;                                                !m557

LOCAL hp_rab: VOLATILE REF $rab_decl,   ! Hold addresses of args for handler
      hp_rst: VOLATILE REF $rms_rst,    !
      hp_nlb: VOLATILE REF $xpn_nlb();  ! 

ENABLE fal$handle (hp_rab, hp_rst, hp_nlb );    ! Enable handler
hp_nlb=.fst[fst$a_nlb];                 ! Set up args for handler         !d557

DO
    BEGIN
    SELECT dap$get_header(idd) OF
    SET
    [dap$k_control]:
        BEGIN
        BIND URab=RabVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rab_decl,  !a557
             URst=RstVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rms_Rst;   !a557

        LOCAL ctlfunc;
        LOCAL ctlmenu: BITVECTOR[28] INITIAL(0);
        LOCAL display: BITVECTOR[28] INITIAL(0);
	LOCAL Key:     BYTE8VECTOR[256] INITIAL(0);			 !630
        LOCAL dkrf;

        Rab = Hp_Rab = URab;                                             !m560
        Rst = Hp_Rst = URst;                                             !m560

        ctlfunc=dap$get_byte(idd);

        URst[rst$v_no_send_control]=1; ! Do not send control msg back
                
        dap$get_bitvector(idd,ctlmenu,1);       ! Get the message menu

	IF .ctlmenu[dap$v_ctl_rac]		! RAC field present
        THEN URab[rab$b_rac]=$dap_translate_value(dap$get_byte(idd),
                                                  dap$k_rac_, rab$k_,
                                                  seq,key,rfa,blk,tra,bft);

	IF .ctlmenu[dap$v_ctl_key]              ! KEY field present     !m555vv
        THEN
            BEGIN
            LOCAL recnum;

            CASE .URab[Rab$b_Rac] FROM Rab$k_Seq TO Rab$k_Bft OF
            SET
            [Rab$k_Key]:

!+ 630
!  Read the key field into an intermediate buffer.  Then match up the
!  Krf with the FST's Fdb to figure out how to decode the field.
!-

                CASE .Fab[Fab$v_Org] FROM Fab$k_Seq TO Fab$k_Idx OF
                SET
                [Fab$k_Idx]:
                    BEGIN
                    LOCAL ksz;
                    ksz = Dap$Get_Variable_Counted (idd,
                                 CH$PTR(key,0,8),
                                 255);
                    IF .ksz EQL Dap$_Ftl
                    THEN SIGNAL(Rms$_Ksz)
                    ELSE URab[Rab$b_Ksz] = .ksz;

                    END; ! of Indexed file access by key
                [Fab$k_Rel]:  ! Record number for relative files
                    (.URab[Rab$a_Kbf]) = dap$get_longword(idd);
                [INRANGE, OUTRANGE]: 
                    Dap$Get_Variable_String(idd,0,255);  ! Ignore field   !a561
                TES;
            [Rab$k_Blk,
             Rab$k_Bft]:
                URab[rab$g_bkt] = Get_Vbn(idd);                           !m577

            [Rab$k_Rfa]:
                BEGIN                                                    !a605v
                LOCAL rfa: BYTE8VECTOR[8];
                Dap$Get_Variable_Counted( idd, CH$PTR(rfa,0,8), 8 );	 !m611
                URab[Rab$g_Rfa] = Dap$Rfa_Dap_Rms(rfa);
                END;                                                     !a605^

            [INRANGE, OUTRANGE]:
                Dap$Get_Variable_String( idd, 0, 255 );  ! Ignore field   !m561
            TES;
            END;  ! of code to handle KEY field                         !m555^^

        dkrf = .URab[rab$b_krf];			! get last-used KRF!630
  
	IF .ctlmenu[dap$v_ctl_krf] 			! KRF field present
        THEN
            BEGIN
            Urab[rab$b_krf] = dap$get_byte(idd);        ! get new KRF	!630
            dkrf = .URab[rab$b_Krf];
            END;

        IF .ctlmenu[dap$v_ctl_key]			! If there was
        AND (.Fab[Fab$v_Org] EQL Fab$k_Idx)		! an indexed KEY
        THEN
          BEGIN						! 630
            LOCAL dtp;
            LOCAL Xabptr: REF $XabKey_decl;

            Xabptr = FalXabKey[.dkrf,0,0,0,0];
            dtp = .Xabptr[Xab$v_Dtp];

            SELECT .dtp OF
              SET
                 [Xab$k_In4, Xab$k_Bn4]:
                    BEGIN
                    .URab[Rab$a_kbf] = Num_Vb (key);
                    URab[Rab$b_Ksz] = 4;			! 620
                    END;
                 [Xab$k_Stg, Xab$k_Ebc, Xab$k_Pac]:       ! ascii
                    BEGIN
                    LOCAL ksz,
                          Keyptr;
                    Keyptr=.URab[Rab$a_Kbf];
                    TGUPointer (Keyptr, .Fst[Fst$h_Bsz] );
                    ksz = chacaz (CH$PTR(key,0,8),.Keyptr);
                    URab[Rab$b_Ksz] = .ksz;
                    END;

                 [OTHERWISE]: SIGNAL(Rms$_dtp);
              TES;
          END;

	IF .ctlmenu[dap$v_ctl_rop] ! ROP field present
        THEN
            BEGIN
            LOCAL rop: BITVECTOR[42] INITIAL(0,0);
            dap$get_bitvector(idd,rop,6);

            $dap_move_bits(rop, dap$v_rop_, ! Translate DAP bits
                           URab, rab$v_, ! to RMS ones
                           eof,fdl,loc,rah,loa,wbh,kgt,kge,pad,
                           nrp,uif,ulk,tpt,nlk,bio,lim,nxr);
            END;

	IF .ctlmenu[dap$v_ctl_hsh] ! HSH field present
        THEN
            BEGIN
            dap_error(odd,dap$k_mac_unsupported,dap$k_mic_control_hsh);
            ! Not Supported -- Reserved as of DAP 7.0
            END;

	IF .ctlmenu[dap$v_ctl_display] ! DISPLAY field present
        THEN
            BEGIN
            dap$get_bitvector(idd,display,4);
            Fst[Fst$v_Display] = .display;
            END;


        ! Save the function code away
        fst [ fst$b_operation ] = .ctlfunc ;

        ! Now do the requested function
        control ( URab, URst )
        END;

    [DAP$K_ACCESS_COMPLETE]:
        BEGIN
        BIND URab=RabVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rab_decl;
        BIND URst=RstVector[ .idd[Dap$b_StreamID], 0,0,0,0 ]: $Rms_Rst; !a561

        Hp_Rab = URab;                                                !a557
        Hp_Rst = URst;                                                !a561

        dap$get_access_complete ( idd, Fab, URab, URst ) ;
        END;

    [OTHERWISE]:
        dap_error (odd, dap$k_mac_sync, .idd[dap$b_operator] )
    TES;
    END WHILE .fst[fst$v_file_open]
END;
ROUTINE dap$generation_check(p_pointer) : NOVALUE =                  !a635vv
!++
! FUNCTIONAL DESCRIPTION:
!
!       Check for a  filename of the  form "file.type;gen" and  change it  into
!       "file.type.gen".   Also  check  for  "<>file.type"  and  change  it  to
!       "file.type".  Yuk.
!
! FORMAL PARAMETERS:
!
!       Byte pointer to ASCIZ filename to check.
!--
BEGIN

LOCAL char,
      bpointer,
      pointer;

! Braindamaged VMS gives us a directory string of "<>", so look for that

pointer = .p_pointer;                   ! Copy byte pointer to string
INCR i FROM 1 TO 255                    ! Look through for the length of string
DO BEGIN
   IF (char = CH$RCHAR_A(pointer)) EQL 0        ! If we hit a null we are done
   THEN EXITLOOP;
   IF .char EQL %C'<' OR .char EQL %C'['        ! Is it the beginning of a dir?
   THEN BEGIN                                   ! yes
        char = CH$RCHAR_A(pointer);             ! Get the next character
        IF .char NEQ %C'>' AND .char NEQ %C']'  ! Is it the end of dir spec?
        THEN EXITLOOP;                          ! Nope, there is nothing wrong
        bpointer = CH$PLUS(.pointer,-2);        ! Back up by two please
        INCR j FROM 1 TO 255-.i                 ! Look through the rest of str
        DO BEGIN                                ! Move string back 2 characters
           char = CH$RCHAR_A(pointer);          ! Get a character
           CH$WCHAR_A(.char,bpointer);          ! Move it back by two
           IF .char EQL 0 THEN EXITLOOP;        ! If null exit INCR j loop
           END;                                 ! End of INCR j loop
        EXITLOOP;                               ! And exit INCR i loop
        END;                                    ! End of INCR i loop
   END;

! Look for the end of the string

pointer = .p_pointer;                   ! Copy byte pointer to string
INCR i FROM 1 TO 255                    ! For the length of the string
DO IF CH$RCHAR_A(pointer) EQL 0 THEN EXITLOOP;  ! Find the null there
pointer = CH$PLUS(.pointer,-1);         ! Back up over the null

! Look backwards until a ";" found, quitting if anything besides a digit is
! found.

UNTIL .pointer EQL .p_pointer           ! Until we are back at the start
DO BEGIN                                ! Loop through here

   pointer = CH$PLUS(.pointer,-1);      ! Back up by one
   char = CH$RCHAR(.pointer);           ! Get that character

   IF .char EQL %C';'                   ! is the character a semicolon? 
   THEN BEGIN                           ! Yes
        CH$WCHAR(%C'.',.pointer);       ! Change it back to a period
        EXITLOOP;                       ! And return
        END;

   IF .char NEQ %C'-' AND (.char LSS %C'0' OR .char GTR %C'9')
   THEN RETURN;                         ! Return now if character not numeric

   END;

END;                                                                    !a635^^
ROUTINE control ( p_rab: REF $rab_decl, p_rst: REF $rms_rst ) =
!++
! FUNCTIONAL DESCRIPTION:
!
!       Perform a record access as requested by remote user
!
! FORMAL PARAMETERS:
!
!       P_RAB:     Address of RMS RAB
!       P_RST:     Address of RST
!
! IMPLICIT INPUTS:
!
!       FAB: Address of FAB
!       FST: Address of FST
!--
BEGIN
BIND Urst=.p_rst: $rms_rst,   ! URst is an argument, Rst is the global !M557ff
     Urab=.p_rab: $rab_decl,  ! URab is an argument, Rab is the global !M557ff
     UFab=.Fab: $Fab_decl,
     UFst=.Fst: $Rms_Fst,
     idd=.Fst[Fst$a_I_Dd]: $dap_descriptor,
     odd=.Fst[Fst$a_O_Dd]: $dap_descriptor;
LOCAL
     rabsav: REF $Rab_decl VOLATILE,
     rstsav: REF $Rms_Rst VOLATILE;

ENABLE Fal$Handle ( rabsav, rstsav );

rabsav=URab;
rstsav=URst;

CASE .fst[fst$b_operation] FROM 1 TO dap$k_ctlfunc_max OF
    SET
    [Dap$k_Get]:                    ! GET RECORD(S)
        BEGIN
        
        SELECT .URab[Rab$b_Rac] OF
            SET
            [Rab$k_Bft]:    ! Block mode file transfer
                BEGIN
                Fst[Fst$h_File_Class] = Typ$k_Image;    ! Block image !a541

                DO  BEGIN
                    $Rms_Read (Rab=URab, Err=Rms$Signal);    ! Get a record
                    Dap$$Put(URab, URst, Rms$Signal);
                    URab[Rab$g_Bkt] = .URab[RAb$g_Rfa]+1; ! Next bucket
                    END WHILE 1;
                END;

            [Rab$k_Tra]:                ! Sequential File Transfer
                BEGIN                   ! in Record Mode
                DO  BEGIN
                    $Rms_Get(Rab=URab, Err=Rms$Signal);    ! Get a record
                    Dap$$Put(URab, URst, Rms$Signal)
                    END WHILE 1;
                END;

            [Rab$k_Blk]:    ! random $READ
                BEGIN
                Fst[Fst$h_File_Class] = Typ$k_Image;    ! Block image !a541
                $Rms_Read (Rab=URab, Err=Rms$Signal);
                Dap$$Put (URab, URst, Rms$Signal);
                Dap$Put_Success( Odd);                  ! Win status  !a555
                END;

            [OTHERWISE]:        ! Record mode $GET
                BEGIN
                $Rms_Get (Rab=URab, Err=Rms$Signal);
                Dap$$Put (URab, URst, Rms$Signal);
                Dap$Put_Success( Odd);                  ! Win status  !a555
                END;
            TES;
        END;
    [Dap$k_Connect]:                ! INITIATE A DATA STREAM
        BEGIN
        LOCAL Rac;

        !+
        ! Set up the RAB we are going to use
        !-                                                              !a557vv
        URab[Rab$h_Bid] = Rab$k_Bid;
        URab[Rab$h_Bln] = Rab$k_Bln;
        $Rab_Store(Rab=URab, Fab=UFab,
                   ubf=UsrBuf, usz=dap$k_buffer_size/(%BPUNIT/8),
                   Kbf=KeyBuf, Ksz=255 );

        URst[Rst$h_Bln] = Rst$k_Bln;                 ! Set up the RST
        URst[Rst$h_Bid] = Rst$k_Bid;                 ! 
        URst[Rst$a_Fst] = .Fst;                      !          
        URst[Rst$v_StreamId] = .Idd[Dap$b_StreamId]; !                  !a557^^

        ! Now save the RAC & make TRA, BLK, or BFT into SEQ
        Rac=.URab[Rab$b_Rac];
        SELECT .Rac OF
            SET
            [Rab$k_Tra,
             Rab$k_Blk,
             Rab$k_Bft]: URab[Rab$b_Rac]=Rab$k_Seq;
            [ALWAYS]:
                BEGIN
                $Rms_Connect(Rab=URab, Err=Rms$Signal); ! Connect RAB to FAB
                Dap$Put_Ack(Odd);           ! Acknowledge the connect
                Dap$Put_Message(Odd);
                END;
            [Rab$k_Tra,
             Rab$k_Blk,
             Rab$k_Bft]: URab[Rab$b_Rac]=.Rac; ! Restore RAC
            TES;

        IF .Fst[Fst$v_Accopt_Crc]       ! If checking CRC !a533
        THEN URst[Rst$h_Checksum] = %O'177777'; ! CRC-16  !a533

        END;

    [Dap$k_Update]:                 ! UPDATE CURRENT RECORD
        BEGIN
        Dap$$Get( URab, URst, Rms$Signal);        ! Read record
        $Rms_Update (Rab=URab, Err=Rms$Signal);      ! Update record
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Put]:                    ! PUT FOLLOWING RECORD(S)
        BEGIN
        LOCAL Rac;
        ! Now save the RAC & make TRA, BLK, or BFT into SEQ
        Rac=.URab[Rab$b_Rac];
        SELECT .Rac OF
            SET
            [Rab$k_Tra]:
                BEGIN
                URab[Rab$b_Rac]=Rab$k_Seq;
                                                                         !M542 
                WHILE Dap$$Get(URab, URst, Rms$Signal) NEQ 0     ! Read record
                DO $Rms_Put(Rab=URab, Err=Rms$Signal);          ! Write record

                URab[Rab$b_Rac]=.Rac; ! Restore RAC
                END;

            [Rab$k_Bft]:    ! Block mode file transfer
                BEGIN                                                     !M542
                Fst[Fst$h_File_Class] = Typ$k_Image; !a542

                WHILE Dap$$Get(URab, URst, Rms$Signal) NEQ 0  ! Read block
                DO
                    BEGIN
                    URab[Rab$g_Bkt] = .URab[Rab$g_Rfa];                   !a542
                    $Rms_Write(Rab=URab, Err=Rms$Signal);   ! Write block !m542
                    END
                END;

            [Rab$k_Blk]:    ! Block mode $WRITE
                BEGIN
                Dap$$Get( URab, URst, Rms$Signal);        ! Read block
                $Rms_Write (Rab=URab, Err=Rms$Signal);       ! Write block
                Dap$Put_Success( Odd);                  ! Win status  !a555
                END;
            [OTHERWISE]:        ! Record mode $PUT
                BEGIN
                Dap$$Get( URab, URst, Rms$Signal);        ! Read record
                $Rms_Put (Rab=URab, Err=Rms$Signal);         ! Write record
                Dap$Put_Success( Odd);                  ! Win status  !a555
                END;
            TES;
        END;                    ! End of $PUT/$WRITE

    [Dap$k_Delete]:                 ! DELETE CURRENT RECORD
        BEGIN
        $Rms_Delete (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Rewind]:                 ! REWIND FILE
        BEGIN
        $Rms_Disconnect (Rab=URab, Err=Rms$Signal);
        $Rms_Connect (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Truncate]:               ! TRUNCATE FILE
        BEGIN
        $Rms_Truncate (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Release]:                ! UNLOCK RECORD
        BEGIN
        $Rms_Release (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Free]:                   ! UNLOCK ALL RECORDS
        BEGIN
        $Rms_Free (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Flush]:                  ! WRITE OUT ALL MODIFIED I/O BUFS
        BEGIN
        $Rms_Flush (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

    [Dap$k_Find]:                   ! FIND RECORD
        BEGIN
        $Rms_Find (Rab=URab, Err=Rms$Signal);
        Dap$Put_Success( Odd);                  ! Win status  !a555
        END;

!            [DAP$K_MODIFY]:                 ! MODIFY FILE ATTRIBUTES
!            [DAP$K_EXTEND_BEGIN]:           ! FORWARD/BACKWARD SPACE
!            [DAP$K_NXTVOL]:                 ! START NEXT VOLUME
!            [DAP$K_EXTEND_END]:             ! EXTEND FILE BY ALC MSG
    [Dap$k_Display]:                ! RETRIEVE ATTRIBUTES MESSAGE !a545vv
        BEGIN
        $Rms_Display( Fab=UFab, Err=Rms$Signal);
        Dap$$Put_Attributes( Odd, UFab, UFst );  
        Dap$Put_Ack( Odd );
        Dap$Put_Message( Odd );
        END;                                                      !a545^^
!            [DAP$K_SPACE_FORWARD]:          ! FORWARD SPACE
!            [DAP$K_SPACE_BACKWARD]:         ! BACKWARD SPACE
!            [DAP$K_CHECKPOINT]:             ! CHECKPOINT
!            [DAP$K_RECOVERY_GET]:           ! GET, recovering after checkpoint
!            [DAP$K_RECOVERY_PUT]:           ! PUT, recovering after checkpoint
    [INRANGE]: Dap_Error(Odd,Dap$k_Mac_Unsupported,
                             Dap$k_Mic_Control_Ctlfunc);
    [OUTRANGE]: Dap_Error(Odd,Dap$k_Mac_Invalid,
                              Dap$k_Mic_Control_Ctlfunc);
    TES;
.URab[rab$h_sts]                         ! Return status
END;                                    ! CONTROL
GLOBAL ROUTINE dap$get_access_complete (p_dd: REF $dap_descriptor,
                                          p_fab: REF $fab_decl,
                                          p_rab: REF $rab_decl,
                                          p_rst: REF $rms_rst )=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!	Routine to process an ACCESS COMPLETE message
!	The message header may have already been eaten
!
! FORMAL PARAMETERS:
!
!	P_DD:  Addr of DAP descriptor
!       P_FAB: Addr of FAB
!       P_RAB: Addr of RAB
!       P_RST: Addr of rst
!
! IMPLICIT INPUTS:
!
!       FALFST: Fst
!
! ROUTINE VALUE:
!
!	CMPFUNC: the ACCESS COMPLETE function code
!
! SIDE EFFECTS:
!
!	The accessed file, if any, will be closed or flushed
!
!--
BIND Idd=.p_Dd: $Dap_Descriptor;
Bind Odd=.idd[Dap$a_Other_Dd]: $Dap_Descriptor;
BIND Fab=.p_Fab: $Fab_decl;
BIND Nam=.Fab[Fab$a_Nam]: $Nam_decl;    ! In Same section as we are in
BIND Rab=.p_Rab: $Rab_decl;
BIND Rst=.p_Rst: $Rms_Rst;
BIND Fst=FalFst: $Rms_fst;

LOCAL fop: BITVECTOR[42];
LOCAL original_fop: BITVECTOR[18];
LOCAL checksum;
LOCAL cmpfunc;
LOCAL v;

original_fop=.fab[fab$h_fop];                      ! Save original fop bits

If .idd[dap$h_length] LEQ 0                        ! If we have not read header
THEN IF dap$get_header(idd) NEQ dap$k_access_complete ! do so, and if it isnt
     THEN                                          ! Access Complete
         BEGIN                                     ! 
         dap$unget_header(idd);                    !  then regurgitate  
         RETURN 0                                  !  and return
         END;

cmpfunc=dap$get_byte(idd);                         ! Save ACCOMP function

IF .idd[dap$h_length] GTR 0                        ! If message continues
THEN                                               ! next field is a FOP
    BEGIN
    dap$get_bitvector(idd,fop,6);                  ! Get FOP field
    $dap_move_bits(fop,dap$v_fop_,fab,fab$v_,                          !m573
                   rwo,rwc,pos,dlk,lck,
                   ctg,sup,nef,tmp,mkd,dmo,
                   wck,rck,cif,lko,sqo,mxv,spl,
                   scf,dlt,cbt,wat,dfw,tef,
                   drj);
    END;

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

        IF .Fop[Dap$v_Fop_Dlt]		! 610 If we're deleting the file
        AND .cmpfunc EQL Dap$k_Accomp_Command  ! 610 on a close
        THEN Dap$Eat_message (idd)	! 610 don't bother with checksum
        ELSE
            BEGIN
            checksum=dap$get_2byte(idd);  ! Get checksum field if any

            IF (.checksum NEQ .Rst[Rst$h_Checksum])   !If it was wrong
            AND .Fst[Fst$v_Accopt_Crc]            ! and the caller cares !a561
            THEN SIGNAL( Dap$_Crc );
            END;
        END;                                                            !a533^^

v=(CASE .cmpfunc FROM 1 TO Dap$k_Accomp_Max OF
   SET
    [Dap$k_Accomp_Command]:
                    BEGIN
                    ! Allow search afterwards if wildcarded
                    Fab[Fab$v_Drj] = ( Nam NEQ 0 AND .Nam[Nam$v_Wildcard]);
                                                                        !m577
                    $Rms_Close (Fab=Fab, Err=Rms$Signal);     ! close the file

                    IF .Fab[Fab$v_Drj]                                  !m577
                    THEN
                        BEGIN
                        $Rms_Search (Fab=Fab);      ! Look for more files

                        IF .Fab[Fab$h_Sts] NEQ Rms$_Nmf
                        THEN Dap$3_Part_Name( Odd, Fab, Fst );  !a566

                        IF .Fab[Fab$h_Sts] EQL Rms$_Suc
                        THEN            ! Found one
                            BEGIN       ! Send new attributes & RETURN
                            $Rms_Open (Fab=Fab, Err=Rms$Signal );
                            Dap$$Put_Attributes( Odd, Fab, Fst );
                            Dap$Put_Ack( Odd );
                            Dap$Put_Message( Odd );
                            Fst[Fst$v_File_Open]=1;     ! file open now !a566
                            RETURN Dap$k_Accomp_Command;
                            END
                        END;

                    Fst[Fst$v_File_Open]=0;     ! no file open now

                    Dap$Put_String(Odd,D_Acr);
                    Dap$Put_Message(Odd);

                    Dap$k_Accomp_Command        ! we won & we're done
                    END;
    [Dap$k_Accomp_Response]:
                    Dap_Error(Idd, Dap$k_Mac_Invalid,Dap$k_Mic_Accomp_Cmpfunc);
                    ! An Active task is not supposed to send this
    [Dap$k_Accomp_Purge]:
                    BEGIN
                    EXTERNAL ROUTINE r$reset;          !?
                    EXTERNAL ROUTINE r$null;           !?
                    r$reset(fab,r$null);               !?
                    fst[fst$v_file_open]=0;            ! No file open now

                    dap$put_string(odd,d_acr);
                    dap$put_message(odd);

                    dap$k_accomp_purge                 ! They gave up on us
                    END;
    [DAP$K_ACCOMP_EOS]:                            ! $DISCONNECT rab
                    BEGIN
                    $Rms_disconnect ( rab=rab, err=rms$signal );

                    dap$put_string(odd,d_acr);
                    dap$put_message(odd);
                    Dap$k_Accomp_Eos
                    END;

    [Dap$k_Accomp_Skip]:
                    BEGIN
                    !+
                    ! This is like Accomp_Command except
                    ! that the FOP close options are NOT honored.
                    ! Unlike Accomp_Purge, wildcard access may continue.
                    !-

                    Fst[Fst$h_Fop] = .Fab[Fab$h_Fop];   ! Save the real FOP
                    Fab[Fab$h_Fop] = Fab$m_Drj+Fab$m_Nam ; ! Allow search

                    IF (.Fab[Fab$a_Ifi] NEQ 0)    ! If the file is open   !a566
                    THEN $Rms_Close (Fab=Fab, Err=Rms$Signal); ! close the file

                    Fab[Fab$h_Fop] = .Fst[Fst$h_Fop];   ! Get back the real FOP

                    IF Nam NEQ 0 AND .Nam[Nam$v_Wildcard]    
                    THEN
                        BEGIN
                        $Rms_Search (Fab=Fab);      ! Look for more files

                        IF .Fab[Fab$h_Sts] NEQ Rms$_Nmf
                        THEN Dap$3_Part_Name( Odd, Fab, Fst );  !a566

                        IF .Fab[Fab$h_Sts] EQL Rms$_Suc
                        THEN            ! Found one
                            BEGIN       ! Send new attributes & RETURN
                            $Rms_Open( Fab=Fab, Err=Rms$Signal );
                            Dap$$Put_Attributes( Odd, Fab, Fst );
                            Dap$Put_Ack( Odd );
                            Dap$Put_Message( Odd );
                            Fst[Fst$v_File_Open]=1;     ! file open now !a566
                            RETURN Dap$k_Accomp_Skip;
                            END
                        END;

                    Fst[Fst$v_File_Open]=0;     ! no file open now

                    Dap$Put_String(Odd,D_Acr);
                    Dap$Put_Message(Odd);

                    Dap$k_Accomp_Skip        ! we won & we're done
                    END;

    [Dap$k_Accomp_Change_Begin]:
                    BEGIN
                    Dap_Error(Idd, Dap$k_Mac_Unsupported,
                                   Dap$k_Mic_Accomp_Cmpfunc);
                    Dap$k_Accomp_Change_Begin
                    END;

    [Dap$k_Accomp_Change_End]:
                    BEGIN
                    Dap_Error(Idd, Dap$k_Mac_Unsupported,
                                   Dap$k_Mic_Accomp_Cmpfunc);
                    Dap$k_Accomp_Change_End
                    END;

    [Dap$k_Accomp_Terminate]:
                    BEGIN
                    Fab[Fab$v_Drj]=0;           ! No more files! Period!
                    $Rms_Close (Fab=Fab, Err=Rms$Signal);     ! close the file
                    Fst[Fst$v_File_Open]=0;     ! no file open now

                    Dap$Put_String(Odd,D_Acr);
                    Dap$Put_Message(Odd);

                    Dap$k_Accomp_Terminate       ! we won & we're done
                    END;

    [OUTRANGE]:     BEGIN                          ! Not a valid function code
                    dap_error(odd,
                              dap$k_mac_invalid,
                              dap$k_mic_accomp_cmpfunc)
                    END;
TES);

fab[fab$h_fop]=.original_fop;                      ! Restore the FOP

.v                 ! Returned value is Access Complete function code
END;	!DAP$GET_ACCESS_COMPLETE
GLOBAL ROUTINE dap$put_ack ( dd: REF $dap_descriptor ): NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!
!	Build an ACK message
!
! FORMAL PARAMETERS:
!
!       DD:     Addr of output DAP message descriptor
!
!--
    BEGIN				
    Init_Message(dd[$]);                ! Set up dap descriptor
    Dd[Dap$b_Operator]=dap$k_ack;       ! Build header
    Dd[Dap$v_Mflags_Length] = 1;        ! Send length field
    Dd[Dap$h_Length] = 0;               ! No data
    dap$put_header(dd[$]);              !
    END;                                ! DAP$PUT_ACK
GLOBAL ROUTINE dap$error_rms_dap (stscode) =
!++
! FUNCTIONAL DESCRIPTION:
!
!	Return appropriate DAP Miccode for RMS error code
!
! FORMAL PARAMETERS:
!
!       STSCODE: RMS error code
!
!--
    BEGIN				
    SELECT .STSCODE OF
        SET
        $dap$$translate_value(rms$_,dap$_,
                              bug,bsz,ccf,ccr,cef,cgj,chg,cod,cof,cur,
                              dan,del,dev,dup,dtp,dme,dnf,eof,ext,
                              fex,flg,flk,fnf,fnm,fop,ful,ian,iop,key,ksz,
                              mrn,mrs,nef,nmf,npk,org,pos,prv,
                              rac,rat,rbf,rer,rex,rfa,rfm,rlk,rnf,rnl,rop,rsz,
                              rtb,shr,siz,
                              typ,ubf,usz,wer,wlk,
                              xab,xcl
                              );
                                                                          !m662

        [rms$_fsi]: dap$_syn;
        [Dap$k_Facility_Code TO Dap$k_Facility_Code+%O'7777777']: !a545
               .StsCode;                ! Already what we want    !a545
        [OTHERWISE]:  0;
        TES
    END;                                ! DAP$ERROR_RMS_DAP
GLOBAL ROUTINE dap$put_status(p_dd: REF $dap_descriptor,
                              maccode,
                              miccode,
                              rfa,
                              recnum,
                              stv,
                              p_txt): NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!
!	Build a STATUS message, using specified status codes
!
! FORMAL PARAMETERS:
!
!       P_DD:      Address of DAP message descriptor
!       MACCODE: As defined in DAP spec
!       MICCODE: As defined in DAP spec
!                 or put the whole code in MICCODE and leave MACCODE 0
!       RFA:     RFA number in error
!       RECNUM:  Record number in error
!       STV:     Secondary status code
!       TXT:     String descriptor to text if nonzero
!--
    BEGIN				! Fix handling of RFAs & recnums  !m605
    BIND dd=.p_dd: $Dap_Descriptor;
    BIND txt=.p_txt: $str_descriptor();
    LOCAL macmic;                       ! Combined code goes here
                                        ! !----!------------!
    macmic=.miccode+.maccode;           ! !MAC !    MIC     !
                                        ! !----!------------!
                                        ! 4 bits  12 bits

    IF .macmic GTR Dap$k_Facility_Code  ! If we got a 32-bit condition code
    THEN macmic=.macmic<DapCode>;       ! Convert to 16-bit Dap status code

    init_message(dd);                ! 
    dd[dap$b_operator]=dap$k_status; ! Build header
    dd[dap$h_length]=2;              ! Length of MACCODE+MICCODE
    dap$put_header(dd);              !
    dap$put_2byte(dd,.macmic);       ! Put maccode & miccode as 2 byte field

    IF .rfa NEQ 0
    THEN
        BEGIN
        LOCAL vrfa: BYTE8VECTOR[8];
        Dap$Rfa_Rms_Dap( .rfa, vrfa );
        Dap$Put_Variable_Counted(dd,CH$PTR(vrfa,0,8));  ! And the RFA !m611
        END;

    IF .recnum NEQ 0 THEN dap$put_longword(dd,.recnum); ! And the record number
    IF .stv NEQ 0 THEN dap$put_longword(dd,.stv);       ! And the STV
    IF txt NEQ 0                                        ! Send text if any
    THEN
        BEGIN
        dap$put_byte(dd,.txt[str$h_length]);
        dap$put_string(dd,txt);
        END;
    END;                                ! DAP$PUT_STATUS
GLOBAL ROUTINE dap$put_Success( dd: REF $dap_descriptor ): NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!
!	Build and send a STATUS message, using SUCCESS status codes
!
! FORMAL PARAMETERS:
!
!       DD:      Address of DAP message descriptor
!
! IMPLICIT INPUTS:
!
!       MACCODE: Dap$k_Mac_Success (as defined in DAP spec)
!       MICCODE: Dap$k_Err_Normal  (As defined in DAP spec)
!       RFA:     from Rab[Rab$g_Rfa] 
!       RECNUM:  0
!       STV:     0
!       TXT:     0
!--
BEGIN
Dap$Put_Status( .dd,                    ! Use output descriptor we were passed
                Dap$k_Mac_Success,      ! Normal success return
                Dap$k_Err_Normal,       ! Normal success return
                .Rab[Rab$g_Rfa],        ! Return the RFA to the user
                0,                      ! No RECNUM
                0,                      ! No STV
                0                       ! No text of error message
              );

Dap$Put_Message( .dd );                 ! Force it out
END;   ! Dap$Put_Success
GLOBAL ROUTINE dap$get_continue ( p_dd: REF $dap_descriptor )=
!++
! FUNCTIONAL DESCRIPTION
!
!      Flush all messages in the pipe until a CONTINUE is seen.
!      Then parse the CONTINUE message and return its function code
!
! FORMAL PARAMETERS
!
!      P_DD: address of input dap descriptor
!
! RETURNED VALUE
!
!      dap function code for CONTINUE message
!--
BEGIN
BIND dd=.p_dd: $dap_descriptor;

! Ignore all messages until a CONTINUE message
WHILE dap$get_header (dd) NEQ dap$k_continue
DO dap$eat_message (dd);                ! Throw away this message

dap$get_byte (dd)                       ! Return CONTINUE function code
END;
GLOBAL ROUTINE dap$retry_last_operation ( p_blk: REF $rab_decl,
                                          P_st: REF $rms_rst )=
!++
! FUNCTIONAL DESCRIPTION
!
!      Retry the last operation we attempted
!
! FORMAL PARAMETERS
!
!      P_BLK: address of RAB or FAB (as appropriate)
!      P_ST:  address of FST or RST ( "  " )
!
! RETURNED VALUE
!
!      whatever the last operation returns when we retry it
!
!--
BEGIN
IF .P_Blk[rab$h_bid] EQL fab$k_bid
THEN access ( .P_Blk, .P_st )
ELSE control ( .P_blk, .P_st )
END;
ROUTINE Dap$3_Part_Name( P_Odd, P_Fab, P_Fst ): NOVALUE =
!+
! Send 3-part Name Message(s) if needed
!-
BEGIN                                                                !a566v
BIND Odd=.P_Odd: $Dap_Descriptor,
     Fab=.P_Fab: $Fab_decl,
     Nam=.Fab[Fab$a_Nam]: $Nam_decl,
     Fst=.P_Fst: $Rms_Fst;

IF .Nam[Nam$v_Wildcard]
THEN Fst[Fst$v_Display_3_Part_Name] = 1;

IF .Fst[Fst$v_Display_3_Part_Name]                               
THEN
    BEGIN
    Local Nametype: BITVECTOR[28];

    IF .Nam[Nam$v_Cha_Str]
    THEN
        BEGIN
        Nametype=0;
        Nametype[Dap$k_Nametype_Str]=1;
        Dap$Put_Name( Odd, Fab, Nametype );
        END;

    IF .Nam[Nam$v_Cha_Dir]
    THEN
        BEGIN
        Nametype=0;
        Nametype[Dap$k_Nametype_Dir]=1;
        Dap$Put_Name( Odd, Fab, Nametype );
        END;

    !+
    ! Send the filename and extension in any case
    !-
    Nametype=0;                                                 
    Nametype[Dap$k_Nametype_Nam]=1;
    Dap$Put_Name( Odd, Fab, Nametype );
    END;             
END; !Dap$3_Part_Name                                                 !A566^
END ELUDOM