%(
	****************************************************************

		Copyright (c) 1992, Carnegie Mellon University

		All Rights Reserved

	Permission  is  hereby  granted   to  use,  copy,  modify,  and
	distribute  this software  provided  that the  above  copyright
	notice appears in  all copies and that  any distribution be for
	noncommercial purposes.

	Carnegie Mellon University disclaims all warranties with regard
	to this software.  In no event shall Carnegie Mellon University
	be liable for  any special, indirect,  or consequential damages
	or any damages whatsoever  resulting from loss of use, data, or
	profits  arising  out of  or in  connection  with  the  use  or
	performance of this software.

	****************************************************************
)%
MODULE DECnet_DRIVER(
		IDENT='3.0',
		LANGUAGE(BLISS32),
		ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				 NONEXTERNAL=LONG_RELATIVE),
		LIST(NOREQUIRE,ASSEMBLY,OBJECT,BINARY),
		OPTIMIZE,
		OPTLEVEL=3,
		ZIP) =


BEGIN
LIBRARY 'SYS$LIBRARY:LIB';			! VMS system defintions
LIBRARY 'CMUIP_SRC:[CENTRAL]NETCOMMON';	! CMU-OpenVMS/IP common definitions
LIBRARY 'CMUIP_SRC:[CENTRAL]NETDEVICES';	! CMU-OpenVMS/IP IP transport defs
LIBRARY 'CMUIP_SRC:[CENTRAL]NETCONFIG';	! CMU-OpenVMS/IP config defs
LIBRARY 'CMUIP_SRC:[CENTRAL]NETTCPIP';		! CMU-OpenVMS/IP TCP/IP defs
LIBRARY 'DNDRV';				! DECNet specific definitions

EXTERNAL ROUTINE
	LIB$ASN_WTH_MBX		: ADDRESSING_MODE (GENERAL),
	LIB$SUBX		: ADDRESSING_MODE (GENERAL),
	LIB$EDIV		: ADDRESSING_MODE (GENERAL),
	STR$APPEND		: BLISS ADDRESSING_MODE (GENERAL),
	STR$COMPARE		: BLISS ADDRESSING_MODE (GENERAL),
	STR$CONCAT		: BLISS ADDRESSING_MODE (GENERAL),
	STR$COPY_DX		: BLISS ADDRESSING_MODE (GENERAL);



!EXTERNAL LITERAL
!    NFB$C_DECLNAME;		!Defined in DNDRV_TRANS.MAR


%(
{***************************************************************************}
{									    }
{ Only one copy needs to be kept of the following data for the whole driver }
{									    }
)%

EXTERNAL
    ! The IPACP_Interface tells us all about the IPACP.  It gives us
    ! entry points, literals and global pointers.  See NETDEVICES.REQ
    ! for a complete explaination of this structure.
    ! Note: This pointer must be named "IPACP_Interface"
    IPACP_Interface : REF IPACP_Info_Structure;


GLOBAL
    DNI_List,
    dev_desc		: VECTOR[2],
    decnet_object	: $BBLOCK[DSC$K_Z_BLN],

    listener_started,
    listener_mbx_chan,
    listener_net_chan,
    listener_mbx_message: mbx_message_structure, 
    listener_mbx_iosb	: NetIO_Status_Block;

!{***************************************************************************}

FORWARD ROUTINE
    timer_ast : NOVALUE,
    read_ast : NOVALUE,
    mbx_ast : NOVALUE,
    listener_mbx_ast : NOVALUE;

%(
{***************************************************************************}
{									    }
{ Start timeout before disconnecting virtual link to remote node	    }
{ A unique number must be assigned to each timeout request; the number must }
{ not interfere with any assigned to timers started elsewhere in the whole  }
{ package.								    }
{									    }
)%

ROUTINE start_timer ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	Status,
	ID;

!!!HACK!!! We have to decide on a way to define timeouts before enabling this
	Return;
%(
    ID = .DN_Int;
    Status = $SETIMR (
	    DAYTIM = DN_Int [ DNI$Timeout ]
	    ASTADR = Timer_AST,
	    REQIDT = .ID );
    IF NOT .Status THEN
    DRV$FATAL_FAO('!%T error starting DECnet timer, status is %X!XL!/',
		   0,.Status);
)%
    END;


ROUTINE stop_timer ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	Status,
	ID;

!!!HACK!!! We have to decide on a way to define timeouts before enabling this
	Return;
%(
    ID = .DN_Int;
    Status = $CANTIM ( REQIDT = .ID );
    IF NOT .Status THEN
	    DRV$FATAL_FAO('!%T error stopping DECnet timer, status is %X!XL!/',
			   0,Status);
)%
    END;

!{****************************************************************************}


ROUTINE swap_bytes ( i : UNSIGNED WORD ) =
    BEGIN
    (.i<0,8,0> * 256) + .i<8,8,0>
    END;
    
ROUTINE dump_ip ( buff : REF IP_Structure , buff_size ) : NOVALUE =
    BEGIN
    LOCAL
	i_src : REF VECTOR [ 4 , BYTE ],
	i_dest : REF VECTOR [ 4 , BYTE ],
	i_paclen,
	i_id,
	i_fragoff,
	i_cksum;

    i_paclen  = swap_bytes( .buff [ IPH$IHL ]);
    i_id      = swap_bytes( .buff [ IPH$Ident ]);
    i_fragoff = swap_bytes( .buff [ IPH$Fragment_offset ]);
    i_cksum   = swap_bytes( .buff [ IPH$Checksum ]);
    i_src     = buff [ IPH$Source ];
    i_dest    = buff [ IPH$Dest ];

    DRV$LOG_FAO(' Vers: !UB Len: !UB SvcTyp: !UB PacLen: !UW ID: !UW!/',
	    .buff[IPH$Version], .buff[IPH$Swap_IHL],
	    .buff[IPH$Type_service], .i_paclen, .i_id);	    
    DRV$LOG_FAO(' FragOff: !UW Tim2Liv: !UB Proto: !UB Cksum: !UW!/',
	    .i_fragoff, .buff[IPH$TTL],
	    .buff[IPH$Protocol], .i_cksum);
    DRV$LOG_FAO(' Src: !UB.!UB.!UB.!UB Dest: !UB.!UB.!UB.!UB!/',
	    .i_src [1],.i_src [2],.i_src [3],.i_src [4],
	    .i_dest[1],.i_dest[2],.i_dest[3],.i_dest[4]);

    END;
    
%(
{***************************************************************************}
{									    }
{ Note that MBX_MESSAGE must be declared 'VAR' so that we are working with  }
{ the original and not a copy.						    }
{									    }
)%

ROUTINE unpack_ncb ( mbx_message , upncb ) : NOVALUE =
    BEGIN
    MAP
	mbx_message : REF mbx_message_structure,
	upncb : REF unpacked_ncb_structure;
    BIND
	uncb_node_name = upncb [ uncb$node ] : $BBLOCK[8],
	data = mbx_message [mbxm$data] : VECTOR [ ,BYTE ];
    LOCAL
	node_desc : VECTOR [2],
	nlen : INITIAL (0),
	CS,c,
	ncb_adr,
	ncb_len;

    ncb_len = .data[0];
    ncb_adr = data[.ncb_len + 2];
    ncb_len = .data[.ncb_len + 1]; 

    upncb [ uncb$len ]  = .ncb_len;
    upncb [ uncb$adr ]  = .ncb_adr;

    cs = .ncb_adr;
    INCR J FROM 0 TO .ncb_len-1 DO
	BEGIN
	c = CH$RCHAR_A ( cs );
	nlen = .J;
	IF (.c LSS %c'0') OR
	  ((.c GTR %c'9') AND (.c LSS %c'A')) OR
	   (.c GTR %c'Z') THEN
	   EXITLOOP
	END;

    node_desc [0] = .nlen;
    node_desc [1] = .ncb_adr;
    $INIT_DYNDESC(uncb_node_name);
    STR$COPY_DX(uncb_node_name,node_desc);

    END;

!{***************************************************************************}

ROUTINE dump_mbx_message ( mbx_message , upncb ) : NOVALUE =
    BEGIN
    MAP
	mbx_message : REF mbx_message_structure,
	upncb	: REF unpacked_ncb_structure;
    BIND
	data = mbx_message [mbxm$data] : VECTOR [ 256, BYTE ];
    LOCAL
	desc : VECTOR [2];

    desc[0] = .data[1];
    desc[1] = data[2];
    DRV$Log_FAO ('!%T    message type is !UW!/',0, .mbx_message[mbxm$msgtype]);
    DRV$Log_FAO ('!%T    device to which message applies is !AS!UW!/',
				  0,desc,mbx_message [ mbxm$unit ]);
    IF .mbx_message [mbxm$msgtype] EQL msg$_connect THEN
	BEGIN
	DRV$Log_FAO ('  NCB size is !UL!/', .upncb[uncb$len]);
	DRV$Log_FAO ('  node is "!AS"!/', upncb[uncb$node]);
	END;
    END;
    
!{**************************************************************************}

ROUTINE drop_link ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	Status;

    Status = $DASSGN ( CHAN = .DN_Int[DNI$net_chan]);
    IF NOT .Status THEN
	DRV$error_fao ('!%T Error dropping DECnet link with node !AS, device !AS, status = %X!XL!/', 
		0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc], .Status)
    ELSE
	BEGIN
	DRV$log_fao(
	  '!%T Successful dropping of DECnet link with node !AS, device !AS!/',
	   0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
	IF .DN_Int[DNI$mbx_chan] NEQ 0 THEN
	    $DASSGN(CHAN = .DN_Int[DNI$mbx_chan]);
	DN_Int[DNI$DN_connected] = 0;
	stop_timer ( .DN_Int )
	END;
    END;
    
%(
{***************************************************************************}
{									    }
{ Connection timeout has occured - simply drop the link			    }
{ Any messages caught at the time will be sorted out by the higher level    }
{ protocols.								    }
{									    }
)%

ROUTINE timer_ast ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
	
    DRV$log_fao('!%T connection timeout for DECnet device !AS!/', 0, DN_Int[DNI$NCB_desc]);
    IF .DN_Int[DNI$DN_Connected] THEN
	drop_link(.DN_Int);
    END;

%(
{***************************************************************************}
{									    }
{ This procedures starts a new read on this DECnet link			    }
{									    }
{ This procedure is executed within an AST - so be careful not to use any   }
{ data structures that could be in use at the time.			    }
{									    }
)%

ROUTINE start_data_read ( DN_Int : REF DN_Interface_Structure ) =
    BEGIN
    LOCAL
	Status;

	!{								    }
	!{ Allocate a receive buffer IF we don't have one		    }
	!{								    }
	IF .DN_Int[DNI$receive_addr] EQL 0 THEN
	    DN_Int[DNI$receive_addr] = DRV$seg_get(DRV$max_physical_bufsize);

    Status = $QIO (
		chan   = .DN_Int[DNI$net_chan],
		func   = IO$_READVBLK,
		iosb   = DN_Int[DNI$net_iosb],
		astadr = read_ast,
		astprm = .DN_Int,
		p1     = .DN_Int[DNI$receive_addr],
		p2     = DRV$max_physical_bufsize );
    IF NOT .Status THEN
	DRV$fatal_fao ('!%T Error starting data read for DECnet node !AS, device !AS, status = %X!XL!/',
			0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc],.Status);

    .Status
    END;
	
%(
{***************************************************************************}
{									    }
{ This procedures starts a new read on the associated mailbox for this link }
{									    }
{ This procedure is executed within an AST - so be careful not to use any   }
{ data structures that could be in use at the time.			    }
{									    }
)%

ROUTINE start_mailbox_read ( DN_Int : REF DN_Interface_Structure ) =
    BEGIN
    LOCAL
	Status;

     Status = $QIO (
		chan   = .DN_Int[DNI$mbx_chan],
		func   = IO$_READVBLK,
		iosb   = DN_Int[DNI$mbx_iosb],
		astadr = mbx_ast,
		astprm = .DN_Int,
		p1     = DN_Int[DNI$mbx_message],
		p2     = mbx_message_blen );
    IF NOT .Status THEN
	DRV$fatal_fao(
		'!%T Error starting mailbox read for DECnet node !AS, device !AS, status = %X!XL!/',
		0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc],.Status);

    .Status
    END;
	
%(
{***************************************************************************}
{									    }
{ A connection request has been received which we are to reject because	    }
{									    }
{ - it is from a node which we do not know about (as it was not specified    }
{   in a device parameter string					    }
{									    }
)%

ROUTINE reject_connection ( upncb : REF unpacked_ncb_structure ) =
    BEGIN
    LOCAL
	Status,
	conn_desc : VECTOR[2];

    conn_desc[0] = .upncb[uncb$len];	!{ Use incoming NCB }
    conn_desc[1] = .upncb[uncb$adr];
    Status = $QIOW (
	chan = .listener_net_chan,
	func = IO$_ACCESS + IO$M_ABORT,
	iosb = listener_mbx_iosb,
	p2   = conn_desc);
    IF .Status THEN Status = .listener_mbx_iosb[NSB$status];
    IF NOT .Status THEN
	BEGIN
	DRV$error_fao (
	'!%T Error rejecting connection from !AS, status = %X!XL!/',
	 0, upncb[uncb$node], .Status);
	END;
    .Status
    END;

%(
{***************************************************************************}
{									    }
{ Accept a connection request						    }
{									    }
)%

ROUTINE accept_call ( DN_Int : REF DN_Interface_Structure , upncb ) =
    BEGIN
    MAP
	upncb : REF unpacked_ncb_structure;
    LOCAL
	Status,
	conn_desc : VECTOR[2],
	c1 : word,
	c2 : word;
    BIND
	mbx_iosb = DN_Int[DNI$mbx_iosb] : NetIO_Status_Block;

    IF .DN_Int[DNI$DN_Connected] THEN
	BEGIN
	DRV$error_fao(
	'!%T connection request received from DECnet node !AS, device !AS  when connection already exists!/',
	    0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
	DRV$error_fao(
	    '!%T  - drop existing connection and make new connection!/',0);
	drop_link ( .DN_Int );
	END;
	!{								    }
	!{ Assign to DECnet channel					    }
	!{								    }

    Status = LIB$ASN_WTH_MBX (
		dev_desc,
		%REF(mbx_message_blen),%REF(mbx_message_blen*4),
		c1, c2 );
    IF NOT .Status THEN
	DRV$error_fao (
	  '!%T Error assigning DECnet channel for node !AS, device !AS, status = %X!XL!/',
	   0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc], .Status);
    IF .Status THEN
	BEGIN
	DN_Int[DNI$net_chan] = .c1;
	DN_Int[DNI$mbx_chan] = .c2;
	conn_desc[0] = .upncb[uncb$len];	!{ Use incoming NCB }
	conn_desc[1] = .upncb[uncb$adr];
	Status = $QIOW (
		chan = .DN_Int[DNI$net_chan],
		func = IO$_ACCESS + io$m_accept,
		iosb = mbx_iosb,
		p2   = conn_desc);
	IF .Status THEN Status = .mbx_iosb [ NSB$Status ];
	IF NOT .Status THEN
	    DRV$error_fao (
	    '!%T Error accepting connection from node !AS, device !AS, status = %X!XL!/',
		0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc],.Status)
	ELSE
	    BEGIN
	    DRV$log_fao('!%T connect from node !AS, device !AS accepted!/',
			 0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc]);
	    DN_Int[DNI$DN_Connected] = 1;
	    stop_timer(.DN_Int);
	    start_timer(.DN_Int);
	    start_mailbox_read(.DN_Int);
	    start_data_read(.DN_Int);
	    END;
	END;

    .Status
    END;
    
%(
{***************************************************************************}
{									    }
{ A connection request has been received				    }
{   - accept the connection if it is from a known node			    }
{									    }
{ This procedure is executed within an AST - so be careful not to use any   }
{ data structures that could be in use at the time.			    }
{									    }
)%

ROUTINE connect_request ( upncb : REF unpacked_ncb_structure ) =
    BEGIN
    LOCAL
	DN_ptr : REF DN_Interface_Structure,
	Status;

    DRV$NOINT;
    DN_ptr = .DNI_List;
    WHILE .DN_ptr GTR 0 DO
	BEGIN
	IF NOT STR$COMPARE(DN_ptr[DNI$Node_name],upncb[uncb$node]) THEN
	    EXITLOOP;
	DN_ptr = .DN_ptr[DNI$Next]
    	END;
    DRV$OKINT;
    IF .DN_ptr EQL 0 THEN
	BEGIN
	DRV$error_fao  (
	    '!%T An IP connection request from unknown DECnet node !AS received - call rejected!/',
	     0,upncb[uncb$node]);
	Status = reject_connection(.upncb);
	END
    ELSE
	BEGIN
	DRV$log_fao('!%T connection request received from DECnet node !AS!/',
	    0,upncb[uncb$node]);
	Status = accept_call(.DN_ptr,.upncb);
	END;

    .Status
    END;

ROUTINE link_confirm ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao('!%T DECnet connect to node !AS (device !AS) confirmed!/',
		     0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
    END;
    
ROUTINE link_reject ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao ('!%T DECnet connection to node !AS (device !AS) rejected!/',
		    0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc]);
    drop_link(.DN_Int);
    END;

ROUTINE link_disconnect ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao (
	'!%T Partner disconnected link with DECnet node !AS, device !AS!/',
	0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
    drop_link(.DN_Int);
    END;

ROUTINE link_abort ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao (
	'!%T Partner aborted link with DECnet node !AS, device !AS!/',
	 0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
    drop_link(.DN_Int);
    END;

ROUTINE link_exit ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao (
      '!%T Partner exited link prematurely with DECnet node !AS, device !AS!/',
       0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
    drop_link(.DN_Int);
    END;

ROUTINE link_pathlost ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    DRV$error_fao ('!%T Partner path lost with DECnet node !AS, device !AS!/',
		    0, DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc]);
    drop_link(.DN_Int);
    END;

%(
{									    }
{ DECnet has been shut down						    }
{									    } 
)%

ROUTINE decnet_shutdown =
    BEGIN
    LOCAL
	DN_ptr : REF DN_Interface_Structure;

    IF .listener_mbx_chan NEQ 0 THEN $DASSGN(chan=.listener_mbx_chan);
    IF .listener_net_chan NEQ 0 THEN $DASSGN(chan=.listener_net_chan);

    DRV$NOINT;
    DN_ptr = .DNI_List;
    WHILE .DN_ptr GTR 0 DO
	BEGIN
	IF .DN_ptr[DNI$DN_Connected] THEN
	    DRV$error_fao (
	    '!%T DECnet shut-down, breaking link with node !AS, device !AS!/',
	     0, DN_ptr[DNI$Node_name], DN_ptr[DNI$NCB_desc]);
	IF .DN_ptr[DNI$mbx_chan] NEQ 0 THEN
	    $DASSGN(chan=.DN_ptr[DNI$mbx_chan]);
	IF .DN_ptr[DNI$net_chan] NEQ 0 THEN
	    $DASSGN(chan=.DN_ptr[DNI$net_chan]);
	DN_ptr[DNI$DN_Connected] = 0;
	stop_timer(.DN_ptr);
	END;

    0
    END;

%(
{***************************************************************************}
{									    }
{ This procedures starts a new read on the associated mailbox for the       }
{ listener channel.							    }
{									    }
{ This procedure is executed within an AST - so be careful not to use any   }
{ data structures that could be in use at the time.			    }
{									    }
)%

ROUTINE start_listener_mailbox_read =
    BEGIN
    LOCAL
	Status;

    Status = $QIO(
	    chan   = .listener_mbx_chan,
	    func   = IO$_READVBLK,
	    iosb   = listener_mbx_iosb,
	    astadr = listener_mbx_ast,
	    p1     = listener_mbx_message,
	    p2     = mbx_message_blen);
    IF NOT .Status THEN
	DRV$Fatal_FAO(
	   '!%T Error starting DECnet listener mailbox read, status = %X!XL!/',
	    0, .Status );

    .Status
    END;
	
%(
{***************************************************************************}
{									    }
{ This AST routine is called whenever a message has been received on the    }
{ listener mailbox.  These should only be connection requests and DECnet    }
{ shutdown messages.							    }
{									    }
)%

ROUTINE listener_mbx_ast : NOVALUE =
    BEGIN
    LOCAL
	Status,
	upncb   : unpacked_ncb_structure;

    Status = .listener_mbx_iosb [ NSB$status ];
    IF NOT .Status THEN
	DRV$ERROR_FAO(
	    '!%T DECnet Listener Mailbox read error, status =%X!XL!/',
	    0, .Status );

    unpack_ncb ( listener_mbx_message, upncb );
    
!{{{ log_fao_i  ('!%T DECnet Listener Mailbox message received!/',0);
!{{{ dump_mbx_message(listener_mbx_message,upncb);

    SELECT .listener_mbx_message[mbxm$msgtype] OF
	SET
	[msg$_connect] :
	    connect_request(upncb);
	[msg$_netshut] :
	    decnet_shutdown;
	[otherwise] :
	    DRV$ERROR_FAO('!%T unexpected DECnet Listener message type !UL!/',
	        0, .listener_mbx_message [ mbxm$msgtype ]);
	TES;

    start_listener_mailbox_read();
    END;
    
%(
{***************************************************************************}
{									    }
{ This AST routine is called whenever data has been received.		    }
{									    }
)%

ROUTINE read_ast ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	len,
	Status;
    BIND
	iosb = DN_Int[DNI$net_iosb] : NetIO_Status_Block;

    stop_timer(.DN_Int);
    Status = .iosb[NSB$Status];
    IF NOT .Status THEN
	BEGIN
	DRV$seg_free(DRV$max_physical_bufsize,.DN_Int[DNI$receive_addr]);
	DN_Int[DNI$receive_addr] = 0;
	IF .DN_Int[DNI$DN_Connected] THEN
	    BEGIN !{link was not dropped read after read started}
	    DRV$error_fao (
	    '!%T DECnet Read error from node !AS, device !AS, status =%X!XL!/',
		0,DN_Int[DNI$node_name],DN_Int[DNI$NCB_desc],.Status);
	    drop_link(.DN_Int);
	    END
	END
    ELSE
	BEGIN
	len = .iosb[NSB$Byte_Count];

	DRV$ip_receive(.DN_Int[DNI$receive_addr],DRV$max_physical_bufsize,
		       .DN_Int[DNI$receive_addr],.len,.DN_Int);
	DN_Int[DNI$receive_addr] = 0;
	    start_data_read(.DN_Int);
	END;

    start_timer(.DN_Int)
    END;
    
%(
{***************************************************************************}
{									    }
{ This AST routine is called whenever a message has been received on the    }
{ associated mailbox for a data channel.				    }
{									    }
)%

ROUTINE mbx_ast ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	upncb : unpacked_ncb_structure,
	Status;
    BIND
	message = DN_Int[DNI$mbx_message] : mbx_message_structure,
	iosb = DN_Int[DNI$mbx_iosb] : NetIO_Status_Block;

    Status = .iosb[NSB$Status];
    IF NOT .Status THEN
	DRV$error_fao (
	'!%T DECnet Mbox read error for node !AS, device !AS, status =%X!XL!/',
	 0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc],.Status);

    unpack_ncb( DN_Int[DNI$mbx_message] , upncb );
	
    SELECT .message[mbxm$msgtype] OF
	SET
	[msg$_confirm]:
	    link_confirm(.DN_Int);
	[msg$_reject]:
	    link_reject(.DN_Int);
	[msg$_abort]:
	    link_abort(.DN_Int);
	[msg$_exit]:
	    link_exit(.DN_Int);
	[msg$_pathlost]:
	    link_pathlost(.DN_Int);
	[msg$_discon]:
	    link_disconnect(.DN_Int);
	[msg$_netshut]:
	    decnet_shutdown;
	[otherwise]:
	    DRV$error_fao('!%T unexpected DECnet message type !UW!/',
	    0,.(DN_Int[DNI$mbx_message]));
	TES;

    IF .DN_Int[DNI$DN_Connected] THEN
	start_mailbox_read(.DN_Int);
    END;
    
%(
{***************************************************************************}
{									    }
{ Attempt to connect to remote node					    }
{									    }
)%

ROUTINE attempt_connection ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN
    LOCAL
	c1 : word,
	c2 : word,
	ncb_desc : VECTOR[2],
	Status,
	iosb     : NetIO_Status_Block;
    
    !{								    }
    !{ Assign to DECnet channel					    }
    !{								    }
    Status = LIB$ASN_WTH_MBX (
		    dev_desc,
		    %REF(mbx_message_blen),%REF(mbx_message_blen*4),
		    c1, c2 );

    IF NOT .Status THEN
	    DRV$error_fao (
	    '!%T Error assigning DECnet channel for node !AS, device !AS, status = %X!XL!/',
		0,DN_Int[DNI$Node_name], DN_Int[DNI$NCB_desc], .Status );
    IF .Status THEN
	BEGIN
	DN_Int[DNI$net_chan] = .c1;
	DN_Int[DNI$mbx_chan] = .c2;
	DRV$log_fao(
	    '!%T attempting to connect to DECnet node !AS, device !AS!/',
	     0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc]);
	Status = $QIOW (
		chan = .DN_Int[DNI$net_chan],
		func = io$_access,
		iosb = iosb,
		p2   = DN_Int[DNI$NCB_desc]);

	IF .Status THEN Status = .iosb[NSB$Status];
	IF NOT .Status THEN
	    BEGIN
	    DRV$error_fao (
		'!%T unable to connect to DECnet node !AS, device !AS, status = %X!XL!/',
		0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc],.Status);
	    $DASSGN(chan=.DN_Int[DNI$net_chan]);
	    $DASSGN(chan=.DN_Int[DNI$mbx_chan]);
	    END;
	END;
    IF .Status THEN
	BEGIN
	DRV$log_fao('!%T connection made to DECnet node !AS, device !AS!/',
		     0,DN_Int[DNI$Node_name],DN_Int[DNI$NCB_desc]);
	DN_Int[DNI$DN_Connected] = 1;
	start_mailbox_read(.DN_Int);
	start_data_read(.DN_Int);
	stop_timer(.DN_Int);
	start_timer(.DN_Int);
	END;
    END;
	    
%(
{***************************************************************************}
{									    }
{ Start the listener channel.						    }
{									    }
{ The listener channel traps connection requests.			    }
{									    }
)%

ROUTINE start_listener =
!    {									    }
!    { Assign to listener DECnet channel				    }
!    {									    }

    BEGIN
    LOCAL
	c1 : word,
	c2 : word,
	Status,
	decnet_object	: $BBLOCK[12] INITIAL ('IP_DECNET'),
	nfb_desc	: VECTOR[2],
	nam_desc	: BLOCKVECTOR[1,4] INITIAL (9,decnet_object),
	nfb		: $BBLOCK[5],
	iosb		: NetIO_Status_Block;

    Status = LIB$ASN_WTH_MBX (
			dev_desc,
			%REF(mbx_message_blen), %REF(mbx_message_blen*4),
			c1, c2 );

    IF NOT .Status THEN
	BEGIN
	DRV$ERROR_FAO(
	    '!%T Error assigning to DECnet listener channel, status = %X!XL!/',
	     0,.Status);
	END;
    !{									    }
    !{ Declare this to be a network process.				    }
    !{									    }
    IF .Status THEN
	BEGIN

	listener_net_chan = .c1;
	listener_mbx_chan = .c2;

	nfb [ 0,0,8,0 ]	  = nfb$c_declname;
	nfb [ 1,0,32,0 ]  = 0;

	nfb_desc[0]	  = 5;
	nfb_desc[1]	  = nfb;

!	nam_desc[0]	  = %CHARCOUNT(object_name);
!	nam_desc[1]	  = UPLIT(object_name);
!
!        DRV$OPR_FAO ( ' !XL !AS ',nfb_desc,nam_desc);
!        DRV$OPR_FAO ( ' !XL !XL ',.nfb_desc[0] ,.nam_desc[0]);
	Status = $QIOW(
		CHAN = .listener_net_chan,
		FUNC = IO$_ACPCONTROL,
		IOSB = iosb,
		P1   = nfb_desc,
		P2   = nam_desc );
	IF .Status THEN Status = .iosb [ NSB$Status ];
	IF NOT .Status THEN
	    BEGIN
	    DRV$ERROR_FAO (
		'!%T Error declaring network process for DECnet listener channel, status = %X!XL!/',
		 0, .Status );
!!!HACK!!! Comment out the next line before releasing this!
	    $EXIT ( CODE = .Status );
	    END;
	END;
    !{								    }
    !{ Start read on mailbox for connection requeStatus etc		    }
    !{								    }
    IF .Status THEN
	Status = start_listener_mailbox_read();
    listener_started = 1
    END;
    
!{***************************************************************************}

ROUTINE parameter_summary ( DN_Int : REF DN_Interface_Structure ) : NOVALUE =
    BEGIN

!    DRV$log_fao('!%T Initializing DECnet link, device !AS!/',0,DN_Int[DNI$NCB_desc]);
    DRV$log_fao('!%T - connections to remote node !AS!/',
		 0,DN_Int[DNI$Node_name]);
    DRV$log_fao('!%T - connections will be made using !AS!/',
		 0, DN_Int[DNI$NCB_desc]);
    END;
    
%(
{***************************************************************************}
{									    }
{ This routine is called at driver initialization			    }
{									    }
{ Inputs:								    }
{   dev_config	            - device configuration table entry		    }
{   DN_Int		    - DECNet interface stricture		    }
)%

GLOBAL ROUTINE DN_startup ( DN_Int , dev_config ) =
    BEGIN
    MAP
	DN_Int : REF DN_Interface_Structure,
	dev_config : REF Device_Configuration_Entry;
    BIND
	srcname_desc = dev_config [ dc_devname ] : $BBLOCK[DSC$K_S_BLN],
	dstname_desc = DN_Int [ DNI$Node_name ] : $BBLOCK[DSC$K_S_BLN],
	usename_desc = DN_Int [ DNI$NCB_desc ] : $BBLOCK[DSC$K_S_BLN];
    LOCAL
	nlen : INITIAL(0),
	cs,c,
	Status;

    IF NOT .listener_started THEN
	start_listener ();
	
    DRV$NOINT;

! Initialize the NetContrlBlck string...
    $INIT_DYNDESC( DN_Int [ DNI$NCB_desc] );
    STR$CONCAT (DN_Int[DNI$NCB_desc], dev_config[dc_devname],
	%ASCID':"0=',
	dev_config[dc_devspec],
	%ASCID'"' );

! Set up the node.
    $INIT_DYNDESC(dstname_desc);
    cs = .srcname_desc [ DSC$A_POINTER ];
    INCR J FROM 0 TO .srcname_desc[DSC$W_LENGTH]-1 DO
	BEGIN
	c = CH$RCHAR_A ( cs );
	nlen = .J;
	IF (.c LSS %c'0') OR
	  ((.c GTR %c'9') AND (.c LSS %c'A')) OR
	   (.c GTR %c'Z') THEN
	   EXITLOOP
	END;

    dstname_desc [DSC$A_POINTER] = .usename_desc[DSC$A_POINTER];
    dstname_desc[DSC$W_LENGTH] = .nlen;
    
    parameter_summary(.DN_Int);

    DN_Int[DNI$DN_Connected] = 0;
    DN_Int[DNI$Next] = .DNI_List;
    DNI_List = .DN_Int;

    stop_timer(.DN_Int);
    DRV$OKINT;

    .Status
    END;

%(
{***************************************************************************}
{									    }
{ Check the time that it took to make the connection.  The time to live	    }
{ field in the packet should be reduced by this amount.  If the time to	    }
{ live has reduced to zero then the packet should not be transmitted.	    }
{									    }
)%

ROUTINE check_time_to_live ( start_time , END_time ) =
    BEGIN
    MAP
	start_time : REF VECTOR[2],
	END_time   : REF VECTOR[2];
    LOCAL    
	ip_buff : IP_Structure,
	diff_time  : VECTOR[2],
	seconds,
	rem;

    LIB$SUBX(.END_time,.start_time,diff_time);
    LIB$EDIV(%REF(10000000),diff_time,seconds,rem);
    DRV$log_fao('!%T DECnet connection attempt took !UL seconds!/',0,.seconds);
    IF .seconds GTR .IP_buff[IPH$TTL] THEN
	RETURN SS$_TIMEOUT
    ELSE
	BEGIN
	    IP_buff[IPH$TTL] = .IP_buff[IPH$TTL] - .seconds;
	    RETURN SS$_NORMAL
	END;
    END;

%(
{***************************************************************************}
{									    }
{ This routine is called whenever a packet is to be transmitted.	    }
{ If no connection to the remote node has been established then make the    }
{ connection first.							    }
{									    }
{ Note that 'var' is used on buff to stop compiler taking a copy of the	    }
{ record - can cause access violation if buffer isn't 2000 bytes long.	    }
{									    }
)%

GLOBAL ROUTINE DECnet_SEND ( DN_Int , buff , buff_size ) =
    BEGIN
    MAP
	DN_Int : REF DN_Interface_Structure;
    LOCAL
	Status,
	iosb		: NetIO_Status_Block,
	start_time	: VECTOR[2],
	END_time	: VECTOR[2];
        
!{{{ log_fao_i('!%T Device !AS transmitting message of size !UW:!/',
!{{{				 0,DN_Int[DNI$NCB_desc],buff_size);
!{{{ dump_ip(buff,buff_size);

    Status = SS$_NORMAL;
    !{								    }
    !{ If there is no connection to the remote node attempt to make one  }
    !{								    }
    IF NOT .DN_Int[DNI$DN_Connected] THEN
	BEGIN
	$GETTIM ( TIMADR = start_time );
	attempt_connection ( .DN_Int );
	$GETTIM ( TIMADR = END_time );
	Status = check_time_to_live(start_time,END_time,.buff);
	END;
    !{								    }
    !{ Transmit the message						    }
    !{								    }
    IF .DN_Int[DNI$DN_Connected] AND .Status THEN
	BEGIN
	stop_timer ( .DN_Int );
	Status = $QIOW (
		chan = .DN_Int[DNI$net_chan],
		func = io$_WRITEVBLK,
		iosb = iosb,
		p1   = .buff,
		p2   = .buff_size);
	IF .Status THEN Status = .iosb[NSB$Status];
	IF NOT .Status THEN
	    BEGIN
	    DRV$error_fao (
		'!%T Error transmitting to DECnet node !AS, device !AS, status = %X!XL!/',
		 0,DN_Int[DNI$node_name],DN_Int[DNI$NCB_desc],.Status);
	    drop_link(.DN_Int);
	    END;
	start_timer(.DN_Int);
	END;

    .Status
    END;
    
END ELUDOM