Google
 

Trailing-Edge - PDP-10 Archives - BB-FB49A-RM - sources/sgadnf.b36
There are no other files named sgadnf.b36 in the archive.
%title 'SNA GATEWAY ACCESS DECNET FUNCTIONS'

module SGADNF (%if %switches (TOPS10) %then ots = 'SYS:B361LB.REL', %fi
               ident = 'Version 1.0') =
begin

! Copyright (c) 1983, 1984, 1985 by
! DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts
!
! 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:
!
!	SNA Gateway Access Module
!
! ABSTRACT:
!
!
! ENVIRONMENT:
!
!	TOPS-10/20 Operating Systems, user interface.
!
!
!--
! STAR:<BRANNON.SNT.SOURCE>SGADNF.B36.2 20-Feb-85 16:34:00, Edit by BRANNON
!
!  Modified GAD$OPEN_LINK for TOPS20 to return the JFN of the network link
!  if an NSP error occurs during the opening of the link.  This was needed
!  so that a MTOPR morda function could be done to get the 3 bytes of abort
!  reason that is returned in the optional data field of the disconnect
!  message sent by the SNT (SNA Trace) server in the DECnet/SNA gateway.
!
! PVC:<X25.DEVELOPMENT>XGADNF.B36.2 26-Jun-84 15:47:00, Edit by VOBA
!
!  Add the OTS switch in the module header to get around the crock in the
!  TOPS-10 BLISS compiler. By default, the TOPS-10 BLISS is so stupid that
!  it generates the expanded file name in the .REQUEST macro which makes the
!  file name become system specific and dependent. Therefore, the library
!  cannot be moved and linked on another system which does not have the same
!  disk structure. By default, the TOPS-10 BLISS will generate an entry
!  similar to the following in the .REL file:
!
!      .REQUEST    DSKA:B361LB.REL[1,5]
!
!  That will not work on a system that does not have a disk pack called DSKA:
!  and the SYS: PPN is not [1,5]. The OTS switch will override that stupidity.
!  The following entry will be generated (similar to that done by the TOPS-20
!  BLISS):
!
!      .REQUEST    SYS:B361LB.REL
!
!  However, for those of you who come after my time, if by specifying the OTS
!  switch in the code in any way breaks the library in the future (eg. the
!  user cannot link the library with their software), don't make funny remarks
!  about me. Instead, direct your curses to Neil Faiman (BLISS Project Leader,
!  DTN 381-2017).
!
! PVC:<X25.DEVELOPMENT>XGADNF.B36.7 30-May-84 11:15:07, Edit by VOBA
!
!  Fixed routine GAD$PSI_CHANNELS.
!  Change the interrupt reason mask not to include the NS.IDR and NS.NDR
!  reasons. This may cause spurious interrupts on the DECnet channel.
!
! PVC:<X25.DEVELOPMENT>XGADNF.B36.2 16-May-84 18:47:43, Edit by VOBA
!
!  Change references to the string block length field (NS.ASL) to include
!  full word when zeroing out that field (i.e. including the byte count
!  field NS.ASC). Otherwise, the UUO call will fail with error code NSADE%.
!
!  Add switches support conditional compilation on TOPS-10 and TOPS-20.
! 
!  Change all references to JFN to be CHANNEL to make it more bland and
!  away from TOPS-20'ish.
!
!  Fix GAD$OPEN_SERVER to return more informative error codes.
!
!
! TABLE OF CONTENTS
!

!
! INCLUDE FILES
!

%if %switches (TOPS10) %then

library 'UUOSYM';			! Monitor symbols
library 'NSPUUO';                       ! NSP. UUO macros
builtin uuo;

%fi

%if %switches (TOPS20) %then

library 'MONSYM';                       ! Monitor symbols
require 'JSYS';                         ! JSYS declarations

%fi

library 'SNTDEF';                       ! SNA Gateway Access Common symbols

!
! FORWARD ROUTINE
!

forward routine                         ! Global routine definitions
    GAD$ABORT_LINK,
    GAD$ABORT_REASON,
    GAD$DISCONNECT_LINK,
    GAD$LINK_STATUS,
    GAD$NETWORK_DESCRIPTOR,
    GAD$OPEN_LINK,
    GAD$OPEN_SERVER,
    GAD$PROTOCOL_TYPE,
    GAD$PSI_CHANNELS,
    GAD$RECEIVE_DATA,
    GAD$RECEIVE_INTERRUPT,
    GAD$SEND_DATA,
    GAD$SEND_INTERRUPT;
%global_routine ('GAD$ABORT_LINK', CHANNEL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function disconnects the DECnet logical link between the Gateway
!       Access Module and the Gateway Module. Abort any output operation
!       currently being done.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         DECnet logical link's channel.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   Link was aborted successfully.
!	$FALSE  Failed to abort link.
!
! SIDE EFFECTS:
!
!	The DECnet logical link is disconnected abortively.
!
!--

    begin

    %if %switches (TOPS10) %then

    if uuo_nsfab (.CHANNEL)
    then return $TRUE
    else uuo_nsfrl (.CHANNEL);

    %fi

    %if %switches (TOPS20) %then

    return jsys_closf (.CHANNEL+cz_abt);

    %fi

    end;                                ! End of GAD$ABORT_LINK
%global_routine ('GAD$ABORT_REASON', CHANNEL, REASON) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function reads reason for aborted link
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!       REASON          Reason to be returned.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   Reason found, and returned in REASON.
!       $FALSE  Failed to find reason.
!
! SIDE EFFECTS:
!
!	Due to a bug in TOPS-10 7.02 DECnet code, the .NSFRD function does
!       not return single-byte user reject data correctly. Therefore, this
!       procedure uses the .NSFRI function instead. The .NSFRI function is
!       not intended for this purpose, but apparently it works equally well
!       with a lot of pointers to be set up prior to the NSP. call.
!
!       The macros V702 and V703 are defined to correspond with the version
!       of TOPS-10 that the software is compiled to run under. Their values
!       should be defined appropriately for future release.
!--

    begin

    macro
        V702 = 1 %,                     ! Update these macros for
        V703 = 0 %;                     !  appropriate releases

    %if %switches (TOPS10) %then

    local
        %if V702 %then BUFFER: CONNECT_BLOCK %fi
        %if V703 %then BUFFER: STRING_BLOCK (5) %fi;

    %if V702 %then

    bind
        DSTMP = BUFFER[NSCSDB]: ref DESCRIPTOR_BLOCK,
        STTMP = BUFFER[NSCUSB]: ref STRING_BLOCK (11),
        UDBLK = BUFFER[NSCUDB]: ref STRING_BLOCK (5);

    %fi

    %fi

    %if %switches (TOPS20) %then

    local
        BUFFER,
        POINTER,
        LENGTH;

    %fi

    local
        TEMP;

    %if %switches (TOPS10) %then

    %if V702 %then

    BUFFER[NSCNL] = 8;                  ! Connect block length
    BUFFER[NSCXX] = 0;                  ! Unused
    BUFFER[NSCSD] =                     ! Source/Destination descriptor blocks
    BUFFER[NSCDD] = DSTMP;
    BUFFER[NSCND] =                     ! Node name block
    BUFFER[NSCUS] =                     ! User id block
    BUFFER[NSCPW] =                     ! Password block
    BUFFER[NSCAC] = STTMP;              ! Account block
    BUFFER[NSCUD] = BUFFER[NSCUDB];     ! User data block

    UDBLK[NSAS0] = (16^18) + 5;         ! User data block maximum length
    DSTMP[NSDFL] =                      ! Temporary blocks with length 0
    STTMP[NSAS0] = 0;

    if (TEMP = (uuo_nsfri (.CHANNEL, 0, BUFFER) and (.UDBLK[NSASC] gtr 0)))
    then .REASON = ch$rchar (ch$ptr (UDBLK[NSAST],,8));

    %fi

    %if V703 %then

    BUFFER[NSAS0] = (16^18) + 5;        ! String block maximum length
    if (TEMP = (uuo_nsfrd (.CHANNEL, 0, BUFFER) and (.BUFFER[NSASC] gtr 0)))
    then .REASON = ch$rchar (ch$ptr (BUFFER[NSAST],,8));

    %fi

    %fi

    %if %switches (TOPS20) %then

    POINTER = ch$ptr (BUFFER,,8);       ! Read reason for aborting link
    jsys_mtopr (.CHANNEL, $morda, .POINTER; ,,, LENGTH);

    if (TEMP = (.LENGTH gtr 0))
    then .REASON = ch$rchar (.POINTER); ! Return reason code

    %fi

    ! Close link and release logical link channel

    GAD$ABORT_LINK (.CHANNEL);

    return .TEMP;
    end;                                ! End of GAD$ABORT_REASON
%global_routine ('GAD$DISCONNECT_LINK', CHANNEL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function disconnects the DECnet logical link between the Gateway
!       Access Module and the Gateway Module normally.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   Link was disconnected successfully.
!	$FALSE  Failed to disconnect link.
!
! SIDE EFFECTS:
!
!	The DECnet logical link is disconnected normally.
!
!--

    begin

    %if %switches (TOPS10) %then

    if uuo_nsfsd (.CHANNEL)
    then return $TRUE
    else if uuo_nsfrl (.CHANNEL)
         then return $TRUE;
    return $FALSE;

    %fi

    %if %switches (TOPS20) %then

    return jsys_closf (.CHANNEL);
    
    %fi

    end;                                ! End of GAD$DISCONNECT_LINK
%global_routine ('GAD$LINK_STATUS', CHANNEL, STATUS) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function gets the current status of the logical link.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!       STATUS          Address of the status word which content is to be
!                       returned.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   Obtained the status of the link successfully.
!       $FALSE  The status of the link is abnormal, the calling party should
!               check for error code in the right half of the status word.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    %if %switches (TOPS10) %then

    return uuo_nsfrs (.CHANNEL, .STATUS);

    %fi

    %if %switches (TOPS20) %then

    jsys_mtopr (.CHANNEL, $morls; ,, .STATUS);
    return (.(.STATUS)<0,18> eql 0);

    %fi

    end;                                ! End of GAD$LINK_STATUS
%global_routine ('GAD$NETWORK_DESCRIPTOR', CONNECT, NODE, OBJECT) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function to build the network file descriptor, using information
!       supplied by the user.
!
! FORMAL PARAMETERS:
!
!	CONNECT         TOPS-10:    Address of the buffer where the
!                                   Connect block is to be returned.
!                       TOPS-20:    String pointer to the buffer where
!                                   the network file descriptor is to be
!                                   returned.
!
!       NODE            User supplied Gateway node name.
!
!       OBJECT          Pointer to character string of format "-nn" where
!                       nn is the object number to use in Network File
!                       Descriptor.
!
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	Network File Descriptor is built and returned in the given buffer.
!
! ROUTINE VALUE:
!
!	$TRUE   The network file descriptor was built successfully.
!       -1      Failed. Unable to obtain gateway node name.
!
! SIDE EFFECTS:
!
!	none
!
!--

    %if %switches (TOPS10) %then
    begin


    map                                 ! Set up the connect block fields
        CONNECT: ref CONNECT_BLOCK;

    bind
        NDBLK = CONNECT[NSCNDB]: STRING_BLOCK (3),
        SDBLK = CONNECT[NSCSDB]: DESCRIPTOR_BLOCK,
        SNBLK = SDBLK[NSDPB]: STRING_BLOCK (6),
        DDBLK = CONNECT[NSCDDB]: DESCRIPTOR_BLOCK,
        PWBLK = CONNECT[NSCPWB]: STRING_BLOCK (11),
        UDBLK = CONNECT[NSCUDB]: STRING_BLOCK (5);


    local
        RESULT,
        LENGTH,
        POINTER;

    ! Set up the connect block buffer

    CONNECT[NSCNL] = 8;                 ! Connect block length
    CONNECT[NSCND] = CONNECT[NSCNDB];   ! Node name block
    CONNECT[NSCSD] = CONNECT[NSCSDB];   ! Source descriptor block
    CONNECT[NSCDD] = CONNECT[NSCDDB];   ! Destination descriptor block
    CONNECT[NSCPW] = CONNECT[NSCPWB];   ! Password block
    CONNECT[NSCUD] = CONNECT[NSCUDB];   ! User data block
    CONNECT[NSCXX] =                    ! Unused and should be set to 0
    CONNECT[NSCUS] =                    ! User id block
    CONNECT[NSCAC] = 0;                 ! Account block

    NDBLK[NSAS0] = (.LENGTH^18) + 3;    ! Node name length
    ch$move (.LENGTH, .NICE, ch$ptr (NDBLK[NSAST],,8));

    ! X.25 Gateway target task number

    SDBLK[NSDFL] = 5;                   ! Set up the source block
    SDBLK[NSDFM] = 1;                   ! Format 1 (user program name only)
    SDBLK[NSDOB] = 0;                   ! Object type 0
    SDBLK[NSDPP] = 0;                   ! No PPN
    SDBLK[NSDPN] = SDBLK[NSDPB];        ! Task name string
    SNBLK[NSAS0] = (4^18) + 2;          ! Task name string length
    ch$move (4, CH$ASCIZ ('USER'), ch$ptr (SNBLK[NSAST],,8));

    DDBLK[NSDFL] = 3;                   ! Set up the destination block
    DDBLK[NSDFM] = 0;                   ! Format 0
    DDBLK[NSDOB] = 31;                  ! Gateway Software Object number

    ! Version number

    UDBLK[NSAS0] = (3^18) + 2;          ! User data length
    POINTER = ch$ptr (UDBLK[NSAST],,8);
    ch$wchar_a (XV$VER, POINTER);       ! Version number
    ch$wchar_a (XV$ECO, POINTER);       ! ECO number
    ch$wchar_a (XV$UEC, POINTER);       ! User ECO number

    ! Password

    if (.PASSWORD neq 0)
    and (LENGTH = CH$LEN (.PASSWORD)) gtr 0
    then begin                          ! User supplies network access code

         PWBLK[NSAS0] = (.LENGTH^18) + 9; ! Password string length
         ch$move (.LENGTH, .PASSWORD, ch$ptr (PWBLK[NSAST],,8));
         end;

    return $TRUE;
    end;                                ! End of GAD$NETWORK_DESCRIPTOR

 %fi

%if %switches (TOPS20) %then

begin

    local
        RESULT,
        LENGTH,
        SNA_GATEWAY,
        POINTER;

    POINTER = .CONNECT;
    SNA_GATEWAY = ch$ptr (uplit ('SNAGAT'));

     begin                          ! Build DECnet DCN: file specification
     CH$MOVSTRING (POINTER, 'DCN:');

     if .NODE eql 0 
     then begin

          local 
                LEN,
                PTR,
                BUF: block [2];

          PTR = ch$ptr (BUF);

          ! Translate SNAGAT=SNA Node Name
          if not (jsys_lnmst ($lnsjb, .SNA_GATEWAY, .PTR)) 
          then begin
               if not (jsys_lnmst ($lnssy, .SNA_GATEWAY, .PTR)) then return -1;
               end;

          LEN = CH$LEN (.PTR);
          POINTER = ch$move (.LEN, .PTR, .POINTER);
          end

     else begin
          CH$MOVSTRING (POINTER, .NODE);
          end;
     end;

    ! SNA Gateway target task number

    CH$MOVZSTRING (POINTER, .OBJECT);   ! Terminate with null

    return $TRUE;
    end;                                ! End of GAD$NETWORK_DESCRIPTOR

%fi
%global_routine ('GAD$OPEN_LINK', CONNECT, CHANNEL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function to establish a DECnet logical link between the Gateway
!       Access Module and the Gateway node.
!
! FORMAL PARAMETERS:
!
!	CONNECT         The Network File Description to be used to open the
!                       network connection.
!       CHANNEL         The address where the channel of the DECnet logical
!                       link is to be returned, if the link is established
!                       successfully.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The DECnet link was established successfully.
!               The channel number is returned.
!	$FALSE  Failed to establish a network connection.
!               Reason: Connect failed after successive retries
!       -1      Failed to establish a network connection.
!               Reason: System error code returned in CHANNEL
!       -2      Failed to establish a network connection.
!               Reason: NSP error code returned in CHANNEL
!
! SIDE EFFECTS:
!
!	A DECnet Logical Link is established between the local host and the
!       Gateway node.
!
!--

    begin

    local
	NEW_CHANNEL;

    %if %switches (TOPS10) %then

    if not uuo_nsfea (NEW_CHANNEL, 0, .CONNECT)
    then GAD$ABORT_LINK (.NEW_CHANNEL)  ! Failed to enter active state, abort
    else begin
         register AC;

         decr I from 10 to 1
         do begin                       ! Counting down while waiting
            local STATUS;

            GAD$LINK_STATUS (.NEW_CHANNEL, STATUS); ! Get link status

            selectone .STATUS<$(ns$sta)> of
                set
                [$nssrn]:               ! Running
                    begin
                    .CHANNEL = .NEW_CHANNEL;

                    return $TRUE        ! Done
                    end;

                [$nssrj]:               ! Reject
                    begin
                    local REASON;

                    if GAD$ABORT_REASON (.NEW_CHANNEL, REASON)
                    then return (-.REASON)
                    else return $FALSE;
                    end;

                [$nssdr,                ! Disconnect Received
                 $nssnr,                ! No Resources
                 $nsscf,                ! No Confidence
                 $nsslk,                ! No Link
                 $nsscm]:               ! No Communication
                    return $FALSE;
                tes;

            AC = 2;                     ! Sleep for 2 seconds
            uuo (0, sleep (AC));
            end;
         end;

    %fi

    %if %switches (TOPS20) %then

    if jsys_gtjfn (gj_sht, .CONNECT; NEW_CHANNEL)
    then begin                          ! Got logical link successfully
         local STATUS;
         if not jsys_openf (.NEW_CHANNEL, of_rd+of_wr+$$(8,of_bsz); STATUS)
         then begin                     ! But OPENF failed
              .CHANNEL = .STATUS;
              jsys_rljfn (.NEW_CHANNEL);
              return (-1);
              end
         else begin                     ! Open for READ/WRITE 8-bit
              decr I from 10 to 1
              do begin                  ! Check link status
                 local
                 SAV_CHANNEL;

                 SAV_CHANNEL = .NEW_CHANNEL;
                 GAD$LINK_STATUS (.NEW_CHANNEL, STATUS);

                 if .STATUS<$(mo_con)>  ! Return if the link is connected
                 then begin
                      .CHANNEL = .NEW_CHANNEL;
                      return $TRUE;
                      end;

                 if .STATUS<$(mo_syn)>  ! If link was aborted, find out why
                 or .STATUS<$(mo_abt)>
                 then begin
                      .CHANNEL = .STATUS<0,18>;  ! NSP error code
                      (.CHANNEL)<18,18> = .SAV_CHANNEL;
                                        ! JFN so we can find out
                      return (-2);      ! the abort reason
                      end;
                 jsys_disms (2000);     ! Idle for 2 seconds before tries
                 end;

              jsys_closf (.NEW_CHANNEL+cz_abt);
              end;
         end
    else begin                          ! Failed to get CHANNEL
         .CHANNEL = .NEW_CHANNEL;       ! Error code
         return (-1);
         end;

    %fi

    return $FALSE;
    end;                                ! End of GAD$OPEN_LINK
%global_routine ('GAD$OPEN_SERVER', OBJECT, CHANNEL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function to establish a DECnet server task waiting for
!       incoming connect from the Gateway node.
!
! FORMAL PARAMETERS:
!
!	OBJECT          Pointer to the object name or numeric ASCIZ string.
!       CHANNEL         The address where the channel to the DECnet server
!                       task is to be returned, if the task is established
!                       successfully.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The DECnet server task was established successfully.
!               The channel is returned.
!	$FALSE  Failed to establish a network connection.
!               Reason: Insufficient access resources.
!       -1      Failed to establish a network connection.
!               Reason: Illegal object id.
!
! SIDE EFFECTS:
!
!       none
!
!--

    begin

    local
        %if %switches (TOPS10) %then CONNECT: CONNECT_BLOCK, %fi
        %if %switches (TOPS20) %then CONNECT: CH$SEQUENCE (128), %fi
        NUMERIC,
        POINTER,
        LENGTH,
	NEW_CHANNEL;

    %if %switches (TOPS10) %then

    bind
        SDBLK = CONNECT[NSCSDB]: DESCRIPTOR_BLOCK,
        DDBLK = CONNECT[NSCDDB]: DESCRIPTOR_BLOCK,
        DNBLK = DDBLK[NSDPB]: STRING_BLOCK (6);

    %fi

    if (LENGTH = CH$LEN (.OBJECT)) leq 0
    then return (-1);                   ! Get object string length

    NUMERIC = ch$rchar (.OBJECT);       ! Get first character of object string
    selectone .NUMERIC of
        set
        [%C'0' to %C'9']:               ! Object number
            NUMERIC = $TRUE;

        [%C'a' to %C'z',                ! Object name
         %C'A' to %C'Z']:
            NUMERIC = $FALSE;

        [otherwise]:                    ! Illegal object id
            return (-1);
        tes;

    %if %switches (TOPS10) %then

    ! Parse Object Identification string

    if .NUMERIC
    then begin                          ! Object number
         local DIGIT, VALUE;

         VALUE = 0;                     ! Reset object number
         POINTER = .OBJECT;             ! Set pointer to the numeric string

         decr I from 3 to 1
         do begin                       ! Process up to 3rd digit only
            if (DIGIT = ch$rchar_a (POINTER)) eql 0
            then exitloop;              ! At the end of ASCIZ string

            if not (selectone .DIGIT of
                        set
                        [%C'0' to %C'9']: $TRUE;
                        [otherwise]: $FALSE;
                        tes)
            then return (-1);           ! Illegal object number digit

            VALUE = (.VALUE * 10) + (.DIGIT - %C'0');
            end;

         if (.DIGIT neq 0)              ! Third digit is non-zero
         and (ch$rchar (.POINTER)) neq 0
         then return (-1);              ! Object number is too big

         DDBLK[NSDFL] = 3;              ! Destination descriptor block length
         DDBLK[NSDFM] = 0;              ! Format 0
         DDBLK[NSDOB] = .VALUE;         ! Object number
         end
    else begin                          ! Object name
         DDBLK[NSDFL] = 5;              ! Destination descriptor block length
         DDBLK[NSDFM] = 1;              ! Format 1 (user task name)
         DDBLK[NSDOB] = 0;              ! Object number 0
         DDBLK[NSDPP] = 0;              ! No PPN
         DDBLK[NSDPN] = DDBLK[NSDPB];   ! Task name string block
         DNBLK[NSAS0] = (.LENGTH^18) + 5; ! Task name string length
         ch$move (.LENGTH, .OBJECT, ch$ptr (DNBLK[NSAST],,8));
         end;

    ! Build Enter Passive DECnet Connect block

    CONNECT[NSCNL] = 4;                 ! Connect block length
    CONNECT[NSCSD] = CONNECT[NSCSDB];   ! Source descriptor block
    CONNECT[NSCDD] = CONNECT[NSCDDB];   ! Destination descriptor block
    CONNECT[NSCXX] =                    ! Unused and should be set to 0
    CONNECT[NSCND] = 0;                 ! Node name block

    SDBLK[NSDFL] = 3;                   ! Source descriptor block length
    SDBLK[NSDFM] = 0;                   ! Format 0
    SDBLK[NSDOB] = 31;                  ! Gateway software Object number

    if not uuo_nsfep (NEW_CHANNEL, 0, CONNECT)
    then GAD$ABORT_LINK (.NEW_CHANNEL)  ! Failed
    else begin                          ! Entered passive successfully
         .CHANNEL = .NEW_CHANNEL;
         return $TRUE;
         end;

    %fi

    %if %switches (TOPS20) %then

    ! Build DECnet SRV: file description string

    POINTER = ch$move (4, CH$ASCIZ ('SRV:'), ch$ptr (CONNECT));
    if not .NUMERIC
    then ch$wchar_a (%C'.', POINTER);
    POINTER = ch$move (.LENGTH, .OBJECT, .POINTER);
    ch$wchar (0, .POINTER);             ! Make ASCIZ

    if jsys_gtjfn (gj_sht, ch$ptr (CONNECT); NEW_CHANNEL)
    then begin                          ! Got logical link successfully
         if jsys_openf (.NEW_CHANNEL, of_rd+of_wr+$$(8,of_bsz))
         then begin                     ! Open for READ/WRITE 8-bit
              .CHANNEL = .NEW_CHANNEL;  ! Return new channel
              return $TRUE;
              end;

         jsys_rljfn (.NEW_CHANNEL);     ! Release channel
         end;

    %fi

    return $FALSE;
    end;                                ! End of GAD$OPEN_SERVER
%global_routine ('GAD$PROTOCOL_TYPE', CHANNEL, TYPE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function determines the type of the message incoming from the logical
!       link by examining the first byte of the record.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!       TYPE            Address of the word where the message type is to be
!                       returned.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The first byte was read successfully.
!       $FALSE  Failed to read the first byte or the link is empty.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    local
	BUFFER,
        POINTER,
	LENGTH;

    %if %switches (TOPS10) %then

    POINTER = ch$ptr (BUFFER,,8);
    if uuo_nsfdr (.CHANNEL, 0, 1, .POINTER)
    then begin                          ! Read one byte from the link
         .TYPE = ch$rchar (.POINTER);
         return $TRUE;
         end;

    %fi

    %if %switches (TOPS20) %then

    if jsys_sibe (.CHANNEL; , LENGTH)   ! Check if logical link buffer is empty
    then return $FALSE;                 ! return if buffer is indeed empty

    if .LENGTH eql 0                    ! Return if number of bytes remaining
    then return $FALSE;                 ! in logical link buffer is 0

    ! Read exactly 1 byte from the logical link

    POINTER = ch$ptr (BUFFER,,8);
    if jsys_sin (.CHANNEL, .POINTER, -1)
    then begin
         .TYPE = ch$rchar (.POINTER);
         return $TRUE;
         end;

    %fi

    return $FALSE;
    end;
%global_routine ('GAD$PSI_CHANNELS', CHANNEL, NUMBER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!       TOPS-10
!
!       Function allows a network task to enable software interrupt
!       channels for all of the DECnet events.
!
!       TOPS-20
!
!	Function allows a network task to enable software interrupt
!       channels for the following work types:
!
!	    . Connect event pending
!           . Interrupt message available
!           . Data available
!
!       TOPS-10 & TOPS-20
!
!	If the channel has a negative value, no channel will be enabled.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!	NUMBER          The software interrupt channel to be enabled.
!                       If value is negative, none will be enabled.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The requested channel was enabled successfully.
!	$FALSE  Failed to enable the requested channel.
!
! COMPLETION CODES:
!
!	none
!
! SIDE EFFECTS:
!
!	The requested software interrupt channel is enabled for the above 3
!       types of event.
!
!--

    begin

    local
        EVENT;

    if .NUMBER lss 0                    ! Return if interrupt channel
    then return $TRUE;                  ! is not selected

    %if %switches (TOPS10) %then

    ! Enable interrupts for all DECnet link states and available
    ! received normal and interrupt data. Disable interrupts when
    ! link is ready to send data

    uuo_nsfpi (.CHANNEL, 0, %O'537777');

    %fi

    %if %switches (TOPS20) %then

    EVENT<$(mo_cdn)> = .NUMBER;         ! Connect event pending
    EVENT<$(mo_ina)> = .NUMBER;         ! Interrupt message available
    EVENT<$(mo_dav)> = .NUMBER;         ! Data available

    return jsys_mtopr (.CHANNEL, $moacn, .EVENT);

    %fi

    end;                                ! End of GAD$PSI_CHANNELS
%global_routine ('GAD$RECEIVE_DATA', CHANNEL, COUNT, POINTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function reads incoming data from the link.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!	COUNT           Address of the data buffer size, contains the maximum
!                       size that the buffer can receive data.  The returned
!                       value reflects the actual size of the received buffer.
!	POINTER         String pointer (8-bit) to the receiving buffer.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	One record of data is read and returned in the buffer pointed to
!       by POINTER.
!
! ROUTINE VALUE:
!
!	$TRUE   One record was read successfully from the logical link.
!               Actual size of the received buffer is returned in COUNT.
!	$FALSE  Failed to read or link data buffer is empty.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    local
        SIZE;

    %if %switches (TOPS10) %then

    if uuo_nsfdr (.CHANNEL, ns$wai, ..COUNT, .POINTER, SIZE)
    then begin                          ! Read data from the link
         .COUNT = ..COUNT - .SIZE;
         return $TRUE;
         end;

    %fi

    %if %switches (TOPS20) %then

    if jsys_sibe (.CHANNEL; , SIZE)     ! Check if logical link buffer is empty
    then return $FALSE;                 ! Return error if it is indeed empty

    if .SIZE eql 0                      ! Return if number of bytes remaining
    then return $FALSE;                 ! in the logical link buffer is 0

    ! Read in one record

    if jsys_sinr (.CHANNEL, .POINTER, -..COUNT; ,, SIZE)
    then begin
         .COUNT = ..COUNT + .SIZE;
         return $TRUE;
         end;

    %fi

    return $FALSE;
    end;                                ! End of GAD$RECEIVE_DATA
%global_routine ('GAD$RECEIVE_INTERRUPT', CHANNEL, COUNT, POINTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function reads interrupt data incoming on interrupt channel of
!       the logical link.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!	COUNT           The address of the buffer size where the actual
!                       size of the received buffer is to be returned.
!	POINTER         String pointer (8-bit) to the buffer where interrupt
!                       data is to be returned.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	Interrupt data is read and returned in the given buffer.
!
! ROUTINE VALUE:
!
!	$TRUE   Interrupt data is read from the link successfully.
!	$FALSE  Failed to read or interrupt data buffer is empty.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    %if %switches (TOPS10) %then

    local
        BUFFER: STRING_BLOCK (5);

    BUFFER[NSAS0] = (16^18) + 5;        ! Data buffer length
    if not uuo_nsfir (.CHANNEL, ns$wai, BUFFER)
    then .COUNT = 0                     ! No interrupt data received
    else begin
         .COUNT = .BUFFER[NSASC];       ! Return actual byte count
         ch$move (.BUFFER[NSASC], ch$ptr (BUFFER[NSAST],,8), .POINTER);
         return $TRUE;
         end;

    %fi

    %if %switches (TOPS20) %then

    local
        LENGTH;

    if not jsys_mtopr (.CHANNEL, $morim, .POINTER; ,,, LENGTH)
    then .COUNT = 0
    else begin
         .COUNT = .LENGTH;
         return $TRUE;
         end;

    %fi

    return $FALSE;
    end;                                ! End of GAD$RECEIVE_INTERRUPT
%global_routine ('GAD$SEND_DATA', CHANNEL, POINTER, COUNT) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function sends data to the logical link.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!	POINTER         String pointer (8-bit) to the data buffer to be sent.
!       COUNT           Size of the given buffer.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The data buffer was sent successfully.
!       $FALSE  Failed to send the buffer.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    return  %if %switches (TOPS10) %then 
            uuo_nsfds (.CHANNEL, ns$eom or ns$wai, .COUNT, .POINTER); %fi

            %if %switches (TOPS20) %then 
            jsys_soutr (.CHANNEL, .POINTER, -.COUNT); %fi

    end;                                ! End of GAD$SEND_DATA
%global_routine ('GAD$SEND_INTERRUPT', CHANNEL, POINTER, COUNT) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Function sends interrupt data to the logical link interrupt channel.
!
! FORMAL PARAMETERS:
!
!	CHANNEL         The DECnet logical link's channel.
!       POINTER         String pointer (8-bit) to the data buffer to be sent.
!       COUNT           Size of the data buffer.
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE:
!
!	$TRUE   The interrupt data was sent successfully.
!       $FALSE  Failed to send data to link.
!
! SIDE EFFECTS:
!
!	none
!
!--

    begin

    %if %switches (TOPS10) %then

    local
        BUFFER: STRING_BLOCK (5);

    BUFFER[NSAS0] = (.COUNT^18) + 5;    ! Data buffer length
    ch$move (.COUNT, .POINTER, ch$ptr (BUFFER[NSAST],,8));
    uuo_nsfis (.CHANNEL, ns$wai, BUFFER);

    %fi

    %if %switches (TOPS20) %then

    return jsys_mtopr (.CHANNEL, $mosim, .POINTER, .COUNT);

    %fi

    end;                                ! End of GAD$SEND_INTERRUPT
end                                   ! End of Module XGADNF
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: