PDP-10 Archive: uetp/lib/cd36t1.cbl from BB-R775B-BM

Trailing-Edge - PDP-10 Archives - BB-R775B-BM - uetp/lib/cd36t1.cbl

There are 20 other files named cd36t1.cbl in the archive. Click here to see a list.

IDENTIFICATION DIVISION.

PROGRAM-ID.

	CD36T1.

AUTHOR.

	DIGITAL EQUIPMENT CORPORATION.

	This program opens a remote  file named DAP.TST and writes  an
	ASCII record into it,  closes the file,  reopens the file  and
	reads the record back and then closes the file again.

	Note: this program writes and  reads the file DAP.TST using  a
	directory called PS:<DIL-TEST>.   If this  directory does  not
	exist, it must be created as a VALID login directory.

	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'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-MARLBOROUGH.

DATE-WRITTEN.

	NOVEMBER 5, 1982.

ENVIRONMENT DIVISION.

INPUT-OUTPUT SECTION.

DATA DIVISION.

FILE SECTION.

WORKING-STORAGE SECTION.

01  INTERFACE-FILES.
    COPY DIT OF "SYS:DIL.LIB".
    COPY DIL OF "SYS:DIL.LIB".

* Dilini is necessary for DECsystem-10 and DECSYSTEM-20 Cobol only.
01  DILINI-PARAMS.
    05  DIL-INIT-STATUS PIC S9(10) COMP.
    05  DIL-STATUS PIC S9(10) COMP.
    05  DIL-SEVERITY PIC S9(10) COMP.
    05  DIL-MESSAGE PIC S9(10) COMP.

* File and directory description fields

01  FILE-NAME PIC X(39) VALUE 'PS:<DIL-TEST>DAP.TST' DISPLAY-7.
01  USERID USAGE DISPLAY-7 PIC X(39) VALUE 'DIL-TEST'.
01  PASSWD USAGE DISPLAY-7 PIC X(39) VALUE SPACES.
01  ACCT USAGE DISPLAY-7 PIC X(39) VALUE SPACES.

* Record and file description fields

01  FILE-NUMBER USAGE COMP PIC S9(10).
01  REC-FORMAT USAGE COMP PIC S9(10).
01  REC-ATTRIBUTES USAGE COMP PIC S9(10).
01  REC-SIZE USAGE COMP PIC S9(10) VALUE 100.
01  REC-UNIT-SIZE USAGE COMP PIC S9(10) VALUE 0.

01  DATA-RECORD USAGE DISPLAY-7 PIC X(100).

PROCEDURE DIVISION.

* Set up for return code values, using DILINI routine

    ENTER MACRO DILINI USING DIL-INIT-STATUS, DIL-STATUS,
			     DIL-MESSAGE, DIL-SEVERITY.

    IF DIL-INIT-STATUS NOT = 1
	DISPLAY "? Invalid return code from DILINI routine = " DIL-INIT-STATUS.

* Get record format

    DISPLAY " Enter the value for the record format (RFM):".
    DISPLAY " 0 = undefined,".
    DISPLAY " 1 = fixed,".
    DISPLAY " 2 = variable, ".
    DISPLAY " 3 = VFC, ".
    DISPLAY " 4 = stream".
    ACCEPT REC-FORMAT.

* Get record attributes

    DISPLAY " Enter a value for the record attributes (RAT):".
    DISPLAY " 0 = unspecified,".
    DISPLAY " 1 = implied <LF><CR> envelope,".
    DISPLAY " 2 = print file format,".
    DISPLAY " 3 = Fortran carriage control,".
    DISPLAY " 4 = MACY11 format".
    ACCEPT REC-ATTRIBUTES.

* Request the password

    DISPLAY " Enter the password: "
	WITH NO ADVANCING ACCEPT PASSWD.

* Open file DAP.TST for output

    ENTER MACRO ROPEN USING FILE-NUMBER, FILE-NAME, USERID, PASSWD, ACCT,
			    DIT-MODE-WRITE, DIT-TYPE-ASCII, REC-FORMAT,
			    REC-ATTRIBUTES, REC-SIZE, REC-UNIT-SIZE.

    DISPLAY " ROPEN Status return: " DIL-STATUS.
    IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? ROPEN: unsuccessful status return "
	STOP RUN.

* Accept a record and write it to the file

    DISPLAY " Enter data for the record for the remote file: ".
    ACCEPT DATA-RECORD.

    ENTER MACRO RWRITE USING FILE-NUMBER, REC-UNIT-SIZE,
			REC-SIZE, DATA-RECORD.

    DISPLAY " RWRITE Status return: " DIL-STATUS.
    IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? RWRITE: unsuccessful status return. "
	STOP RUN.

* Close the file

    ENTER MACRO RCLOSE USING FILE-NUMBER, DIT-OPT-NOTHING.

    DISPLAY " RCLOSE Status return: ", DIL-STATUS.
    IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? RCLOSE: unsuccessful status return."
	STOP RUN.

* Open the file to read the record

    ENTER MACRO ROPEN USING FILE-NUMBER, FILE-NAME, USERID, PASSWD, ACCT,
		      DIT-MODE-READ, DIT-TYPE-ASCII, REC-FORMAT,
		      REC-ATTRIBUTES, REC-SIZE, REC-UNIT-SIZE.

    DISPLAY " ROPEN Status return: ", DIL-STATUS.
    IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? ROPEN: unsuccessful status return."
	STOP RUN.

* Read the record

    MOVE SPACES TO DATA-RECORD.

    ENTER MACRO RREAD USING FILE-NUMBER, REC-UNIT-SIZE,
			    REC-SIZE, DATA-RECORD.

    DISPLAY " RREAD returned ", DIL-STATUS.
    IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? RREAD: unsuccesful status return."
	STOP RUN.

    DISPLAY " The record was: ".
    DISPLAY DATA-RECORD.

* Close the file

    ENTER MACRO RCLOSE USING FILE-NUMBER, DIT-OPT-NOTHING.

    DISPLAY " RCLOSE Status return: ", DIL-STATUS.
     IF DIL-SEVERITY NOT = STS-K-SUCCESS 
       AND DIL-SEVERITY NOT = STS-K-INFO
	DISPLAY "? RCLOSE: unsuccessful status return."
	STOP RUN.

    DISPLAY " ".
    DISPLAY " CD36T1 test successful. ".
    STOP RUN.