Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/faldo.b36
There are 3 other files named faldo.b36 in the archive. Click here to see a list.
MODULE FALDO (
              IDENT='7.0(637) 25-Jun-86',
              ENTRY(
                    Fal$Do,
                    Fal$Handle,
                    UsrErr
                   )
             ) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY: RMS FAL
!
! ABSTRACT:
!          This is the top level of the RMS File Access Listener for TOPS-20
!          It will (eventually) support:
!
!          o   Record Mode File Access,
!          o   Record Mode File Transfer,
!          o   Block Mode File Transfer,
!          o   $ERASE (file deletion)
!          o   $RENAME
!          o   $SUBMIT (transfer & submit as batch job)
!          o   $EXECUTE (submit existing file as batch job)
!          o   Directory List
!
! ENVIRONMENT: TOPS-20
!
! AUTHOR: Andrew Nourse

!
! Table of Contents
!

FORWARD ROUTINE
    fal$do,
    fal$handle;
!   UsrErr;

!
! Library and Include files
!

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

!
! Literals
!

LITERAL namesize=300;
%IF %BLISS(BLISS36)
    %THEN
    %IF %SWITCHES(TOPS20)
        %THEN
            LITERAL our_ostype=dap$k_tops20;
            LITERAL ma_return = 1;

        %FI
    %FI

!
! OWN Storage
!
GLOBAL
    Usrsts,
    Usrstv,
    UsrRecNum,
    UsrTxt;

GLOBAL BIND debugword=%O'135';          ! Kludge for debug FAL

OWN logger;                             ! Log errors if nonzero

UNDECLARE %QUOTE type;                  ! This macro breaks XPN totally

GLOBAL
    FalFna: VECTOR[CH$ALLOCATION(namesize)] VOLATILE,
    FalEsa: VECTOR[CH$ALLOCATION(namesize)] VOLATILE,
    FalRsa: VECTOR[CH$ALLOCATION(namesize)] VOLATILE,
    FalTyp: $typ() VOLATILE,
    FalNam: $nam(Rsa=CH$PTR(FalRsa), Rss=Namesize,    ! NAMe block for file
              Esa=CH$PTR(FalEsa), Ess=Namesize) VOLATILE,
    FalCfg: $xabcfg() VOLATILE ,
    Idd: $dap_descriptor VOLATILE,
    Odd: $dap_descriptor VOLATILE,
    FalFst: $rms_fst VOLATILE PRESET( [fst$h_bln] = fst$k_bln, ! Block length
                                      [fst$h_bid] = fst$k_bid, ! Block ID
                                      [fst$a_config] = FalCfg, ! Remote info
                                      [fst$a_i_dd] = idd,      ! Input Dap Desc
                                      [fst$a_o_dd] = odd ),    ! Output ..

    obuff: VECTOR[CH$ALLOCATION(dap$k_buffer_size,8)] VOLATILE,   !M541
    usrbuf: VECTOR[CH$ALLOCATION(dap$k_buffer_size,9)] VOLATILE,  !M541
    KeyBuf: VECTOR[255] VOLATILE,
    FalDat: $xabdat() VOLATILE,
    FalSum: $xabsum(Nxt=FalDat) VOLATILE,

    FalFab: $fab(fna=CH$PTR(FalFna),   ! FAB for file being accessed
              typ=FalTyp,
              nam=FalNam,
              xab=FalSum) VOLATILE,

    RabVector: BLOCKVECTOR[ 256, Rab$k_Bln ] FIELD( Rab$r_Fields ) VOLATILE, 
    RstVector: BLOCKVECTOR[ 256, Rst$k_Bln ] FIELD( Rst$r_Fields ) VOLATILE;
UNDECLARE
    Fab, Rab, Fst, Rst, Fpt, Cbd, Kdb, Adb;

GLOBAL
    Fab:  REF BLOCK %( $Fab_decl )% INITIAL( FalFab ),
    Rab:  REF BLOCK %( $Rab_decl )%,
    Fst:  REF BLOCK %( $Rms_Fst )% INITIAL( FalFst ),
    Rst:  REF BLOCK %( $Rms_Rst )%,
    Fpt:  REF BLOCK %( $Rms_Fpt )%,
    Cbd:  REF BLOCK %( $Rms_Bucket_Descriptor )%,
    Kdb:  REF BLOCK %( $Rms_Kdb )%,
    Adb:  REF BLOCK %( $Rms_Adb[8] )%;

MAP
    Fab:  REF $Fab_decl,
    Rab:  REF $Rab_decl,
    Fst:  REF $Rms_Fst,
    Rst:  REF $Rms_Rst,
    Fpt:  REF $Rms_Fpt,
    Cbd:  REF $Rms_Bucket_Descriptor,
    Kdb:  REF $Rms_Kdb,
    Adb:  REF $Rms_Adb[8];

!
! Externals
!
EXTERNAL ROUTINE
    dap$get_config,
    dap$put_config,
    dap$$get_attributes,
    dap$$put_attributes,
    dap$get_access,
    dap$get_control,
    dap$put_status,
    dap$put_ack,
    dap$$put,
    rms$signal,
    dap$get_message,
    dap$put_message,
    dap$put_string,
    dap$error_rms_dap,
    xpn$signal,
    r$message,
    dap$retry_last_operation,
    dap$get_access_complete,
    dap$get_continue;

EXTERNAL
    d_acr: $xpn_descriptor();
GLOBAL ROUTINE Fal$Do ( P_Nlb ) =
!
! Functional Description
!
!          This is the top level of the RMS File Access Listener for TOPS-20
!
! Formal Parameter:
!
!    P_NLB: Address of NLB on which we just got a connect
!
! Condition Codes:
!
!    RMS success or error code
!
!--
BEGIN
BIND Nlb=.P_Nlb: $Xpn_Nlb();        ! This is the NLB

ENABLE fal$handle( FalFab, FalFst );    ! Set up condition handler

$Xpn_Desc_Init( Descriptor=Odd, Class=Dynamic_Bounded,
                Binary_Data=(Dap$k_Buffer_Size, Obuff, Bytes) );

$Xpn_Desc_Init( Descriptor=Idd, Class=Bounded );

Fst[Fst$a_Nlb]=Nlb;                     ! Set up the NLB in the FST
Fst[Fst$a_I_dd]=Idd;                    ! Point the FST at the descriptors
Fst[Fst$a_O_dd]=Odd;                    ! ..
Idd[Dap$a_Nlb]=Nlb;                     ! and the Dap descriptors
Odd[Dap$a_Nlb]=Nlb;                     ! so the rest of the code can find it
Odd[Dap$a_Other_dd]=Idd;                ! Link the descriptors to each other
Idd[Dap$a_Other_dd]=Odd;                ! ..

DO                                      ! Loop while link remains active
    BEGIN
    Dap$Get_Config(Idd, FalCfg, falfab);        ! get a config message !m637
    IF .Idd[Dap$b_Operator] EQL Dap$k_Config    ! If we got one        !m557
    THEN
        BEGIN
        Dap$Put_Config( Odd, Dap$k_Buffer_Size ); ! send back one
        Dap$Put_Message( Odd );                   ! now
        END;

    Dap$$Get_Attributes( Idd, FalFab, FalFst ); ! process attributes
    Dap$Get_Access( Idd, FalFab, FalFst );      ! process access message

    IF .Fst[Fst$v_File_Open]                    ! If access opened a file
    THEN Dap$Get_Control( Idd );                ! Process Control Messages!m557
    END WHILE 1
END;                                    ! FAL
GLOBAL ROUTINE fal$handle (signal_args,mech_args,enable_args) =
!++
! FUNCTIONAL DESCRIPTION:
!
!       Condition handler for requests
!
! FORMAL PARAMETERS:
!
!	SIGNAL_ARGS: addr of vector of SIGNAL arguments,
!       MECH_ARGS: not used,
!       ENABLE_ARGS: args passed when this handler was established
!                    [1] Addr of FAB
!                    [2] Addr of FST
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	0: Resignal, 1: Continue
!
! SIDE EFFECTS:
!
!	Will UNWIND if severity is ERROR
!
!--

BEGIN
MAP signal_args: REF VECTOR,
    mech_args: REF VECTOR,
    enable_args: REF VECTOR;

BIND blk=..enable_args[1]: $rab_decl;          ! RMS block
BIND rab=(IF .blk[rab$h_bid] EQL rab$k_bid
          THEN blk                             ! Block was a RAB
          ELSE 0): $Rab_decl;
BIND fab=(IF .blk[rab$h_bid] EQL fab$k_bid
          THEN blk                             ! Block was a FAB
          ELSE .blk[rab$a_fab]): $fab_decl;    ! Block was a RAB
BIND rst=..enable_args[2]: $rms_rst;
BIND fst=(IF .rst[rst$h_bid] EQL fst$k_bid
          THEN rst
          ELSE .rst[rst$a_fst]): $rms_fst;
BIND nlb=.Fst[Fst$a_Nlb]: $Xpn_Nlb();

LOCAL severity;

severity= .(signal_args[1])<0,3>;

SELECT .signal_args[1] OF
       SET
       [SS$_UNWIND]:
                     BEGIN          ! Just return winningly
                     RETURN sts$k_normal;
                     END;

       [rms$k_suc_min TO rms$k_suc_max]: severity=SS$_NORMAL;

       [RMS$K_ERR_MIN TO RMS$K_ERR_MAX]:
                     severity=SS$_ERROR;

       [RMS$_EOF]:
                     IF .Rab[Rab$h_Rsz] NEQ 0   ! If we got some data
                     THEN
                         BEGIN
                         Dap$$Put (Rab, Rst, Rms$Signal);
                         END;

       [rms$k_err_min TO rms$k_err_max, rms$k_suc_min TO rms$k_suc_max]:
                     BEGIN
                     Usrsts=.signal_args[1];
                     Usrstv=.signal_args[2];

                     UsrErr ();         ! send a status message 
                     END;

       [xpn$$select_xpn_errors]:
            IF NOT .severity
            THEN
                BEGIN
                fst[fst$v_file_open]=fst[fst$v_access_active]=0;
                             ! abort means it is not open any more
                severity=sts$k_error;  ! treat as error
                Usrsts=rms$_dcb;
                Usrstv=.signal_args[1];
                END;       ! Network link broken (Abort or Disconnect)

       [Dap$k_Facility_Code TO Dap$k_Facility_Code + %O'7777777']: !a545vv
                BEGIN
                Usrsts=.signal_args[1];
                Usrstv=.signal_args[2];
                UsrErr();
                END;                                               !a545^^

       [OTHERWISE]:
            BEGIN
            Usrsts=rms$_bug;        ! should not occur
            Usrstv=.signal_args[1]; !
            severity=ss$_fatal;     !
            END;
       TES;

blk[rab$h_sts]=.Usrsts;
blk[rab$h_stv]=.Usrstv;

IF .logger NEQ 0                    ! Log error message if possible
THEN
    BEGIN
    LOCAL filedesc: $str_descriptor();
    $str_desc_init(desc=filedesc, string=asciz_str(.fab[fab$a_fna]));
    r$message(.Usrsts,.Usrstv,filedesc);
    END;


CASE .SEVERITY FROM 0 TO 7 OF
     SET
     [STS$K_ERROR]:
            BEGIN
            SETUNWIND();
            mech_args[ma_return]=.Usrsts;  ! Return status code
            RETURN 0;
            END;
     [STS$K_WARNING]:  
            BEGIN
            RETURN STS$K_NORMAL;
            END;
     [STS$K_NORMAL, STS$K_INFO]: RETURN STS$K_NORMAL;
     [STS$K_FATAL,INRANGE]: ;
     TES;

SS$_RESIGNAL
    END;			!End of FAL$HANDLE

GLOBAL ROUTINE UsrErr: ExitSub =
!++
! FUNCTIONAL DESCRIPTION:
!
!     Send Error status back to requestor
!
! IMPLICIT INPUTS:
!
!     UsrSts: STS value (RMS Status Code)
!     UsrStv: STV value (Secondary Status)
!     Rab[Rab$g_Rfa]: Record RFA number
!     UsrRecnum: Record number
!     UsrTxt: Descriptor for error text or 0
!
! COMPLETION CODE:
!
!     The RMS status code (contents of UsrSts)
!
!--
BEGIN
Dap$Put_Status( Odd,
                0, ! Maccode included in miccode
                Dap$Error_Rms_Dap( .Usrsts ),
                .Rab[Rab$g_Rfa],
                .Usrrecnum,
                .Usrstv,
                .Usrtxt );

Dap$Put_Message ( Odd );                ! Force the message out now

.UsrSts                                 ! Return the status code
END;                                    ! End of UsrErr
END ELUDOM