[INHERIT ('SYS$LIBRARY:STARLET')]

PROGRAM psi$x25_send_pascal (input, output);

{
*************************************************************************
**                                                                      *
**         COPYRIGHT  (c)  DIGITAL EQUIPMENT CORPORATION, 1993          *
**         ALL RIGHTS RESERVED.  UNPUBLISHED - RIGHTS RESERVED          *
**         UNDER THE COPYRIGHT LAWS OF THE UNITED STATES.               *
**                                                                      *
**         RESTRICTED RIGHTS LEGEND: USE, DUPLICATION, OR DISCLOSURE    *
**         BY THE U.S. GOVERNMENT IS SUBJECT TO RESTRICTIONS AS SET     *
**         FORTH IN SUBPARAGRAPH (C)(1)(II) OF DFARS 252.227-7013,      *
**         OR IN FAR 52.227-19, OR IN FAR 52.227-14 ALT. III, AS        *
**         APPLICABLE.                                                  *
**                                                                      *
**         THIS SOFTWARE IS PROPRIETARY TO AND EMBODIES CONFIDENTIAL    *
**         TECHNOLOGY OF DIGITAL.  POSSESSION, USE, OR COPYING OF THE   *
**         SOFTWARE AND MEDIA IS AUTHORIZED ONLY PURSUANT TO A VALID    *
**         WRITTEN LICENSE FROM DIGITAL.                                *
**                                                                      *
*************************************************************************
**++
**
**  FACILITY:
**
**      X.25 Example Program
**
**  ABSTRACT:
**	SEND PROGRAM
**  
**      Digital is furnishing this example software "as is" without
**      warranty of any kind, express or implied, including the implied
**      warranties of merchantability and fitness for a particular purpose.
**      Digital disclaims any and all liability for the performance or
**      non-performance of this software.
**
**
**      This program is intended to run with the receive example programes. 
**	Data is entered via the terminal to the send program, and sent by
**	X.25 to the receive program.  
**	
**	The link command should include psilib.obj in the object list.
**	The following NCL commands can be used to configure X.25.  This 
**      configeration assumes the following
**	    - the send and recieve programs are running  on the same system
**	    - the same gateway is used to place and outgoing call and recieve 
**	    - the incomming call.
**	    - the recieve example is started by a application entity
**	    - the file specified by the application entity contains a DCL
**	      command to run the receive executable.
**	      
**
**    create x25 access
**    create x25 client
**    !
**    !	Create DTE classes
**    !
**    create x25 access dte class crock type remote
**    set x25 access dte class crock service node ((node=dundee, -
**	    rating=512))
**    create x25 access dte class crock1 type remote
**    set x25 access dte class crock1 service node ((node=dundee, -
**	    rating=512))
**    !                                                                 
**    !	Create security DTE class
**    !
**    create x25 access security dte class default
**    !
**    !	Create remote DTE entity
**    !
**    create x25 access security dte class default remote dte match_all -
**	    remote address prefix *
**    set x25 access security dte class default remote dte match_all -
**	    rights identifier (match_all)
**    !
**    !	Create template
**    !
**    create x25 access template net_template1
**    set x25 access template net_template1 dte class crock
**    create x25 access template default
**    !
**    !	Create filter
**    !
**    create x25 access filter receive
**    set x25 access filter receive incoming dte address 12345
**    !
**    !	Create security filter
**    !
**    create x25 access security filter default
**    set x25 access security filter default acl -
**	    ((identifier=(match_all),access=all))
**    !
**    !	Create application entity
**    !
**    create x25 access application receive
**    set x25 access application receive filters (receive)
**    set x25 access application receive user system
**    set x25 access application receive file sys$system:x25$receive.com
**    !
**    !	Enable everything
**    !
**    enable x25 access
**    enable x25 client
**    enable x25 access application receive
**
**
**
**  FUNCTIONAL DESCRIPTION:
**
**	* Inherit external declarations from 'starlet' environment
**	* Declare local constants, types and variables
**	* Define the NCB and its descriptor
**	* Define descriptors for the mailbox and network device
**	* Create a mailbox for the network device
**	* Assign an input/output (I/O) channel to the network
**	  device (NWA0:)
**	* Set up a virtual circuit
**	* Read the mailbox to obtain the status of the connection
**	* Loop reading data from keyboard and sending to remote
**	  process until control-z received
**	* Clear the call
**	* Deassign the mailbox and I/O channels
**
**--
}


    {	Define remote DTE address and sub-address as required   }

CONST	    rem_dte		    = '12345';
	    len_rem_dte		    = 5;	{length of rem_dte string}
	    template		    = 'NET_TEMPLATE1';
	    len_template	    = 13;


	    iobsz		    = 70;
	    ctrlz		    = 26;



TYPE	    t_ubyte		    = [byte] 0..255;	{08bits 1byte}
	    t_uword		    = [word] 0..65535;	{16bits 2bytes}
	    t_ulong		    = [long] unsigned;	{32bits 4bytes}
	    t_uquad		    = [quad, unsafe]	RECORD
							    l0,l1:unsigned;
							END; {64bits 8bytes}

	    t_dte_item	=   RECORD
				len	: t_uword;
				code	: t_uword;
				s_size	: t_ubyte;
				s	: PACKED ARRAY
					    [1..len_rem_dte] OF char;
			    END;

	    t_temp_item	=   RECORD
				len	: t_uword;
				code	: t_uword;
				s_size	: t_ubyte;
				s	: PACKED ARRAY
					    [1..len_template] OF char;
			    END;


	    t_ncb	=   RECORD
				dte	: t_dte_item;
				temp	: t_temp_item;
			    END;


	    t_mbx_buf	=   RECORD
				msg_typ	: t_uword;
				unit	: t_uword;
				name_sz	: t_ubyte;
				name	: PACKED ARRAY [1..15] OF char;
				info_sz	: t_ubyte;
				info	: PACKED ARRAY [1..15] OF char;
			    END;

	    t_iosb	=   RECORD
				status,
				dlen,
				devdep1,
				devdep2	: t_uword
			    END;





VAR	    ncb			:   [volatile] t_ncb;
	    ncb_desc		:   [volatile] DSC1$TYPE;
	    PSI$C_NCB_REMDTE	:   [value, external] t_ubyte;
	    PSI$C_NCB_TEMPLATE	:   [value, external] t_ubyte;
	    PSI$C_NCB_REMSUBADR	:   [value, external] t_ubyte;

	    mbx_msg		:   t_mbx_buf;

	    iosb		:   t_iosb;


	    mbx		:   DSC1$TYPE;

	    mbx_name	:   [volatile] PACKED ARRAY [1..8] OF char
							:= 'X25S_MBX';

	    dev		:   DSC1$TYPE;

	    dev_name	:   [volatile] PACKED ARRAY [1..6] OF char
							:= '_NWA0:';

	    io_buf	:   PACKED ARRAY [1..iobsz] OF char;

	    status	:   t_uword;

	    mbx_channel,
	    psi_channel	:   t_uword;



PROCEDURE build_ncb;

{   Build the ncb and its descriptor   }

BEGIN
    WITH ncb DO
	BEGIN
	    dte.len	:= len_rem_dte + 5;
            dte.code	:= PSI$C_NCB_REMDTE;
	    dte.s_size	:= len_rem_dte;
	    dte.s	:= rem_dte;
	    temp.len	:= len_template + 5;
            temp.code	:= PSI$C_NCB_TEMPLATE;
	    temp.s_size	:= len_template;
	    temp.s	:= template;
	END;

    WITH ncb_desc DO
	BEGIN
	    DSC$W_MAXSTRLEN	:= size(ncb);
	    DSC$B_DTYPE		:= DSC$K_DTYPE_VT;
	    DSC$B_CLASS		:= DSC$K_CLASS_VS;
	    DSC$A_POINTER	:= address(ncb)
	END
END;   { build_ncb }



PROCEDURE build_descs;

{   Build mailbox and network device descriptors   }

BEGIN
    WITH mbx DO
	BEGIN
	    DSC$W_MAXSTRLEN	:= size(mbx_name);
	    DSC$B_DTYPE		:= DSC$K_DTYPE_T;
	    DSC$B_CLASS		:= DSC$K_CLASS_S;
	    DSC$A_POINTER	:= address(mbx_name)
	END;

    WITH dev DO
	BEGIN
	    DSC$W_MAXSTRLEN	:= size(dev_name);
	    DSC$B_DTYPE		:= DSC$K_DTYPE_T;
	    DSC$B_CLASS		:= DSC$K_CLASS_S;
	    DSC$A_POINTER	:= address(dev_name)
	END
END;   { build_decs }



BEGIN	{ main }

    build_ncb;
    build_descs;


    {   Create mailbox   }

    status := $crembx(	chan	:= mbx_channel,
			lognam	:= mbx_name);

    IF NOT odd(status) THEN $exit(status);


    {   Assign a channel to the network device   }

    status := $assign(	devnam	:= dev_name,
			chan	:= psi_channel,
			mbxnam	:= mbx_name);

    IF NOT odd(status) THEN $exit(status);


    {	Set up a virtual call   }

    status := $qiow(	chan	:= psi_channel,
			func	:= IO$_ACCESS,
			iosb	:= iosb,
			p2	:= iaddress(ncb_desc) );

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);


    {	Read mailbox to get the status of the connection   }

    status := $qiow(	chan	:= mbx_channel,
			func	:= IO$_READVBLK,
			iosb	:= iosb,
			p1	:= mbx_msg,
			p2	:= size(mbx_msg));

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);


    {	Loop to read lines from keyboard until control-z entered,
        send each line to remote process			    }

    write('> ');
    WHILE NOT eof DO
	BEGIN
	    readln(io_buf);
	    status := $qiow(    chan    := psi_channel,
				func    := IO$_WRITEVBLK,
				iosb    := iosb,
				p1	:= io_buf,
				p2	:= size(io_buf) );

	    IF NOT odd(status) THEN $exit(status);
	    IF NOT odd(iosb.status) THEN $exit(iosb.status);

	    write('> ');
	END;


    {	Send control-z to remote process to signal end of data   }

    status := $qiow(	chan	:= psi_channel,
			func	:= IO$_WRITEVBLK,
			iosb	:= iosb,
			p1	:= ctrlz,
			p2	:= 1	    );

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);



    {	Deaccess network channel   }

    status := $qiow(	chan	:= psi_channel,
    			func	:= IO$_DEACCESS,
    			iosb	:= iosb	    );

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);



    {	Deassign network device and mailbox channels   }

    status := $dassgn(	chan	:= psi_channel );

    IF NOT odd(status) THEN $exit(status);


    status := $dassgn(	chan	:= mbx_channel );

    IF NOT odd(status) THEN $exit(status);


    $exit(ss$_normal);

END.