Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!COBOL AND SORT TEST
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1983 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

!.R SETSRC
*CP [5,33,CBLSRT]
*LIB:[5,33]
*

!.Set default prot <000>

@DEFINE UTP: <UETP.LIB>		!.none

!FILES NEEDED:
!		XT7409.CBL
!		XT749S.CBL
@DEF DSK: <UETP.CBLSRT>,DSK:<UETP.LIB>	!.none
@TAKE SYS.CMD	!.none
		! ***** message START OF COBOL SORT TEST
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE START
*BLABEL BEGIN:
*TEST COBOL
*SEND Start of cobol W/ SORT TEST
*EXIT

@NOERROR	!.NOERROR
@DELETE *.*
@EXPUNGE <UETP.CBLSRT>	!.none
@ERROR	!.ERROR


@I DIS <UETP.CBLSRT>	!.none
@I  LOG ALL	!.none


!TEST FOR EXISTENCE OF COBOL COMPILER ON THIS SYSTEM.
@GET SYS:COBOL.EXE	!.GET SYS:COBOL.EXE
@IF (NOERROR) @GOTO COB::	!.IF (NOERROR) .GOTO COB::

		! ***** message:COBOL not available will use .EXE files
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE MINOR
*BLABEL BEGIN:
*TEST COBOL
*SEND COBOL not available will use .EXE files
*EXIT

@GOTO NOCOB::	!.GOTO NOCOB::

COB::
!
!COBOL WARNING MESSAGES ARE NORMAL HERE
!
@GET SYS:COBOL	!.GET SYS:COBOL
@INF VER	!.VERSIO
@START
*=XT7409
*=XT749S
@IF (ERROR) @GOTO CERR
@LOAD XT7409.REL,XT749S.REL
@IF (NOERROR) @GOTO SAVE::

CERR::
! ***** message: ERROR compiling XTBL09 or XTBL9S 
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE ERROR
*BLABEL COB:
*TEST COBOL
*SEND ERROR compiling XT7409 or XT749S 
*EXIT

@GOTO FIN::	!.GOTO FIN::

SAVE::

@SAVE COBOLT.EXE	!.Save COBOLT.EXE 

NOCOB::
@RUN COBOLT.EXE	!.RUN COBOLT.EXE
*X
*X
*X
*1
*1
*1
@IF (NOERROR) @GOTO FIN::	!.IF (NOERROR) .GOTO FIN::

		! ***** message: ERROR in COBOLT.EXE
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE ERROR
*BLABEL NOCOB:
*TEST COBOL
*SEND ERROR in COBOLT.EXE
*EXIT

@GOTO FIN::	!.GOTO FIN::

END::

%ERR::
		! ***** message: unknon ERROR in COBOL SORT TEST
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE ERROR
*BLABEL END:
*TEST COBOL
*SEND unknown ERROR in COBOL SORT TEST
*EXIT



fin::
%FIN::

@NOERROR	!.NOERROR
@RESET	!.none
@DELETE XT7409.REL
@DELETE PRNTFI.LE
@DELETE CBL74T.EXE
@DELETE XT7409.DAT
@DELETE XT749S.REL
@EXPUNGE <UETP.CBLSRT>	!.none

@CHKPNT ADSF::	!.CHKPNT ADSF::
		! ***** message: END OF COBOL SORT TEST
@RUN UTP:SENDER	!.RUN UTP:SENDER
*TYPE END
*BLABEL END:
*TEST COBOL
*SEND END OF COBOL SORT TEST
*EXIT