Trailing-Edge
-
PDP-10 Archives
-
bb-r775c-bm_tops20_ks_upd_3
-
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.
* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
* OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
*
* COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985.
* ALL RIGHTS RESERVED.
*
* 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 )%
*
* Edit (%O'17', '8-Oct-84', 'Sandy Clemens')
* %( Put in new copyright notices. FILES: CD36T1.10-CBL,
* CD36T1.CBL, CD32T1.VAX-COB, CT36T1.10-CBL, CT32T1.VAX-COB,
* FD7T1.10-FOR, FD7T1.FOR, FD32T1.VAX-FOR, FT7T1.FOR,
* FT32T1.VAX-FOR. )%
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.