*/* -------------------------------------------------------------------
* Restore a cckd file to a real dasd unit.
* The dasd unit must be offline.
*
* Invocation:
* //step EXEC PGM=CCKDLOAD,PARM=unit
* //STEPLIB DD DISP=SHR,DSN=apf.authorized.loadlib
* //SYSPRINT DD SYSOUT=*
* //SYSUT1 DD DISP=SHR,DSN=cckd.file
*
* ------------------------------------------------------------------ */
*/* -------------------------------------------------------------------
* local macros
* ------------------------------------------------------------------ */
MACRO
&L #LLE &R,&A load little-endian
&L IC &R,&A
ICM &R,2,1+&A
ICM &R,4,2+&A
ICM &R,8,3+&A
MEND
MACRO
&L #LHLE &R,&A load halfword little-endian
&L SLR &R,&R
IC &R,&A
ICM &R,2,1+&A
MEND
MACRO
&L #LC &R,&A load conditional
&L TM cdevhdr_options,CCKD_BIGENDIAN
BO #LC&SYSNDX.A
#LLE &R,&A
B #LC&SYSNDX.B
#LC&SYSNDX.A L &R,&A
#LC&SYSNDX.B DS 0H
MEND
MACRO
&L #LHC &R,&A load halfword conditional
&L TM cdevhdr_options,CCKD_BIGENDIAN
BO #LHC&SYSNDX.A
#LHLE &R,&A
B #LHC&SYSNDX.B
#LHC&SYSNDX.A SLR &R,&R
ICM &R,3,&A
#LHC&SYSNDX.B DS 0H
MEND
MACRO
&L #READ &OFFSET=,&LENGTH=,&ADDR= read a cckd block
&L LA r1,pl
.*
AIF ('&OFFSET'(1,1) EQ '(').r1
LA re,&OFFSET
AGO .x1
.r1 LR re,&OFFSET(1)
.x1 ANOP
.*
AIF ('&LENGTH'(1,1) EQ '(').r2
LA rf,&LENGTH
AGO .x2
.r2 LR rf,&LENGTH(1)
.x2 ANOP
.*
AIF ('&ADDR'(1,1) EQ '(').r3
LA r0,&ADDR
AGO .x3
.r3 LR r0,&ADDR(1)
.x3 ANOP
.*
STM re,r0,0(r1)
L rf,=A(readr)
BALR re,rf
MEND
MACRO
&L #WRITE &ADDR= write a ckd track image
.*
AIF ('&ADDR'(1,1) EQ '(').r1
&L LA r1,&ADDR
AGO .x1
.r1 ANOP
&L LR r1,&ADDR(1)
.x1 ANOP
L rf,=A(writer)
BALR re,rf
MEND
MACRO
&L #MSG &MSG,&TYPE=CALL messages
LCLA &A,&N,&O
LCLC &C
GBLA &MSG_IX
GBLC &MSGS(256)
AIF ('&TYPE' EQ 'CALL').CALL, x
('&TYPE' EQ 'GEN').GEN
MNOTE 8,'Invalid type specified'
MEXIT
.*
.CALL ANOP
&MSG_IX SETA &MSG_IX+1
&MSGS(&MSG_IX) SETC '&MSG'
&L L re,=A(#MSG&MSG_IX)
LA rf,L'#MSG&MSG_IX
&A SETA 2
&O SETA 0
&N SETA N'&SYSLIST
AGO .PL0
.PLLOOP ANOP
LA re,&SYSLIST(&A)
&A SETA &A+1
AIF (&A GT &N).PLX14
LA rf,&SYSLIST(&A)
&A SETA &A+1
.PL0 ANOP
AIF (&A GT &N).PLX15
LA r0,&SYSLIST(&A)
&A SETA &A+1
AIF (&A GT &N).PLX0
LA r1,&SYSLIST(&A)
&A SETA &A+1
AIF (&A GT &N).PLX1
STM re,r1,pl+&O
&O SETA &O+16
AGO .PLLOOP
.PLX14 ST re,pl+&O
AGO .CALL2
.PLX15 STM re,rf,pl+&O
AGO .CALL2
.PLX0 STM re,r0,pl+&O
AGO .CALL2
.PLX1 STM re,r1,pl+&O
.CALL2 LA r1,pl
L rf,=a(msgr)
BALR re,rf
MEXIT
.*
.GEN ANOP
AIF ('&L' EQ '').GENNOL
&L DS 0H
.GENNOL ANOP
&A SETA 1
.GENLOOP AIF (&A GT &MSG_IX).MEND
#MSG&A DC C&MSGS(&A)
&A SETA &A+1
AGO .GENLOOP
.MEND MEND
*/* -------------------------------------------------------------------
* mainline routine
* ------------------------------------------------------------------ */
main CSECT ,
main AMODE 31
main RMODE ANY
B init-*(,rf)
DC AL1(init-*)
pgmid DC CL8'cckdload'
vrm DC X'000101' version 0 release 1 modlvl 1
DC C' &SYSDATE &SYSTIME '
init SAVE (14,12)
LR rc,rf set base reg
USING main,rc
LA ra,4095(,rc) set 2nd base reg
USING main+4095,ra
LR r2,r1 copy parm reg
*/* -------------------------------------------------------------------
* obtain and initialize workareas
* ------------------------------------------------------------------ */
STORAGE OBTAIN,LENGTH=workl,BNDRY=PAGE get work area
ST r1,8(,rd) chain save areas
ST rd,4(,r1)
LR rd,r1 set area base
USING work,rd
MVC workid,pgmid set area identifier
LA r0,work+8 clear the area
L r1,=a(workl-8)
SLR rf,rf
MVCL r0,re
STORAGE OBTAIN,LENGTH=work24l,LOC=BELOW,BNDRY=PAGE 24 bit area
LR rb,r1 set 24-bit area base
USING work24,rb
MVC work24id,pgmid set 24-bit area identifier
LA r0,work24+4 clear the 24-bit area
L r1,=a(work24l-4)
SLR rf,rf
MVCL r0,re
*/* -------------------------------------------------------------------
* process PARM= : <unit-address>
* ------------------------------------------------------------------ */
N r2,=A(X'7fffffff') test parameter reg
BZ Enoparm invalid parameter list
L r3,0(,r2) point to parameters
N r3,=A(X'7fffffff') test parameter reg
BZ Enoparm invalid parameter list
LH r4,0(,r3) get length of parameters
LTR r4,r4 test length
BNP Enoparm invalid parameter list
BCTR r4,0 decrement for EX
LA r3,2(,r3) point past length
SLR r2,r2 clear TRT register
*/* 1st and only parm is unit address in hex */
XC dw,dw clear double-word work area
CH r4,=Y(4) check 2nd parm length
BNL Ebadparm error if too long
EX r4,parmmvc copy 2nd parameter
*/* MVC dw(0),0(r3) *** executed *** */
TR dw,upcase convert to uppercase
EX r4,parmhexc test if all hex digits
*/* TRT drwdw(0),hexchars *** executed *** */
BNZ Ebadparm error if not
EX r4,parmhex convert to hex digits
*/* TR dw(0),hextab *** executed *** */
LA r5,1(,r4)
EX r5,parmpack get hex value
*/* PACK dw2,dw(0) *** executed *** */
SLR r5,r5 clear unit address
ICM r5,3,dw2+5 load hex value
STH r5,unit save unit address
*/* -------------------------------------------------------------------
* print initialization message
* ------------------------------------------------------------------ */
TIME DEC
STM r0,r1,ctime get time and date of load
LA r1,ctime
LA r0,dtime
BAL re,datetime
#MSG '%s:8 %d:1.%d:1.%d:1 load starting at %s:20', X
pgmid,vrm,vrm+1,vrm+2,dtime
*/* -------------------------------------------------------------------
* open the cckd file
* ------------------------------------------------------------------ */
MVC sysut1,m_sysut1 copy the model dcb
MVC sysut1e,m_sysut1e copy the model dcbe
ut1 USING IHADCB,sysut1
LA r1,sysut1e set dcbe address
ST r1,ut1.DCBDCBE in the dcb
DEVTYPE ut1.DCBDDNAM,devta get device info
LTR rf,rf test return code
BNZ Edevterr error if non-zero
TM devta+2,UCB3DACC check for dasd device
BNO Enotdasd1 error if not on dasd
MVC openl,m_openl copy model open list
OPEN (sysut1,INPUT),MODE=31,MF=(E,openl) open the cckd file
TM ut1.DCBOFLGS,DCBOFOPN did cckd file open ?
BNO Eopenerr no, open error
CLC ut1.DCBBLKSI,=Y(4096) check block size
BNE Ebadblksz error if not 4096
MVC pl(l_tcpl),m_tcpl copy model parm list
TRKCALC FUNCTN=TRKCAP,TYPE=devta+3,RKDD==x'01001000', x
REGSAVE=YES,MF=(E,pl) calculate blks/trk
LTR rf,rf test return code
BNZ Etrkcalc error if non-zero
ST r0,bpt save blks/trk
*/* -------------------------------------------------------------------
* read the CKDDASD_DEVHDR
* ------------------------------------------------------------------ */
#READ OFFSET=0,LENGTH=CKDDASD_DEVHDR_SIZE,ADDR=devhdr
USING CKDDASD_DEVHDR,devhdr
TR devhdr_devid,A2E
CLC devhdr_devid,=C'CKD_C370' check devid
BNE Edevid
#LLE r1,devhdr_heads get number of heads
ST r1,heads
#LLE r1,devhdr_trksize get trk size
ST r1,trklen
IC r1,devhdr_devtype get device type
STC r1,devtype+1
STC r1,devtype
TR devtype(1),devtype_table get 1st byte
CLI devtype,0 known type ?
BE Ebaddevt no, error
*/* -------------------------------------------------------------------
* read the CCKDDASD_DEVHDR
* ------------------------------------------------------------------ */
#READ OFFSET=CKDDASD_DEVHDR_SIZE,LENGTH=CCKDDASD_DEVHDR_SIZE, x
ADDR=cdevhdr
USING CCKDDASD_DEVHDR,cdevhdr
TM cdevhdr_options,CCKD_OPENED was file closed ?
BNO openok yes, continue
#MSG 'Warning... cckd file was not closed'
MVC result,=A(4)
openok DS 0H
#LC r1,cdevhdr_cyls number of cylinders
ST r1,cyls
#LC r2,cdevhdr_numl1tab l1 table entries
ST r2,numl1tab
*/* -------------------------------------------------------------------
* read the CCKD_L1TAB
* ------------------------------------------------------------------ */
SLL r2,2 size of l1tab
STORAGE OBTAIN,LENGTH=(r2) get l1tab storage
LR r3,r1
ST r3,l1tab
#READ OFFSET=CCKD_L1TAB_POS,LENGTH=(r2),ADDR=(r3)
*/* -------------------------------------------------------------------
* find the last used track and cylinder
* ------------------------------------------------------------------ */
ALR r2,r3 end of l1tab
lastl1 SH r2,=Y(CCKD_L1ENT_SIZE) backup an entry
CLR r2,r3 before the beginning ?
BL Eempty yes, empty file
#LC r4,0(r2) get l2tab offset
LTR r4,r4 empty ?
BZ lastl1 yes, keep looking
#READ OFFSET=(r4),LENGTH=CCKD_L2TAB_SIZE,ADDR=l2tab
LA r4,l2tab beginning of l2tab
LA r5,CCKD_L2TAB_SIZE(,r4) end of l2tab
lastl2 SH r5,=Y(CCKD_L2ENT_SIZE) backup an entry
CLR r5,r4 before the beginning ?
BL lastl1 yes, keep looking
USING CCKD_L2ENT,r5
#LC r0,l2ent_pos load trk offset
LTR r0,r0 empty ?
BZ lastl2 yes, keep looking
SR r2,r3 each 4-byte l1tab
SRL r2,2 entry represents
SLL r2,8 256 tracks
SR r5,r4 each 8-byte l2tab
SRL r5,3 entry is a track
AR r5,r2 have last used trk
ST r5,lasttrk
SLR r4,r4
D r4,heads have last used cyl
ST r5,lastcyl
DROP r5
#MSG 'cckd file is a %x4:2 cyls %d heads %d trklen %d; cyl %dx
is the last used cylinder', x
devtype,cyls,heads,trklen,lastcyl
*/* -------------------------------------------------------------------
* `fake-open' the offline device
* ------------------------------------------------------------------ */
*/* -------------------------------------------------------------------
* look for the ucb for the unit & make sure it's an offline dasd
* ------------------------------------------------------------------ */
MVC pl(l_ulpl),m_ulpl copy parm list
MODESET MODE=SUP
UCBLOOK DEVN=unit,UCBPTR=ucbaddr,PIN,PTOKEN=ptoken, x
DYNAMIC=YES,RANGE=ALL,LOC=ANY,MF=(E,pl), x
TEXT==C'cckddump offline dasd lookup'
STM rf,r0,retcd save ret/rsn codes
MODESET MODE=PROB
LM rf,r0,retcd
LTR rf,rf check return code
BNZ Ebaducbl ucblook error
OI flags,ucbpin
L r2,ucbaddr
USING UCBOB,r2
CLI UCBTBYT3,UCB3DACC check for dasd ucb
BNE Ebaducbt not a dasd unit
TM UCBSTAT,UCBONLI is device online ?
BO Ebaducbs unit is not offline
*/* -------------------------------------------------------------------
* if we got a 31-bit address then we need to `capture' a 24-bit addr
* ------------------------------------------------------------------ */
MVC cucbaddr,ucbaddr copy ucb addr
TM ucbaddr,X'ff' 31 bit address ?
BZ cucbok no, continue
MVC pl(l_cupl),m_cupl copy parm list
MODESET MODE=SUP
IOSCAPU CAPTUCB,UCBPTR=ucbaddr,CAPTPTR=cucbaddr, x
MF=(E,pl) capture 24 bit addr
STM rf,r0,retcd save ret/rsn codes
MODESET MODE=PROB
LM rf,r0,retcd
LTR rf,rf check return code
BNZ Ebaducbc ioscapu error
OI flags,captucb
cucbok DS 0H
*/* -------------------------------------------------------------------
* build a dcb for the offline dasd
* ------------------------------------------------------------------ */
MVC unitdcb,m_unitdcb copy model dcb
udcb USING IHADCB,unitdcb
MVC udcb.DCBMACRF,udcb.DCBMACR copy macr
*/* -------------------------------------------------------------------
* build a deb for the offline dasd
* ------------------------------------------------------------------ */
MODESET MODE=SUP,KEY=ZERO
GETMAIN RU,LV=DEBLENGTH,SP=230,LOC=BELOW
ST r1,debaddr save deb address
XC 0(DEBLENGTH,r1),0(r1) clear the deb
LR r3,r1 app vector table
USING DEBAVT,r3
LA r4,DEBBASND-DEBAVT(,r3) debdasd section
USING DEBDASD,r4
LA r5,DEBDASDE-DEBDASD(,r4) deb ext section
USING DEBXTN,r5
L r6,CVTPTR get cvt address
USING CVT,r6
L rf,CVTXAPG ios app vector table
MVC DEBAVT(DEBPREFX-DEBAVT),0(rf) copy vector table
ST r5,DEBXTNP set ext address
USING PSA,r0
L r7,PSATOLD get tcb address
USING TCB,r7
ST r7,DEBTCBAD set tcb address
OI DEBFLGS1,DEBXTNIN indicate ext exists
LA r0,unitdcb get dcb address
ST r0,DEBDCBAD set dcb address
MVI DEBDEBID,15 set deb identifier
OC DEBPROTG,TCBPKF set protection key
ST r3,DEBAPPAD set app table address
MVC DEBUCBA,cucbaddr+1 set ucb address
MVC DEBXLNGH,=Y(DEBXLEN) set ext length
LA r1,DEBBASIC get basic address
STCM r1,7,udcb.DCBDEBA set deb addr in dcb
SETLOCK OBTAIN,TYPE=LOCAL,REGS=STDSAVE,MODE=UNCOND
MVC DEBDEBB,TCBDEB+1 set addr next deb
LA r1,DEBBASIC get basic addr
ST r1,TCBDEB chain deb to the tcb
SETLOCK RELEASE,TYPE=LOCAL,REGS=STDSAVE
*/* -------------------------------------------------------------------
* add the deb to the deb list
* ------------------------------------------------------------------ */
DEBCHK unitdcb,TYPE=ADD,AM=EXCP
STM rf,r0,retcd
MODESET MODE=PROB,KEY=NZERO
LM rf,r0,retcd
LTR rf,rf test return code
BNZ Ebaddeba debchk add failed
OI flags,debadded
*/* -------------------------------------------------------------------
* build the dasd extent
* ------------------------------------------------------------------ */
MODESET MODE=SUP,KEY=ZERO
MVC DEBUCBAD,cucbaddr set 24-bit ucb addr
MVI DEBDVMOD,0 set device modifier
MVC DEBENDCC,=X'7fff' set end cylinder
MVC DEBENDHH,=X'00ff' set end head
MVC DEBNMTRK,=X'7fff' set nbr trks in extent
MODESET MODE=PROB,KEY=NZERO
DROP r0,r2,r3,r4,r6,r7
*/* -------------------------------------------------------------------
* build a couple of iobs
* ------------------------------------------------------------------ */
i1 USING IOBSTDRD,iob1
OI i1.IOBFLAG1,IOBDATCH+IOBCMDCH+IOBUNREL
LA r1,ecb1
ST r1,i1.IOBECBPT
LA r1,ccws
ST r1,i1.IOBSTART
LA r1,unitdcb
ST r1,i1.IOBDCBPT
i2 USING IOBSTDRD,iob2
OI i2.IOBFLAG1,IOBDATCH+IOBCMDCH+IOBUNREL
LA r1,ecb2
ST r1,i2.IOBECBPT
LA r1,ccws
LA r1,ccwl(,r1)
ST r1,i2.IOBSTART
LA r1,unitdcb
ST r1,i2.IOBDCBPT
*/* -------------------------------------------------------------------
* turn off the `not ready' bit
* ------------------------------------------------------------------ */
L r2,ucbaddr load ucb addr
USING UCBOB,r2
TM UCBFLA,UCBNRY `not ready' bit on ?
BNO nryok no, continue
MODESET MODE=SUP,KEY=ZERO
NI UCBFLA,255-UCBNRY turn off `not ready'
MODESET MODE=PROB,KEY=NZERO
DROP r2
OI flags,notready
nryok DS 0H
*/* -------------------------------------------------------------------
* sense the offline device
* ------------------------------------------------------------------ */
LA r2,ccws
USING CCW0,r2
MODESET MODE=SUP,KEY=ZERO
OI DEBXFLG2,DEBCHCMP+DEBBYP
MODESET MODE=PROB,KEY=NZERO
*/* seek */
XC CCW0(8),CCW0
MVI CCW0CMD,SK
LA r1,zeros
STCM r1,7,CCW0ADDR
MVI CCW0FLAG,CCW0SLI
MVC CCW0CNT,=Y(6)
EXCP iob1
WAIT 1,ECB=ecb1
CLI ecb1,ECBNORM
BNE Esnserr
*/* Sense ID */
XC ecb1,ecb1
XC CCW0(8),CCW0
MVI CCW0CMD,SNSID
LA r1,snsidarea
STCM r1,7,CCW0ADDR
MVI CCW0FLAG,CCW0SLI
MVC CCW0CNT,=Y(L'snsidarea)
EXCP iob1
WAIT 1,ECB=ecb1
CLI ecb1,ECBNORM
BNE Esnserr
*/* Sense */
XC ecb1,ecb1
XC CCW0(8),CCW0
MVI CCW0CMD,SNS
LA r1,snsarea
STCM r1,7,CCW0ADDR
MVI CCW0FLAG,CCW0SLI
MVC CCW0CNT,=Y(L'snsarea)
EXCP iob1
WAIT 1,ECB=ecb1
CLI ecb1,ECBNORM
BNE Esnserr
*/* Read Device Characteristics */
XC ecb1,ecb1
XC CCW0(8),CCW0
MVI CCW0CMD,RDC
LA r1,rdcarea
STCM r1,7,CCW0ADDR
MVI CCW0FLAG,0
MVC CCW0CNT,=Y(L'rdcarea)
EXCP iob1
WAIT 1,ECB=ecb1
CLI ecb1,ECBNORM
BNE Esnserr
*/* Sense Subsystem Status
XC ecb1,ecb1
XC CCW0(8),CCW0
MVI CCW0CMD,SNSS
LA r1,snssarea
STCM r1,7,CCW0ADDR
MVI CCW0FLAG,CCW0SLI
MVC CCW0CNT,=Y(L'snssarea)
EXCP iob1
WAIT 1,ECB=ecb1
CLI ecb1,ECBNORM
BNE Esnserr
MODESET MODE=SUP,KEY=ZERO
NI DEBXFLG2,255-DEBBYP
MODESET MODE=PROB,KEY=NZERO
DROP r2,r5
*/* -------------------------------------------------------------------
* perform some sanity checks
* ------------------------------------------------------------------ */
USING RDCinfo,rdcarea
MVC pl(l_tcpl),m_tcpl copy model parm list
L r2,cucbaddr
TRKCALC FUNCTN=TRKBAL,UCB=(r2),RKDD==A(x'0100ffff'), x
MAXSIZE=YES,REGSAVE=YES,MF=(E,pl)
CH rf,=Y(8)
BNE Ebadcap unexpected return code
LR r1,r0 round up 512
LA r1,511(,r1)
N r1,=A(x'fffffe00')
ST r1,utrklen
#MSG 'unit %x4:2 is a %x4:2 cyls %d:2 heads %d:2 trklen %d', x
unit,RDCdevt,RDCprime,RDCheads,utrklen
CLC RDCdevt,devtype
BNE Emisdevt
CLC RDCheads,heads+2
BNE Emisheads
CLC trklen,utrklen
BNE Emislen
CLC RDCprime,lastcyl+2
BH cylok
#MSG 'Warning... cckd file uses more cylinders than availablex
on %x4:2; extras will be omitted',unit
MVC result,=A(4)
cylok DS 0H
*/* Dump tracks thru last used cylinder, or thru last cylinder on */
*/* on the output device, whichever is lower */
L r3,lastcyl
LA r3,1(,r3)
M r2,heads
ST r3,tracks
SLR r3,r3
ICM r3,3,RDCprime
M r2,heads
C r3,tracks
BH *+8
ST r3,tracks tracks to write
#MSG '%d tracks will be written',tracks
L r3,tracks tracks to write
D r2,=A(10)
LA r3,99(,r3)
SLR r2,r2
D r2,=A(100)
LTR r3,r3
BNZ *+8
LA r3,1 10% of tracks to be
MH r3,=Y(100) written rounded up
ST r3,trk10pct to next 100
SLR r2,r2 for status msg
L r3,tracks
D r2,heads
ST r3,cyls
*/* -------------------------------------------------------------------
* get area for the buffers
* ------------------------------------------------------------------ */
L r2,trklen
SLL r2,2 space for 4 buffers
STORAGE OBTAIN,LENGTH=(r2)
ST r1,buf1
AL r1,trklen
ST r1,buf2
AL r1,trklen
ST r1,buf3
AL r1,trklen
ST r1,buf4
*/* -------------------------------------------------------------------
* create a persistent c environment
* ------------------------------------------------------------------ */
LA r2,handle
LA r3,=A(32*1024)
LA r4,=A(1)
STM r2,r4,pl
OI pl+8,X'80'
LA r1,pl
L rf,=V(EDCXHOTL) create persistent c environ
BALR re,rf
******* #MSG 'persistent c environment created, handle=0x%x',handle
*/* -------------------------------------------------------------------
* setup the output channel programs
* ------------------------------------------------------------------ */
LA r2,ccws point to 1st ccws
USING CCW0,r2
LA r3,lrparm1 point to 1st LR parameters
USING LRparm,r3
LA r4,idaw1 point to 1st idaw list
LA rf,2 build 2 sets of ccws
bldcp XC CCW0(8),CCW0 clear the ccw
MVI CCW0CMD,DX set define extent command
LA r1,dxarea address of dx area
STCM r1,7,CCW0ADDR set address
MVI CCW0FLAG,CCW0CC command chaining
MVC CCW0CNT,=Y(L'dxarea) set length
LA r2,CCW0END to next ccw
XC CCW0(8),CCW0 clear the ccw
MVI CCW0CMD,TIC set transfer-in-control command
LA r1,CCW0END address of next ccw
STCM r1,7,CCW0ADDR set next ccw address
LA r2,CCW0END to next ccw
XC CCW0(8),CCW0 clear the ccw
MVI CCW0CMD,LR set locate record command
STCM r3,7,CCW0ADDR set address in locate record ccw
OI CCW0FLAG,CCW0CC command chaining
MVC CCW0CNT,=Y(LRparml) set length
MVI LRop,LRocount+LRfwrite set operation byte
LA r0,255 build 255 write ccws
bldcp2 LA r2,CCW0END point to next ccw
XC CCW0(8),CCW0 clear the ccw
MVI CCW0CMD,WCKD set read track command
STCM r4,7,CCW0ADDR set address for idaw
LA r4,4(,r4) point to next idaw
BCT r0,bldcp2 loop back
LA r2,ccws point to 2nd
LA r2,ccwl(,r2) channel program
LA r3,lrparm2 point to 2nd LR parameters
LA r4,idaw2 point to 2nd idaw list
BCT rf,bldcp build 2nd channel program
DROP r2,r3
*/* -------------------------------------------------------------------
* setup the output define extent area
* ------------------------------------------------------------------ */
MVI dxarea,X'c0' permit all write operations
MVI dxarea+1,X'c0' eckd
L r1,cyls low extent is cyl 0 head 0
BCTR r1,0 set high extent
stcm r1,3,dxarea+12
ICM r1,3,RDCheads
BCTR r1,0
STCM r1,3,dxarea+14
*/* -------------------------------------------------------------------
* Read/write each track image
* ------------------------------------------------------------------ */
SLR r2,r2 init buffer switch
SLR r3,r3 init l1tab index
MVC trkstat,trk10pct init status
rwloop DS 0H
*/* Read the next l2tab */
LR r4,r3
SLL r4,2
AL r4,l1tab
#LC r5,0(r4)
LTR r4,r5
BZ l2null
#READ OFFSET=(r4),LENGTH=CCKD_L2TAB_SIZE,ADDR=l2tab
B l2ok
l2null LA r0,l2tab
LA r1,CCKD_L2TAB_SIZE
SLR rf,rf
MVCL re,r0
l2ok DS 0H
*/* Loop for each entry in the l2tab, exit if all tracks processed */
SLR r4,r4
rwloop2 LR rf,r3
SLL rf,8
AR rf,r4
CL rf,tracks
BNL rwexit
ST rf,track
*/* Get offset/length of the track image from the l2tab entry */
LR r5,r4
SLL r5,3
LA r5,l2tab(r5)
USING CCKD_L2ENT,r5
#LC r6,l2ent_pos
#LHC r7,l2ent_len
DROP r5
L r5,bufs(r2)
*/* Read the track image unless its a null track */
LTR r6,r6
BZ trknull
#READ OFFSET=(r6),LENGTH=(r7),ADDR=(r5)
B trkok
trknull XC 0(CCKD_NULLTRK_SIZE,r5),0(r5)
*/* Build a null trk: 0cchh cchh0008 00000000 cchh1000 ffffffff */
SLR re,re
L rf,track
D re,heads
STCM rf,3,1(r5)
STCM re,3,3(r5)
MVC 5(4,r5),1(r5)
MVI 8(r5),8
MVC 21(4,r5),1(r5)
MVI 25(r5),1
MVC 29(8,r5),eightFF
trkok DS 0H
CLI 0(r5),CCKD_COMPRESS_MAX
BNH compok
#MSG 'Trk %d unknown compression: %d:1',track,0(r5)
MVC result,=A(8)
B trknull
compok DS 0H
*/* Uncompress the track image */
SLR rf,rf
IC rf,0(,r5)
SLL rf,2
B *+4(rf)
B compnone 0 - not compressed
B compzlib 1 - zlib compression
B compbz2 2 - bz2 compression
*/* Not compressed */
compnone LR r6,r5
B compdone
*/* zlib compression */
compzlib LR r6,r5
AL r6,trklen
MVC 0(CKDDASD_TRKHDR_SIZE,r6),0(r5)
LA re,handle
LA rf,=V(UNCOMPRE)
LA r0,CKDDASD_TRKHDR_SIZE(,r6)
L r1,trklen
SH r1,=Y(CKDDASD_TRKHDR_SIZE)
ST r1,complen
LA r1,complen
STM re,r1,pl
LA re,CKDDASD_TRKHDR_SIZE(,r5)
LR rf,r7
SH rf,=Y(CKDDASD_TRKHDR_SIZE)
STM re,rf,pl+16
LA r1,pl
L rf,=V(EDCXHOTU)
BALR re,rf
LTR rf,rf
BZ compdone
ST rf,retcd
#MSG 'trk %d zlib uncompress error: %d',track,retcd
MVC result,=A(8)
B trknull
*/* bzip2 compression */
compbz2 LR r6,r5
AL r6,trklen
MVC 0(CKDDASD_TRKHDR_SIZE,r6),0(r5)
LA re,handle
LA rf,=V(bzbuffd)
LA r0,CKDDASD_TRKHDR_SIZE(,r6)
L r1,trklen
SH r1,=Y(CKDDASD_TRKHDR_SIZE)
ST r1,complen
LA r1,complen
STM re,r1,pl
LA re,CKDDASD_TRKHDR_SIZE(,r5)
LR rf,r7
SH rf,=Y(CKDDASD_TRKHDR_SIZE)
SLR r0,r0
SLR r1,r1
STM re,r1,pl+16
LA r1,pl
L rf,=V(EDCXHOTU)
BALR re,rf
LTR rf,rf
BZ compdone
ST rf,retcd
#MSG 'trk %d bzip2 decompress error: %d',track,retcd
MVC result,=A(8)
B trknull
compdone DS 0H
*/* Schedule the track image to be written */
#WRITE ADDR=(r6)
*/* Write status message if it's time */
CLC track,trkstat
BL rwnext2
#MSG '%d tracks written',track
L r1,trkstat
AL r1,trk10pct
ST r1,trkstat
rwnext2 X r2,=A(8) flip/flop buffers
LA r4,1(,r4)
CH r4,=Y(256)
BL rwloop2
rwnext LA r3,1(,r3)
B rwloop
rwexit DS 0H
TIME DEC
STM r0,r1,ctime
LA r1,ctime
LA r0,dtime
BAL re,datetime
#MSG '%d tracks written at %s:20, max code: %d', x
tracks,dtime,result
*/* -------------------------------------------------------------------
* cleanup and terminate
* ------------------------------------------------------------------ */
terminate DS 0H
*/* Make sure all write i/o has completed */
#WRITE ADDR=0
*/* Terminate the persistant c environment */
CLC =A(0),handle
BE term1
LA r1,handle
ST r1,pl
OI pl,X'80'
LA r1,pl
L rf,=V(EDCXHOTT)
BALR re,rf
term1 DS 0H
*/* Close the cckd file */
TM ut1.DCBOFLGS,DCBOFOPN
BNO term2
MVC openl,m_openl
CLOSE (sysut1),MODE=31,MF=(E,openl)
term2 DS 0H
*/* Free the i/o areas */
L r1,buf1
LTR r1,r1
BZ term3
L r2,trklen
SLL r2,2
STORAGE RELEASE,ADDR=(1),LENGTH=(r2)
term3 DS 0H
*/* Free the l1tab */
L r1,l1tab
LTR r1,r1
BZ term4
L r2,numl1tab
SLL r2,2
STORAGE RELEASE,ADDR=(1),LENGTH=(r2)
term4 DS 0H
*/* Call debchk to delete the deb */
TM flags,debadded
BNO term5
MODESET MODE=SUP,KEY=ZERO
DEBCHK unitdcb,TYPE=DELETE,AM=EXCP delete the deb
MODESET MODE=PROB,KEY=NZERO
term5 DS 0H
L r2,debaddr
LTR r2,r2
BZ term6
*/* Remove the deb from the deb chain */
USING DEBAVT,r2
LA r3,DEBBASIC
DROP r2
L r4,PSATOLD-PSA
USING TCB,r4
LA r5,TCBDEB-(DEBDEBAD-DEBBASIC)
USING DEBBASIC,r4
MODESET MODE=SUP,KEY=ZERO
SETLOCK OBTAIN,TYPE=LOCAL,REGS=STDSAVE,MODE=UNCOND
SPKA X'80'
termdeb LR r4,r5
SLR r5,r5
ICM r5,7,DEBDEBB
BZ termdebx
CLR r3,r5
BNE termdeb
SPKA 0
MVC DEBDEBB,DEBDEBB-DEBBASIC(r5)
DROP r4
termdebx SPKA 0
SETLOCK RELEASE,TYPE=LOCAL,REGS=STDSAVE
MODESET MODE=PROB,KEY=NZERO
*/* Free deb storage */
MODESET MODE=SUP,KEY=ZERO
FREEMAIN RU,A=(r2),LV=DEBLENGTH,SP=230
MODESET MODE=PROB,KEY=NZERO
term6 DS 0H
*/* Turn the ucb `not ready' bit back on if we turned it off */
TM flags,notready
BNO term7
L r2,ucbaddr
USING UCBOB,r2
MODESET MODE=SUP,KEY=ZERO
OI UCBFLA,UCBNRY
MODESET MODE=PROB,KEY=NZERO
DROP r2
term7 DS 0H
*/* Uncapture the ucb */
TM flags,captucb
BNO term8
MVC pl(l_cupl),m_cupl
MODESET MODE=SUP
IOSCAPU UCAPTUCB,CAPTPTR=cucbaddr,MF=(E,pl)
MODESET MODE=PROB
term8 DS 0H
*/* Unpin the ucb */
TM flags,ucbpin
BNO term9
MVC pl(l_uupl),m_uupl
MODESET MODE=SUP
UCBPIN UNPIN,PTOKEN=ptoken,MF=(E,pl)
MODESET MODE=PROB
term9 DS 0H
*/* Close the sysprint file */
pdcb USING IHADCB,prtdcb
TM pdcb.DCBOFLGS,DCBOFOPN
BNO term10
MVC openl,m_openl
CLOSE (prtdcb),MODE=31,MF=(E,openl)
term10 DS 0H
*/* Free the work areas */
STORAGE RELEASE,ADDR=(rb),LENGTH=work24l
LR r1,rd
L r2,result
L rd,4(,rd)
STORAGE RELEASE,ADDR=(1),LENGTH=workl
*/* Return */
LR rf,r2
RETURN (14,12),RC=(15)
*/* -------------------------------------------------------------------
* format date & time
* ------------------------------------------------------------------ */
datetime STM re,r2,12(rd) save some regs
LR r2,r0 copy output area address
MVI 0(r2),C' ' blank the output area
MVC 1(19,r2),0(r2)
MVC 11(9,r2),=X'4021207a20207a2020' edit pattern for time
ED 11(9,r2),0(r1) edited time
XC dw,dw clear double word work area
SLR rf,rf
ICM rf,3,4(r1) decimal year
SLL rf,4 shift over a nibble
ST rf,dw+4 store in the double word
OI dw+7,X'0f' set bottom nibble
AP dw,=P'1900' calculate the year
OI dw+7,X'0f' fix bottom nibble for unpk
UNPK 7(4,r2),dw set the year
CVB rf,dw get binary year
N rf,=A(3) test for leap year
BZ *+8 jumps if leap year
LA rf,2 else set non-leapyr offset
ZAP dw,6(2,r1) get julian day in double word
CVB r0,dw get julian day binary
LA re,dtjtab point to julian table
dtfind CH r0,8(rf,re) found table entry ?
BNH dtfound yes, exit loop
LA re,8(,re) point to next entry
B dtfind and loop back
dtfound MVC 3(3,r2),4(re) set month from the table
SH r0,0(rf,re) calculate day of month
CVD r0,dw get day of month packed
L r0,dw+4 load packed day
SLL r0,20 shift out hi bits
SRL r0,28 shift down
STC r0,0(,r2) set 1st digit of the month
OI 0(r2),C'0' convert to ebcdic character
L r0,dw+4 load packed day
SLL r0,24 shift out hi bits
SRL r0,28 shift down
STC r0,1(,r2) set 2nd digit of the month
OI 1(r2),C'0' convert to ebcdic character
LM re,r2,12(rd) restore regs
BR re and thankfully return
dtjtab DC Y(0,0),C'Jan ' Julian date table
DC Y(31,31),C'Feb '
DC Y(60,59),C'Mar '
DC Y(91,90),C'Apr '
DC Y(121,120),C'May '
DC Y(152,151),C'Jun '
DC Y(182,181),C'Jul '
DC Y(213,212),C'Aug '
DC Y(244,243),C'Sep '
DC Y(274,273),C'Oct '
DC Y(305,304),C'Nov '
DC Y(335,334),C'Dec '
DC Y(999,999),C'??? '
*/* -------------------------------------------------------------------
* error routines
* ------------------------------------------------------------------ */
Enoparm #MSG '** Unit address not specified'
B Eexit
Ebadparm MVC dw,=CL8' '
CH r4,=Y(8)
BNH *+8
LA r4,8
SH r4,=Y(1)
BM *+4+4+6
EX r4,*+4
MVC dw(0),0(r3)
#MSG '** Invalid unit address: %s:8',dw
B Eexit
Edevid #MSG '** SYSUT1 is not a cckd file; devid validation failed'
B Eexit
Edevterr STM rf,r0,retcd
CLC retcd(8),=A(4,4) missing ddname ?
BE Enoddn yes, noddn error
#MSG '** SYSUT1 DEVTYPE error: rc=%d, reason=%d', X
retcd,rsncd
B Eexit
Enoddn #MSG '** SYSUT1 ddname not found'
B Eexit
Enotdasd1 #MSG '** SYSUT1 not a dasd file'
B Eexit
Eopenerr #MSG '** SYSUT1 did not open'
B Eexit
Ebadblksz #MSG '** SYSUT1 blksz is not 4096'
B Eexit
Etrkcalc ST rf,retcd
#MSG '** TRKCAP failed for SYSUT1: rc=%d',retcd
B Eexit
Ebaddevt #MSG '** cckd dasd devtype not supported: 0x%x2:1',devtype+1
B Eexit
Eempty #MSG '** cckd file contains all null tracks'
B Eexit
Epoint ST rf,retcd
#MSG '** SYSUT1 point error: rc=%d ttr=%x6:3',retcd,ttr
B Eexit
Ebaducbl CH RF,=Y(4)
BE Enoucb
#MSG '** UCBLOOK error for unit %x4:2: rc 0x%x rsn 0x%x', X
unit,retcd,rsncd
B Eexit
Enoucb #MSG '** UCB not found for unit %x4:2',unit
B Eexit
Ebaducbt L r2,ucbaddr
USING UCBOB,r2
#MSG '** UCB for unit %x4:2 is not dasd, type is %x:1', X
unit,UCBTBYT3
B Eexit
DROP r2
Ebaducbs #MSG '** Device %x4:2 is not offline',unit
B Eexit
Ebaducbc #MSG '** IOSCAPU CAPTUCB failed for %x4:2; rc=0x%x rsn=0x%x',X
unit,retcd,rsncd
B Eexit
Ebaddeba #MSG '** DEBCHK ADD for %x4:2 failed; rc=0x%x', X
unit,retcd
B Eexit
Esnserr #MSG '** Sense failed for %x4:2: command %x2:1, CC 0x%x2:1, SX
tat 0x%x4:2',unit,ccws,ecb1,i1.IOBSTBYT
B Eexit
Ebadcap ST rf,retcd
#MSG '** TRKBAL for %x4:2 unexpected return code; rc=0x%x', X
unit,retcd
B Eexit
Emisdevt #MSG '** devtype mismatch %x4:2=%x4:2, cckd=%x4:2', X
unit,RDCdevt,devtype
B Eexit
Emisheads #MSG '** number heads mismatch %x4:2=%d:2, cckd=%d', X
unit,RDCheads,heads
B Eexit
Emislen #MSG '** trklen mismatch %x4:2=%d, cckd=%d', X
unit,utrklen,trklen
B Eexit
Eioerr SLR r2,r2
ICM r2,7,waitecb+1
LA r0,ecb1
LA r3,iob1
CLR r0,r2
BE *+8
LA r3,iob2
USING ECB,r2
USING IOBSTDRD,r3
#MSG '** I/O error %x4:2 CCHH %x8: CC %x2:1, Stat %x4:2', X
unit,prevcchh,ECBCC,IOBSTBYT
DROP r2,r3
B Eexit
Eexit MVC result,=A(12)
B terminate
*/* -------------------------------------------------------------------
* literals and constants
* ------------------------------------------------------------------ */
LTORG ,
parmmvc MVC dw(0),0(r3) *** executed ***
parmhexc TRT dw(0),hexchars *** executed ***
parmhex TR dw(0),hextab *** executed ***
parmpack PACK dw2,dw(0) *** executed ***
m_unitdcb DCB DDNAME=0,DSORG=PS,MACRF=E
l_unitdcb EQU *-m_unitdcb
m_sysut1 DCB DDNAME=SYSUT1,DSORG=PS,MACRF=RP,DCBE=m_sysut1e,RECFM=F
l_sysut1 EQU *-m_sysut1
m_sysut1e DCBE RMODE31=BUFF
l_sysut1e EQU *-m_sysut1e
m_prtdcb DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PL,DCBE=m_prtdcbe
l_prtdcb EQU *-m_prtdcb
m_prtdcbe DCBE RMODE31=BUFF
l_prtdcbe EQU *-m_prtdcbe
m_openl OPEN (0),MODE=31,MF=L
l_openl EQU *-m_openl
UCBLOOK MF=(L,m_ulpl)
l_ulpl EQU *-m_ulpl
UCBPIN MF=(L,m_uupl)
l_uupl EQU *-m_uupl
IOSCAPU MF=(L,m_cupl)
l_cupl EQU *-m_cupl
m_tcpl TRKCALC MF=L
l_tcpl EQU *-m_tcpl
eightFF DC X'ffffffffffffffff'
devtype_table DC 256X'00'
ORG devtype_table+x'80'
DC X'33'
ORG devtype_table+x'90'
DC X'33'
ORG devtype_table+x'45'
DC X'93'
ORG devtype_table+256
hextab DC 256X'00'
ORG hextab+C'0'
DC AL1(0,1,2,3,4,5,6,7,8,9)
ORG hextab+C'a'
DC AL1(10,11,12,13,14,15)
ORG hextab+C'A'
DC AL1(10,11,12,13,14,15)
ORG hextab+256
hexchars DC 256x'ff'
ORG hexchars+C'a'
DC 6x'0'
ORG hexchars+C'A'
DC 6x'0'
ORG hexchars+C'0'
DC 10x'0'
ORG hexchars+256
upcase DC C' ',255AL1(*-upcase)
ORG upcase+c'a'
DC C'ABCDEFGHI'
ORG upcase+c'j'
DC C'JKLMNOPQR'
ORG upcase+c's'
DC C'STUVWXYZ'
ORG upcase+256
A2E DS 0D
* 0 1 2 3 4 5 6 7 8 9 a b c d e f
DC X'00010203372D2E2F1605250B0C0D0E0F' 0
DC X'101112133C3D322618193F27221D351F' 1
DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 2
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 3
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 4
DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 5
DC X'79818283848586878889919293949596' 6
DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 7
DC X'00010203372D2E2F1605250B0C0D0E0F' 8
DC X'101112133C3D322618193F27221D351F' 9
DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' a
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' b
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' c
DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' d
DC X'79818283848586878889919293949596' e
DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' f
hex2char EQU *-240
DC C'0123456789ABCDEF'
DROP ,
mainend DS 0D
*/* -------------------------------------------------------------------
* Subroutine to read the cckd file
* ------------------------------------------------------------------ */
USING readr,r9
USING work,rd
USING work24,rb
USING main,rc
USING (main+4095,mainend),ra
readr STM r0,rf,save1
LR r9,rf
LM r2,r4,0(r1) load offset, length, address
*/* Read the first block into the tempbuf */
LR r7,r2 copy the offset
SRL r7,12 get the block number
LTR r2,r2 test offset
BZ r_getblk1 always read 1st block for offset 0
CL r7,lastblk already have the 1st block ?
BE r_gotblk1 yes, continue
ST r7,lastblk remember this block
SLR r6,r6
D r6,bpt calculate ttr
STCM r7,3,ttr
LA r6,1(,r6)
STC r6,ttr+2
POINT sysut1,ttr position to the block
LTR rf,rf
BNZ Epoint
r_getblk1 READ ut1decb,SF,sysut1,tempbuf,'S',MF=E
CHECK ut1decb read the block
r_gotblk1 DS 0H
*/* Copy data from the first block to the caller's buffer */
LR r5,r2 calculate data offset
N r5,=A(X'00000fff') in the first block
LH r6,=Y(4096) calculate data length
SR r6,r5 in the first block
AR r2,r6 new offset
LR re,r4 target address
LR rf,r6 data length in the first block
CR rf,r3 if requested length is less
BL *+6 then use that instead
LR rf,r3
LA r0,tempbuf(r5) source address
LR r1,rf length to copy
AR r4,rf adjust target address
SR r3,rf adjust target length
MVCL re,r0 copy data from the 1st block
*/* Read the intermediate blocks directly into the caller's buffer */
r_getint LTR r3,r3 test length left to read
BZ r_return return if everything read
CH r3,=Y(4096) able to read a full block ?
BL r_getlast no, special processing for last
READ ut1decb,SF,sysut1,(r4),'S',MF=E
CHECK ut1decb read an intermediate block
AH r2,=Y(4096) adjust the offset
SH r3,=Y(4096) adjust the length left
AH r4,=Y(4096) adjust buffer position
B r_getint read some more
*/* Read the last block into the tempbuf */
r_getlast SRL r2,12 change offset to block number
ST r2,lastblk and save it
READ ut1decb,SF,sysut1,tempbuf,'S',MF=E
CHECK ut1decb
LR re,r4 target address
LR rf,r3 target length
LA r0,tempbuf source address
LR r1,rf source length
MVCL re,r0 copy data from the last block
r_return LM r0,rf,save1
BR re
LTORG ,
DROP ,
*/* -------------------------------------------------------------------
* Subroutine to write track images to the offline dasd unit
* ------------------------------------------------------------------ */
USING writer,r9
USING work,rd
USING work24,rb
USING main,rc
USING (main+4095,mainend),ra
writer STM r0,rf,save1
LR r9,rf
*/* If buffer address is zero then we simply wait on the last I/O */
LTR r1,r1
BZ w_finish
*/* Get the IOB we will use */
L r2,iobswtch 0 = iob1, 1 = iob2
LA r3,iob1 presume iob1
LTR r2,r2
BZ *+8
LA r3,iob2 use iob2 if switch is non-zero
USING IOBSTDRD,r3
X r2,=A(1) flip/flop the switch
ST r2,iobswtch
*/* Complete the channel program */
MVC prevcchh,curcchh copy last cchh scheculed
MVC curcchh,1(r1) current cchh (from HA)
MVC IOBCC(4),curcchh set extent in the iob
SLR r2,r2
ICM r2,7,IOBECBPB
USING ECB,r2
XC ECB,ECB clear the ecb
*/* If record 1 is end-of-track then make it eof then eot */
CLC eightFF,5+8+8(r1) check for end-of-track
BNE w_wnoteot continue if not
MVC 5+8+8(8,r1),5(r1) else copy r0 t0 r1
MVI 5+8+8+4(r1),1 and set r to 1
MVI 5+8+8+7(r1),0 and data len to 0
MVC 5+8+8+8(8,r1),eightFF now set the eot
w_wnoteot DS 0h
LA r1,5+8+8(,r1) point to record 1
SLR rf,rf clear record count
SLR r4,r4
ICM r4,7,IOBSTRTB address of the channel program
USING CCW0,r4
LA r4,CCW0END point past dx ccw
LA r4,CCW0END point past tic ccw
SLR r5,r5
ICM r5,7,CCW0ADDR locate record parm addr
USING LRparm,r5
MVC LRseek,IOBCC
MVC LRsearch,IOBCC
w_wckd LA r4,CCW0END point to next ccw
LA rf,1(,rf) increment record count
SLR r6,r6
ICM r6,7,CCW0ADDR load IDAW address
ST r1,0(,r6) set record addr in the IDAW
SLR r0,r0
IC r0,5(,r1) key length
SLR re,re
ICM re,3,6(r1) data length
AR re,r0
LA re,8(,re) cound-key-data-length
STCM re,3,CCW0CNT
OI CCW0FLAG,CCW0CC+CCW0IDA set chain & idaw bits
AR r1,re point to the next record
CLC eightFF,0(r1) at end of the track ?
BNE w_wckd no, keep building
NI CCW0FLAG,255-CCW0CC turn off chain bit for last ccw
STC rf,LRcount set count of WCKD ccws
*/* Schedule this channel program and wait for the previous one */
LR rf,r2 copy ecb address
L r2,waitecb load ecb address to wait on
ST rf,waitecb set new ecb address to wait on
EXCP IOBSTDRD schedule the i/o
LTR r2,r2 any ecb to wait on ?
BZ w_return no, just return
WAIT 1,ECB=ECB wait for previous i/o
CLI ECBCC,ECBNORM successful completion ?
BNE Eioerr no, i/o error
B w_return
*/* Wait for the last i/o to finish */
w_finish L r2,waitecb ecb for last i/o
LTR r2,r2 is it set ?
BZ w_return no, just return
XC waitecb,waitecb
WAIT 1,ECB=ECB wait for the last i/o
CLI ECBCC,ECBNORM normal completion ?
BNE Eioerr no, i/o error
w_return LM r0,rf,save1
BR re
LTORG ,
DROP ,
*/* -------------------------------------------------------------------
* Subroutine to issue messages
* ------------------------------------------------------------------ */
USING msgr,r9
USING work,rd
USING work24,rb
USING main,rc
USING (main+4095,mainend),ra
msgr STM r0,rf,save2
LR r9,rf
prt USING IHADCB,prtdcb
TM prt.DCBOFLGS,DCBOFOPN
BO mr_opened continue if message file is opened
LR r2,r1 save reg 1
TM flags,noprint test if no print file
BO mr_ret return if not
MVC prtdcb,m_prtdcb copy the model print dcb
MVC prtdcbe,m_prtdcbe copy model print dcbe
LA r1,prtdcbe set dcbe address
ST r1,prt.DCBDCBE in the dcb
OI flags,noprint presume no print
DEVTYPE prt.DCBDDNAM,dw issue devtype for the ddname
LTR rf,rf test devtype return code
BNZ mr_ret return if some error
L r1,=A(mr_oxit) get address of the open exit
LA rf,mr_oxitl get open exit length
BCTR rf,0 decrement
EX rf,*+4 copy the open exit
MVC openxit(0),0(r1) *** executed ***
LA r1,openxit get open exit addr
ST r1,exlst set in exit list
MVI exlst,x'85' set exit type
LA r1,exlst point to exit list
STCM r1,7,prt.DCBEXLSA set exlst addr in the dcb
MVC openl,m_openl copy model open list
OPEN (prtdcb,OUTPUT),MODE=31,MF=(E,openl)
TM prt.DCBOFLGS,DCBOFOPN did the file open ?
BNO mr_ret no, return
NI flags,255-noprint else turn off `noprt' bit
LR r1,r2 restore reg 1
mr_opened LM r4,r5,0(r1) pattern addr, length
BCTR r5,0
LA r3,8(,r1) first parameter
LA r6,msg
MVI msg,C' ' init msg to blanks
MVC msg+1(L'msg-1),msg
mr_loop LTR r5,r5
BM mr_exit
LA r1,1(r4,r5)
SLR r2,r2
EX r5,mr_trt1
SR r1,r4 length scanned
BNP mr_skip1
LR rf,r1
BCTR rf,0
EX rf,mr_mvc1 copy literal text
AR r6,r1
mr_skip1 AR r4,r1
SR r5,r1
BM mr_exit
BP mr_skip2
MVC 0(1,r6),0(r4) string ends in special char
LA r6,1(,r6)
B mr_exit
mr_skip2 B *(r2) br on special char type
B mr_pct '%'
B mr_bs '\'
mr_pct CLI 1(r4),C's'
BE mr_pct_s
CLI 1(r4),C'x'
BE mr_pct_x
CLI 1(r4),C'd'
BE mr_pct_d
MVC 0(1,r6),0(r4) treat '%' as any other char
LA r6,1(,r6)
LA r4,1(,r4)
BCTR r5,0
B mr_loop
mr_pct_s L r7,0(,r3) load string ptr
LA r3,4(,r3)
LA r4,2(,r4) point past '%s'
SH r5,=Y(2)
BAL re,mr_op r1 - target len, r2 - source len
LTR r2,r2
BNZ mr_pct_s3
LR r2,r7 source len = 0, find end of string
mr_pct_s1 CLI 0(r2),C' '
BNH mr_pct_s2
LA r2,1(,r2)
B mr_pct_s1
mr_pct_s2 SR r2,r7
BNP mr_loop
mr_pct_s3 LR rf,r2 copy source string to the msg
BCTR rf,0
EX rf,mr_mvc2
LTR r1,r1
BNZ mr_pct_s5
AR r6,r2 truncate trailing spaces if
mr_pct_s4 BCTR r6,0 target len is 0
CLI 0(r6),C' '
BNH mr_pct_s4
LA r6,1(,r6)
B mr_loop
mr_pct_s5 CR r1,r2
BH mr_pct_s6
AR r6,r1 truncate the string
B mr_loop
mr_pct_s6 AR r6,r2 pad string with trailing blanks
SR r1,r2
mr_pct_s7 MVI 0(r6),C' '
LA r6,1(,r6)
BCT r1,mr_pct_s7
B mr_loop
mr_pct_x L r7,0(,r3) load hex ptr
LA r3,4(,r3)
LA r4,2(,r4) point past '%x'
SH r5,=Y(2)
BAL re,mr_op r1 - target len, r2 - source len
LTR r2,r2
BNZ *+8
LA r2,4 default source len is 4
EX r2,mr_pct_x_unpk
TR dw,mr_hextab
LTR r1,r1
BNZ mr_pct_x1
LA r1,8 determine default target len
CLC =C'00',dw
BNE mr_pct_x1
LA r1,6
CLC =C'0000',dw
BNE mr_pct_x1
LA r1,4
CLC =C'000000',dw
BNE mr_pct_x1
LA r1,2
mr_pct_x1 LA r7,dw+8 copy the hex string to the msg
SR r7,r1
BCTR r1,0
EX r1,mr_mvc2
LA r6,1(r1,r6)
B mr_loop
mr_pct_d L r7,0(,r3) load decimal ptr
LA r3,4(,r3)
LA r4,2(,r4) point past '%d'
SH r5,=Y(2)
BAL re,mr_op r1 - target len, r2 - source len
LTR r2,r2
BNZ *+8
LA r2,4 default source len is 4
LA rf,4
SR rf,r2
LA re,15
SRL re,0(rf)
EX re,mr_pct_d_icm
CVD rf,dw
MVC dw2(16),=X'40202020202020202020202020202120'
ED dw2(16),dw
LTR r1,r1
BNZ mr_pct_d2
LA rf,dw2+16 default length -
mr_pct_d1 BCTR rf,0 truncate leading spaces
CLI 0(rf),C' '
BH mr_pct_d1
LA r1,dw2+15
SR r1,rf
mr_pct_d2 LA r7,dw2+16
SR r7,r1
BCTR r1,0
EX r1,mr_mvc2
LA r6,1(r1,r6)
B mr_loop
mr_bs MVC 0(1,r6),1(r4) copy char following '\'
LA r6,1(,r6)
LA r4,2(,r4)
SH r5,=Y(2)
B mr_loop
mr_exit LA r1,msg
SR r6,r1 calculate msg length
BNP mr_ret
TM prt.DCBRECFM,DCBRECCA+DCBRECCM
BZ *+8
LA r6,1(,r6) increment for carriage control
TM prt.DCBRECFM,DCBRECU
BO mr_u
TM prt.DCBRECFM,DCBRECF
BO mr_f
TM prt.DCBRECFM,DCBRECV
BO mr_v
mr_u CH r6,prt.DCBBLKSI
BNH *+8
LH r6,prt.DCBBLKSI
STH r6,prt.DCBLRECL
PUT prtdcb
TM prt.DCBRECFM,DCBRECCA+DCBRECCM
BZ mr_u1
MVI 0(r1),C' '
LA r1,1(,r1)
BCTR r6,0
TM prt.DCBRECFM,DCBRECCA
BO mr_u1
BCTR r1,0
MVI 0(r1),X'09'
LA r1,1(,r1)
mr_u1 BCTR r6,0
EX r6,mr_mvc3
B mr_ret
mr_f CH r6,prt.DCBLRECL
BNH *+8
LH r6,prt.DCBLRECL
PUT prtdcb
TM prt.DCBRECFM,DCBRECCA+DCBRECCM
BZ mr_f1
MVI 0(r1),C' '
LA r1,1(,r1)
BCTR r6,0
TM prt.DCBRECFM,DCBRECCA
BO mr_f1
BCTR r1,0
MVI 0(r1),X'09'
LA r1,1(,r1)
mr_f1 BCTR r6,0
EX r6,mr_mvc3
B mr_ret
mr_v LA r6,4(,r6)
LH r1,prt.DCBBLKSI
SH r1,=Y(4)
CR r6,r1
BNH *+6
LR r6,r1
STH r6,prt.DCBLRECL
PUT prtdcb
STH r6,0(,r1)
XC 2(2,r1),2(r1)
LA r1,4(,r1)
SH r6,=Y(4)
TM prt.DCBRECFM,DCBRECCA+DCBRECCM
BZ mr_v1
MVI 0(r1),C' '
LA r1,1(,r1)
BCTR r6,0
TM prt.DCBRECFM,DCBRECCA
BO mr_v1
BCTR r1,0
MVI 0(r1),X'09'
LA r1,1(,r1)
mr_v1 BCTR r6,0
EX r6,mr_mvc3
B mr_ret
mr_ret LM r0,rf,save2
BR re
*/* -------------------------------------------------------------------
* message subroutine to get operand lengths
* ------------------------------------------------------------------ */
mr_op SLR r1,r1
SLR r2,r2
mr_op1 LTR r5,r5 first number is target length
BMR re
CLI 0(r4),C'0'
BL mr_op2
IC rf,0(,r4)
N rf,=A(X'0000000f')
MH r1,=Y(10)
AR r1,rf
LA r4,1(,r4)
BCTR r5,0
B mr_op1
mr_op2 CLI 0(r4),C':' second number follows a ':'
BNER re
mr_op3 LA r4,1(,r4) second number is source length
SH r5,=Y(1)
BMR re
CLI 0(r4),C'0'
BLR re
IC rf,0(,r4)
N rf,=A(X'0000000f')
MH r2,=Y(10)
AR r2,rf
B mr_op3
*/* ---------------------------------------------------------------- */
mr_mvc1 MVC 0(0,r6),0(r4)
mr_trt1 TRT 0(0,r4),mr_tab1
mr_mvc2 MVC 0(0,r6),0(r7)
mr_mvc3 MVC 0(0,r1),msg
mr_pct_x_unpk UNPK dw(9),0(0,r7)
mr_pct_d_icm ICM rf,0,0(r7)
mr_tab1 DC XL256'0'
ORG mr_tab1+C'%'
DC AL1(4)
ORG mr_tab1+C'\'
DC AL1(8)
ORG mr_tab1+256
mr_hextab EQU *-240
DC C'0123456789abcdef'
LTORG ,
#MSG TYPE=GEN messages
DROP ,
*/* -------------------------------------------------------------------
* message open exit - relocated to 24 bit storage
* ------------------------------------------------------------------ */
USING mr_oxit,rf
USING IHADCB,R1
mr_oxit CLI DCBRECFM,0 any record format ?
BNE *+8 jumps if yes
MVI DCBRECFM,DCBRECV+DCBRECBR else set to `vb'
SLR r0,r0 get a zero
CH r0,DCBLRECL any lrecl
BNE *+10 jumps if yes
MVC DCBLRECL,=Y(125) copy default lrecl
CH r0,DCBBLKSI any blksize
BNE *+10 jumps if yes
MVC DCBBLKSI,=Y(4096) copy default blksize
TM DCBRECFM,DCBRECU test record type
BO mr_oxitu undefined
TM DCBRECFM,DCBRECV test record type
BO mr_oxitv variable
TM DCBRECFM,DCBRECF test record type
BO mr_oxitf fixed
B mr_oxit0 unknown, return
mr_oxitu MVC DCBLRECL,DCBBLKSI undefined, set lrecl from blksize
B mr_oxit0 return
mr_oxitv LH r3,DCBBLKSI variable, load blksize
LA r0,4 calculate maximum
SR r3,r0 lrecl
CH r3,DCBLRECL check against lrecl
BNL mr_oxit0 return if not too high
STH r3,DCBLRECL else reset to max
B mr_oxit0 return
mr_oxitf LH r3,DCBBLKSI fixed, load blksize
SLR r2,r2 clear for divide
LH r0,DCBLRECL load lrecl
DR r2,r0 divide lrecl into blksize
LTR r2,r2 test if any remainder
BZ mr_oxit0 return if not
MH r3,DCBLRECL calculate new blksize
STH r3,DCBBLKSI set new blksize
mr_oxit0 BR re
LTORG ,
mr_oxitl EQU *-mr_oxit
DROP ,
*/* -------------------------------------------------------------------
* workareas
* ------------------------------------------------------------------ */
work DSECT ,
workid DS 0CL4 identifier
save DS 18F standard save area
save1 DS 16F save area for read/write
save2 DS 16F save area for subroutines
result DS F result (return) value
flags DS X flag bits
ucbpin EQU X'80' offline dasd ucb pinned
captucb EQU X'40' offline dasd ucb captured
debadded EQU X'20' offline dasd ucb deb added
notready EQU X'10' offline ucb `not ready' bit
noprint EQU X'01' print ddname not present
unit DS H offline unit address
bpt DS F cckd file blocks per track
heads DS F cckd heads per cylinder
trklen DS F cckd track length
utrklen DS F unit track length
complen DS F compression length
devtype DS H cckd device type
numl1tab DS F number l1tab entries
lasttrk DS F last track
lastcyl DS F last cylinder
cyls DS F cylinders to write
tracks DS F tracks to write
track DS F tracks being written
trk10pct DS F tracks per status message
trkstat DS F write status msg at this trk
handle DS F persistent c handle
prevcchh DS F previous cchh written
curcchh DS F current cchh being written
waitecb DS A address of ecb to wait on
iobswtch DS F iob flip/flop indicator
retcd DS F return code
rsncd DS F reason code
ucbaddr DS A ucb address
cucbaddr DS A captured ucb address
debaddr DS A deb address
bufs DS 0A i/o area address
buf1 DS A
buf2 DS A
buf3 DS A
buf4 DS A
ptoken DS D ucb pin token
devta DS D devtype area
ctime DS D current date/time
dtime DS CL20 date/time display area
lastblk DS F last cckd 4096 block read
ttr DS F ttr for cckd block
dw DS D double word work areas
dw2 DS D
dw3 DS D
dw4 DS D
sysut1e DS XL(l_sysut1e) cckd file dcbe
prtdcbe DS XL(l_prtdcbe) print dcbe
pl DS 32F general parameter list
openl DS XL(l_openl) open parameter list
devhdr DS 0XL(CKDDASD_DEVHDR_SIZE) device header
cdevhdr DS XL(CCKDDASD_DEVHDR_SIZE) compressed device header
l1tab DS A l1tab address
l2tab DS XL(CCKD_L2TAB_SIZE) l2tab
msg DS CL256 message
tempbuf DS XL4096 temp buffer for cckd read
workl EQU *-work
work24 DSECT , 24-bit work area
work24id DS CL4 identifier
zeros DS XL16 24-bit zeroes
unitdcb DS XL(l_unitdcb) offline dasd dcb
sysut1 DS XL(l_sysut1) sysut1 dcb
READ ut1decb,SF,MF=L sysut1 decb
prtdcb DS XL(l_prtdcb) sysprint dcb
exlst DS F dcb exit list
snsidarea DS XL20 device snsid info
snsarea DS XL32 device sense
rdcarea DS XL64 device characteristics
snssarea DS XL40 device snss info
ecb1 DS F output ecb 1
ecb2 DS F output ecb 2
iob1 DS XL40 output iob 1
iob2 DS XL40 output iob 2
lrparm1 DS XL16 locate record parameter area 1
lrparm2 DS XL16 locate record parameter area 2
dxarea DS XL16 define extent area
openxit DS XL256 relocated message open exit
idaw1 DS 255A idaws 1
idaw2 DS 255A idaws 2
ccws DS 258D channel program 1
ccwl EQU *-ccws channel program length
ccw2 DS 258D channel program 2
work24l EQU *-work24
RDCinfo DSECT , read device characteristics info
RDCsdt DS XL2 storage director type
RDCsdmi DS X storage director model information
RDCdevt DS XL2 device type
RDCdevm DS X device model
RDCdasdf DS XL4 device & storage director facilities
RDCclass DS X device class code
RDCtype DS X device type code
RDCprime DS XL2 number of primary cylinders
RDCheads DS XL2 tracks per cylinde
RDCsctrs DS X number of sectors
RDCtrkln DS XL3 total track length (usable)
RDChar0 DS XL2 length of ha and r0
RDCtccf DS X track capacity calculation formula
RDCfctrs DS XL5 track capacity calculation factors
RDCacyl DS XL2 address of first alternate cylinder
RDCacyln DS XL2 number of alternate tracks
RDCdcyl DS XL2 address of first diagnostic cylinder
RDCdcyln DS XL2 number of diagnostic tracks
RDCscyl DS XL2 address of first device support cyl
RDCscyln DS XL2 number of device support tracks
RDCmdrid DS X mdr record id
RDCobrid DS X obr record id
RDCsdtc DS X storage director type code
RDCrtspl DS X read trackset parameter length
RDCmaxr0 DS XL2 maximum record zero data length
DS X (reserved)
RDCtss DS X track set size
RDCatccf DS X additional track capacity calc. factr
RDCrps DS XL2 rps sector calculation factors
DS XL3 (reserved)
RDCgdff DS X generic device/cu functions/features
DS X (reserved -- zeroes)
RDCrduc DS X real control unit code
RDCrdc DS X real device code
DS XL6 (reserved)
RDCinfol EQU *-RDCinfo
LRparm DSECT , locate record paramete
LRop DS X operation byte
LRocount EQU B'00000000' orient count
LRohome EQU B'01000000' orient home
LRodata EQU B'10000000' orient data
LRoindex EQU B'11000000' orient index
LRorient EQU X'00' orient
LRwrite EQU X'01' write data
LRfwrite EQU X'03' format write
LRread EQU X'06' read data
LRwt EQU X'0b' write track
LRrt EQU X'0c' read tracks
LRrd EQU X'16' read
LRaux DS X auxiliary byte
LRusetlf EQU B'10000000' transfer length factor specified
LRrcccw EQU B'00000001' a read count ccw is suffixed
DS X
LRcount DS X count parameter
LRseek DS 0XL4 seek addr
LRseekcc DS XL2
LRseekhh DS XL2
LRsearch DS 0XL5 search arg
LRsrchcc DS XL2
LRsrchhh DS XL2
LRsrchr DS X
LRsector DS X
LRtlf DS XL2 transfer length factor
LRparml EQU *-LRparm
CKDDASD_DEVHDR DSECT ,
devhdr_devid DS CL8
devhdr_heads DS F
devhdr_trksize DS F
devhdr_devtype DS X
devhdr_fileseq DS X
devhdr_highcyl DS H
DS XL492
CKDDASD_DEVHDR_SIZE EQU *-CKDDASD_DEVHDR
CKDDASD_TRKHDR DSECT ,
trkhdr_bin DS X
trkhdr_cyl DS XL2
trkhdr_head DS XL2
CKDDASD_TRKHDR_SIZE EQU *-CKDDASD_TRKHDR
CCKDDASD_DEVHDR DSECT ,
cdevhdr_vrm DS XL3
cdevhdr_options DS X
cdevhdr_numl1tab DS F
cdevhdr_numl2tab DS F
cdevhdr_size DS F
cdevhdr_used DS F
cdevhdr_free DS F
cdevhdr_free_total DS F
cdevhdr_free_largest DS F
cdevhdr_free_number DS F
cdevhdr_free_imbed DS F
cdevhdr_cyls DS F
DS X
cdevhdr_compress DS X
cdevhdr_compress_parm DS H
DS XL464
CCKDDASD_DEVHDR_SIZE EQU *-CCKDDASD_DEVHDR
CCKD_VERSION EQU 0
CCKD_RELEASE EQU 2
CCKD_MODLVL EQU 1
CCKD_NOFUDGE EQU 1
CCKD_BIGENDIAN EQU 2
CCKD_OPENED EQU 128
CCKD_COMPRESS_NONE EQU 0
CCKD_COMPRESS_ZLIB EQU 1
CCKD_COMPRESS_BZIP2 EQU 2
CCKD_COMPRESS_MAX EQU CCKD_COMPRESS_BZIP2
CCKD_L1TAB_POS EQU CKDDASD_DEVHDR_SIZE+CCKDDASD_DEVHDR_SIZE
CCKD_L1ENT_SIZE EQU 4
CCKD_NULLTRK_SIZE EQU 37
CCKD_L2ENT DSECT ,
l2ent_pos DS F
l2ent_len DS H
l2ent_size DS H
CCKD_L2ENT_SIZE EQU *-CCKD_L2ENT
CCKD_L2TAB_SIZE EQU 256*CCKD_L2ENT_SIZE
*/* -------------------------------------------------------------------
* dsects
* ------------------------------------------------------------------ */
PRINT NOGEN
DCBD DSORG=PS
IHADCBE ,
UCBDSECT DSECT ,
IEFUCBOB ,
IEZDEB ,
DEBLENGTH EQU (DEBBASND-DEBAVT)+(DEBDASDE-DEBDASD)+DEBXLEN
IEZIOB ,
IHAECB ,
IOSDCCW ,
CVT DSECT=YES
IHAPSA ,
IKJTCB ,
STAR TRKCALC MF=D
*/* -------------------------------------------------------------------
* equates
* ------------------------------------------------------------------ */
SK EQU X'07'
SNSID EQU X'e4'
SNS EQU X'04'
RDC EQU X'64'
SNSS EQU X'54'
RT EQU X'de'
DX EQU X'63'
LR EQU X'47'
WR0 EQU X'15'
WCKD EQU X'1d'
TIC EQU X'08'
r0 EQU 0
r1 EQU 1
r2 EQU 2
r3 EQU 3
r4 EQU 4
r5 EQU 5
r6 EQU 6
r7 EQU 7
r8 EQU 8
r9 EQU 9
ra EQU 10
rb EQU 11
rc EQU 12
rd EQU 13
re EQU 14
rf EQU 15
END ,
distrib
>
Fedora
>
17
>
i386
>
media
>
updates
>
by-pkgid
>
8c430bbfe7ce899abe0113d8716ceba1
>
files
>
180
