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

PROGRAM pascal_recv (input, output);

{
*
* 			Copyright (c) 1987
*	DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts, USA
*
* This software is furnished under a license and may be  used  and  copied 
* only in accordance with the terms of such licence 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 the reliability of  its 
* software on equipment which is not supplied by DIGITAL.
*
**++
**  FACILITY:
**
**      VOTS Example Program
**
**  ABSTRACT:
**
**	RECEIVE PROGRAM
**      This program is one of a pair of demonstration programs which will
**	transfer data entered at the terminal from one VAX to another  via
**	the VAX OSI Transport Service.  This program should be declared as
**	a TSAP 'VOTS_RECEIVE1' to be run when the transport  connection is
**	requested.
**
**  ENVIRONMENT:
**
**	Native mode VAX processor, User mode.
**
**  COMPILATION/LINKAGE:
**
**	$ PASCAL this_prog
**	$ LINK this_prog, sys$library:osit$library/lib, sys$library:starlet/lib
**	$ RUN this_prog
**
**  AUTHOR:
**
**
**  CREATION DATE:
**
**	30-SEP-1987
**
**  MODIFICATIONS:
**
**      19-NOV-1987   SMcL  Added parser call to obtain item list from ncb.
**
**--
}



CONST	    iobsz	= 70;



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

	    t_iosb	=   RECORD
				status,
				null	: t_uword;
				iosb_1	: t_ulong
			    END;

	    t_trn_item	=   RECORD CASE INTEGER OF
				1:( buf_len,
				    itm_cod	: t_uword;
				    eq_bf_adr,
				    rt_ln_adr	: [unsafe] t_ulong
				  );
				2:( terminator	: [pos (0)] t_ulong
				  )
			    END;





VAR	    net			:   [volatile] PACKED ARRAY [1..7] OF char
					:= 'SYS$NET';

	    osi			:   [volatile] PACKED ARRAY [1..11] OF char
					:= 'OSIT$DEVICE';

	    tab			:   [volatile] PACKED ARRAY [1..17] OF char
					:= 'LNM$PROCESS_TABLE';



            item_list		:   [volatile] ARRAY
					[0..OSIT$K_MAX_OUTPUT_ITEM_LIST - 1]
						    OF t_ubyte;

            item_list_size      :   [volatile] t_uword :=
						OSIT$K_MAX_OUTPUT_ITEM_LIST;

            item_list_len	:   [volatile] t_uword;

	    item_list_desc,
	    net_desc, osi_desc,
	    ncb_desc, tab_desc	:   [volatile] DSC1$TYPE;

	    iosb		:   t_iosb;

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

	    ncb_buf		:   [volatile] PACKED ARRAY
						[1..LNM$C_NAMLENGTH] OF char;

	    eqv_len		:   [volatile] t_uword;

	    status		:   t_uword;

	    vots_channel	:   t_word := 0;

	    trn_list		:   ARRAY [1..2] OF t_trn_item;

	    fn_code		:   [unsafe] t_uword;





[asynchronous,external(LIB$PARSE_NCB)] FUNCTION lib$parse_ncb (
	%immed	ncb		: [unsafe] integer;
	var	itemlist        : [volatile] DSC1$TYPE;
	var	len		: [volatile] t_uword    ): integer; external;





{   $QIOW1 redefines $QIOW formal parameters p1 and p2 for VOTS use   }

[asynchronous,external(SYS$QIOW)] FUNCTION $qiow1 (
	%immed	efn		: unsigned := %immed 0;
	%immed	chan		: integer;
	%immed	func		: integer;
	var	iosb		: [volatile] t_uquad := %immed 0;
	%immed	[unbound, asynchronous] procedure astadr := %immed 0;
	%immed	astprm		: unsigned := %immed 0;
	%immed	p1		: [unsafe] integer := %immed 0;
	%immed	p2		: [unsafe] integer := %immed 0;
	%immed	p3		: integer := %immed 0;
	%immed	p4		: integer := %immed 0;
	%immed	p5		: integer := %immed 0;
	%immed	p6		: integer := %immed 0) : integer; external;









PROCEDURE build_descs;

{   Build ncb & osi descriptors   }

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

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



    WITH ncb_desc DO
	BEGIN
{  ncb_desc.DSC$W_MAXSTRLEN determined on receipt of mailbox   }
	    DSC$B_DTYPE		:= DSC$K_DTYPE_T;
	    DSC$B_CLASS		:= DSC$K_CLASS_S;
	    DSC$A_POINTER	:= address(ncb_buf)
	END;

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

    WITH item_list_desc DO
        BEGIN
            DSC$W_MAXSTRLEN     := item_list_size;
            DSC$B_DTYPE         := DSC$K_DTYPE_T;
            DSC$B_CLASS         := DSC$K_CLASS_S;
            DSC$A_POINTER       := address(item_list[0])
        END;
END;   { build_descs }









PROCEDURE build_trn_list;

{   Build list of item codes to describe logical name translation   }

BEGIN
    trn_list[1].buf_len	        := LNM$C_NAMLENGTH;
    trn_list[1].itm_cod		:= LNM$_STRING;
    trn_list[1].eq_bf_adr	:= address(ncb_buf);
    trn_list[1].rt_ln_adr	:= address(eqv_len);

    trn_list[2].terminator	:= 0;
END;   { build_trn_list }









PROCEDURE check_status( status: t_uword; iosb: t_iosb );

{   Check System Service return status and VOTS return code   }

BEGIN
    IF status <> SS$_NORMAL
    THEN $EXIT(status)
    ELSE IF iosb.status <> SS$_NORMAL
	 THEN BEGIN
		  $PUTMSG(iosb.status);   {output VMS return code}
		  $EXIT(iosb.iosb_1)      {output VOTS return code}
              END
END;   { check_status }







BEGIN	{ main }
    writeln('VOTS Receiver');

    build_descs;
    build_trn_list;



    {   Assign a network channel to the OSIT$DEVICE
	this does not provide a network connection   }

    writeln('Assigning channel');

    status := $ASSIGN(	devnam	:= osi,
			chan	:= vots_channel,
			acmode	:= 0    );

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







    {	Obtain the ncb from a translation of SYS$NET   }

    writeln('Translating logical name');

    status := $TRNLNM(	lognam	:= net,
			tabnam	:= tab,
			itmlst	:= trn_list	);

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







    {   Set ncb_desc length field from mailbox   }

    ncb_desc.DSC$W_MAXSTRLEN := eqv_len;







    {	Parse NCB to obtain an item list   }

    writeln('Parsing NCB');

    status := lib$parse_ncb(	ncb	    := address(ncb_desc),
				itemlist    := item_list_desc,
				len	    := item_list_len      );

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





    {   Set item_list_desc length field from value
	returned by LIB$PARSE_NCB                    }

    item_list_desc.DSC$W_MAXSTRLEN := item_list_len;







    {	Accept the Transport connection   }

    writeln('Accepting connection');

    status := $qiow1(	chan	:= vots_channel,
			func	:= IO$_ACCESS,
			iosb	:= iosb,
			p1	:= address(item_list_desc) );

    check_status(status, iosb);







    {	Read data from the remote task   }

    writeln('Reading data from remote task');

    status := $QIOW(	chan	:= vots_channel,
			func	:= IO$_READVBLK,
			iosb	:= iosb,
			p1	:= io_buf,
			p2	:= size(io_buf));

    check_status(status, iosb);





    {   Output the message to SYS$OUTPUT   }

    writeln(io_buf);





    {   Terminate the transport connection   }

    writeln('Deaccessing channel');

    fn_code := uor(IO$_DEACCESS, IO$M_ABORT);

    status := $QIOW(    chan    := vots_channel,
			func    := fn_code,
			iosb    := iosb  );

    check_status(status, iosb);

    $EXIT(SS$_NORMAL);

END.