PDP-10 Archive: source/ct32t1.vax-cob from BB-R775B-BM

Trailing-Edge - PDP-10 Archives - BB-R775B-BM - source/ct32t1.vax-cob
There are 2 other files named ct32t1.vax-cob in the archive. Click here to see a list.
IDENTIFICATION DIVISION.

PROGRAM-ID.

	CT32T1.

AUTHOR.

	DIGITAL EQUIPMENT CORPORATION.

	This is a test program for  the DIT.  It opens a passive  link
	and then connects  to itself  creating an  active link.   User
	specified messages are sent  both directions across the  link,
	and then the link is closed.

	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983.

	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: DIT-TEST
* 
* Edit History:
* 
* new_version (1, 0)
* 
* Edit (%O'1', '15-Dec-82', 'Sandy Clemens')
* %(  Add the DIT (Dap and Task-to-task) Installation Verification tests
*     for the VAX and DECSYSTEM-20 to the library.  
*     Files:  DITTHST.TXT (NEW), CD32T1.VAX-COB (NEW),
*     CT32T1.VAX-COB (NEW), FD32T1.VAX-FOR (NEW),
*     FT32T1.VAX-FOR (NEW), CD36T1.CBL (NEW), CT36T1.CBL (NEW),
*     FD6T1.FOR (NEW), FD7T1.FOR (NEW), FT6T1.FOR (NEW),
*     FT7T1.FOR (NEW) )%
*     
*
* Edit (%O'2', '14-Jan-83', 'Sandy Clemens')
* %(  Many edits to the Installation Verification system (ICS)  files.
*     Add SYS:  to all  the  10/20 programs  in  the COPY  or  INCLUDE
*     statement for the interface files.   Add SYS$LIBRARY to the  VAX
*     programs in  the COPY  or INCLUDE  statement for  the  interface
*     files.  Add check for INFO or  SUCCESS status return in all  ICS
*     programs.  Remove node names from all DIT programs so that local
*     node is used.  Change  directory used by 20  DAP programs to  be
*     PS:<DIL-TEST> with  password  DIL-TEST.   Remove  all  directory
*     specifications  from  VMS  programs  so  they  use  the  default
*     connected directory.   Add Lib$Match_Cond  to VMS  programs  for
*     status checking.  Change some of the symbolic variable names for
*     clarification.   Change  use  of  numeric  parameter  values  to
*     symbolic variable names.  Get rid  of use of "IMPLICIT  INTEGER"
*     in FORTRAN test programs.   Add copyright notice to  everything.
*     
*     Files: CD32T1.VAX-COB,  CD36T1.CBL, CT32T1.VAX-COB,  CT36T1.CBL,
*     FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
*     FT7T1.FOR, DITTHST.TXT )%
*     
* Edit (%O'3', '20-Jan-83', 'Sandy Clemens')
* %(  Fix CT32T1.VAX-COB so that it legibly displays the status
*     returned from the second call to NFRCV.  This was accidently
*     left out of the original version.  FILE: CT32T1.VAX-COB )%
*     
* Edit (%O'6', '25-Jan-83', 'Sandy Clemens')
* %(  Add copyright and liability waiver to whatever needs it.
*     FILES: CD32T1.VAX-COB, CD36T1.CBL, CT32T1.VAX-COB, CT36T1.CBL,
*     FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
*     FT7T1.FOR, SUB6D1.FOR, SUB6T1.FOR, SUB7D1.FOR, SUB7T1.FOR  )%
*
* Edit (%O'7', '25-Jan-83', 'Sandy Clemens')
* %(  Standardize "Author" entry in ICS Cobol programs.
*     FILES: CD32T1.VAX-COB, CD36T1.CBL, CT32T1.VAX-COB, CT36T1.CBL )%

INSTALLATION.

	DEC-MARLBORO.

DATE-WRITTEN.

	NOVEMBER 5, 1982.

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SOURCE-COMPUTER.

	VAX-11.

OBJECT-COMPUTER.

	VAX-11.

DATA DIVISION.

WORKING-STORAGE SECTION.

01  INTERFACE-FILES.
    COPY DIT$COBOL OF "SYS$LIBRARY:DIL.TLB".
    COPY DIL$COBOL OF "SYS$LIBRARY:DIL.TLB".

* DIL status return
01  DIL-STATUS PIC S9(9) COMP.

01  DIL-DATA-FLDS.
    05  SEND-DATA PIC X(100).
    05  RECEIVE-DATA PIC X(100).

01  COUNT-OPT-DATA PIC S9(9) COMP VALUE 0.
01  OPT-DATA PIC X(16) VALUE SPACES.
01  PNETLN PIC S9(9) COMP.
01  ANETLN PIC S9(9) COMP.
01  HOSTN PIC X(06) VALUE SPACES.
01  OBJID PIC X(16).
01  DESCR PIC X(16).
01  TASKNAME PIC X(16).
01  USERID PIC X(39) VALUE SPACES.
01  PASSWD PIC X(39) VALUE SPACES.
01  ACCT PIC X(39) VALUE SPACES.
01  MESSAGE-SIZE PIC S9(9) COMP VALUE 100.
01  MESSAGE-UNITS-SIZE PIC S9(9) COMP VALUE 8.
01  SYNCH-DISCONN PIC S9(9) COMP VALUE 0.

01  DIL-DISPLAY PIC X(12).

* Lib$match_cond parameters
01  DIL-MATCH PIC S9(9) COMP.
    88  NO-MATCH VALUE 0.
    88  MATCH-1 VALUE 1.
    88  MATCH-2 VALUE 2.

PROCEDURE DIVISION.

OPEN-PASSIVE.
* Open a passive link.

    MOVE SPACES TO DESCR.
    MOVE "SERVER" TO TASKNAME.
    MOVE "0" TO OBJID.
    MOVE 1 TO PNETLN.

    CALL "DIT$NFOPP" USING PNETLN, OBJID, DESCR, TASKNAME, DIT$K_WAIT_NO
		     GIVING DIL-STATUS.

    MOVE PNETLN TO DIL-DISPLAY.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFOPP Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFOPP: unsuccessful status return "
	STOP RUN.

CONNECT-TO-SELF.
* Ask for a connection to the passive link

    MOVE "0" TO OBJID.
    MOVE "SERVER" TO DESCR.
    MOVE SPACES TO TASKNAME.

    CALL "DIT$NFOPA" USING ANETLN, HOSTN, OBJID, DESCR, TASKNAME,
			   USERID, PASSWD, ACCT, OPT-DATA, DIT$K_WAIT_NO
		     GIVING DIL-STATUS.

    MOVE ANETLN TO DIL-DISPLAY.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFOPA Status return: ", DIL-DISPLAY.

    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFACC: unsuccessful status return "
	STOP RUN.

CHECK-THE-LINK.
* Wait for confirmation of the link request

    CALL "DIT$NFGND" USING PNETLN, DIT$K_WAIT_NO
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFGND status return: ", DIL-DISPLAY.
    CALL "LIB$MATCH_COND" USING DIL-STATUS,
				DIT$_CONNECTEVENT,
			  GIVING DIL-MATCH.
    IF NO-MATCH
	DISPLAY "? NFGND: Unexpected or invalid status returned."
	STOP RUN.

ACCEPT-LINK.
* Accept link from self

    CALL "DIT$NFACC" USING PNETLN, DIT$K_LTYPE_ASCII, COUNT-OPT-DATA, OPT-DATA
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFACC Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFACC: unsuccessful status return "
	STOP RUN.


SEND-SOME-DATA.
* Send some data over the link to self

    DISPLAY " Enter some data to be sent over the link: ".
    ACCEPT SEND-DATA.

    CALL "DIT$NFSND" USING ANETLN, MESSAGE-UNITS-SIZE, MESSAGE-SIZE,
			   SEND-DATA, DIT$K_MSG_MSG
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFSND Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFSND: unsuccessful status return "
	STOP RUN.


READ-THE-DATA.
* Read the data sent over the link

    CALL "DIT$NFRCV" USING PNETLN, MESSAGE-UNITS-SIZE, MESSAGE-SIZE,
			   RECEIVE-DATA, DIT$K_MSG_MSG, DIT$K_WAIT_YES
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFRCV Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFRCV: unsuccessful status return "
	STOP RUN.

    DISPLAY " Data received: ".
    DISPLAY RECEIVE-DATA.

SEND-SOME-DATA-BACK.
* Send some data over the link in the opposite direction.

    MOVE 100 TO MESSAGE-SIZE.
    MOVE SPACES TO SEND-DATA RECEIVE-DATA.

    DISPLAY " Enter some data to be sent back over the link: ".
    ACCEPT SEND-DATA.

    CALL "DIT$NFSND" USING PNETLN, MESSAGE-UNITS-SIZE, MESSAGE-SIZE,
			   SEND-DATA, DIT$K_MSG_MSG
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFSND Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFSND: unsuccessful status return "
	STOP RUN.


READ-THE-2ND-DATA.
* Read the data sent over the link the second time

    CALL "DIT$NFRCV" USING ANETLN, MESSAGE-UNITS-SIZE, MESSAGE-SIZE,
			   RECEIVE-DATA, DIT$K_MSG_MSG, DIT$K_WAIT_YES
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFRCV Status return: " DIL-STATUS.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFRCV: unsuccessful status return "
	STOP RUN.

    DISPLAY " Data received: ".
    DISPLAY RECEIVE-DATA.

CLOSE-LINK.
* Close the link to self

    CALL "DIT$NFCLS" USING ANETLN, SYNCH-DISCONN, COUNT-OPT-DATA, OPT-DATA
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFCLS Status return: " DIL-DISPLAY.
    IF DIL-STATUS IS NOT SUCCESS
	DISPLAY "? NFCLS: unsuccessful status return "
	STOP RUN.

    CALL "DIT$NFGND" USING PNETLN, DIT$K_WAIT_YES
		     GIVING DIL-STATUS.

    MOVE DIL-STATUS TO DIL-DISPLAY.
    DISPLAY " NFGND Status return: " DIL-DISPLAY.

    CALL "LIB$MATCH_COND" USING DIL-STATUS,
				DIT$_ABREJEVENT,
				DIT$_DISCONNECTEVENT,
			  GIVING DIL-MATCH.
    IF NO-MATCH
	DISPLAY "? NFGND: invalid status returned"
	STOP RUN.

    DISPLAY " ".
    DISPLAY " CT32T1 test successful".
    STOP RUN.