ZOS] sms rule 변경 후 적용 명령어

acds switch 명령어
/setsms acds(SYS1.SMS.PROD.ACDS)


scds 적용 및 activate
/setsms scds(SYS1.SMS.PROD.SCDS)

ZOS] multi volume data set catalog add

//PSJTSO1V JOB A,A,CLASS=K,MSGCLASS=X
//*------------------------------------------------------------
//* VSAM RECATALOG ( CLUSTER & AIX ) --
//*------------------------------------------------------------
//STEP1 EXEC PGM=IDCAMS,REGION=512K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEFINE NONVSAM(NAME(SD.NISPLAN.UNLOAD) -
VOLUMES(RB0052,RB0053) -
DEVICETYPES(3390)) -
CATALOG(CATALOG.UC.SAM)

ZOS,BMC] ADU share level change option 사용 case #2

//BMC@UDMG JOB CLASS=W,MSGCLASS=X,NOTIFY=&SYSUID
//* UNLOAD
//UNLOAD EXEC PGM=ADUUMAIN,REGION=0M,
// PARM='DSNA,LCFB01TS,NEW,,MSGLEVEL(1)'
//STEPLIB DD DISP=SHR,DSN=BMCP.DB2.LOAD
//SYSREC01 DD DSN=SD.DATA.D071206.LCFB01T.M200711,
// DISP=(NEW,CATLG),UNIT=3390,
// SPACE=(CYL,(100,200),RLSE),
// VOL=SER=RB0045
//SORTWK01 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB10
//SORTWK02 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB11
//SORTWK03 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB12
//SORTWK04 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB13
//SORTWK05 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB14
//SORTWK06 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB15
//SORTWK07 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB16
//SORTWK08 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB17
//SORTWK09 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB18
//SORTWK10 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB19
//*YSCNTL DD DSN=SD.DATA.D071206.LCFB01T.PUNCH,
//* UNIT=3390,SPACE=(TRK,(15,15)),
//* DISP=(NEW,CATLG),VOL=SER=KB1319
//UTPRINT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSIN DD *
UNLOAD
SHRLEVEL CHANGE
UNLOADDN(SYSREC01)
SELECT * FROM KBDB.LCFB01T
WHERE LCFB01_FIN_YM = '200711'
;
/*

ZOS,BMC] ADU share level change option 사용 case #1

//BMC@UD03 JOB CLASS=W,MSGCLASS=X,NOTIFY=&SYSUID
//* UNLOAD
//UNLOAD EXEC PGM=ADUUMAIN,REGION=0M,
// PARM='DSNA,LCFB01TS,NEW,,MSGLEVEL(1)'
//STEPLIB DD DISP=SHR,DSN=BMCP.DB2.LOAD
//VSAMDD DD DISP=SHR,DSN=PDB2.DSNDBD.LCDB00.LCFB01S.I0001.A003
//SYSREC01 DD DSN=SD.DATA.D071206.LCFB01T.PART03,
// DISP=(NEW,CATLG),UNIT=3390,
// SPACE=(CYL,(2000,200),RLSE),
// VOL=SER=(RB0021,RB0046)
//SORTWK01 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB10
//SORTWK02 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB11
//SORTWK03 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB12
//SORTWK04 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB13
//SORTWK05 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB14
//SORTWK06 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB15
//SORTWK07 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB16
//SORTWK08 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB17
//SORTWK09 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB18
//SORTWK10 DD UNIT=3390,SPACE=(CYL,(2000,300)),VOL=SER=UADB19
//*YSCNTL DD DSN=SD.DATA.D071206.LCFB01T.PUNCH,
//* UNIT=3390,SPACE=(TRK,(15,15)),
//* DISP=(NEW,CATLG),VOL=SER=KB1319
//UTPRINT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSIN DD *
UNLOAD
DIRECT YES SHRLEVEL CHANGE
INFILE VSAMDD
UNLOADDN(SYSREC01)
SELECT * FROM KBDB.LCFB01T OPTIONS (PART 3);
/*

ZOS,BMC] PTF BIN lib. 정보

Data Set Name . . . . : DBPGBMC.UIS.PTF.BIN

General Data Current Allocation
Management class . . : **None** Allocated cylinders : 10
Storage class . . . : **None** Allocated extents . : 1
Volume serial . . . : PSF159
Device type . . . . : 3390
Data class . . . . . : **None** Current Utilization
Organization . . . : PS Used cylinders . . : 1
Record format . . . : FB Used extents . . . : 1
Record length . . . : 80
Block size . . . . : 27920
1st extent cylinders: 10
Secondary cylinders : 10
Data set name type : SMS Compressible : NO

Creation date . . . : 2007/04/03 Referenced date . . : 2007/11/22
Expiration date . . : ***None***

ZOS,BMC] 설치 Tape file download

//UNLOAD EXEC PGM=IEBCOPY
//SYSPRINT DD SYSOUT=*
//SYSUT3 DD UNIT=SYSDA,SPACE=(TRK,(1,1))
//SYSUT4 DD UNIT=SYSDA,SPACE=(TRK,(1,1))
//BMCTLOAD DD DSN=BMC.INSTALL.LOAD,DISP=OLD,VOL=SER=B9A789,
// UNIT=ACST,LABEL=(1,SL,EXPDT=98000)
//*
//BMCTINST DD DSN=BMC.INSTALL,DISP=OLD,VOL=SER=B9A789,
// UNIT=AFF=BMCTLOAD,LABEL=(2,SL,EXPDT=98000)
//*
//BMCILOAD DD DISP=(,CATLG,DELETE),DSN=DBTGBMC.UIS.INSTALL.LOAD,
// UNIT=SYSDA,SPACE=(CYL,(50,5,500)),VOL=SER=TS7090,
// DCB=(RECFM=U,BLKSIZE=23476)
//*
//BMCIINST DD DISP=(,CATLG,DELETE),DSN=DBTGBMC.UIS.INSTALL,
// UNIT=SYSDA,SPACE=(CYL,(60,5,900)),VOL=SER=TS7090,
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=6160)
//*
//SYSIN DD *
COPY I=BMCTLOAD,O=BMCILOAD
COPY I=BMCTINST,O=BMCIINST
/*

ZOS,DB2] 특정 문자에 대한 변경 (update)

UPDATE DCT.DTZ250
SET Z25_CD_ABNM = REPLACE(Z25_CD_ABNM, ' 현대카드 ',' 큐로컴 ')
WHERE Z25_CD_ABNM LIKE '% 현대카드 %'
;

ZOS] BMC REORG maint list 출력 JCL

//BMCINSTJ JOB MSGCLASS=X,CLASS=A,MSGLEVEL=(1,1),NOTIFY=&SYSUID
//* NOTIFY=&SYSUID
//*
//REORG EXEC PGM=ARUUMAIN,
// PARM='DBPG,BMCUIS02,MAINT,,MSGLEVEL(1)',
// REGION=4M
//STEPLIB DD DISP=SHR,DSN=DBPGBMC.UIS.LOAD
//BMCCPY DD DUMMY
//BMCCPZ DD DUMMY
//UTPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SORTWK01 DD UNIT=3390,SPACE=(CYL,(1,1)),DISP=(NEW,DELETE)
//SYSUT1 DD DUMMY
//SYSREC DD DUMMY
//SYSIN DD DUMMY
/*

ZOS] FTP 사용시 한글 전송이 가능하도록 환경 설정 명령어

QUOTE TYPE B 6

BMC,ZOS] SMP/E applied list

//BMCINSTL JOB (PLS,81038),CLASS=A,MSGCLASS=H,MSGLEVEL=(1,1),
// NOTIFY=SYSPRG1
//BMCSMP PROC GBL='BMC1026A.SMPE.GLOBAL.CSI',
// SMPDS='BMC1026A.SMPE',
// DHLQ='BMC1026A.SMPE.DLIB.CSI',
// THLQ='BMC1026A.SMPE.TARGET.CSI',
// RGN=0K, REGION SIZE SET FOR MAX. REGION
// SOUT='*', SYSOUT CLASS
// WRKCYL=75, CYL ALLOC. FOR SMPWRKX
// UTCYL=35, CYL ALLOC. FOR SYSUTX
// DIRBLKS=999 DIR BLKS FOR SMPWRKX
//SMP EXEC PGM=GIMSMP,PARM='DATE=U',REGION=&RGN,TIME=1440
//SMPCSI DD DSN=&GBL,DISP=SHR GLOBAL ZONE
//BMC0DZN DD DSN=&DHLQ,DISP=OLD DLIB ZONE
//BMC0TZN DD DSN=&THLQ,DISP=SHR TARGET ZONE
//SMPPTS DD DSN=&SMPDS..SMPPTS,DISP=SHR SMP/E DATA SETS
//SMPMTS DD DSN=&SMPDS..SMPMTS,DISP=SHR
//SMPLTS DD DSN=&SMPDS..SMPLTS,DISP=SHR
//SMPSTS DD DSN=&SMPDS..SMPSTS,DISP=SHR
//SMPSCDS DD DSN=&SMPDS..SMPSCDS,DISP=SHR
//SMPLOG DD DSN=&SMPDS..SMPLOG,DISP=MOD
//SMPRPT DD SYSOUT=&SOUT SYSOUT
//SMPOUT DD SYSOUT=&SOUT SYSOUT
//SMPLIST DD SYSOUT=&SOUT SYSOUT
//SYSPRINT DD SYSOUT=&SOUT SYSOUT
//SYSTERM DD SYSOUT=&SOUT SYSOUT
//SMPWRK1 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)), WORK
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK2 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK3 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK4 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK6 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SYSLIB DD DSN=&SMPDS..SMPMTS,DISP=SHR SYSLIB
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5)) WORK
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
// PEND
//*
//LIST EXEC BMCSMP
//SMP.SMPCNTL DD *
SET BDY(GLOBAL).
LIST SYSMODS
ALLZONES .
/*
//*

BMC,ZOS] SMP/E apply JCL (with CHECK option)

//BMCINSTL JOB (PLS,81038),CLASS=A,MSGCLASS=H,MSGLEVEL=(1,1),
// NOTIFY=SYSPRG1
/*JOBPARM L=9999
//BMCSMP PROC GBL='BMC1026A.SMPE.GLOBAL.CSI',
// SMPDS='BMC1026A.SMPE',
// DHLQ='BMC1026A.SMPE.DLIB.CSI',
// THLQ='BMC1026A.SMPE.TARGET.CSI',
// RGN=0K, REGION SIZE SET FOR MAX. REGION
// SOUT='*', SYSOUT CLASS
// WRKCYL=75, CYL ALLOC. FOR SMPWRKX
// UTCYL=35, CYL ALLOC. FOR SYSUTX
// DIRBLKS=999 DIR BLKS FOR SMPWRKX
//SMP EXEC PGM=GIMSMP,PARM='DATE=U',REGION=&RGN,TIME=1440
//SMPCSI DD DSN=&GBL,DISP=SHR GLOBAL ZONE
//BMC0DZN DD DSN=&DHLQ,DISP=OLD DLIB ZONE
//BMC0TZN DD DSN=&THLQ,DISP=SHR TARGET ZONE
//SMPPTS DD DSN=&SMPDS..SMPPTS,DISP=SHR SMP/E DATA SETS
//SMPMTS DD DSN=&SMPDS..SMPMTS,DISP=SHR
//SMPLTS DD DSN=&SMPDS..SMPLTS,DISP=SHR
//SMPSTS DD DSN=&SMPDS..SMPSTS,DISP=SHR
//SMPSCDS DD DSN=&SMPDS..SMPSCDS,DISP=SHR
//SMPLOG DD DSN=&SMPDS..SMPLOG,DISP=MOD
//SMPRPT DD SYSOUT=&SOUT SYSOUT
//SMPOUT DD SYSOUT=&SOUT SYSOUT
//SMPLIST DD SYSOUT=&SOUT SYSOUT
//SYSPRINT DD SYSOUT=&SOUT SYSOUT
//SYSTERM DD SYSOUT=&SOUT SYSOUT
//SMPWRK1 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)), WORK
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK2 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK3 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK4 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK6 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SYSLIB DD DSN=&SMPDS..SMPMTS,DISP=SHR SYSLIB
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5)) WORK
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
// PEND
//*
//APPLY EXEC BMCSMP
//SMP.SMPCNTL DD *
SET BDY(BMC0TZN).
APPLY SELECT(
BPU0172,BPU0174,BPU0176,BPU0177,BPU0178,BPU0193
BPU0197,BPU0227,BPU0229,BPU0232,BPU0238,BPU0270
BPU0277,BPU0290,BPU0297,BPU0301
)
GROUPEXTEND
BYPASS(HOLDSYS(DOC,ACTION,DELETE))
CHECK
.
/*

BMC,ZOS] SMP/E receive jcl

//BMCINSTL JOB (PLS,81038),CLASS=A,MSGCLASS=H,MSGLEVEL=(1,1),
// NOTIFY=SYSPRG1
/*JOBPARM L=9999
//********************************************************************
//BMCSMP PROC GBL='BMC1026A.SMPE.GLOBAL.CSI',
// SMPDS='BMC1026A.SMPE',
// DHLQ='BMC1026A.SMPE.DLIB.CSI',
// THLQ='BMC1026A.SMPE.TARGET.CSI',
// RGN=0K, REGION SIZE SET FOR MAX. REGION
// SOUT='*', SYSOUT CLASS
// WRKCYL=75, CYL ALLOC. FOR SMPWRKX
// UTCYL=35, CYL ALLOC. FOR SYSUTX
// DIRBLKS=999 DIR BLKS FOR SMPWRKX
//SMP EXEC PGM=GIMSMP,PARM='DATE=U',REGION=&RGN,TIME=1440
//SMPCSI DD DSN=&GBL,DISP=SHR GLOBAL ZONE
//BMC0DZN DD DSN=&DHLQ,DISP=OLD DLIB ZONE
//BMC0TZN DD DSN=&THLQ,DISP=SHR TARGET ZONE
//SMPPTS DD DSN=&SMPDS..SMPPTS,DISP=SHR SMP/E DATA SETS
//SMPMTS DD DSN=&SMPDS..SMPMTS,DISP=SHR
//SMPLTS DD DSN=&SMPDS..SMPLTS,DISP=SHR
//SMPSTS DD DSN=&SMPDS..SMPSTS,DISP=SHR
//SMPSCDS DD DSN=&SMPDS..SMPSCDS,DISP=SHR
//SMPLOG DD DSN=&SMPDS..SMPLOG,DISP=MOD
//SMPRPT DD SYSOUT=&SOUT SYSOUT
//SMPOUT DD SYSOUT=&SOUT SYSOUT
//SMPLIST DD SYSOUT=&SOUT SYSOUT
//SYSPRINT DD SYSOUT=&SOUT SYSOUT
//SYSTERM DD SYSOUT=&SOUT SYSOUT
//SMPWRK1 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)), WORK
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK2 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK3 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK4 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SMPWRK6 DD UNIT=SYSDA,SPACE=(CYL,(&WRKCYL,15,&DIRBLKS)),
// DCB=(BLKSIZE=6160,RECFM=FB,LRECL=80)
//SYSLIB DD DSN=&SMPDS..SMPMTS,DISP=SHR SYSLIB
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5)) WORK
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(&UTCYL,5))
// PEND
//* *
//PTFS EXEC BMCSMP,
// COND=(8,LT)
//SMPHOLD DD DUMMY
//SMPPTFIN DD DISP=SHR,DSN=BMC1026A.PTF.ZALP081.F8W9427
//SMPCNTL DD *
SET BDY(GLOBAL).
RECEIVE SYSMODS.
/*
//

DOS] host 전송 FTP

!!! ftp 전송 batch 실행 파일 : upload-9a.bat
ftp -s:upload-9a.txt

!!! ftp 전송 실행 문장 : upload-9a.txt
open 192.168.254.99
sysprg1
dbadmin
bin
hash
prompt
literal site recfm=fb lr=80 blocksi=3120
literal site unit=3390 cylinders pri=40 sec=10
literal site storclas=USRBASE
lcd D:\Hercules\BMC\ESD
put bmcb9a-v2215-image.bin 'bmc1005t.bmc.b9a.image'
quit

BMC,ZOS] maint list

//BMCINST1 JOB CLASS=M,MSGCLASS=X,TIME=1440,REGION=0M,
// NOTIFY=NMSTSO1
//LOADPLUS EXEC PGM=AMUUMAIN,
// PARM='DSN3,BMCUIS01,MAINT,,MSGLEVEL(1)'
//STEPLIB DD DISP=SHR,DSN=BMCT.UTIL83.LOAD
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY

ZOS] zap JCL - AMASPZAP

//BMCZAPP JOB (PALP),'ZAP-ALP',CLASS=A,MSGCLASS=X,MSGLEVEL=(1,1)
//*--------------------------------------------------------------------
//* A ZAPPING WE WILL GO....
//*--------------------------------------------------------------------
//ZAPPING EXEC PGM=AMASPZAP,PARM='IGNIDRFULL'
//SYSLIB DD DISP=SHR,DSN=BMC.DIS.LOAD
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
*-------------------------------------------------------------------
*

ZOS] TAPE를 파일로 만드는 작업 실행 JCL

//SJS05C JOB 'NEXSIS',CLASS=A,MSGCLASS=X,REGION=4M,NOTIFY=&SYSUID
//AWSUTIL EXEC PGM=AWSUTIL
//STEPLIB DD DISP=SHR,DSN=SJS05.BATCH.LOADLIB
//SYSPRINT DD SYSOUT=*
//SYSOUT DD DISP=(NEW,CATLG,DELETE),DSN=SJS05.DB2.IR2101,
// UNIT=3390,
// VOL=SER=SYS2B4,SPACE=(CYL,(100,20),RLSE)
//INTAPE DD DISP=SHR,UNIT=TAPEC,VOL=SER=IR2101,
// LABEL=(1,SL),DSN=SMPMCS
//*NPUT DD *
//SYSIN DD *
VERIFY
TAPEALL INTAPE
/*
//

ZOS] TAPE를 파일로 만드는 소스 컴파일하기

//BMCINSTL JOB CLASS=A,MSGCLASS=A,TIME=1440,NOTIFY=&SYSUID,
// MSGLEVEL=(1,1)
//ASMCLG PROC
//C EXEC PGM=ASMA90,PARM='NOOBJECT,DECK',REGION=4M
//SYSPRINT DD SYSOUT=*
//SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR
// DD DSN=SYS1.MODGEN,DISP=SHR
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(5,5))
//SYSPUNCH DD DSN=&&OBJSET,DISP=(,PASS),UNIT=SYSDA,
// SPACE=(TRK,(5,5)),DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120)
//IEWL EXEC PGM=IEWL,PARM='LIST,LET,NCAL,MAP',REGION=4M
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(5,5))
//SYSLIN DD DSN=&&OBJSET,DISP=(OLD,DELETE)
//SYSLMOD DD DISP=SHR,DSN=DBTGBMC.UIS.LOAD(AWSUTIL)
// PEND
//ASMCLG EXEC ASMCLG
//C.SYSIN DD *
MACRO
&LABEL SETRC &SYM
&LABEL CLC MAXRC,&SYM | Check for
BNL *+4+6 | ERR>MAX
MVC MAXRC,&SYM |
MEND
MACRO
&LABEL PRMSG &MSG,&INIT=NO,&INCPTR=YES,&LEN=0
LCLA &L
LCLC &LIT
AIF ('&INIT' EQ 'YES').INIT
AIF ('&MSG'(1,1) EQ '=').LIT
.SYM ANOP
&L SETA &LEN
AIF (&L NE 0).MOVESYM
&L SETA L'&MSG
.MOVESYM ANOP
&LABEL MVC 0(&L.,1),&MSG | Move data
AIF ('&INCPTR' EQ 'NO').EXITSYM
LA 1,&L.(,1) | Bump pointer
.EXITSYM MEXIT
.LIT ANOP
&L SETA &LEN
AIF (&L NE 0).MOVELIT
&L SETA K'&MSG-4
AIF ('&MSG'(2,1) EQ 'C').MOVELIT
&L SETA &L/2
AIF ('&MSG'(2,1) EQ 'X').MOVELIT
&LIT SETC '&MSG'(1,2)
MNOTE 8,'UNSUPPORTED LITERAL: &LIT'
MEXIT
.MOVELIT ANOP
&LABEL MVC 0(&L.,1),&MSG | Move data
AIF ('&INCPTR' EQ 'NO').EXITLIT
LA 1,&L.(,1) | Bump pointer
.EXITLIT MEXIT
.INIT ANOP
AIF ('&MSG' EQ '').DEFCC
&LABEL MVI OUTANSI,&MSG | Set CC
AGO .CLRBUF
.DEFCC ANOP
&LABEL MVI OUTANSI,ANSI#1L | Default CC
.CLRBUF ANOP
MVI OUTBUFF,C' ' | Clear Buffer
MVC OUTBUFF+1(L'OUTBUFF-1),OUTBUFF |
LA 1,OUTBUFF | Set Pointer
MEND
TITLE 'AWSUTIL - Generate AWSTAPE format tape image'
AWSUTIL CSECT
STM 14,12,12(13) | Entry
LR 12,15 |
USING AWSUTIL,12 |
GETMAIN R,LV=72 |
ST 13,4(,1) |
ST 1,8(,13) |
LR 13,1 |
SPACE
OPEN (SYSPRINT,OUTPUT) | Open SYSOUT
LTR 15,15 |
BNZ PRINTERR |
SPACE
PRMSG ANSI#TOP,INIT=YES | Page header
PRMSG =C'AWSUTIL V1.1 PROGRAM STARTED' |
PUT SYSPRINT,OUTLINE |
SPACE
PRMSG INIT=YES | Blank line
PUT SYSPRINT,OUTLINE |
SPACE
OPEN SYSIN | Open SYSIN
LTR 15,15 |
BNZ INPUTERR |
SPACE
OPEN (SYSOUT,OUTPUT) | Open SYSOUT
LTR 15,15 |
BNZ SYSOUTER |
SPACE
XC PREVBLOK,PREVBLOK | Reset counters
XC CURRBLOK,CURRBLOK |
SPACE
GETMAIN R,LV=OUTBLKL+4 | Put Buffer
LR 10,1 |
SPACE
MAINLOOP DS 0H
SPACE
GET SYSIN,INLINE | Get a line
SPACE
PRMSG ANSI#1L,INIT=YES |
CLI VERIFY$,X'00' | Skip?
BE *+8 |
MVI OUTANSI,ANSI#2L |
SPACE
PRMSG =C'>>> ' | Redisplay
PRMSG INLINE |
PUT SYSPRINT,OUTLINE |
SPACE
MVC INVERB,=CL8' ' | Erase tokens
MVC INARG1,=CL8' ' |
SPACE
LA 0,L'INLINE | Buffer to scan
LA 1,INLINE |
SPACE
PARSET1A CLI 0(1),C' ' | Skip past space
BNE PARSET1 |
LA 1,1(,1) |
BCT 0,PARSET1A |
B PARSEXX |
SPACE
PARSET1 LA 2,L'INVERB | Fill Verb
LA 3,INVERB |
SPACE
PARSET1X CLI 0(1),C' ' | Copy data
BE PARSET2A |
LTR 2,2 |
BNP PARSET1Y |
MVC 0(1,3),0(1) |
SH 2,=H'1' |
LA 3,1(,3) |
PARSET1Y LA 1,1(,1) |
BCT 0,PARSET1X |
B PARSEXX |
SPACE
PARSET2A CLI 0(1),C' ' | Skip past space
BNE PARSET2 |
LA 1,1(,1) |
BCT 0,PARSET2A |
B PARSEXX |
SPACE
PARSET2 LA 2,L'INARG1 | Fill Arg1
LA 3,INARG1 |
SPACE
PARSET2X CLI 0(1),C' ' | Copy data
BE PARSEXX |
LTR 2,2 |
BNP PARSET2Y |
MVC 0(1,3),0(1) |
SH 2,=H'1' |
LA 3,1(,3) |
PARSET2Y LA 1,1(,1) |
BCT 0,PARSET2X |
SPACE
PARSEXX DS 0H
SPACE
CLI INVERB,C'*' | Comment?
BE MAINLOOP |
SPACE
*
* Check command name and call routine
*
SPACE
CLC INVERB,=CL8'TAPEMARK' | TAPEMARK cmd
L 11,=A(@TAPEMRK) |
BZR 11 |
SPACE
CLC INVERB,=CL8'READ' | READ cmd
L 11,=A(@READ) |
BZR 11 |
SPACE
CLC INVERB,=CL8'GET' | GET cmd
L 11,=A(@GET) |
BZR 11 |
SPACE
CLC INVERB,=CL8'TAPEFILE' | TAPEFILE cmd
L 11,=A(@TAPE) |
BZR 11 |
SPACE
CLC INVERB,=CL8'TAPEALL' | TAPEALL cmd
L 11,=A(@TAPE) |
BZR 11 |
SPACE
CLC INVERB,=CL8'ASCII' | ASCII command
L 11,=A(@LABLFRM) |
BZR 11 |
SPACE
CLC INVERB,=CL8'EBCDIC' | EBCDIC command
L 11,=A(@LABLFRM) |
BZR 11 |
SPACE
CLC INVERB,=CL8'VERIFY' | VERIFY command
L 11,=A(@VERIFY) |
BZR 11 |
SPACE
*
* Check command name for tape label identifier
*
SPACE
LA 0,LABELS# | Setup loop
LA 1,LABELS |
L 11,=A(@LABELS) |
SPACE
LABELOOP CLC INVERB(4),0(1) | Check for
BER 11 | label id
SPACE
LA 1,4(,1) | Check next
BCT 0,LABELOOP |
SPACE
*
* Command is not supported, report error
*
SPACE
PRMSG ANSI#3L,INIT=YES | Print Err
PRMSG =C'ERROR: COMMAND VERB "' |
PRMSG INVERB |
PRMSG =C'" IS UNKNOWN' |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B MAINLOOP | Loop
SPACE
INPUTERR DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print Err
PRMSG =C'FATAL: UNABLE TO OPEN DD=SYSIN' |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B CLOSEOUT |
SPACE
SYSOUTER DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print Err
PRMSG =C'FATAL: UNABLE TO OPEN DD=SYSOUT' |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B CLOSEIN
SPACE
CLOSE DS 0H
SPACE
FREEMAIN R,LV=OUTBLKL+4,A=(10) | Free Put Buff
SPACE
CLOSE SYSOUT | Try to close
LTR 15,15 |
BZ CLOSEIN |
SPACE
PRMSG ANSI#3L,INIT=YES | Print Err
PRMSG =C'FATAL: ERROR CLOSING DD=SYSOUT' |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
CLOSEIN DS 0H
SPACE
CLOSE SYSIN | Close input
SPACE
CLOSEOUT DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Final Line
PRMSG =C'AWSUTIL PROGRAM TERMINATED, MAX RC' |
PRMSG =X'40202120',INCPTR=NO |
LH 0,MAXRC |
CVD 0,DWORD |
ED 0(4,1),DWORD+6 |
PRMSG =C'=' |
PUT SYSPRINT,OUTLINE |
SPACE
CLOSE SYSPRINT | Close output
SPACE
B RETURN
SPACE
RETURN LR 1,13 | Exit with rc
L 13,4(,1) |
FREEMAIN R,LV=72,A=(1) |
LH 15,MAXRC |
L 14,12(13) |
LM 0,12,20(13) |
BR 14 |
SPACE 00380007
PRINTERR DS 0H
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B RETURN |
SPACE
DROP 12
SPACE
OUTBLKL EQU 4096 | block length
SPACE
ANSI#TOP EQU C'1'
ANSI#3L EQU C'-'
ANSI#2L EQU C'0'
ANSI#1L EQU C' '
LTORG
TITLE 'Common Storage'
SPACE 00380007
DWORD DS 1D | DoubleWord
ECB DS 1F | General ECB
SPACE
MAXRC DC H'0' | Maximum RC
ERR$ERR DC H'8' | error rc
ERR$FATL DC H'16' | fatal rc
SPACE 00380007
VERIFY$ DC X'00' | Verify off
SPACE
ASCIILBL DC X'00' | ASC/EBC labels
SPACE
OUTLINE DS 0CL133' ' | Output buffer
OUTANSI DS CL1' ' |
OUTBUFF DS CL132' ' |
SPACE
INLINE DS CL80' ' | Input buffer
SPACE
INVERB DS CL8' ' |
INARG1 DS CL8' ' |
SPACE
PREVBLOK DS F
CURRBLOK DS F
AWS#MARK EQU X'40'
AWS#REC EQU X'80'+X'20'
SPACE
LABELS DC C'VOL1HDR1EOV1EOF1HDR2EOV2EOF2' | All valid
DC C'UHL1UHL2UHL3UHL4UHL5UHL6UHL7UHL8' | 80 byte
DC C'UTL1UTL2UTL3UTL4UTL5UTL6UTL7UTL8' | labels
LABELS# EQU (*-LABELS)/4
SPACE
IEZIOB DSECT=NO | IOB
SPACE
SYSPRINT DCB DDNAME=SYSPRINT, +
MACRF=PM, +
DSORG=PS, +
LRECL=133, +
RECFM=FBA
SYSIN DCB DDNAME=SYSIN, +
MACRF=GM, +
DSORG=PS, +
LRECL=80, +
RECFM=FB, +
EODAD=CLOSE
SYSOUT DCB DDNAME=SYSOUT, +
MACRF=PM, +
DSORG=PS, +
LRECL=OUTBLKL+4, +
RECFM=VB
SPACE
LTORG
SPACE
TITLE '@VERIFY - toggle verify flag'
SPACE
@VERIFY CSECT
USING @VERIFY,11
USING AWSUTIL,12
SPACE
CLI VERIFY$,X'00' | Check flag
BE VFY$ON |
SPACE
MVI VERIFY$,X'00' |
SPACE
PRMSG ANSI#1L,INIT=YES | Print
PRMSG =C'VERIFY FLAG IS NOW OFF' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP
SPACE
VFY$ON DS 0H
SPACE
MVI VERIFY$,X'FF' | Turn on flag
SPACE
PRMSG ANSI#1L,INIT=YES | Print
PRMSG =C'VERIFY FLAG IS NOW ON' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP
SPACE
DROP 11,12
SPACE
LTORG
TITLE '@LABLFRM - set ASCII or EBCDIC labels'
SPACE
@LABLFRM CSECT
USING @LABLFRM,11
USING AWSUTIL,12
SPACE
CLC INVERB,=CL8'ASCII'
BE LAB$ASC
SPACE
MVI ASCIILBL,X'00'
SPACE
CLI VERIFY$,X'00' | Check flag
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print
PRMSG =C'EBCDIC LABELS SELECTED' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP
SPACE
LAB$ASC DS 0H
SPACE
MVI ASCIILBL,X'FF'
SPACE
CLI VERIFY$,X'00' | Check flag
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print
PRMSG =C'ASCII LABELS SELECTED' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP
SPACE
DROP 11,12
SPACE
LTORG
SPACE
TITLE '@TAPEMRK - write a tapemark to the AWS tape'
SPACE
@TAPEMRK CSECT
USING PUTBUFF,10
USING @TAPEMRK,11
USING AWSUTIL,12
SPACE
MVC PUTRDW,=AL2(6+4) | Setup RDW
XC PUTCLR,PUTCLR |
SPACE
MVC PREVBLOK,CURRBLOK | Cycle bloks
XC CURRBLOK,CURRBLOK |
SPACE
MVC PUTCURL,CURRBLOK+3 | Reverse byte
MVC PUTCURH,CURRBLOK+2 | order
SPACE
MVC PUTPRVL,PREVBLOK+3 | Reverse byte
MVC PUTPRVH,PREVBLOK+2 | order
SPACE
MVI PUTFLG1,AWS#MARK | Tape Mark
XC PUTFLG2,PUTFLG2
SPACE
PUT SYSOUT,PUTBUFF | Put record
SPACE
CLI VERIFY$,X'00' | Skip?
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print info
PRMSG =C'WRITE TAPE MARK OK' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP | Back to loop
SPACE
DROP 10,11,12
SPACE
LTORG
TITLE '@LABELS - write 80 byte tape label to AWS tape'
SPACE
@LABELS CSECT
USING PUTBUFF,10
USING @LABELS,11
USING AWSUTIL,12
SPACE
MVC PUTRDW,=AL2(80+6+4) | Setup RDW
XC PUTCLR,PUTCLR |
SPACE
MVC PREVBLOK,CURRBLOK | Cycle bloks
MVC CURRBLOK,=F'80' |
SPACE
MVC PUTCURL,CURRBLOK+3 | Reverse byte
MVC PUTCURH,CURRBLOK+2 | order
SPACE
MVC PUTPRVL,PREVBLOK+3 | Reverse byte
MVC PUTPRVH,PREVBLOK+2 | order
SPACE
MVI PUTFLG1,AWS#REC | Data Block
XC PUTFLG2,PUTFLG2 |
SPACE
MVC PUTDATA(L'INLINE),INLINE | Copy record
SPACE
CLI ASCIILBL,X'00' | Check for
BE LAB$PUT | ASCII
SPACE
XLATE PUTDATA,80,TO=A | Xlate 2 ASCII
SPACE
LAB$PUT DS 0H
SPACE
PUT SYSOUT,PUTBUFF | Put record
SPACE
CLI VERIFY$,X'00' | Skip?
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print info
PRMSG =C'WRITE LABEL ' |
PRMSG INVERB,LEN=4 |
PRMSG =C' OK' |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP | Back to loop
SPACE
DROP 10,11,12
SPACE
LTORG
TITLE '@READ - read records from input to AWS tape'
SPACE
@READ CSECT
USING PUTBUFF,10
USING @READ,11
USING AWSUTIL,12
SPACE
MVC RD$INDCB+DCBDDNAM-IHADCB(8),=CL8'INPUT' Default name
SPACE
CLI INARG1,C' ' | Check DDNAME
BE *+10 |
MVC RD$INDCB+DCBDDNAM-IHADCB(8),INARG1 | Set DDNAME
SPACE
MVC RD$INDD,RD$INDCB+DCBDDNAM-IHADCB | Save DDNAME
SPACE
OPEN RD$INDCB | Open DD
LTR 15,15 |
BNZ RD$OERR |
SPACE
CLI VERIFY$,X'00' | Skip?
BE RD$START |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'OPEN COMPLETE FOR INPUT DD=' |
PRMSG RD$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
RD$START DS 0H
SPACE
XC RD$BLK,RD$BLK | Clear counter
SPACE
GETMAIN R,LV=65536 | Get buffer
LR 9,1 |
SPACE
RD$LOOP DS 0H
SPACE
READ RD$CHK,SF,RD$INDCB,(9) | Read block
CHECK RD$CHK |
SPACE
LH 3,RD$INDCB+DCBBLKSI-IHADCB | Calc block
L 2,RD$CHK+16 | length
SH 3,14(,2) |
LR 2,9 |
SPACE
MVC PREVBLOK,CURRBLOK | Cycle bloks
ST 3,CURRBLOK |
SPACE
MVC PUTRDW,=AL2(6+4) | Setup RDW
XC PUTCLR,PUTCLR |
SPACE
MVC PUTCURL,CURRBLOK+3 | Reverse byte
MVC PUTCURH,CURRBLOK+2 | order
SPACE
MVC PUTPRVL,PREVBLOK+3 | Reverse byte
MVC PUTPRVH,PREVBLOK+2 | order
SPACE
MVI PUTFLG1,AWS#REC | Record
XC PUTFLG2,PUTFLG2
SPACE
PUT SYSOUT,PUTBUFF | Put record
SPACE
RD$LLOP DS 0H
SPACE
LR 1,3 | Current
CH 1,=AL2(OUTBLKL) | output
BNH *+8 | length
LH 1,=AL2(OUTBLKL) |
SPACE
LA 0,4(,1) | Setup RDW
STCM 0,B'0011',PUTRDW |
XC PUTCLR,PUTCLR |
SPACE
LA 0,PUTRDW+4 | Move data
MVCL 0,2 |
SPACE
PUT SYSOUT,PUTBUFF | PUT data
SPACE
LTR 3,3 | Check for
BP RD$LLOP | more data
SPACE
L 0,RD$BLK |
AH 0,=H'1' |
ST 0,RD$BLK |
SPACE
B RD$LOOP |
SPACE
*
* End of input data
*
SPACE
RD$EOD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE RD$CLOSE |
SPACE
PRMSG ANSI#1L,INIT=YES | Print info
PRMSG =C'READ OK, BLOCKS PROCESSED' |
PRMSG =X'402020206B2020206B202120',INCPTR=NO |
L 0,RD$BLK |
CVD 0,DWORD |
ED 0(12,1),DWORD+3 |
PRMSG =C'=' |
PUT SYSPRINT,OUTLINE |
SPACE
RD$CLOSE DS 0H
SPACE
FREEMAIN R,LV=65536,A=(9) | Free buffer
SPACE
CLOSE RD$INDCB | Try to close
LTR 15,15 |
BZ RD$CLOSD |
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'FATAL: ERROR CLOSING INPUT DD=' |
PRMSG RD$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B CLOSE | Just leave
SPACE
RD$CLOSD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'CLOSE COMPLETE FOR INPUT DD=' |
PRMSG RD$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP | Back to main
SPACE
RD$OERR DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'ERROR: ERROR OPENING INPUT DD=' |
PRMSG RD$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B MAINLOOP | Back to main
SPACE
DROP 10,11,12
SPACE
RD$BLK DS F | Block Count
RD$INDCB DCB DDNAME=INPUT, +
MACRF=R, +
DSORG=PS, +
EODAD=RD$EOD
RD$INDD DS CL8' '
LTORG
TITLE '@GET - get records from input to AWS tape'
SPACE
@GET CSECT
USING PUTBUFF,10
USING @GET,11
USING AWSUTIL,12
SPACE
MVC GT$INDCB+DCBDDNAM-IHADCB(8),=CL8'INPUT' Default name
SPACE
CLI INARG1,C' ' | Check DDNAME
BE *+10 |
MVC GT$INDCB+DCBDDNAM-IHADCB(8),INARG1 | Set DDNAME
SPACE
MVC GT$INDD,GT$INDCB+DCBDDNAM-IHADCB | Save DDNAME
SPACE
OPEN GT$INDCB | Open DD
LTR 15,15 |
BNZ GT$OERR |
SPACE
CLI VERIFY$,X'00' | Skip?
BE GT$START |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'OPEN COMPLETE FOR INPUT DD=' |
PRMSG GT$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
GT$START DS 0H
SPACE
XC GT$BLK,GT$BLK | Clear counter
SPACE
GETMAIN R,LV=65536 | Get buffer
LR 9,1 |
SPACE
GT$LOOP DS 0H
SPACE
GET GT$INDCB,(9) | Read block
SPACE
LH 3,GT$INDCB+DCBLRECL-IHADCB | Calc block
LR 2,9 | length
SPACE
MVC PREVBLOK,CURRBLOK | Cycle bloks
ST 3,CURRBLOK |
SPACE
MVC PUTRDW,=AL2(6+4) | Setup RDW
XC PUTCLR,PUTCLR |
SPACE
MVC PUTCURL,CURRBLOK+3 | Reverse byte
MVC PUTCURH,CURRBLOK+2 | order
SPACE
MVC PUTPRVL,PREVBLOK+3 | Reverse byte
MVC PUTPRVH,PREVBLOK+2 | order
SPACE
MVI PUTFLG1,AWS#REC | Record
XC PUTFLG2,PUTFLG2
SPACE
PUT SYSOUT,PUTBUFF | Put record
SPACE
GT$LLOP DS 0H
SPACE
LR 1,3 | Current
CH 1,=AL2(OUTBLKL) | output
BNH *+8 | length
LH 1,=AL2(OUTBLKL) |
SPACE
LA 0,4(,1) | Setup RDW
STCM 0,B'0011',PUTRDW |
XC PUTCLR,PUTCLR |
SPACE
LA 0,PUTRDW+4 | Move data
MVCL 0,2 |
SPACE
PUT SYSOUT,PUTBUFF | PUT data
SPACE
LTR 3,3 | Check for
BP GT$LLOP | more data
SPACE
L 0,GT$BLK |
AH 0,=H'1' |
ST 0,GT$BLK |
SPACE
B GT$LOOP |
SPACE
*
* End of input data
*
SPACE
GT$EOD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE GT$CLOSE |
SPACE
PRMSG ANSI#1L,INIT=YES | Print info
PRMSG =C'GET OK, RECORDS PROCESSED' |
PRMSG =X'402020206B2020206B202120',INCPTR=NO |
L 0,GT$BLK |
CVD 0,DWORD |
ED 0(12,1),DWORD+3 |
PRMSG =C'=' |
PUT SYSPRINT,OUTLINE |
SPACE
GT$CLOSE DS 0H
SPACE
FREEMAIN R,LV=65536,A=(9) | Free buffer
SPACE
CLOSE GT$INDCB | Try to close
LTR 15,15 |
BZ GT$CLOSD |
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'FATAL: ERROR CLOSING INPUT DD=' |
PRMSG GT$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B CLOSE | Just leave
SPACE
GT$CLOSD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'CLOSE COMPLETE FOR INPUT DD=' |
PRMSG GT$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP | Back to main
SPACE
GT$OERR DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'ERROR: ERROR OPENING INPUT DD=' |
PRMSG GT$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B MAINLOOP | Back to main
SPACE
DROP 10,11,12
SPACE
GT$BLK DS F | Block Count
GT$INDCB DCB DDNAME=INPUT, +
MACRF=GM, +
DSORG=PS, +
EODAD=GT$EOD
GT$INDD DS CL8' '
LTORG
TITLE '@TAPE - Copy tape via excp to AWS tape'
SPACE
@TAPE CSECT
USING PUTBUFF,10
USING @TAPE,11
USING AWSUTIL,12
SPACE
MVC TP$INDCB+DCBDDNAM-IHADCB(8),=CL8'INPUT' | Default name
SPACE
CLI INARG1,C' ' | Check DDNAME
BE *+10 |
MVC TP$INDCB+DCBDDNAM-IHADCB(8),INARG1 | Set DDNAME
SPACE
MVC TP$INDD,TP$INDCB+DCBDDNAM-IHADCB | Save DDNAME
SPACE
OPEN TP$INDCB | Open DD
LTR 15,15 |
BNZ TP$OERR |
SPACE
XR 1,1 |
ICM 1,B'0111',TP$INDCB+DCBDEBA-IHADCB | DEB <-- DCB
ICM 1,B'0111',DEBSUCBB-DEBBASIC(1) | UCB <-- DEB
SPACE
CLI UCBTBYT3-UCBOB(1),UCB3TAPE | Check for tape
BNE TP$NOTAP |
SPACE
*
* The 02 command is read forward on all tape drives except 3590
* The 06 command is read forward on 3590 tape drives
*
MVI TP$READ,X'02' | Read Forward
CLC =X'78048083',UCBTYP-UCBOB(1) | 3590?
BNE *+8 |
MVI TP$READ,X'06' | Read Forward
SPACE
CLI VERIFY$,X'00' | Skip?
BE TP$START |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'OPEN COMPLETE FOR INPUT DD=' |
PRMSG TP$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
TP$START DS 0H
SPACE
CLC INVERB,=CL8'TAPEALL' | If TAPEALL,
BNE TP$GETM | rewind tape
SPACE
XC IOB,IOB
MVI IOBFLAG1,B'11000010' | Init IOB
MVI IOBFLAG2,B'00100000' |
LA 0,ECB |
STCM 0,B'0111',IOBECBPB | Point to ECB
LA 0,TP$INDCB |
STCM 0,B'0111',IOBDCBPB | Point to DCB
LA 0,TP$REW |
STCM 0,B'0111',IOBSTRTB | Point to CCW
SPACE
EXCP IOBSTDRD | Execute ch prog
LTR 15,15 |
BNZ TP$EXCPE |
SPACE
WAIT ECB=ECB | Wait for I/O
SPACE
TP$GETM DS 0H
SPACE
GETMAIN R,LV=65536 | Get buffer
LR 9,1 |
SPACE
STCM 9,B'0111',TP$READ+1 | Save buf addr
SPACE
XC TP$BLK,TP$BLK | Clear counter
SPACE
TP$LOOP DS 0H
SPACE
XC IOB,IOB
MVI IOBFLAG1,B'11000010' | Init IOB
MVI IOBFLAG2,B'00100000' |
LA 0,ECB |
STCM 0,B'0111',IOBECBPB | Point to ECB
LA 0,TP$INDCB |
STCM 0,B'0111',IOBDCBPB | Point to DCB
LA 0,TP$READ |
STCM 0,B'0111',IOBSTRTB | Point to CCW
SPACE
EXCP IOBSTDRD | Execute ch prog
LTR 15,15 |
BNZ TP$EXCPE |
SPACE
WAIT ECB=ECB | Wait for I/O
SPACE
TM IOBUSTAT,IOBUSB7 | Check for
BZ TP$DATA | Tape Mark
SPACE
CLC INVERB,=CL8'TAPEFILE' | Leave if only
BE TP$EOD | 1 file
SPACE
XR 2,2 | Clear ptr
XR 3,3 | and len
SPACE
B TP$WRITE |
SPACE
TP$DATA DS 0H
SPACE
CLI ECB,X'7F' | I/O err?
BNE TP$EOD |
SPACE
L 3,=X'0000FFFF' | Record length
XC DWORD(4),DWORD |
MVC DWORD+2(2),IOBCSW+5 |
S 3,DWORD |
SPACE
LR 2,9 | Block Pointer
SPACE
TP$WRITE DS 0H
SPACE
MVC PREVBLOK,CURRBLOK | Cycle bloks
ST 3,CURRBLOK |
SPACE
MVC PUTRDW,=AL2(6+4) | Setup RDW
XC PUTCLR,PUTCLR |
SPACE
MVC PUTCURL,CURRBLOK+3 | Reverse byte
MVC PUTCURH,CURRBLOK+2 | order
SPACE
MVC PUTPRVL,PREVBLOK+3 | Reverse byte
MVC PUTPRVH,PREVBLOK+2 | order
SPACE
MVI PUTFLG1,AWS#REC | Record
LTR 3,3 |
BP *+8 |
MVI PUTFLG1,AWS#MARK | or tapemark
XC PUTFLG2,PUTFLG2 |
SPACE
PUT SYSOUT,PUTBUFF | Put record
SPACE
TP$LLOP DS 0H
SPACE
LTR 3,3 | Check for
BNP TP$BLKC | more data
SPACE
LR 1,3 | Current
CH 1,=AL2(OUTBLKL) | output
BNH *+8 | length
LH 1,=AL2(OUTBLKL) |
SPACE
LA 0,4(,1) | Setup RDW
STCM 0,B'0011',PUTRDW |
XC PUTCLR,PUTCLR |
SPACE
LA 0,PUTRDW+4 | Move data
MVCL 0,2 |
SPACE
PUT SYSOUT,PUTBUFF | PUT data
SPACE
B TP$LLOP
SPACE
TP$BLKC L 0,TP$BLK |
AH 0,=H'1' |
ST 0,TP$BLK |
SPACE
B TP$LOOP |
SPACE
*
* End of input data
*
SPACE
TP$EOD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE TP$CLOSE |
SPACE
PRMSG ANSI#1L,INIT=YES | Print info
PRMSG =C'READ OK, BLOCKS PROCESSED' |
PRMSG =X'402020206B2020206B202120',INCPTR=NO |
L 0,TP$BLK |
CVD 0,DWORD |
ED 0(12,1),DWORD+3 |
PRMSG =C'=' |
PUT SYSPRINT,OUTLINE |
SPACE
TP$CLOSE DS 0H
SPACE
FREEMAIN R,LV=65536,A=(9) | Free buffer
SPACE
CLOSE TP$INDCB | Try to close
LTR 15,15 |
BZ TP$CLOSD |
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'FATAL: ERROR CLOSING INPUT DD=' |
PRMSG TP$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$FATL | Fatal Error
SPACE
B CLOSE | Just leave
SPACE
TP$CLOSD DS 0H
SPACE
CLI VERIFY$,X'00' | Skip?
BE MAINLOOP |
SPACE
PRMSG ANSI#1L,INIT=YES | Print it
PRMSG =C'CLOSE COMPLETE FOR INPUT DD=' |
PRMSG TP$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
B MAINLOOP | Back to main
SPACE
TP$OERR DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'ERROR: ERROR OPENING INPUT DD=' |
PRMSG TP$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B MAINLOOP | Back to main
SPACE
TP$NOTAP DS 0H
SPACE
CLOSE TP$INDCB | Try to close
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'ERROR: INPUT DD=' |
PRMSG TP$INDD |
PRMSG =C' IS NOT ON A TAPE DEVICE' |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B MAINLOOP | Back to main
SPACE
TP$EXCPE DS 0H
SPACE
PRMSG ANSI#3L,INIT=YES | Print it
PRMSG =C'ERROR: EXCP ERROR ON INPUT DD=' |
PRMSG TP$INDD |
PUT SYSPRINT,OUTLINE |
SPACE
SETRC ERR$ERR | Error
SPACE
B TP$CLOSE | Back to main
SPACE
DROP 10,11,12
SPACE
TP$BLK DS F | Block Count
TP$INDCB DCB DDNAME=INPUT, +
MACRF=E, +
EODAD=TP$EOD
TP$INDD DS CL8' '
SPACE
TP$READ DC 0D'0',X'02',AL3(0),X'2000',AL2(65535) | Read CCW
TP$REW DC 0D'0',X'07',AL3(0),X'6000',AL2(1) | Rewind CCW
DC X'03',AL3(0),X'2000',AL2(1) | Nop CCW
SPACE
LTORG
TITLE 'DESCTs'
PUTBUFF DSECT
PUTRDW DS 1H
PUTCLR DS 1H
PUTCURL DS 1B
PUTCURH DS 1B
PUTPRVL DS 1B
PUTPRVH DS 1B
PUTFLG1 DS 1B
PUTFLG2 DS 1B
PUTDATA DS 0B
DCBD DSORG=PS
IEZDEB
IEFUCBOB
END
/*