//jobname JOB (ACCT#),CLASS=x,MSGCLASS=x,NOTIFY=userid <- CHECK //* ----------------------------------------------------------------- //* Revive ! Install ... <- CHECK //* //* Step1: //* File Transfer to MVS . //* Step2: //* Enter Flow Line //* => X ALL;F '<- CHECK' ALL (Enter) //* Step3: <- CHECK //* Update Non-Exclusive Line . <- CHECK //* e.g. => C serial VOL001 ALL NX (Enter) <- CHECK //* Step4: <- CHECK //* Submit This JCL. <- CHECK //* Step5:(Optional) <- CHECK //* Comcat Created Datasets in Your Logon Procedure . <- CHECK //* module.library : ISPLLIB or STEPLIB <- CHECK //* clist.library : SYSPROC <- CHECK //* panel.library : ISPPLIB or ISPPALT <- CHECK //* Step6: <- CHECK //* Enter Flow Line on ISPF Command Line . <- CHECK //* => TSO @REV ( Enter ) <- CHECK //* or <- CHECK //* => TSO EX 'clist.library(@REV)' (Enter) <- CHECK //* <- CHECK //* ----------------------------------------------------------------- //JOBCAT DD DSN=user.catalog,DISP=SHR <- CHECK //* - Volume Serial Define ----------------------------------------- //DUMMY EXEC PGM=IEFBR14 //TARGET DD DISP=SHR,UNIT=SYSALLDA,VOL=SER=serial <- CHECK //WORK DD DISP=SHR,UNIT=SYSALLDA,VOL=SER=serial <- CHECK //* - Dataset Scratch ---------------------------------------------- //REMOVE EXEC PGM=IEFBR14 //OBJECT DD DSN=object.library,DISP=(OLD,DELETE), <- CHECK //* -------------- // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET //LOAD DD DSN=module.library,DISP=(OLD,DELETE), <- CHECK //* -------------- // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET //PLIB DD DSN=panel.library,DISP=(OLD,DELETE), <- CHECK //* -------------- // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET //CLIST DD DSN=clist.library,DISP=(OLD,DELETE), <- CHECK //* -------------- // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET //* - Dataset Create ----------------------------------------------- //CREATE EXEC PGM=IEFBR14 //OBJECT DD DSN=*.REMOVE.OBJECT,DISP=(,CATLG), // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET, // SPACE=(TRK,(20,20,10)), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120) //LOAD DD DSN=*.REMOVE.LOAD,DISP=(,CATLG), // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET, // SPACE=(TRK,(20,20,10)), // DCB=(RECFM=U,LRECL=0,BLKSIZE=23200) //PLIB DD DSN=*.REMOVE.PLIB,DISP=(,CATLG), // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET, // SPACE=(TRK,(20,20,10)), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120) //CLIST DD DSN=*.REMOVE.CLIST,DISP=(,CATLG), // UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET, // SPACE=(TRK,(20,20,10)), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120) //* - Copy Routine ------------------------------------------------- //COPY EXEC PGM=IEBGENER //SYSUT1 DD * * --- Start of Oh Shock ! Dummy Section --------------------------- @RV#COPY DSECT *--- Version Number --- @RV#VER DS CL6 OH-Shock Version Number *--- Compiled Date --- @RV#COMP DS CL14 OH-Shock Compiled Date *--- DD Name -------- @RV#DD DS CL8 DD-Name *--- Dataset Name --- @RV#DSN DS CL44 Dataset Name *--- Volume Serial --- @RV#VOL DS CL6 Volume Serial Number *--- Disposition --- @RV#DISP DS CL1 Disposition *--- Search String --- @RV#LSTR DS F Search String Length @RV#SSTR DS CL50 Search Storing *--- PDS ( Directory ) DCB address --- APDSFD DS A Address of PDSFD *--- PDS ( Data ) DCB address --- APDSF DS A Address of PDSF * --- Copy Section ( using R07 ) --- CPY_A DS F Copy Section Getmain Address CPY_L DS F Copy Section Getmain Length * --- Directory Table --- DIRT_A DS F Directory Table GetM Address DIRT_P DS F Directory Table GetM Pointer DIRT_L DS F Directory Table GetM Length * --- Data Area Read Buffer --- BUFF_A DS F Data Read Buff GetM Address BUFF_L DS F Data Read Buff GetM Length * --- dataset configration area --- *ETM_A3 DS F GETMAIN ADDRESS 2 *ETM_L3 DS F GETMAIN LENGTH 2 D_ENDP DS F DIRECTORY END POINT *--- Dataset Dynamic Allocation Parameter --- DA#AREA DS 0F DA#PROC DS CL8 Process Name DA#DSN DS CL44 Dataset Name DA#VOL DS CL6 Volume Serial DA#DISP DS CL3 Disposition DA#RETDD DS CL8 Return DD-Name DA#RETC DS CL4 Return Code DA#SPC DS CL3 Space ( TRK or CYL ) DA#SIZE1 DS XL3 Primary Space DA#SIZE2 DS XL3 Secondary Space DA#DSORG DS CL2 Dataset Organization ( PS ) DA#RECFM DS XL1 Record Format * ( F, V, FB, VB, FBA, VBA, U ) DA#LRECL DS XL2 Logical Record Length DA#BLKSZ DS XL2 Block Size *--- Length of Copy Section --- @RV#CPYL EQU *-@RV#COPY /* //SYSUT2 DD DSN=&©(@RV#080X),DISP=(,PASS), // UNIT=SYSALLDA,VOL=REF=*.DUMMY.WORK,SPACE=(TRK,(10,10,10)), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120) //SYSPRINT DD SYSOUT=* //SYSIN DD DUMMY //* - CLIST -------------------------------------------------------- //CLIST EXEC PGM=IEBGENER //SYSUT1 DD *,DLM=@@ /* - REXX - - REVIVE ! PDS Members ... */ TRACE N SIGNAL ON ERROR NAME ERR_PROC ADDRESS TSO "ALLOC F(ISPLUSR) DA('isp.sispload'," , /* <- CHECK */ "'module.library')" , /* <- CHECK */ "SHR REU" "ALLOC F(ISPPUSR) DA('panel.library')" , /* <- CHECK */ "SHR REU" "ALLOC F(SNAPDD) DA(*)" , "SHR REU" ADDRESS ISPEXEC "LIBDEF ISPLLIB EXCLLIBR ID(ISPLUSR) COND" "LIBDEF ISPPLIB LIBRARY ID(ISPPUSR) COND" "SELECT PGM(@RV#0)" "LIBDEF ISPLLIB EXCLLIBR" "LIBDEF ISPPLIB LIBRARY" ADDRESS TSO "FREE F(ISPLUSR,ISPPUSR,SNAPDD)" EXIT ERR_PROC: SAY SAY SAY '>> OS000 Initial Process Abnormal Ended .... Bye !!' SAY @@ //SYSUT2 DD DSN=*.CREATE.CLIST,DISP=OLD //SYSPRINT DD SYSOUT=* //SYSIN DD * GENERATE MAXNAME=1 MEMBER NAME=(@REV) //* - PANELS ( @RV#2ENT ) ------------------------------------------ //PNL#ENT EXEC PGM=IEBGENER //SYSUT1 DD *,DLM=@@ )Attr % type(text ) intens(high) caps(off) + type(text ) intens(low ) _ type(input ) intens(high) caps(off) just(left ) $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore) \ type(input ) intens(high) caps(on ) just(right) hilite(uscore) ? type(input ) intens(high) caps(off) just(left ) hilite(uscore) @ type(text) intens(high) caps(off) color(yellow) ~ type(text) intens(high) caps(off) color(turq) )Body Expand(//) %-/-/- Revive ! < &rev > Entry -/-/- %Command ===>_zcmd / / + + @ Keyin Recovery Dataset .. + Dataset Name :$I#DSN + + Volume Serial :$I#VOL + -------------------------- + | Version :~&REV +| + Select Option | Fix :~&REVD +| + o Recovery Members After Compressed .. | Compile :~&REVC +| + Extended Recovery :$z+ ( Y.N ) -------------------------- + + o Add Current Member ... + :\z+ ( Y.N ) + + o Recovery Dataset Disposition .. + :$z+ ( S:shr O:old ) + + o GetMain Directory Table Space ... + :\z + ( nnnnn:Byte ) + + o Search String .. ( BLANK or Search String ) + :?i#srhstr + + )Init .help = @rv#2hlp /* insert name of tutorial panel */ .cursor = i#dsn .zvars = '(i#extopt i#extop2 i#disp i#dspace)' )proc ver (&i#dsn,nb,dsname) if ( &i#vol ^= ' ' ) ver (&i#vol,len,EQ,6) ver (&i#extopt,nb,list,Y,N) ver (&i#extop2,nb,list,Y,N) ver (&i#disp,nb,list,S,O) ver (&i#dspace,nb,num) ver (&i#dspace,range,3,9999999) vput i#srhstr )END @@ //SYSUT2 DD DSN=*.CREATE.PLIB,DISP=OLD //SYSPRINT DD SYSOUT=* //SYSIN DD * GENERATE MAXNAME=1 MEMBER NAME=(@RV#2ENT) //* - PANELS ( @RV#2LST ) ------------------------------------------ //PNL#LST EXEC PGM=IEBGENER //SYSUT1 DD *,DLM=@@ )Attr % type(text ) intens(high) caps(off) + type(text ) intens(low ) _ type(input ) intens(high) caps(on ) just(left ) $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore) @ type(text) intens(high) caps(off) color(yellow) ^ type(output) intens(low ) caps(off) just(asis ) color(blue) ~ type(output) intens(low ) caps(off) just(right) color(blue) \ type(input ) intens(low ) caps(on ) just(asis ) color(turq) )Body Expand(//) %-/-/- P D S F - Oh Shock ! < &rev > -/-/- %Command ===>_zcmd / /%Scroll ===>_amt + + + DataSet Name :^I#DSN + Vol :^I#VOL + @ Select: 'B' - Browse 'R' - Restore % Member -- Data ( First 60 Byte ) -- Rec# )MODEL $Z\O#M ^O#D ~O#LEN+ )Init &amt = csr .help = @rv#2hlp /* insert name of tutorial panel */ .zvars = '( @select )' )PROC )END @@ //SYSUT2 DD DSN=*.CREATE.PLIB,DISP=OLD //SYSPRINT DD SYSOUT=* //SYSIN DD * GENERATE MAXNAME=1 MEMBER NAME=(@RV#2LST) //* - PANELS ( @RV#CRE ) ------------------------------------------- //PNL#CRE EXEC PGM=IEBGENER //SYSUT1 DD *,DLM=@@ )Attr % type(text ) intens(high) caps(off) + type(text ) intens(low ) _ type(input ) intens(high) caps(off) just(left ) $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore) @ type(text) intens(high) caps(off) color(yellow) )Body Expand(//) %-/-/- Revive ! < &rev > Restore -/-/- %Command ===>_zcmd / / + + @ Keyin Restore Dataset .. + + Dataset Name :$R#DSN + + Volume Serial :$R#VOL + + )Init .help = tutorpan /* insert name of tutorial panel */ .cursor = r#dsn )proc ver (&r#dsn,nb,dsname) if ( &r#vol ^= ' ' ) ver (&r#vol,len,EQ,6) )END @@ //SYSUT2 DD DSN=*.CREATE.PLIB,DISP=OLD //SYSPRINT DD SYSOUT=* //SYSIN DD * GENERATE MAXNAME=1 MEMBER NAME=(@RV#CRE) //* - PANELS ( @RV#INF ) ------------------------------------------- //PNL#INF EXEC PGM=IEBGENER //SYSUT1 DD *,DLM=@@ )Attr % type(text ) intens(high) caps(off) + type(text ) intens(low ) _ type(input ) intens(high) caps(off) just(left ) $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore) @ type(text) intens(high) caps(off) color(yellow) ^ type(output) intens(low ) caps(off) just(asis ) color(blue) \ type(input ) intens(low ) caps(on ) just(asis ) color(turq) )Body Expand(//) %-/-/- Revive ! < &rev > Information -/-/- %Command ===>_zcmd / / + + + DataSet Name :^i#dsn + m b b c c h h r t t r + ------------ Addr :^o#asp +recfm :^o#recfm + | Directory | blks :^o#dblk +mem# :^o#mem +lrecl :^o#lrecl + ------------ Addr :^o#adp +(^z +)+blksize :^o#blksz + | Data | +devtype :^o#devt + | ( Used ) | +serial :^i#vol + ------------ Addr :^o#aup +(^z +)+extent :^o#ext + | Data | +allocated :^o#alc+trk + | ( UnUsed ) | +use :^o#use+per + ------------ Addr :^o#aep +(^z +)+creation :^o#cre + +expiration :^o#exp + +system code :^o#syscd + 1st 2nd 3rd 4th 5th 6th 7th 8th + Low :^o#l1 ^o#l2 ^o#l3 ^o#l4 ^o#l5 ^o#l6 ^o#l7 ^o#l8 + High:^o#h1 ^o#h2 ^o#h3 ^o#h4 ^o#h5 ^o#h6 ^o#h7 ^o#h8 + 9th 10th 11th 12th 13th 14th 15th 16th + Low :^o#l9 ^o#l10 ^o#l11 ^o#l12 ^o#l13 ^o#l14 ^o#l15 ^o#l16 + High:^o#h9 ^o#h10 ^o#h11 ^o#h12 ^o#h13 ^o#h14 ^o#h15 ^o#h16 + + )init .zvars = '(o#adp2 o#aup2 o#aep2)' )proc )end @@ //SYSUT2 DD DSN=*.CREATE.PLIB,DISP=OLD //SYSPRINT DD SYSOUT=* //SYSIN DD * GENERATE MAXNAME=1 MEMBER NAME=(@RV#INF) //A EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START * ----------------------------------------------------------------- DC C'<< Revive ! >> Version 0.80 ( ' REV DC CL6'v0r8m0' DC C' ) _ Kimu // ' DC C' Fixed Date : ' REVD DC C'05/02/96 00.00' *EVD DC C'*Test Version*' DC C' Compiled Date : ' REVC DC C'&SYSDATE &SYSTIME' PRINT NOGEN * --- Start of Process -------------------------------------------- @RV#080 CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03,R04,R05,R06 Base Reg. R03,R04,R05 LA R04,2048(R03) 2'ND Base Reg LA R04,2048(R04) LA R05,2048(R04) 3'ND Base Reg LA R05,2048(R05) LA R06,2048(R05) 4'ND Base Reg LA R06,2048(R06) ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) *-------- Initialization ------------------------------------------- L R01,0(R01) LH R02,0(R01) LTR R02,R02 BZ @INISKP CL R02,=F'44' BH @INISKP MVI I#DSN,C' ' Search String MVC I#DSN+1(43),I#DSN BCTR R02,0 STC R02,*+5 MVC I#DSN(0),2(R01) @INISKP EQU * *-------- Copy Section Storae ------------------------------------- LA R08,@RV#CPYL Get Copy Section Length GETMAIN RC,LV=(R08) Member TTR Save Area LTR R15,R15 BNZ GETM_ER0 LR R07,R01 USING @RV#COPY,R07 using r07 <- Copy Section ST R07,CPY_L Store GetMain Length ST R09,CPY_A Getmain Copy Section Addr. *-------- Morning Message ------------------------------------------ * L R01,=A(REV) * MVC @RV#VER(L'@RV#VER),0(R01) * L R01,=A(REVC) * MVC @RV#COMP(L'@RV#COMP),0(R01) * MVC MSG004+17(L'@RV#VER),@RV#VER * MVC MSG004+26(L'@RV#COMP),@RV#COMP * TPUT MSG004,L'MSG004 *-------- Set Copy Section ----------------------------------------- LA R01,PDSFD save PDSFD DCB address ST R01,APDSFD ( PDS Directory ) LA R01,PDSF save PDSF DCB address ST R01,APDSF ( PDS Data ) *-------- Define ISPF Variable ------------------------------------- BAL R14,ISPFVDEF *-------- Initialize Entry Panel Variable ... ---------------------- MVI I#VOL,C' ' Search String MVC I#VOL+1(6),I#VOL MVI I#EXTOPT,C'N' Extended Option 1 MVI I#EXTOP2,C'N' Extended Option 2 MVI I#DISP,C'S' Disposition MVC I#DSPACE,=F'110000' Directory Space MVI I#SRHSTR,C' ' Search String MVC I#SRHSTR+1(49),I#SRHSTR *-------- Entry Panel Show ----------------------------------------- SHOW_ENT EQU * CALL ISPLINK,(DISPLAY,PANELENT),VL Entry Panel Display LTR R15,R15 if PF03 then BNZ @QUIT goto @EXIST *-------- Panel Field Copy ----------------------------------------- MVC @RV#DSN(44),I#DSN Copy Dataset name MVC @RV#VOL(06),I#VOL Copy Volume Serial MVC @RV#DISP(1),I#DISP Copy Disposition MVC DIRT_L,I#DSPACE Copy Genmain Size MVI @RV#SSTR,C' ' Search String MVC @RV#SSTR(L'@RV#SSTR-1),@RV#SSTR+1 XC @RV#LSTR,@RV#LSTR LA R01,L'I#SRHSTR BCTR R01,0 LA R02,I#SRHSTR(R01) S#SSTRL EQU * CLI 0(R02),C' ' BNE S#SSTRLX BCTR R02,0 BCT R01,S#SSTRL B S#SSTRLQ S#SSTRLX EQU * LA R01,1(R01) ST R01,@RV#LSTR STC R01,*+5 MVC @RV#SSTR(0),I#SRHSTR S#SSTRLQ EQU * *-------- Recover Dataset ENQ ( Exclusive ) ----------------------- MVC RNAME(44),@RV#DSN ENQ rname ENQ MF=(E,@ENQ) LTR R15,R15 BNZ ENQ_ER0 *-------- Dynamic Allocaation of Recovery dataset ----------------- MVC DA#PROC(8),=CL8'ALLOCATE' Dynamic Allocation Rout MVC DA#DSN(44),@RV#DSN Copy Allocation DataSet MVC DA#VOL(06),@RV#VOL Copy Allocation Volume CLI @RV#DISP,C'O' if DISP = OLD then BE @ENT_OLD MVC DA#DISP(3),=CL3'SHR' Set Disposition B @ENT_ALC @ENT_OLD EQU * MVC DA#DISP(3),=CL3'OLD' Set Disposition @ENT_ALC EQU * LA R01,DA#AREA Set r01 = Parm Area L R15,@RV#6DA BALR R14,R15 Call Dynam Alloc Routine LTR R15,R15 if rc = 0 then BZ @ENT_OK goto @DY_OK *-------- Dynamic Allocation Error --------------------------------- CL R15,=F'8' if rc = 8 then BNE @ENT_DNF dataset not found MVC ZEDLMSG,ERRMSG06 MVC ZEDSMSG,=CL20'DSN Not Found !' B @ENT_ERX @ENT_DNF EQU * LA R01,DA#RETC CALL @RV#6HC,((R01),ERRMSG02+30,4) MVC ZEDLMSG,ERRMSG02 CLC DA#RETC(2),=XL2'0210' Dataset In Use ( EXCL ) * Already Other JOB BE @ENT_USE CLC DA#RETC(2),=XL2'020C' Dataset In Use ( SHR ) * Already Other JOB BE @ENT_USE MVC ZEDSMSG,=CL20'Dynam alloc err !' B @ENT_ERX @ENT_USE EQU * MVC ZEDSMSG,=CL20'In Use .. Other User !' @ENT_ERX EQU * DEQ MF=(E,@DEQ) DEQ CALL ISPLINK,(SETMSG,ISRZ001),VL B SHOW_ENT Retry Entry Panel *-------- Allocate & Initialization -------------------------------- @ENT_OK EQU * MVC @RV#DD(8),DA#RETDD Save Input DD MVC PDSF+X'28'(8),@RV#DD Directory Read DD MVC PDSFD+X'28'(8),@RV#DD Data Read DD MVC PDSFS+X'28'(8),@RV#DD Stow DD MVC PDSFR+X'28'(8),@RV#DD ExRecovery Write DD MVC ZEDLMSG,MSG002 MVC ZEDSMSG,=CL20' ' CALL ISPLINK,(SETMSG,ISRZ001),VL Show Wait Message CALL ISPLINK,(CONTROL,DISPLAY,LOCK),VL CALL ISPLINK,(DISPLAY,PANELENT),VL * OPEN (PDSFD,,PDSF) RDJFCB PDSF Get JFCB CALL @RV#6DC Get Dataset Information *-------- Check Input Dataset Organization ( PO File Only ) -------- CLI CK#DSORG,JFCORGPO If Dsorg is Not PO Then BE @ENT_QUT goto @dy_quit CALL @RV#6HC,(CK#DSORG,ERRMSG05+40,1) MVC ZEDLMSG,ERRMSG05 MVC ZEDSMSG,=CL20'OSORG Error !' CALL ISPLINK,(SETMSG,ISRZ001),VL CLOSE (PDSFD,,PDSF) MVC DA#PROC(8),=CL8'FREE ' Free MVC DA#RETDD(8),@RV#DD LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 Call Free Routine DEQ MF=(E,@DEQ) DEQ B SHOW_ENT @ENT_QUT EQU * *-------- Directory Table Area GetMain ----------------------------- L R02,DIRT_L GETMAIN RC,LV=(R02) Member TTR Save Area LTR R15,R15 BNZ GETM_ER1 ST R01,DIRT_A getmain 1 address ST R01,DIRT_P getmain 1 pointer *-------- Data Area Read Buffer Getmain ---------------------------- LH R02,PDSF+X'3E' ST R02,BUFF_L getmain 2 length GETMAIN RC,LV=(R02) Read Buffer Work Area LTR R15,R15 BNZ GETM_ER2 ST R01,BUFF_A getmain 2 address *-------- ISPF Table Create ---------------------------------------- CALL ISPLINK,(TBCREATE,@RV#00,KEYN,NAMEL,NOWRITE),VL *-------- Directory Read ------------------------------------------- XR R10,R10 Clear Member Counter XC O#DBLK(L'O#DBLK),O#DBLK Clear Directory Block @D_READ EQU * READ DECB01,SF,PDSFD,DIR,'S' READ DIRECTORY CHECK DECB01 * L R01,O#DBLK Directory Block Count LA R01,1(R01) ST R01,O#DBLK * LH R12,DIR Load Read Length LA R12,DIR(R12) ST R12,D_ENDP Save Directory END-ADDR LA R12,DIR+2 Set Member Start Point @D_LOP01 EQU * CL R12,D_ENDP If Directory END-ADDR BNL @D_READ Goto Read Next Record CLI 0(R12),X'FF' If End of Member Name BE @D_READ Goto Read Next Record L R11,DIRT_P R11 <- Table Pointer MVC 0(11,R11),0(R12) Copy Member Name and TTR LA R11,11(R11) ST R11,DIRT_P Store Table Pointer LA R10,1(R10) Member Counter + 1 L R01,DIRT_A L R02,DIRT_L LA R01,0(R01,R02) Check End of Table Space CLR R01,R11 If No More Table BL @TB_OVER Goto @TB_OVER * IC R11,11(R12) Load 'C' N R11,=X'0000001F' User Data Length SLL R11,1 * 2 LA R12,12(R12,R11) Point Next Member B @D_LOP01 *-------- End of Directory ( Directory at end Routie ) ------------- @D_EXIT EQU * NOTE PDSFD Get Last Directory Addr ST R01,W_TTR MVI W_TTR+3,X'00' POINT PDSF,W_TTR Point Data Area Addr *-------- Store Member Number -------------------------------------- CVD R10,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' MVC O#MEM(5),UPK_AREA+3 *-------- Store Member Number -------------------------------------- CALL @RV#6HC,(W_TTR,O#ADP2,3) L R00,W_TTR MBBCCHHR Convert N R00,=X'FFFFFF00' L R01,PDSF+44 Load DEB Address N R01,=X'00FFFFFF' LA R02,W_CHR BAL R14,@CNVCHR Convert TTR -> MBBCCHHR CALL @RV#6HC,(W_CHR,O#ADP,8) *-------- Read First Data Area ------------------------------------- @M_FIRST EQU * MVI MEMAREA,X'40' Clear OutArea MVC MEMAREA+1(77),MEMAREA XC O#LEN,O#LEN Clear Record Counter * OI FLAG,X'02' Set Str Srch Flag NI FLAG,X'FD' Clear Str-Srch Flag * Convert 'Real Address' to 'Relative Address' * DEBUG * * CALL @RV#6HC,(PDSF+5,ERRMSG10+2,8) * CALL @RV#6HC,(T#CHR,ERRMSG10+22,8) * TPUT ERRMSG10,L'ERRMSG10 * DEBUG * L R01,PDSF+44 Load DEB Address N R01,=X'00FFFFFF' LA R02,PDSF+5 MBCCHHR ADDRESS BAL R14,@CNVTTR CONVERT MBCCHHR -> TTR ST R00,W_TTR GET TTR CLI I#EXTOPT,C'Y' BE EXTOPT1 CLC W_TTR(3),E#TTR IF END BLOCK BNL @M_EXIT2 B EXTOPT1X EXTOPT1 EQU * CLC T#CHR+3(4),PDSF+8 IF END BLOCK BNH @M_EXIT2 * EXTOPT1X EQU * L R12,BUFF_A READ DECB11,SF,PDSF,(R12),'S' READ MEMBER CHECK DECB11 ( FIRST BLOCK ) LA R01,1 ST R01,O#LEN Clear Record Counter L R01,DECB11+16 LH R01,14(R01) L R02,BUFF_L SR R02,R01 ST R02,R_LEN Save Read Length * * TPUT =CL20'** 1ST 1 **',20 BAL R10,@SRCHSTR * TPUT =CL20'** 1ST 2 **',20 * LA R12,FLAG * CALL @RV#6HC,((R12),ERRMSG10+9,1) * CALL @RV#6HC,(R_LEN,ERRMSG10+11,4) * TPUT ERRMSG10,L'ERRMSG10 * --- DEBUG --- * CALL @RV#6HC,(PDSF+5,ERRMSG07+11,8) * TPUT ERRMSG07,L'ERRMSG07 * --- DEBUG --- L R01,PDSF+44 DEB ADDRESS N R01,=X'00FFFFFF' LA R02,PDSF+5 MBCCHHR ADDRESS BAL R14,@CNVTTR CONVERT MBCCHHR -> TTR ST R00,W_TTR GET TTR CLI I#EXTOPT,C'Y' BE EXTOPT2 CLC W_TTR(3),E#TTR IF END BLOCK BNL @M_EXIT2 B EXTOPT2X EXTOPT2 EQU * CLC T#CHR+3(4),PDSF+8 IF END BLOCK BNH @M_EXIT2 * EXTOPT2X EQU * * L R12,DIRT_A @M_LOP01 EQU * SEARCH TTR * B @M_NOF CL R12,DIRT_P IF END ADDRESS BNL @M_NOF CLC 8(3,R12),W_TTR IF EQUAL BE @M_FND LA R12,11(R12) B @M_LOP01 *-------- TTR Found on Directory Table ----------------------------- @M_FND EQU * CLI I#EXTOP2,C'Y' BE @M_FND2 NI FLAG,X'FE' Set Add Table Flag B @M_DUM_L @M_FND2 EQU * MVC O#M(8),0(R12) Copy Member Name MVC O#TTRB(4),W_TTR CALL @RV#6HC,(W_TTR,O#TTR,3) L R01,PDSF+44 Load DEB Address N R01,=X'00FFFFFF' LA R02,O#MBCHR BAL R14,@CNVCHR convert ttr -> mbbcchhr L R12,BUFF_A * L R10,BUFF_L * S R10,R_LEN L R10,R_LEN LA R11,60 CLR R10,R11 BNL @M_FNDS IF READ LENGTH >= 55 BCTR R10,0 STC R10,*+5 MVC O#D(0),0(R12) COPY DATA AREA B @M_SKIPX @M_FNDS EQU * MVC O#D(60),0(R12) COPY DATA AREA B @M_SKIPX @M_NOF EQU * MVI O#M,C'+' MEMBER NAME ( +TTR ) CALL @RV#6HC,(W_TTR,O#M+1,3) MVC O#TTRB(4),W_TTR CALL @RV#6HC,(W_TTR,O#TTR,3) L R01,PDSF+44 Load DEB Address N R01,=X'00FFFFFF' LA R02,O#MBCHR BAL R14,@CNVCHR convert ttr -> mbbcchhr * L R12,BUFF_A * L R10,BUFF_L * S R10,R_LEN L R10,R_LEN LA R11,60 CLR R10,R11 BNL @M_SKIP IF READ LENGTH >= 55 BCTR R10,0 STC R10,*+5 MVC O#D(0),0(R12) COPY DATA AREA B @M_SKIPX @M_SKIP EQU * MVC O#D(60),0(R12) COPY DATA AREA @M_SKIPX EQU * OI FLAG,X'01' *-------- Read Data Area ( Dummy Read ) ---------------------------- @M_DUM_L EQU * L R12,BUFF_A 2'ND BLOCK READ DECB12,SF,PDSF,(R12),'S' READ MEMBER CHECK DECB12 L R01,O#LEN Add block length + 1 LA R01,1(R01) ST R01,O#LEN L R01,DECB12+16 LH R01,14(R01) L R02,BUFF_L SR R02,R01 ST R02,R_LEN Save Read Length * TPUT =CL20'** 2ND 1 **',20 BAL R10,@SRCHSTR * TPUT =CL20'** 2ND 2 **',20 * LA R12,FLAG * CALL @RV#6HC,((R12),ERRMSG10+9,1) * TPUT ERRMSG10,L'ERRMSG10 * --- DEBUG --- * CALL @RV#6HC,(PDSF+5,ERRMSG07+11,8) * TPUT ERRMSG07,L'ERRMSG07 * --- DEBUG --- L R01,PDSF+44 DEB ADDRESS N R01,=X'00FFFFFF' LA R02,PDSF+5 MBCCHHR ADDRESS BAL R14,@CNVTTR CONVERT MBCCHHR -> TTR ST R00,W_TTR GET TTR CLI I#EXTOPT,C'Y' BE EXTOPT3 CLC W_TTR(3),E#TTR IF END BLOCK BNL @M_EXIT1 B EXTOPT3X EXTOPT3 EQU * CLC T#CHR+3(4),PDSF+8 IF END BLOCK BNH @M_EXIT1 * EXTOPT3X EQU * * B @M_DUM_L *-------- Next Member Process -------------------------------------- @M_NEXT EQU * next member read ! TM FLAG,X'01' BNO @M_NEXTX TM FLAG,X'02' BNO @M_NEXTX L R01,O#LEN If Member is No-Records LTR R01,R01 Goto @M_NEXTX BZ @M_NEXTX CALL ISPLINK,(TBADD,@RV#00,NAMELIST),VL @M_NEXTX EQU * B @M_FIRST @M_EXIT1 EQU * member read terminate. TM FLAG,X'01' BNO @M_EXIT2 CALL ISPLINK,(TBADD,@RV#00,NAMELIST),VL @M_EXIT2 EQU * member read terminate. B @R_EXIT @R_EXIT EQU * read terminate . CLOSE (PDSFD,,PDSF) CALL ISPLINK,(TBTOP,@RV#00),VL MVC ZEDLMSG,MSG001 * CALL ISPLINK,(VPUT,VPUT#N),VL CALL ISPLINK,(SETMSG,ISRZ001),VL * *-------- List Panel Display --------------------------------------- @DISPLAY EQU * MVI @SELECT,C' ' clear table select area * CALL ISPLINK,(TBQUERY,@RV#00),VL CURR),VL * CALL ISPLINK,(TBSKIP,@RV#00,,,,,TBCURR),VL * CALL ISPLINK,(VPUT,V@SELECT),VL CALL ISPLINK,(TBDISPL,@RV#00,PANELLST),VL CL R15,=F'8' BNL @RLSE **** MVC ZEDSMSG(20),=CL20' ' MVC ZEDLMSG(60),=CL60' ' **** PACK PK_AREA(8),ZTDSELS multi select code CVB R11,PK_AREA R11 <- selection number @D_LOP02 EQU * CL R11,=F'1' if multi sel last one BNH @D_LOP_X CALL ISPLINK,(CONTROL,DISPLAY,SAVE),VL panel save BAL R10,@D_CMD_P command process BCTR R11,0 multi sel - 1 * CALL ISPLINK,(VPUT,VPUT#N),VL * CALL ISPLINK,(SETMSG,ISRZ001),VL CALL ISPLINK,(CONTROL,DISPLAY,RESTORE),VL panel restore CALL ISPLINK,(TBDISPL,@RV#00),VL display B @D_LOP02 loop to multi select @D_LOP_X EQU * BAL R10,@D_CMD_P command process last one **** * CALL ISPLINK,(VPUT,VPUT#N),VL CALL ISPLINK,(SETMSG,ISRZ001),VL B @DISPLAY *------------------------------------------------------------------- *-------- command process ------------------------------------------ *------------------------------------------------------------------- @D_CMD_P EQU * STM R00,R15,CMD#REG CLC ZCMD(3),=CL3'INF' BE @INFORM CLI @SELECT,C'B' BE @BROWSE CLI @SELECT,C'R' BE @RESTORE CLI @SELECT,C'A' BE @ADDRESS @D_CMD_X EQU * LM R00,R15,CMD#REG BR R10 *-------- Information Panel Display -------------------------------- @INFORM EQU * * CALL ISPLINK,(DISPLAY,PANELINF),VL information panel B @D_CMD_X *-------- TTR and MBBCCHHR Message Display ------------------------- @ADDRESS EQU * MVC ERRMSG14+6(6),O#TTR CALL @RV#6HC,(O#MBCHR,ERRMSG14+24,8) MVC ZEDSMSG(20),=CL20' ' MVC ZEDLMSG(60),ERRMSG14 B @D_CMD_X * CALL ISPLINK,(DISPLAY,PANELINF),VL information panel B @D_CMD_X *-------- Member Browse -------------------------------------------- @BROWSE EQU * MVC ZEDSMSG(20),=CL20'browse ..' CLI O#M,C'+' BNE @BR_SKP1 BAL R14,@STOW_A @BR_SKP1 EQU * MVI BR#DSN,C'''' MVC BR#DSN+1(44),I#DSN LA R12,BR#DSN+1 @BR_LOP1 EQU * CLI 0(R12),X'40' BE @BR_LOPX LA R12,1(R12) B @BR_LOP1 @BR_LOPX EQU * MVI 0(R12),C'(' LA R12,1(R12) MVC 0(8,R12),O#M @BR_LOP2 EQU * CLI 0(R12),C' ' BE @BR_LOPY LA R12,1(R12) B @BR_LOP2 @BR_LOPY EQU * MVI 0(R12),C')' MVI 1(R12),C'''' MVC BR#VOL(6),@RV#VOL * TPUT BR#DSN,L'BR#DSN CALL ISPLINK,(BROWSE,BR#DSN,BR#VOL),VL CLI O#M,C'+' BNE @BR_SKP2 BAL R14,@STOW_D @BR_SKP2 EQU * * CALL ISPLINK,(VPUT,VPUT#N),VL * CALL ISPLINK,(SETMSG,ISRZ001),VL B @D_CMD_X *-------- Member Restore ------------------------------------------- @RESTORE EQU * CLI I#EXTOPT,C'Y' BE @RST_OPT BAL R14,@STOW_A MVC MSG003+12(8),O#M CALL @RV#6HC,(STOW_RC,MSG003+35,4) MVC ZEDSMSG(20),=CL20' ' MVC ZEDLMSG(60),MSG003 CLC STOW_RC,=F'0' BNE @REST_X CALL ISPLINK,(TBSCAN,@RV#00,NTBSCAN),VL CALL ISPLINK,(TBDELETE,@RV#00),VL B @REST_X @RST_OPT EQU * CALL ISPLINK,(DISPLAY,PANELCRE),VL information panel LTR R15,R15 if PF03 then BNZ @REST_X goto @EXIST MVC DA#PROC(8),=CL8'CREATE ' dynamic allocation rout MVC DA#DSN(44),R#DSN copy input dataset name MVC DA#VOL(6),R#VOL copy input volume MVC DA#DISP(3),=CL3'NEW' set disposition MVC DA#DSORG(2),=CL2'PS' copy dataset organization MVC DA#SPC(3),=CL3'TRK' copy dataset space * MVC DA#SIZE1(3),=XL3'000010' copy dataset space CLC R#VOL,=CL6' ' BE @RST_OP1 CALL @RV#6TC,(R#VOL,CK#BLKSZ,SPC1) LTR R15,R15 BZ @RST_OP2 ST R15,RC# CALL @RV#6HC,(RC#,ERRMSG12+37,4) MVC ZEDLMSG,ERRMSG12 MVC ZEDSMSG,=CL20'TRKCALC Error !' CALL ISPLINK,(SETMSG,ISRZ001),VL B @RST_OPT @RST_OP1 EQU * MVC BR#VOL(6),@RV#VOL CALL @RV#6TC,(BR#VOL,CK#BLKSZ,SPC1) LTR R15,R15 BZ @RST_OP2 ST R15,RC# CALL @RV#6HC,(RC#,ERRMSG12+37,4) MVC ZEDLMSG,ERRMSG12 MVC ZEDSMSG,=CL20'TRKCALC Error !' CALL ISPLINK,(SETMSG,ISRZ001),VL B @RST_OPT @RST_OP2 EQU * * CALL @RV#6HC,(SPC1,ERRMSG02+30,4) * TPUT ERRMSG02,L'ERRMSG02 * CALL @RV#6HC,(O#LEN,ERRMSG02+30,4) * TPUT ERRMSG02,L'ERRMSG02 L R08,O#LEN SRDA R08,32 D R08,SPC1 LTR R08,R08 BZ @RST_OP3 LA R09,1(R09) @RST_OP3 EQU * ST R09,SPC2 * CALL @RV#6HC,(SPC2,ERRMSG02+30,4) * TPUT ERRMSG02,L'ERRMSG02 * B @RST_OPT MVC DA#SIZE1(3),SPC2+1 * MVC DA#SIZE1(3),=XL3'000010' copy dataset space MVC DA#SIZE2(3),=XL3'000001' copy dataset space MVC DA#RECFM(1),CK#RFM copy record format MVC DA#LRECL(2),CK#LRECL copy logical record length MVC DA#BLKSZ(2),CK#BLKSZ copy block size LA R01,DA#AREA set r01 = parm area L R15,@RV#6DA BALR R14,R15 call dynam alloc routine * LTR R15,R15 if rc = 0 then BZ @RS_OK goto @DY_OK LA R01,DA#RETC CALL @RV#6HC,((R01),ERRMSG02+30,4) MVC ZEDLMSG,ERRMSG02 MVC ZEDSMSG,=CL20'Dynam alloc err !' CALL ISPLINK,(SETMSG,ISRZ001),VL B @REST_X * @RS_OK EQU * MVC RESTDCB+X'28'(8),DA#RETDD MVC RESTDCB+X'24'(1),CK#RFM MVC RESTDCB+X'3E'(2),CK#BLKSZ copy block size MVC RESTDCB+X'52'(2),CK#LRECL copy logical record length OPEN (PDSFR,,RESTDCB,(OUTPUT)) POINT PDSFR,O#TTRB FIRST DATA ADDRESS @RS_LOP EQU * * TPUT =CL80'** WRITE **',80 L R12,BUFF_A READ DECB30,SF,PDSFR,(R12),'S' CHECK DECB30 ( FIRST BLOCK ) L R01,BUFF_L L R11,DECB30+16 SH R01,14(R11) STH R01,RESTDCB+X'3E' copy block size WRITE DECB31,SF,RESTDCB,(R12),'S' CHECK DECB31 ( FIRST BLOCK ) B @RS_LOP @RS_LOPX EQU * CLOSE (PDSFR,,RESTDCB) MVC DA#PROC(8),=CL8'FREE ' free MVC DA#RETDD(8),RESTDCB+X'28' LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 * @REST_X EQU * * CALL ISPLINK,(VPUT,VPUT#N),VL * CALL ISPLINK,(SETMSG,ISRZ001),VL B @D_CMD_X *--------- Return to Entry Panel ----------------------------------- @RLSE EQU * CALL ISPLINK,(TBCLOSE,@RV#00),VL L R02,DIRT_L L R12,DIRT_A FREEMAIN RC,LV=(R02),A=(R12) L R02,BUFF_L L R12,BUFF_A FREEMAIN RC,LV=(R02),A=(R12) MVC DA#PROC(8),=CL8'FREE ' MVC DA#RETDD(8),@RV#DD LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 DEQ MF=(E,@DEQ) B SHOW_ENT *--------- Directory Table Over Flow ------------------------------- @TB_OVER EQU * CLOSE (PDSFD,,PDSF) Close Recover File L R02,DIRT_L L R12,DIRT_A FREEMAIN RC,LV=(R02),A=(R12) FreeMain Direct Table L R02,BUFF_L L R12,BUFF_A FREEMAIN RC,LV=(R02),A=(R12) FreeMain Read Buffer MVC DA#PROC(8),=CL8'FREE ' MVC DA#RETDD(8),@RV#DD LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 Recover File De-Alloc DEQ MF=(E,@DEQ) DEQ LA R02,DIRT_A CALL @RV#6HC,((R02),ERRMSG03+29,4) LA R02,DIRT_L CALL @RV#6HC,((R02),ERRMSG03+40,4) LA R02,DIRT_P CALL @RV#6HC,((R02),ERRMSG03+51,4) MVC ZEDLMSG,ERRMSG03 MVC ZEDSMSG,=CL20'Table OverFlow' CALL ISPLINK,(SETMSG,ISRZ001),VL B SHOW_ENT Return Entry Panel *--------- Recovery Dataset ENQ Check ------------------------------ ENQ_ER0 EQU * * ST R15,WK#F Set ENQ Code CALL @RV#6HC,((15),ERRMSG16+47,4) MVC ZEDLMSG,ERRMSG16 MVC ZEDSMSG,=CL20'Recover Faile' CALL ISPLINK,(SETMSG,ISRZ001),VL B SHOW_ENT Return Entry Panel *-------- Read Buffer Getmain False -------------------------------- GETM_ER2 EQU * GETMAIN ERROR ST R15,WK#F Set GETMAIN Code CALL @RV#6HC,(WK#F,ERRMSG16+36,4) LA R02,DIRT_L Set GETMAIN Length CALL @RV#6HC,((R02),ERRMSG16+52,4) L R02,DIRT_L L R12,DIRT_A FREEMAIN RC,LV=(R02),A=(R12) CLOSE (PDSFD,,PDSF) Close Input File MVC DA#PROC(8),=CL8'FREE ' MVC DA#RETDD(8),@RV#DD LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 DEQ MF=(E,@DEQ) DEQ MVC ZEDLMSG,ERRMSG16 MVC ZEDSMSG,=CL20'Getmain Faile.' CALL ISPLINK,(SETMSG,ISRZ001),VL B SHOW_ENT Return Entry Panel *--------- Directory Table Space GETMAIN faile --------------------- GETM_ER1 EQU * ST R15,WK#F Set GETMAIN Code CALL @RV#6HC,(WK#F,ERRMSG15+36,4) LA R02,DIRT_L Set GETMAIN Length CALL @RV#6HC,((R02),ERRMSG15+52,4) CLOSE (PDSFD,,PDSF) Close Input File MVC DA#PROC(8),=CL8'FREE ' MVC DA#RETDD(8),@RV#DD LA R01,DA#AREA L R15,@RV#6DA BALR R14,R15 DEQ MF=(E,@DEQ) DEQ MVC ZEDLMSG,ERRMSG15 MVC ZEDSMSG,=CL20'Table to Large' CALL ISPLINK,(SETMSG,ISRZ001),VL B SHOW_ENT Return Entry Panel *--------- Control Table Space Getmain Faile ---------------------- GETM_ER0 EQU * ST R15,WK#F CALL @RV#6HC,(WK#F,ERRMSG13+35,4) TPUT ERRMSG13,L'ERRMSG13 B @TERM8 *------------------------------------------------------------------- @TERM8 EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=8 *--------- Terminate Nommary Process ------------------------------- @QUIT EQU * L R02,CPY_L L R12,CPY_A FREEMAIN RC,LV=(R02),A=(R12) Copy Section Free Main L R13,SAVEAREA+4 RETURN (14,12),RC=0 *--------- Member Stow ( Add New Member ) -------------------------- @STOW_A EQU * MVC S_TTR(3),O#TTRB MVC S_MEMBER(8),O#M OPEN (PDSFS,(OUTPUT)) STOW PDSFS,ST#LIST,A ST R15,STOW_RC CLOSE (PDSFS) BR R14 *--------- Member Stow ( Remove Work Member ) ---------------------- @STOW_D EQU * * MVC S_TTR(3),O#TTRB * MVC S_MEMBER(8),O#M OPEN (PDSFS,(OUTPUT)) STOW PDSFS,ST#LIST,D CLOSE (PDSFS) BR R14 *------------------------------------------------------------------- *-------- Define ISPF Variable ------------------------------------- *------------------------------------------------------------------- ISPFVDEF EQU * STM R00,R15,REGS * --- Panel I/O --- CALL ISPLINK,(VDEFINE,@I#DSN,I#DSN,CHAR,LI#DSN),VL CALL ISPLINK,(VDEFINE,@I#VOL,I#VOL,CHAR,LI#VOL),VL CALL ISPLINK,(VDEFINE,@R#DSN,R#DSN,CHAR,LR#DSN),VL CALL ISPLINK,(VDEFINE,@R#VOL,R#VOL,CHAR,LR#VOL),VL CALL ISPLINK,(VDEFINE,@I#EXTOP,I#EXTOPT,CHAR,LI#EXTOP),VL CALL ISPLINK,(VDEFINE,@I#EXTO2,I#EXTOP2,CHAR,LI#EXTO2),VL CALL ISPLINK,(VDEFINE,@I#DISP,I#DISP,CHAR,LI#DISP),VL CALL ISPLINK,(VDEFINE,@I#DSPAC,I#DSPACE,FIXED,LI#DSPAC),VL CALL ISPLINK,(VDEFINE,@I#SRHST,I#SRHSTR,CHAR,LI#SRHST),VL * --- Panel I/O ( Table Row Selection Area ) --- CALL ISPLINK,(VDEFINE,@@SELECT,@SELECT,CHAR,L@SELECT),VL * --- Command Line --- CALL ISPLINK,(VDEFINE,@ZCMD,ZCMD,CHAR,LZCMD),VL * --- Version number --- CALL ISPLINK,(VDEFINE,@REV,REV,CHAR,LREV),VL * --- Panel I/O ( Information Panels ) --- CALL ISPLINK,(VDEFINE,@O#DEVT,O#DEVT,CHAR,LO#DEVT),VL CALL ISPLINK,(VDEFINE,@O#BLKSZ,O#BLKSZ,CHAR,LO#BLKSZ),VL CALL ISPLINK,(VDEFINE,@O#LRECL,O#LRECL,CHAR,LO#LRECL),VL CALL ISPLINK,(VDEFINE,@O#RECFM,O#RECFM,CHAR,LO#RECFM),VL CALL ISPLINK,(VDEFINE,@O#EXT,O#EXT,CHAR,LO#EXT),VL CALL ISPLINK,(VDEFINE,@O#ALC,O#ALC,CHAR,LO#ALC),VL CALL ISPLINK,(VDEFINE,@O#USE,O#USE,CHAR,LO#USE),VL CALL ISPLINK,(VDEFINE,@O#CRE,O#CRE,CHAR,LO#CRE),VL CALL ISPLINK,(VDEFINE,@O#EXP,O#EXP,CHAR,LO#EXP),VL CALL ISPLINK,(VDEFINE,@O#SYSCD,O#SYSCD,CHAR,LO#SYSCD),VL CALL ISPLINK,(VDEFINE,@O#ASP,O#ASP,CHAR,LO#ASP),VL CALL ISPLINK,(VDEFINE,@O#ADP,O#ADP,CHAR,LO#ADP),VL CALL ISPLINK,(VDEFINE,@O#AUP,O#AUP,CHAR,LO#AUP),VL CALL ISPLINK,(VDEFINE,@O#AEP,O#AEP,CHAR,LO#AEP),VL CALL ISPLINK,(VDEFINE,@O#ASP2,O#ASP2,CHAR,LO#ASP2),VL CALL ISPLINK,(VDEFINE,@O#ADP2,O#ADP2,CHAR,LO#ADP2),VL CALL ISPLINK,(VDEFINE,@O#AUP2,O#AUP2,CHAR,LO#AUP2),VL CALL ISPLINK,(VDEFINE,@O#AEP2,O#AEP2,CHAR,LO#AEP2),VL CALL ISPLINK,(VDEFINE,@O#DBLK,O#DBLK,FIXED,LO#DBLK),VL CALL ISPLINK,(VDEFINE,@O#H1,O#H1,CHAR,LO#H1),VL CALL ISPLINK,(VDEFINE,@O#H2,O#H2,CHAR,LO#H2),VL CALL ISPLINK,(VDEFINE,@O#H3,O#H3,CHAR,LO#H3),VL CALL ISPLINK,(VDEFINE,@O#H4,O#H4,CHAR,LO#H4),VL CALL ISPLINK,(VDEFINE,@O#H5,O#H5,CHAR,LO#H5),VL CALL ISPLINK,(VDEFINE,@O#H6,O#H6,CHAR,LO#H6),VL CALL ISPLINK,(VDEFINE,@O#H7,O#H7,CHAR,LO#H7),VL CALL ISPLINK,(VDEFINE,@O#H8,O#H8,CHAR,LO#H8),VL CALL ISPLINK,(VDEFINE,@O#H9,O#H9,CHAR,LO#H9),VL CALL ISPLINK,(VDEFINE,@O#H10,O#H10,CHAR,LO#H10),VL CALL ISPLINK,(VDEFINE,@O#H11,O#H11,CHAR,LO#H11),VL CALL ISPLINK,(VDEFINE,@O#H12,O#H12,CHAR,LO#H12),VL CALL ISPLINK,(VDEFINE,@O#H13,O#H13,CHAR,LO#H13),VL CALL ISPLINK,(VDEFINE,@O#H14,O#H14,CHAR,LO#H14),VL CALL ISPLINK,(VDEFINE,@O#H15,O#H15,CHAR,LO#H15),VL CALL ISPLINK,(VDEFINE,@O#H16,O#H16,CHAR,LO#H16),VL CALL ISPLINK,(VDEFINE,@O#L1,O#L1,CHAR,LO#L1),VL CALL ISPLINK,(VDEFINE,@O#L2,O#L2,CHAR,LO#L2),VL CALL ISPLINK,(VDEFINE,@O#L3,O#L3,CHAR,LO#L3),VL CALL ISPLINK,(VDEFINE,@O#L4,O#L4,CHAR,LO#L4),VL CALL ISPLINK,(VDEFINE,@O#L5,O#L5,CHAR,LO#L5),VL CALL ISPLINK,(VDEFINE,@O#L6,O#L6,CHAR,LO#L6),VL CALL ISPLINK,(VDEFINE,@O#L7,O#L7,CHAR,LO#L7),VL CALL ISPLINK,(VDEFINE,@O#L8,O#L8,CHAR,LO#L8),VL CALL ISPLINK,(VDEFINE,@O#L9,O#L9,CHAR,LO#L9),VL CALL ISPLINK,(VDEFINE,@O#L10,O#L10,CHAR,LO#L10),VL CALL ISPLINK,(VDEFINE,@O#L11,O#L11,CHAR,LO#L11),VL CALL ISPLINK,(VDEFINE,@O#L12,O#L12,CHAR,LO#L12),VL CALL ISPLINK,(VDEFINE,@O#L13,O#L13,CHAR,LO#L13),VL CALL ISPLINK,(VDEFINE,@O#L14,O#L14,CHAR,LO#L14),VL CALL ISPLINK,(VDEFINE,@O#L15,O#L15,CHAR,LO#L15),VL CALL ISPLINK,(VDEFINE,@O#L16,O#L16,CHAR,LO#L16),VL CALL ISPLINK,(VDEFINE,@O#MEM,O#MEM,CHAR,LO#MEM),VL * --- Message Area --- CALL ISPLINK,(VDEFINE,@ZEDLMS,ZEDLMSG,CHAR,LZEDLMSG),VL CALL ISPLINK,(VDEFINE,@ZEDSMS,ZEDSMSG,CHAR,LZEDSMSG),VL * --- ISPF Table Item --- CALL ISPLINK,(VDEFINE,@O#M,O#M,CHAR,LO#M),VL CALL ISPLINK,(VDEFINE,@O#D,O#D,CHAR,LO#D),VL CALL ISPLINK,(VDEFINE,@O#TTR,O#TTR,CHAR,LO#TTR),VL CALL ISPLINK,(VDEFINE,@O#TTRB,O#TTRB,CHAR,LO#TTRB),VL CALL ISPLINK,(VDEFINE,@O#LEN,O#LEN,FIXED,LO#LEN),VL CALL ISPLINK,(VDEFINE,@O#MBCHR,O#MBCHR,CHAR,LO#MBCHR),VL CALL ISPLINK,(VDEFINE,@ZTDSEL,ZTDSELS,CHAR,LZTDSELS),VL CALL ISPLINK,(VDEFINE,@TBCURR,TBCURR,CHAR,LTBCURR),VL CALL ISPLINK,(VDEFINE,@REVC,REVC,CHAR,LREVC),VL CALL ISPLINK,(VDEFINE,@REVD,REVD,CHAR,LREVD),VL LM R00,R15,REGS BR R14 *------------------------------------------------------------------- *-------- Search String -------------------------------------------- *------------------------------------------------------------------- @SRCHSTR EQU * * L R15,@RV#LSTR If No-string Search LTR R15,R15 Goto @SRCH_NG BZ @SRCH_BP * L R11,BUFF_A R01 <- Read Buffer L R12,R_LEN R02 <- Read Length * DEBUG * * ST R11,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+9,4) * ST R12,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+19,4) * TPUT ERRMSG10,L'ERRMSG10 * DEBUG * LTR R12,R12 BZ @SRCH_BP * CLR R12,R15 * BNH @SRCH_BP S R12,@RV#LSTR L'Read - L'Srch Str * LA R12,1(R12) + 1 LA R11,0(R11,R12) Chk Pos <- Buf + L'Chk * DEBUG * * ST R11,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+9,4) * ST R12,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+19,4) * TPUT ERRMSG10,L'ERRMSG10 * DEBUG * @SRCH_LP EQU * * DEBUG * * L R15,@RV#LSTR * STC R15,*+5 * MVC ERRMSG10+30(0),0(R11) * ST R11,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+9,4) * ST R12,WK#F * CALL @RV#6HC,(WK#F,ERRMSG10+19,4) * L R15,@RV#LSTR * STC R15,*+5 * MVC ERRMSG10+40(0),@RV#SSTR * TPUT ERRMSG10,L'ERRMSG10 * DEBUG * L R15,@RV#LSTR BCTR R15,0 *** EX R15,EX#CLC STC R15,*+5 CLC 0(0,R11),@RV#SSTR BE @SRCH_OK BCTR R11,0 BCT R12,@SRCH_LP B @SRCH_NG @SRCH_BP EQU * OI FLAG,X'02' BR R10 @SRCH_OK EQU * OI FLAG,X'02' BR R10 @SRCH_NG EQU * BR R10 * ***CLC CLC 0(0,R11),@RV#SSTR *------------------------------------------------------------------- *-------- convert mbcchhr to ttr ----------------------------------- *------------------------------------------------------------------- @CNVTTR EQU * STM R03,R15,REGS L R12,CVTPTR USING CVTMAP,R12 L R15,CVTPRLTV DROP R12 BALR R14,R15 LM R03,R15,REGS BR R14 @CNVCHR EQU * STM R03,R15,REGS L R12,CVTPTR USING CVTMAP,R12 L R15,CVTPCNVT DROP R12 BALR R14,R15 LM R03,R15,REGS BR R14 *------------------------------------------------------------------- *-------- i/o error routine ( ps ) --------------------------------- *------------------------------------------------------------------- IOERR_S EQU * SYNADAF ACSMETH=BSAM I/O ERROR STM R01,R15,REGS LA R01,91(R01) * B @IOERR MVC ERRMSG04+23(15),0(R01) CALL @RV#6HC,(W_TTR,ERRMSG04+16,3) TPUT ERRMSG04,L'ERRMSG04 B @IOERR * LR R12,R01 * B @IOERR *------------------------------------------------------------------- *-------- i/o error routine ( po ) --------------------------------- *------------------------------------------------------------------- IOERR_P EQU * SYNADAF ACSMETH=BPAM STM R01,R15,REGS LA R01,91(R01) * B @IOERR MVC ERRMSG04+23(15),0(R01) CALL @RV#6HC,(W_TTR,ERRMSG04+16,3) TPUT ERRMSG04,L'ERRMSG04 B @IOERR IOERR_W EQU * SYNADAF ACSMETH=BPAM STM R01,R15,REGS LA R01,91(R01) * B @IOERR MVC ERRMSG04+23(15),0(R01) CALL @RV#6HC,(W_TTR,ERRMSG04+16,3) TPUT ERRMSG04,L'ERRMSG04 B @IOERR IOERR_WS EQU * SYNADAF ACSMETH=BSAM STM R01,R15,REGS LA R01,91(R01) MVC ERRMSG04+23(15),0(R01) CALL @RV#6HC,(W_TTR,ERRMSG04+16,3) TPUT ERRMSG04,L'ERRMSG04 B @IOERR @IOERR EQU * LM R01,R15,REGS SYNADRLS * LTR R00,R00 * BZ @IOERRX * TPUT =CL20'SYNADRLS ERR',20 B @R_EXIT @IOERRX EQU * TPUT =CL20'RETURN ',20 LM R01,R15,REGS PRINT GEN RETURN PRINT NOGEN * B @M_NEXT *------------------------------------------------------------------- *-------- Dataset Configratin Block -------------------------------- *------------------------------------------------------------------- RESTDCB DCB DSORG=PS,MACRF=W,DDNAME=@@@@, * SYNAD=IOERR_WS,EODAD=@RS_LOPX PDSFR DCB DSORG=PO,MACRF=(R),DDNAME=@@@@, * SYNAD=IOERR_WS,EODAD=@RS_LOPX PDSFD DCB DSORG=PS,MACRF=(RP),DDNAME=@@@@,BLKSIZE=256, * SYNAD=IOERR_S,EODAD=@D_EXIT,RECFM=F ENTRY PDSF PDSF DCB DSORG=PO,MACRF=(R),DDNAME=@@@@, * SYNAD=IOERR_P,EODAD=@M_NEXT,EXLST=EXLST EXLST DC X'87',AL3(POSJFCB) PDSFS DCB DSORG=PO,MACRF=W,DDNAME=@@@@, * SYNAD=IOERR_W * DS 0F * --- SAVE AREA --- SAVEAREA DS 18F SAVEAREA * --- Work Area --- WK#F DS F * --- Register Save ( work ) area --- REGS DS 18F WORK SAVEAREA CMD#REG DS 18F WORK SAVEAREA FLAG DS XL1 * * '........' * + : Add List . * + : String Search . * --- V con --- @RV#6DA DC V(@RV#6DA) *RV#6DC DC V(@RV#6DC) DS 0D * --- Panel RC Packed Area --- PK_AREA DC PL8'0' UPK_AREA DC CL16' ' DS 0F * --- Condition Code --- RC# DS F SPC1 DS F SPC2 DS F * --- ENQ And DEQ List Function --- QNAME DC CL8'@REVIVE' RNAME DS CL44 @ENQ ENQ (QNAME,RNAME,E,44,SYSTEMS),RET=USE,MF=L @DEQ DEQ (QNAME,RNAME,44,SYSTEMS),MF=L * --- ISPF Control Name --- CONTROL DC CL8'CONTROL ' DISPLAY DC CL8'DISPLAY ' SAVE DC CL8'SAVE ' RESTORE DC CL8'RESTORE ' TBDELETE DC CL8'TBDELETE' TBSCAN DC CL8'TBSCAN ' LOCK DC CL8'LOCK ' SETMSG DC CL8'SETMSG ' ISRZ001 DC CL8'ISRZ001 ' VDEFINE DC CL8'VDEFINE ' VDEFINE COMMAND TBCREATE DC CL8'TBCREATE' TBCREATE COMMAND TBTOP DC CL8'TBTOP ' TBTOP COMMAND TBSKIP DC CL8'TBSKIP ' TBTOP COMMAND TBQUERY DC CL8'TBQUERY ' TBTOP COMMAND TBDISPL DC CL8'TBDISPL ' TBDISPL COMMAND TBCLOSE DC CL8'TBCLOSE ' TBCLOSE COMMAND TBADD DC CL8'TBADD ' TBADD COMMAND VPUT DC CL8'VPUT ' TBADD COMMAND VGET DC CL8'VGET ' TBADD COMMAND BROWSE DC CL8'BROWSE ' TBCREATE COMMAND PANELLST DC CL8'@RV#2LST' ISPF PANEL ( LIST ) PANELENT DC CL8'@RV#2ENT' ISPF PANEL ( ENTRY ) PANELINF DC CL8'@RV#INF ' ISPF PANEL ( INFO ) PANELCRE DC CL8'@RV#CRE ' ISPF PANEL ( INFO ) @RV#00 DC CL8'@RV#00 ' ISPF TABLE NAME KEYN DC CL8'O#M ' TABLE KEY NAME NTBSCAN DC CL8'( O#M ) ' TABLE KEY NAME * ispf table * O#M : Restore Member name * O#D : Data Area * O#TTR : TTR Area * O#TTRB : TTR Area ( binary ) * O#LEN : Member Block# NAMEL DC CL40'(O#D O#TTR O#TTRB O#LEN O#MBCHR)' LIST ( TBCREATE ) NAMELIST DC CL40'(O#M O#D O#TTR O#TTRB O#LEN O#MBCHR)' ( TBADD ) VPUT#N DC CL25'( ZEDLMSG ZEDSMSG )' V@SELECT DC CL25'( @SELECT I#DSN )' NOWRITE DC CL8'NOWRITE ' TBCREATE NOWRITE CHAR DC CL8'CHAR ' VDEFINE CHAR FIXED DC CL8'FIXED ' VDEFINE CHAR * --- ispf Variable Name --- @ZEDLMS DC CL8'ZEDLMSG ' @ZEDSMS DC CL8'ZEDSMSG ' @ZTDSEL DC CL8'ZTDSELS ' @TBCURR DC CL8'TBCURR ' @ZCMD DC CL8'ZCMD ' @REV DC CL8'REV ' @O#M DC CL8'O#M ' Table ( Member Name ) @O#D DC CL8'O#D ' Table ( Data ) @O#TTR DC CL8'O#TTR ' Table ( TTR ) @O#TTRB DC CL8'O#TTRB ' Table ( TTR ) @O#LEN DC CL8'O#LEN ' Table ( TTR ) @O#MBCHR DC CL8'O#MBCHR ' Table ( TTR ) @I#DSN DC CL8'I#DSN ' Input Dataset Name @I#VOL DC CL8'I#VOL ' Input Volume Serial @R#DSN DC CL8'R#DSN ' Input Dataset Name @R#VOL DC CL8'R#VOL ' Input Volume Serial @I#EXTOP DC CL8'I#EXTOPT' Input Volume Serial @I#EXTO2 DC CL8'I#EXTOP2' Input Volume Serial @I#DISP DC CL8'I#DISP ' Input Volume Serial @I#DSPAC DC CL8'I#DSPACE' Input Volume Serial @I#SRHST DC CL8'I#SRHSTR' Input Volume Serial @O#DEVT DC CL8'O#DEVT ' Device Type @O#BLKSZ DC CL8'O#BLKSZ ' Block Size @O#LRECL DC CL8'O#LRECL ' Record Length @O#RECFM DC CL8'O#RECFM ' Record Format @O#EXT DC CL8'O#EXT ' Extencson @O#ALC DC CL8'O#ALC ' Allocation Size @O#USE DC CL8'O#USE ' InUse Size @O#CRE DC CL8'O#CRE ' Creation Date @O#EXP DC CL8'O#EXP ' Expiration Date @O#SYSCD DC CL8'O#SYSCD ' System Code @O#ASP DC CL8'O#ASP ' Start Address @O#ADP DC CL8'O#ADP ' Data Address @O#AUP DC CL8'O#AUP ' Use Address @O#AEP DC CL8'O#AEP ' End Address @O#ASP2 DC CL8'O#ASP2 ' Start Address ( TTR ) @O#ADP2 DC CL8'O#ADP2 ' Data Address ( TTR ) @O#AUP2 DC CL8'O#AUP2 ' Use Address ( TTR ) @O#AEP2 DC CL8'O#AEP2 ' End Address ( TTR ) @O#DBLK DC CL8'O#DBLK ' Directory Blocks @O#H1 DC CL8'O#H1 ' extent high c-h @O#H2 DC CL8'O#H2 ' extent high c-h @O#H3 DC CL8'O#H3 ' extent high c-h @O#H4 DC CL8'O#H4 ' extent high c-h @O#H5 DC CL8'O#H5 ' extent high c-h @O#H6 DC CL8'O#H6 ' extent high c-h @O#H7 DC CL8'O#H7 ' extent high c-h @O#H8 DC CL8'O#H8 ' extent high c-h @O#H9 DC CL8'O#H9 ' extent high c-h @O#H10 DC CL8'O#H10 ' extent high c-h @O#H11 DC CL8'O#H11 ' extent high c-h @O#H12 DC CL8'O#H12 ' extent high c-h @O#H13 DC CL8'O#H13 ' extent high c-h @O#H14 DC CL8'O#H14 ' extent high c-h @O#H15 DC CL8'O#H15 ' extent high c-h @O#H16 DC CL8'O#H16 ' extent high c-h @O#L1 DC CL8'O#L1 ' extent high c-h @O#L2 DC CL8'O#L2 ' extent high c-h @O#L3 DC CL8'O#L3 ' extent high c-h @O#L4 DC CL8'O#L4 ' extent high c-h @O#L5 DC CL8'O#L5 ' extent high c-h @O#L6 DC CL8'O#L6 ' extent high c-h @O#L7 DC CL8'O#L7 ' extent high c-h @O#L8 DC CL8'O#L8 ' extent high c-h @O#L9 DC CL8'O#L9 ' extent high c-h @O#L10 DC CL8'O#L10 ' extent high c-h @O#L11 DC CL8'O#L11 ' extent high c-h @O#L12 DC CL8'O#L12 ' extent high c-h @O#L13 DC CL8'O#L13 ' extent high c-h @O#L14 DC CL8'O#L14 ' extent high c-h @O#L15 DC CL8'O#L15 ' extent high c-h @O#L16 DC CL8'O#L16 ' extent high c-h @O#MEM DC CL8'O#MEM ' extent high c-h @@SELECT DC CL8'@SELECT ' Selection Area @REVC DC CL8'REVC ' Selection Area @REVD DC CL8'REVD ' Selection Area * --- ispf Variable Length --- LI#DSN DC F'44' ITEM LENGTH LI#VOL DC F'6' ITEM LENGTH LR#DSN DC F'44' ITEM LENGTH LR#VOL DC F'6' ITEM LENGTH LI#EXTOP DC F'1' ITEM LENGTH LI#EXTO2 DC F'1' ITEM LENGTH LI#DISP DC F'1' ITEM LENGTH LI#DSPAC DC F'4' ITEM LENGTH LI#SRHST DC F'50' ITEM LENGTH LO#M DC F'8' ITEM LENGTH LO#D DC F'60' ITEM LENGTH LO#TTR DC F'6' ITEM LENGTH LO#TTRB DC F'4' ITEM LENGTH LO#LEN DC F'4' LO#MBCHR DC F'8' LZEDLMSG DC F'60' LZEDSMSG DC F'20' LZTDSELS DC F'4' LTBCURR DC F'8' LZCMD DC F'80' LREV DC F'6' L@SELECT DC F'1' LO#DEVT DC F'4' Device Type LO#BLKSZ DC F'5' Block Size LO#LRECL DC F'5' Record Length LO#RECFM DC F'3' Record Format LO#EXT DC F'2' Extencson LO#ALC DC F'5' Allocation Size LO#USE DC F'5' InUse Size LO#CRE DC F'6' Creation Date LO#EXP DC F'6' Expiration Date LO#SYSCD DC F'13' System Code LO#ASP DC F'17' Start Address LO#ADP DC F'17' Data Address LO#AUP DC F'17' Use Address LO#AEP DC F'17' End Address LO#ASP2 DC F'6' Start Address ( TTR ) LO#ADP2 DC F'6' Data Address ( TTR ) LO#AUP2 DC F'6' Use Address ( TTR ) LO#AEP2 DC F'6' End Address ( TTR ) LO#DBLK DC F'4' Directory Blocks LO#H1 DC F'8' extent high c-h LO#H2 DC F'8' extent high c-h LO#H3 DC F'8' extent high c-h LO#H4 DC F'8' extent high c-h LO#H5 DC F'8' extent high c-h LO#H6 DC F'8' extent high c-h LO#H7 DC F'8' extent high c-h LO#H8 DC F'8' extent high c-h LO#H9 DC F'8' extent high c-h LO#H10 DC F'8' extent high c-h LO#H11 DC F'8' extent high c-h LO#H12 DC F'8' extent high c-h LO#H13 DC F'8' extent high c-h LO#H14 DC F'8' extent high c-h LO#H15 DC F'8' extent high c-h LO#H16 DC F'8' extent high c-h LO#L1 DC F'8' extent high c-h LO#L2 DC F'8' extent high c-h LO#L3 DC F'8' extent high c-h LO#L4 DC F'8' extent high c-h LO#L5 DC F'8' extent high c-h LO#L6 DC F'8' extent high c-h LO#L7 DC F'8' extent high c-h LO#L8 DC F'8' extent high c-h LO#L9 DC F'8' extent high c-h LO#L10 DC F'8' extent high c-h LO#L11 DC F'8' extent high c-h LO#L12 DC F'8' extent high c-h LO#L13 DC F'8' extent high c-h LO#L14 DC F'8' extent high c-h LO#L15 DC F'8' extent high c-h LO#L16 DC F'8' extent high c-h LO#MEM DC F'5' extent high c-h LREVC DC F'14' extent high c-h LREVD DC F'14' extent high c-h * --- ispf Variable --- ZEDSMSG DC CL20' ' short error message ZEDLMSG DS CL60 long error message ZTDSELS DS CL4 multi select number TBCURR DS XL8 multi select number ZCMD DS CL80 command line *REV DC CL6 command line MEMAREA DS 0CL78 O#M DS CL8 member name O#D DS CL60 data ( first 60 byte ) O#TTR DS CL6 ttr ( character ) O#TTRB DS XL4 ttr ( binary ) O#LEN DS F member block length O#MBCHR DS XL8 member block length * ----------------------------------- * ENTRY POSJFCB POSJFCB DS 0CL176 job file control block ENTRY POSJDSN POSJDSN DS CL44 dataset name ENTRY POSJDSCB POSJDSCB DS CL140 ENTRY O#DEVT O#DEVT DS CL4 Device Type ENTRY O#BLKSZ O#BLKSZ DS CL5 Block Size ENTRY O#LRECL O#LRECL DS CL5 Record Length ENTRY O#RECFM O#RECFM DS CL3 Record Format ENTRY O#EXT O#EXT DS CL2 Extencson ENTRY O#ALC O#ALC DS CL5 Allocation Size ENTRY O#USE O#USE DS CL5 InUse Size ENTRY O#CRE O#CRE DS CL6 Creation Date ENTRY O#EXP O#EXP DS CL6 Expiration Date ENTRY O#SYSCD O#SYSCD DS CL13 System Code ENTRY O#ASP O#ASP DS CL17 Start Address ENTRY O#ADP O#ADP DS CL17 Data Address ENTRY O#AUP O#AUP DS CL17 Use Address ENTRY O#AEP O#AEP DS CL17 End Address ENTRY O#ASP2 O#ASP2 DS CL6 Start Address ( TTR ) ENTRY O#ADP2 O#ADP2 DS CL6 Data Address ( TTR ) ENTRY O#AUP2 O#AUP2 DS CL6 Use Address ( TTR ) ENTRY O#AEP2 O#AEP2 DS CL6 End Address ( TTR ) ENTRY O#DBLK O#DBLK DS F Directory Blocks ENTRY O#XXX O#XXX DS 0CL256 extent high c-h ENTRY O#H1 O#H1 DS CL8 extent high c-h ENTRY O#H2 O#H2 DS CL8 extent high c-h ENTRY O#H3 O#H3 DS CL8 extent high c-h ENTRY O#H4 O#H4 DS CL8 extent high c-h ENTRY O#H5 O#H5 DS CL8 extent high c-h ENTRY O#H6 O#H6 DS CL8 extent high c-h ENTRY O#H7 O#H7 DS CL8 extent high c-h ENTRY O#H8 O#H8 DS CL8 extent high c-h ENTRY O#H9 O#H9 DS CL8 extent high c-h ENTRY O#H10 O#H10 DS CL8 extent high c-h ENTRY O#H11 O#H11 DS CL8 extent high c-h ENTRY O#H12 O#H12 DS CL8 extent high c-h ENTRY O#H13 O#H13 DS CL8 extent high c-h ENTRY O#H14 O#H14 DS CL8 extent high c-h ENTRY O#H15 O#H15 DS CL8 extent high c-h ENTRY O#H16 O#H16 DS CL8 extent high c-h ENTRY O#L1 O#L1 DS CL8 extent high c-h ENTRY O#L2 O#L2 DS CL8 extent high c-h ENTRY O#L3 O#L3 DS CL8 extent high c-h ENTRY O#L4 O#L4 DS CL8 extent high c-h ENTRY O#L5 O#L5 DS CL8 extent high c-h ENTRY O#L6 O#L6 DS CL8 extent high c-h ENTRY O#L7 O#L7 DS CL8 extent high c-h ENTRY O#L8 O#L8 DS CL8 extent high c-h ENTRY O#L9 O#L9 DS CL8 extent high c-h ENTRY O#L10 O#L10 DS CL8 extent high c-h ENTRY O#L11 O#L11 DS CL8 extent high c-h ENTRY O#L12 O#L12 DS CL8 extent high c-h ENTRY O#L13 O#L13 DS CL8 extent high c-h ENTRY O#L14 O#L14 DS CL8 extent high c-h ENTRY O#L15 O#L15 DS CL8 extent high c-h ENTRY O#L16 O#L16 DS CL8 extent high c-h ENTRY O#MEM O#MEM DS CL5 member number * --- extent high and low address ( cchh ) --- ENTRY EXT#XXX EXT#XXX DS 0XL128 ( 16 * 2 * 4 byte ) ENTRY EXT#0HI EXT#0HI DS XL4 ENTRY EXT#0LO EXT#0LO DS XL4 ENTRY EXT#1HI EXT#1HI DS XL4 ENTRY EXT#1LO EXT#1LO DS XL4 ENTRY EXT#2HI EXT#2HI DS XL4 ENTRY EXT#2LO EXT#2LO DS XL4 ENTRY EXT#3HI EXT#3HI DS XL4 ENTRY EXT#3LO EXT#3LO DS XL4 ENTRY EXT#4HI EXT#4HI DS XL4 ENTRY EXT#4LO EXT#4LO DS XL4 ENTRY EXT#5HI EXT#5HI DS XL4 ENTRY EXT#5LO EXT#5LO DS XL4 ENTRY EXT#6HI EXT#6HI DS XL4 ENTRY EXT#6LO EXT#6LO DS XL4 ENTRY EXT#7HI EXT#7HI DS XL4 ENTRY EXT#7LO EXT#7LO DS XL4 ENTRY EXT#8HI EXT#8HI DS XL4 ENTRY EXT#8LO EXT#8LO DS XL4 ENTRY EXT#9HI EXT#9HI DS XL4 ENTRY EXT#9LO EXT#9LO DS XL4 ENTRY EXT#AHI EXT#AHI DS XL4 ENTRY EXT#ALO EXT#ALO DS XL4 ENTRY EXT#BHI EXT#BHI DS XL4 ENTRY EXT#BLO EXT#BLO DS XL4 ENTRY EXT#CHI EXT#CHI DS XL4 ENTRY EXT#CLO EXT#CLO DS XL4 ENTRY EXT#DHI EXT#DHI DS XL4 ENTRY EXT#DLO EXT#DLO DS XL4 ENTRY EXT#EHI EXT#EHI DS XL4 ENTRY EXT#ELO EXT#ELO DS XL4 ENTRY EXT#FHI EXT#FHI DS XL4 ENTRY EXT#FLO EXT#FLO DS XL4 * ----------------------------------- * @SELECT DS CL1 1 Table Selection Area * DS 0F ST#LIST DS 0CL24 S_MEMBER DC CL8' ' S_TTR DC XL3'000000' C DC BL1'10000110' * 1....... ARIAS * ...11111 USER DATA LENGTH ( HALF WORD ) USERDATA DC CL12'- BY KIMU - ' * DS 0F * --- Browse DataSet Name --- BR#DSN DS CL46 DS XL10 BR#VOL DS CL6 * --- Input DataSet Name --- ENTRY I#DSN I#DSN DS CL44 * --- Input Volume Serial --- ENTRY I#VOL I#VOL DS CL6 * --- Restore DataSet Name --- ENTRY R#DSN R#DSN DS CL44 * --- Restore Volume Serial --- ENTRY R#VOL R#VOL DS CL6 * --- Input Volume Serial --- I#EXTOPT DS CL1 I#EXTOP2 DS CL1 I#DISP DS CL1 I#DSPACE DS F I#SRHSTR DS CL50 *#DD DS CL8 R_LEN DS F data area read length * --- check of dataset organization for input dataset --- DS 0F ENTRY CK#DSORG CK#DSORG DS BL1 * --- check of record format for input dataset --- DS 0F ENTRY CK#RFM CK#RFM DS BL1 * --- check of block size --- DS 0F ENTRY CK#BLKSZ CK#BLKSZ DS BL2 * --- check of logical record length --- DS 0F ENTRY CK#LRECL CK#LRECL DS BL2 * --- end of ttr --- ENTRY E#TTR E#TTR DS 0F,XL4 end of ttr * --- terminate of mbbcchhr --- ENTRY T#CHR T#CHR DS 0F,XL8 end of mbbcchhr * --- end of mbbcchhr --- ENTRY E#CHR E#CHR DS 0F,XL8 end of mbbcchhr * --- work of ttr --- W_TTR DS 0F,XL4 work ttr * --- work of mbbcchhr --- W_CHR DS 0F,XL8 end of mbbcchhr * --- number of logical cylindar --- ENTRY NUMCYL# NUMCYL# DS XL2 * --- number of track in a logical cylindar --- ENTRY NUMTRK# NUMTRK# DS XL2 * --- number of allocation track number --- ENTRY NUMALC# NUMALC# DS F * --- number of extent --- ENTRY EXT# EXT# DS B DS 0F STOW_RC DS F DS 0F *--- messages --- *RRMSG01 DC CL30' << Getmain Error >>' GETMAIN ERROR MESSAGE ERRMSG02 DC CL60'< Dynamic Allocation Error rc_@@@@@@@@ >' * |....+....1....+....2....+....3....+....4....+....5 * ....+....6....+....7....+....8 ERRMSG03 DS 0CL75 DC CL27'Directory Table OverFlow . ' DC CL48'A:@@@@@@@@ L:@@@@@@@@ P:@@@@@@@@' ERRMSG04 DC CL60'< I/O Error TTR:@@@@@@ @@@@@@@@@@@@@@@ >' ERRMSG05 DC CL60'< DSORG Error ! Not Partitioned File :@@ >' ERRMSG06 DC CL60'< This Dataset is Not Found ... >' *RRMSG07 DC CL60'< MBBCCHHR:M B B C C H H R >' ERRMSG10 DC CL60'< SRCH :' *RRMSG11 DC CL60'< BLOCK : @@@@ / @@@@ = @@@@@@@@@@@@@@@@@@ >' ERRMSG12 DC CL60'< Allocation Space Compute Error RC:@@@@@@@@ >' ERRMSG13 DC CL60'< Control Table Getmain Faile .. : @@@@@@@@ >' ERRMSG14 DC CL60'< TTR:@@@@@@ = MBBCCHHR:@@@@@@@@ @@@@@@@@ >' * |....+....1....+....2....+....3....+....4....+....5 * ....+....6....+....7....+....8 ERRMSG15 DC CL75'Directory Table Space to Large . RC:@@@@@@@@ Length* :@@@@@@@@' ERRMSG16 DC CL75'Dataset Now Recovering of Other User . ENQ RC:@@@@* @@@@' ERRMSG17 DC CL75'Read Buffer Space Getmain False. RC:@@@@@@@@ Length* :@@@@@@@@' *RRMSG99 DC CL60'< TTR:@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >' *RRMSG99 DC CL60'< GETMAIN SPACE IS:@@@@@@@@ >' MSG001 DC CL60'< Select ---- members . >' MSG002 DC CL60'<< Dataset Reading ... Wait a Few Minuts .. >>' MSG003 DC CL60'<< Member ( @@@@@@@@ ) restored rc_@@@@@@@@ >>' * |....+....1....+....2....+....3....+....4....+....5 MSG004 DC CL70'>> RV001 : @RV ; @@@@@@ < @@/@@/@@ @@:@@ > ; Good M* orning !! ' *SG005 DC CL60'>> RV002 : Parameter Area GetMain OK .' *SG006 DC CL60'>> RV001 : @RV Initialize Start ...' *SG007 DC CL60'>> RV001 : @RV Initialize Start ...' * --- directory read buffer --- LTORG DIR DS CL256 DIRECTORY WORK AREA * PRINT GEN JFCBSECT DSECT IEFJFCBN LIST=YES IEFUCBOB LIST=YES DCBD DSORG=PO,DEVD=DA CVT DSECT=YES,LIST=YES * --- Dataset Configration Dsect --- PRINT GEN * COPY @RV#06DC * --- @RV Copy Section --- COPY @RV#080X R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @RV#080 /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR // DD DSN=&©,DISP=(OLD,PASS) //SYSUT1 DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@RV#080),DISP=OLD <- CHECK //B EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START DC C'<< Oh Shock ! _ Dynamic Allocation >> Version 6 ( ' REV DC CL6'v6r0m1' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' * RC * 0 : OK * 1 : dynamic allocation error * 8 : dsn not found ! * 16 : PAn not found ! * PRINT NOGEN @RV#6DA CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03,R04,R05 Base Reg. R03,R04,R05 LA R04,2048(R03) 2'ND Base Reg LA R04,2048(R04) LA R05,2048(R04) 3'ND Base Reg LA R05,2048(R05) ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) *-------- Parameter Process ---------------------------------------- LR R12,R01 USING @RVDA#PM,R12 CLC 0(8,R12),=CL8'ALLOCATE' if allocation process BE @DY_ALC CLC 0(8,R12),=CL8'CREATE ' if allocation process BE @DY_CRE CLC 0(8,R12),=CL8'FREE ' if free process BE @DY_FRE LA R15,16 initial condition code B @BYE *-------- Dynamic Allocation ( Allocate ) -------------------------- @DY_ALC EQU * * --- Dynamic Allocation Parameter List --- LA R06,ALLOCTP parameter list address * --- dataset name --- MVC ALCDSN(44),P#DSN copy to dataset name LA R07,@D_DSN dsn parm address ST R07,0(R06) LA R06,4(R06) * --- volume serial --- CLC P#VOL(6),=CL6' ' if volume serial is not space BE @DY_VOL goto @DY_VOL MVC W#DSN(44),P#DSN copy to dataset name MVC W#VOL(6),P#VOL copy to volume serial XC DSCB,DSCB search dataset in volume OBTAIN DSCBFMT1 LTR R15,R15 BZ @DY_VOL1 LA R15,8 dataset not found B @BYE @DY_VOL1 EQU * else MVC ALCVOL(06),P#VOL copy Input Volume Serial LA R07,@D_VOL volser parm address ST R07,0(R06) LA R06,4(R06) @DY_VOL EQU * volume serial get * --- disp --- * old CLC P#DISP,=CL3'OLD' BNE @DY_DOLD LA R07,@D_DOLD disp parm address ST R07,0(R06) LA R06,4(R06) B @DY_DEXT @DY_DOLD EQU * * shr LA R07,@D_DSHR disp parm address ST R07,0(R06) LA R06,4(R06) @DY_DEXT EQU * * --- unit --- LA R07,@D_UNIT unit parm address ST R07,0(R06) LA R06,4(R06) * --- dd name --- LA R07,@D_RETDD return dd name list ST R07,0(R06) LA R06,4(R06) * --- dataset organization --- LA R07,@D_RETOR return organization O R07,=X'80000000' end of parameter list ST R07,0(R06) * --- end of parameter list --- LA R01,ALLOC SVC 99 Dynamic Allocate LTR R15,R15 if Alloc OK then BZ @DY_OK goto @DY_OK MVC P#RETC(4),ALLOCER LA R15,1 B @BYE @DY_OK EQU * MVC P#RETDD(8),ALCDD MVC P#RETC(4),ALLOCER LA R15,0 B @BYE *------------------------------------------------------------------- *-------- Dynamic Allocation ( Allocate ) -------------------------- @DY_CRE EQU * * B @BYE * TPUT =CL20'** CREATE **',20 * --- Dynamic Allocation Parameter List --- XC ALLOCTP(LALLOCTP),ALLOCTP LA R06,ALLOCTP parameter list address * --- dataset name --- * TPUT =CL20'** DSNAME **',20 MVC ALCDSN(44),P#DSN copy to dataset name LA R07,@D_DSN dsn parm address ST R07,0(R06) LA R06,4(R06) * --- volume serial --- CLC P#VOL(6),=CL6' ' if volume serial is not space BE @CR_VOL goto @DY_VOL * TPUT =CL20'** VOLUME **',20 MVC ALCVOL(06),P#VOL copy Input Volume Serial LA R07,@D_VOL volser parm address ST R07,0(R06) LA R06,4(R06) @CR_VOL EQU * volume serial get * --- disp --- * new * TPUT =CL20'** DISP **',20 LA R07,@D_DNEW disp parm address ST R07,0(R06) LA R06,4(R06) * --- disp --- LA R07,@D_CTLG disp parm address ST R07,0(R06) LA R06,4(R06) * --- space --- * TPUT =CL20'** SPACE **',20 CLC P#SPC(3),=CL3'CYL' BE @CR_DNE1 LA R07,@D_STRK B @CR_DNE2 @CR_DNE1 EQU * LA R07,@D_SCYL @CR_DNE2 EQU * ST R07,0(R06) LA R06,4(R06) * --- size 1 --- * TPUT =CL20'** SIZE 1 **',20 MVC ALCSPC1(3),P#SIZE1 LA R07,@D_SPC1 ST R07,0(R06) LA R06,4(R06) * --- size 2 --- * TPUT =CL20'** SIZE 2 **',20 MVC ALCSPC2(3),P#SIZE2 LA R07,@D_SPC2 ST R07,0(R06) LA R06,4(R06) * --- dsorg --- * TPUT =CL20'** DSORG **',20 MVC ALCDSORG(2),@D_PS LA R07,@D_DSORG ST R07,0(R06) LA R06,4(R06) * --- recfm --- * TPUT =CL20'** RECFM **',20 MVC ALCRECFM(1),P#RECFM LA R07,@D_RECFM ST R07,0(R06) LA R06,4(R06) * --- blksize --- * TPUT =CL20'** BLKSIZE **',20 MVC ALCBLKSZ(2),P#BLKSZ LA R07,@D_BLKSZ ST R07,0(R06) LA R06,4(R06) * --- lrecl --- * TPUT =CL20'** LRECL **',20 MVC ALCLRECL(2),P#LRECL LA R07,@D_LRECL ST R07,0(R06) LA R06,4(R06) * --- unit --- * TPUT =CL20'** UNIT **',20 LA R07,@D_UNIT unit parm address ST R07,0(R06) LA R06,4(R06) * --- dd name --- * TPUT =CL20'** DDNAME **',20 LA R07,@D_RETDD return dd name list O R07,=X'80000000' end of parameter list ST R07,0(R06) LA R06,4(R06) * --- dataset organization --- * TPUT =CL20'** DSORG **',20 * LA R07,@D_RETOR return organization * ST R07,0(R06) * --- end of parameter list --- * TPUT =CL20'** START **',20 LA R01,ALLOC SVC 99 Dynamic Allocate LTR R15,R15 if Alloc OK then BZ @CR_OK goto @DY_OK * B @CR_OK goto @DY_OK * TPUT =CL20'** ERROR **',20 MVC P#RETC(4),ALLOCER LA R15,1 B @BYE @CR_OK EQU * * TPUT =CL20'** OK OK **',20 MVC P#RETDD(8),ALCDD MVC P#RETC(4),ALLOCER LA R15,0 B @BYE *------------------------------------------------------------------- @DY_FRE EQU * MVC FREEDD(8),P#RETDD LA R01,FREE SVC 99 B @BYE *------------------------------------------------------------------- @BYE EQU * L R13,SAVEAREA+4 return RETURN (14,12),RC=(15) DS 0F * --- SAVE AREA --- SAVEAREA DS 18F SAVEAREA * --- Convert Hexa to Char Routine Work Area --- DS 0D *--- job file control block --- JFCB DS 0CL176 JOB FILE CONTROL BLOCK W#DSN DS CL44 DATASET NAME DSCB DC CL140' ' DATASET CONTROL BLOCK W#VOL DS CL6 DATASET NAME DS 0F * --- dinamic allocations --- ALLOC DC 0F'0',X'80',AL3(ALLOCRB) ALLOCRB DS 0F DC AL1(20),AL1(01),AL2(0) ALLOCER DC AL2(0) ALLOCIN DC AL2(0) DC A(ALLOCTP) DC A(0) DC A(0) ALLOCTP DC A(0) A(@D_DSN) DC A(0) A(@D_DISP) DC A(0) A(@D_UNIT) DC A(0) A(@D_VOL) DC A(0) X'80',AL3(@D_RETDD) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) DC A(0) LALLOCTP EQU *-ALLOCTP * DDNAME <- DSN=@@@@,DISP=SHR,UNIT=SYSDA,VOL=SER=@@@@@@ @D_DSN DC XL2'0002',XL2'0001',HL2'44' ALCDSN DS CL44 @D_DOLD DC XL2'0004',XL2'0001',HL2'01',XL1'01' disp=old @D_DNEW DC XL2'0004',XL2'0001',HL2'01',XL1'04' disp=new @D_DSHR DC XL2'0004',XL2'0001',HL2'01',XL1'08' disp=shr @D_CTLG DC XL2'0005',XL2'0001',HL2'01',XL1'02' disp=(,catlg) @D_UNIT DC XL2'0015',XL2'0001',HL2'08',CL8'SYSALLDA' @D_STRK DC XL2'0007',XL2'0000' @D_SCYL DC XL2'0008',XL2'0000' @D_SPC1 DC XL2'000A',XL2'0001',HL2'03' ALCSPC1 DS CL3 @D_SPC2 DC XL2'000B',XL2'0001',HL2'03' ALCSPC2 DS CL3 @D_BLKSZ DC XL2'0030',XL2'0001',HL2'02' ALCBLKSZ DS CL2 @D_LRECL DC XL2'0042',XL2'0001',HL2'02' ALCLRECL DS CL2 @D_RECFM DC XL2'0049',XL2'0001',HL2'01' ALCRECFM DS CL1 @D_F DC XL1'80' recfm=f @D_FB DC XL1'90' recfm=fb @D_DSORG DC XL2'003C',XL2'0001',HL2'02' ALCDSORG DS CL2 @D_PS DC XL2'4000' dataset organization ( PS ) @D_VOL DC XL2'0010',XL2'0001',HL2'06' ALCVOL DS CL6 @D_RETDD DC XL2'0055',XL2'0001',HL2'08' ALCDD DS CL8 @D_RETOR DC XL2'0057',XL2'0001',HL2'02' ALCORG DS H * @D_DDN DC XL2'0001',XL2'0001',HL2'08',CL8'INDD ' ************************************************************** FREE DC 0F'0',X'80',AL3(FREERB) FREERB DS 0F DC AL1(20),AL1(02),AL2(0) FREEER DC AL2(0) FREEIN DC AL2(0) DC A(FREETP) DC A(0) DC A(0) FREETP DC X'80',AL3(@FREEDD) @FREEDD DC XL2'0001',XL2'0001',HL2'08' FREEDD DS CL8 DSCBFMT1 CAMLST SEARCH,W#DSN,W#VOL,DSCB LTORG * --- Dynamic Allocation Parameter Area ( Dummy Section ) --- @RVDA#PM DSECT P#PROC DS CL8 P#DSN DS CL44 P#VOL DS CL6 P#DISP DS CL3 P#RETDD DS CL8 P#RETC DS CL4 P#SPC DS CL3 'trk' or 'cyl' P#SIZE1 DS XL3 P#SIZE2 DS XL3 P#DSORG DS CL2 'ps' P#RECFM DS XL1 f, v, fb, vb, fba, vba, u P#LRECL DS XL2 P#BLKSZ DS XL2 * --- R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @RV#6DA /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //*YSPUNCH DD SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0)) //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@RV#6DA),DISP=OLD <- CHECK //C EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START DC C'<< Oh Shock ! Dataset Configration >> Version 6 ( ' REV DC CL6'v6r0m1' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' PRINT NOGEN @RV#6DC CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03,R04,R05 Base Reg. R03,R04,R05 LA R04,2048(R03) 2'ND Base Reg LA R04,2048(R04) LA R05,2048(R04) 3'ND Base Reg LA R05,2048(R05) ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) * --- dataset configration --- @DS_CONF EQU * dataset configration * L R07,APDSF * RDJFCB (R07) get JFCB * LTR R15,R15 * BZ @DS_SKP1 * TPUT ERRMSG01,L'ERRMSG01 *DS_SKP1 EQU * USING JFCBSECT,R12 base reg. R12 L R12,AOSJFCB * --- volume serial --- L R01,AI#VOL MVC 0(6,R01),JFCBVOLS MVC VOLUME,JFCBVOLS camlst volume serial * --- dataset organization --- XR R01,R01 IC R01,JFCDSRG1 L R02,ACK#DSOR STC R01,0(R02) * --- record format --- XR R01,R01 IC R01,JFCRECFM L R02,ACK#RFM STC R01,0(R02) * --- block size --- XR R01,R01 LH R01,JFCBLKSI L R02,ACK#BLKS STH R01,0(R02) CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#BLKSZ MVC 0(5,R02),UPK_AREA+3 * --- records# of 1 track --- L R02,ACK#BLKS CALL @RV#6TC,(VOLUME,(R02),R) * --- logical record length --- XR R01,R01 LH R01,JFCLRECL L R02,ACK#LRL STH R01,0(R02) CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#LRECL MVC 0(5,R02),UPK_AREA+3 * --- directory block --- L R01,JFCBDQTY CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#DBLK MVC 0(5,R02),UPK_AREA+3 * --- drop rdjfcb dsect --- DROP R12 * --- DSCB type 4 ( volume information ) --- XC DSCB4,DSCB4 clear dscb area MVI DSCB4DSN,X'04' move dscb 4 name MVC DSCB4DSN+1(43),DSCB4DSN OBTAIN DSCBFMT4 get JFCB LTR R15,R15 BZ @DSCB4CK TPUT ERRMSG02,L'ERRMSG02 @DSCB4CK EQU * USING DSCBSEC4,R12 base reg. R12 LA R12,DSCB4 L R02,ANUMCYL# MVC 0(2,R02),DS4DSCYL L R02,ANUMTRK# MVC 0(2,R02),DS4DSTRK * --- DEBUG --- * CALL @RV#6HC,((R02),ERRMSG99+4,4) * TPUT ERRMSG99,L'ERRMSG99 * --- drop dscb4 --- DROP R12 * --- DSCB type 1 ( dstaset formation ) --- XC DSCB1,DSCB1 L R01,AI#DSN MVC DSCB1DSN(44),0(R01) OBTAIN DSCBFMT1 get JFCB LTR R15,R15 BZ @DSCB1CK TPUT ERRMSG03,L'ERRMSG03 @DSCB1CK EQU * USING DSCBSEC1,R12 base reg. R12 LA R12,JFCB1 * --- last used track --- L R06,AE#TTR MVC 0(4,R06),DS1LSTAR ttr L R07,A#AUP2 CALL @RV#6HC,((R06),(R07),3) L R00,DS1LSTAR mbbcchhr N R00,=X'FFFFFF00' * L R01,PDSFD+44 L R01,APDSF L R01,44(R01) N R01,=X'00FFFFFF' L R02,AE#CHR BAL R14,@CNVCHR convert ttr -> mbbcchhr L R06,AE#CHR L R07,A#AUP CALL @RV#6HC,((R06),(R07),8) * --- start address --- L R00,=X'00000100' ttr ( first address ) L R01,APDSF L R01,44(R01) N R01,=X'00FFFFFF' LA R02,W_CHR BAL R14,@CNVCHR convert ttr -> mbbcchhr L R07,A#ASP CALL @RV#6HC,(W_CHR,(R07),8) * --- extent --- XR R01,R01 IC R01,DS1NOEPV L R02,AEXT# STC R01,0(R02) CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#EXT MVC 0(2,R02),UPK_AREA+6 * --- system code --- L R02,A#SYSCD MVC 0(13,R02),DS1SYSCD * --- creation date --- IC R01,DS1CREDT CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#CRE MVC 0(2,R02),UPK_AREA+6 MVI 2(R02),C'/' L R01,DS1CREDT SRL R01,8 N R01,=X'0000FFFF' CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' MVC 3(3,R02),UPK_AREA+5 * --- expiration date --- IC R01,DS1EXPDT CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R02,A#EXP MVC 0(2,R02),UPK_AREA+6 MVI 2(R02),C'/' L R01,DS1EXPDT SRL R01,8 CL R01,=F'0' BE @EXPJP1 N R01,=X'0000FFFF' CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' MVC 3(3,R02),UPK_AREA+5 B @EXPJP2 @EXPJP1 EQU * L R02,A#EXP MVC 0(6,R02),=CL6'*NONE*' @EXPJP2 EQU * * --- extent address --- XR R06,R06 extent number XR R08,R08 allocation space compute L R02,AEXT#XXX clear extent area MVI 0(R02),X'00' MVC 1(127,R02),0(R02) L R02,A#XXX clear extent area MVI 0(R02),C' ' ( display area ) MVC 1(255,R02),0(R02) L R07,AT#CHR terminate cchhr IC R06,DS1NOEPV * --- extent 1 address --- L R09,AEXT#0LO MVC 0(4,R09),DS1EXT1+2 ext 0 high L R08,A#L1 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#0HI MVC 0(4,R10),DS1EXT1+6 ext 0 low L R08,A#H1 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'000000' ( mbb ) MVC 3(4,R07),DS1EXT1+6 ext 0 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R02,ANUMALC# allocation track number ST R01,0(R02) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 2 address --- L R09,AEXT#1LO MVC 0(4,R09),DS1EXT2+2 ext 1 high L R08,A#L2 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#1HI MVC 0(4,R10),DS1EXT2+6 ext 1 low L R08,A#H2 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'010000' ( mbb ) MVC 3(4,R07),DS1EXT2+6 ext 1 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 3 address --- L R09,AEXT#2LO MVC 0(4,R09),DS1EXT3+2 ext 2 high L R08,A#L3 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#2HI MVC 0(4,R10),DS1EXT3+6 ext 2 low L R08,A#H3 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'020000' ( mbb ) MVC 3(4,R07),DS1EXT3+6 ext 2 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- dscb type 3 ( extent dataset information ) --- MVC DSCB3CHR(5),DS1PTRDS XC DSCB3,DSCB3 OBTAIN DSCBFMT3 LTR R15,R15 BNZ @E_A_X USING DSCBSEC3,R11 LA R11,DSCB3 * --- extent 4 address --- L R09,AEXT#3LO MVC 0(4,R09),DS3EXTNT+2 ext 3 high L R08,A#L4 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#3HI MVC 0(4,R10),DS3EXTNT+6 ext 3 low L R08,A#H4 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'030000' ( mbb ) MVC 3(4,R07),DS3EXTNT+6 ext 3 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 5 address --- L R09,AEXT#4LO MVC 0(4,R09),DS3EXTNT+12 ext 4 high L R08,A#L5 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#4HI MVC 0(4,R10),DS3EXTNT+16 ext 4 low L R08,A#H5 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'040000' ( mbb ) MVC 3(4,R07),DS3EXTNT+16 ext 4 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 6 address --- L R09,AEXT#5LO MVC 0(4,R09),DS3EXTNT+22 ext 5 high L R08,A#L6 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#5HI MVC 0(4,R10),DS3EXTNT+26 ext 5 low L R08,A#H6 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'050000' ( mbb ) MVC 3(4,R07),DS3EXTNT+26 ext 5 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 7 address --- L R09,AEXT#6LO MVC 0(4,R09),DS3EXTNT+32 ext 6 high L R08,A#L7 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#6HI MVC 0(4,R10),DS3EXTNT+36 ext 6 low L R08,A#H7 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'060000' ( mbb ) MVC 3(4,R07),DS3EXTNT+36 ext 6 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 8 address --- L R09,AEXT#7LO MVC 0(4,R09),DS3ADEXT+2 ext 7 high L R08,A#L8 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#7HI MVC 0(4,R10),DS3ADEXT+6 ext 7 low L R08,A#H8 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'070000' ( mbb ) MVC 3(4,R07),DS3ADEXT+6 ext 7 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 9 address --- L R09,AEXT#8LO MVC 0(4,R09),DS3ADEXT+12 ext 8 high L R08,A#L9 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#8HI MVC 0(4,R10),DS3ADEXT+16 ext 8 low L R08,A#H9 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'080000' ( mbb ) MVC 3(4,R07),DS3ADEXT+16 ext 8 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 10 address --- L R09,AEXT#9LO MVC 0(4,R09),DS3ADEXT+22 ext 9 high L R08,A#L10 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#9HI MVC 0(4,R10),DS3ADEXT+26 ext 9 low L R08,A#H10 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'090000' ( mbb ) MVC 3(4,R07),DS3ADEXT+26 ext 9 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 11 address --- L R09,AEXT#ALO MVC 0(4,R09),DS3ADEXT+32 ext 10 high L R08,A#L11 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#AHI MVC 0(4,R10),DS3ADEXT+36 ext 10 low L R08,A#H11 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0A0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+36 ext 10 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 12 address --- L R09,AEXT#BLO MVC 0(4,R09),DS3ADEXT+42 ext 11 high L R08,A#L12 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#BHI MVC 0(4,R10),DS3ADEXT+46 ext 11 low L R08,A#H12 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0B0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+46 ext 11 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 13 address --- L R09,AEXT#CLO MVC 0(4,R09),DS3ADEXT+52 ext 12 high L R08,A#L13 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#CHI MVC 0(4,R10),DS3ADEXT+56 ext 12 low L R08,A#H13 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0C0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+56 ext 12 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 14 address --- L R09,AEXT#DLO MVC 0(4,R09),DS3ADEXT+62 ext 13 high L R08,A#L14 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#DHI MVC 0(4,R10),DS3ADEXT+66 ext 13 low L R08,A#H14 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0D0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+66 ext 13 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 15 address --- L R09,AEXT#ELO MVC 0(4,R09),DS3ADEXT+72 ext 14 high L R08,A#L15 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#EHI MVC 0(4,R10),DS3ADEXT+76 ext 14 low L R08,A#H15 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0E0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+76 ext 14 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X * --- extent 16 address --- L R09,AEXT#FLO MVC 0(4,R09),DS3ADEXT+82 ext 15 high L R08,A#L16 CALL @RV#6HC,((R09),(R08),4) L R10,AEXT#FHI MVC 0(4,R10),DS3ADEXT+86 ext 15 low L R08,A#H16 CALL @RV#6HC,((R10),(R08),4) MVC 0(3,R07),=X'0F0000' ( mbb ) MVC 3(4,R07),DS3ADEXT+86 ext 15 high ( cchh ) MVC 7(1,R07),R+3 ext 0 high ( cchh ) BAL R14,@E_A_TRK allocation space compute L R09,ANUMALC# allocation track number L R10,0(R09) LA R10,0(R10,R01) ST R10,0(R09) BCTR R06,0 LTR R06,R06 BZ @E_A_X ** @E_A_X EQU * L R01,AT#CHR L R02,A#AEP CALL @RV#6HC,((R01),(R02),8) L R01,APDSF L R01,44(R01) N R01,=X'00FFFFFF' L R02,AT#CHR BAL R14,@CNVTTR convert ttr -> mbbcchhr L R02,A#AEP2 ST R00,W_TTR CALL @RV#6HC,(W_TTR,(R02),3) * L R01,ANUMALC# allocation track number * L R02,A#ALC * CALL @RV#6HC,((R01),(R02),4) L R08,ANUMALC# allocation track number L R08,0(R08) allocation track number CVD R08,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' L R01,A#ALC MVC 0(5,R01),UPK_AREA+3 DROP R11 DROP R12 * --- end of sub routine --- L R13,SAVEAREA+4 RETURN (14,12),RC=0 @E_A_TRK EQU * STM R03,R00,REGS XR R06,R06 LH R06,0(R10) SH R06,0(R09) L R07,ANUMTRK# MH R06,0(R07) AH R06,2(R10) SH R06,2(R09) LA R01,1(R06) LM R03,R00,REGS BR R14 *------------------------------------------------------------------- *-------- convert mbcchhr to ttr ----------------------------------- *------------------------------------------------------------------- @CNVTTR EQU * STM R03,R15,REGS L R12,CVTPTR USING CVTMAP,R12 L R15,CVTPRLTV DROP R12 BALR R14,R15 LM R03,R15,REGS BR R14 @CNVCHR EQU * STM R03,R15,REGS L R12,CVTPTR USING CVTMAP,R12 L R15,CVTPCNVT DROP R12 BALR R14,R15 LM R03,R15,REGS BR R14 * DS 0F * --- SAVE AREA --- SAVEAREA DS 18F savearea APDSF DC V(PDSF) dcb address AOSJFCB DC V(POSJFCB) jfcb ( rdjfcb ) AI#VOL DC V(I#VOL) volume serial AI#DSN DC V(I#DSN) volume serial ACK#DSOR DC V(CK#DSORG) dataset organization ACK#RFM DC V(CK#RFM) record format ACK#BLKS DC V(CK#BLKSZ) record format ACK#LRL DC V(CK#LRECL) record format A#BLKSZ DC V(O#BLKSZ) block size A#LRECL DC V(O#LRECL) logical record length A#DBLK DC V(O#DBLK) directory block number ANUMCYL# DC V(NUMCYL#) number of cylinder ANUMTRK# DC V(NUMTRK#) track number of 1 cylinder ANUMALC# DC V(NUMALC#) track number of 1 cylinder AE#TTR DC V(E#TTR) end of ttr A#AUP2 DC V(O#AUP2) end of ttr ( display area ) AE#CHR DC V(E#CHR) end of cchhr A#AUP DC V(O#AUP) end of cchhr ( display area ) A#ASP DC V(O#ASP) start of cchhr A#AEP DC V(O#AEP) end of address A#AEP2 DC V(O#AEP2) end of address AEXT# DC V(EXT#) extent A#EXT DC V(O#EXT) extent A#SYSCD DC V(O#SYSCD) system code A#CRE DC V(O#CRE) create code A#USE DC V(O#USE) create code A#ALC DC V(O#ALC) create code W_CHR DS 0F,XL8 W_TTR DS 0F,XL4 A#EXP DC V(O#EXP) AT#CHR DC V(T#CHR) AEXT#XXX DC V(EXT#XXX) AEXT#0LO DC V(EXT#0LO) AEXT#1LO DC V(EXT#1LO) AEXT#2LO DC V(EXT#2LO) AEXT#3LO DC V(EXT#3LO) AEXT#4LO DC V(EXT#4LO) AEXT#5LO DC V(EXT#5LO) AEXT#6LO DC V(EXT#6LO) AEXT#7LO DC V(EXT#7LO) AEXT#8LO DC V(EXT#8LO) AEXT#9LO DC V(EXT#9LO) AEXT#ALO DC V(EXT#ALO) AEXT#BLO DC V(EXT#BLO) AEXT#CLO DC V(EXT#CLO) AEXT#DLO DC V(EXT#DLO) AEXT#ELO DC V(EXT#ELO) AEXT#FLO DC V(EXT#FLO) AEXT#0HI DC V(EXT#0HI) AEXT#1HI DC V(EXT#1HI) AEXT#2HI DC V(EXT#2HI) AEXT#3HI DC V(EXT#3HI) AEXT#4HI DC V(EXT#4HI) AEXT#5HI DC V(EXT#5HI) AEXT#6HI DC V(EXT#6HI) AEXT#7HI DC V(EXT#7HI) AEXT#8HI DC V(EXT#8HI) AEXT#9HI DC V(EXT#9HI) AEXT#AHI DC V(EXT#AHI) AEXT#BHI DC V(EXT#BHI) AEXT#CHI DC V(EXT#CHI) AEXT#DHI DC V(EXT#DHI) AEXT#EHI DC V(EXT#EHI) AEXT#FHI DC V(EXT#FHI) A#XXX DC V(O#XXX) A#H1 DC V(O#H1) A#H2 DC V(O#H2) A#H3 DC V(O#H3) A#H4 DC V(O#H4) A#H5 DC V(O#H5) A#H6 DC V(O#H6) A#H7 DC V(O#H7) A#H8 DC V(O#H8) A#H9 DC V(O#H9) A#H10 DC V(O#H10) A#H11 DC V(O#H11) A#H12 DC V(O#H12) A#H13 DC V(O#H13) A#H14 DC V(O#H14) A#H15 DC V(O#H15) A#H16 DC V(O#H16) A#L1 DC V(O#L1) A#L2 DC V(O#L2) A#L3 DC V(O#L3) A#L4 DC V(O#L4) A#L5 DC V(O#L5) A#L6 DC V(O#L6) A#L7 DC V(O#L7) A#L8 DC V(O#L8) A#L9 DC V(O#L9) A#L10 DC V(O#L10) A#L11 DC V(O#L11) A#L12 DC V(O#L12) A#L13 DC V(O#L13) A#L14 DC V(O#L14) A#L15 DC V(O#L15) A#L16 DC V(O#L16) * --- Error Message --- ERRMSG01 DC CL79'*** RDJFCB Error ***' ERRMSG02 DC CL79'*** OBTAIN Error ( DSCB - Type 4 ) ***' ERRMSG03 DC CL79'*** OBTAIN Error ( DSCB - Type 1 ) ***' ERRMSG99 DC CL79'*** @@@@@@@@ @@@@@@@ ***' * --- Convert Hexa to Char Routine Work Area --- REGS DS 18F WORK SAVEAREA DS 0D * --- Panel RC Packed Area --- PK_AREA DC PL8'0' UPK_AREA DC CL16' ' DS 0F * --- hexa to character convert ( translate character ) --- *R DC C'0123456789ABCDEF' CHAR TRUNC TABLE *_TR DC A(TR) * --- dscb search --- DSCBFMT1 CAMLST SEARCH,DSCB1DSN,VOLUME,DSCB1 DSCBFMT3 CAMLST SEEK,DSCB3CHR,VOLUME,DSCB3 DSCBFMT4 CAMLST SEARCH,DSCB4DSN,VOLUME,DSCB4 VOLUME DS CL6 R DS F DSCB3CHR DS CL6 JFCB1 DS 0CL176 job file control block DSCB1DSN DS CL44 DSCB1 DS CL140 DSCB3 DS CL140 * JFCB4 DS 0CL176 job file control block DSCB4DSN DS CL44 dataset name DSCB4 DS CL140 dataset control block DS 0F LTORG JFCBSECT DSECT IEFJFCBN LIST=YES DSCBSEC1 DSECT IECSDSL1 (1) DSCBSEC3 DSECT IECSDSL1 (3) DSCBSEC4 DSECT IECSDSL1 (4) IEFUCBOB LIST=YES DCBD DSORG=PO,DEVD=DA CVT DSECT=YES,LIST=YES R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @RV#6DC /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@RV#6DC),DISP=OLD <- CHECK //D EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START DC C'<< Oh Shock ! >> Version 6 ( ' REV DC CL6'v6r1m1' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' PRINT NOGEN @RV#6HC CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03 Base Reg. R03 ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) * --- from characher --- L R07,0(R01) * --- to character --- L R08,4(R01) * --- convert length --- L R09,8(R01) * LA R07,ALLOCER * LA R08,ERRMSG02+30 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR @CO_HEX EQU * CONVERT HEX-CHARACTER LA R15,5 @CO_HC EQU * LTR R09,R09 BZ @CO_EXIT BCT R15,@CO_SKIP * MVI 0(R08),X'40' LA R08,1(R08) LA R15,4 @CO_SKIP EQU * SR R01,R01 IC R01,0(R07) SRL R01,4 A R01,A_TR ICM R02,B'0010',0(R01) IC R01,0(R07) N R01,=F'15' A R01,A_TR ICM R02,B'0001',0(R01) STCM R02,B'0011',0(R08) LA R07,1(R07) LA R08,2(R08) BCTR R09,0 B @CO_HC @CO_EXIT EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=0 * SAVEAREA DS 18F WORK SAVEAREA TR DC C'0123456789ABCDEF' CHAR TRUNC TABLE A_TR DC A(TR) LTORG R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @RV#6HC /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //*YSPUNCH DD SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0)) //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@RV#6HC),DISP=OLD <- CHECK //E EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START PRINT NOGEN DC C'<< Oh Shock ! _ Track Calculator >> Version 6 ( ' REV DC CL6'V6R1M2' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' * RC * 0 : OK ( RETURN BLOCK# -> R00 ) * 4 : Block Size Over . * 8 : Block Size Over . * 12 : UCB Error * 16 : Volume Serial Not Found . * @RV#6TC CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03,R04,R05,R06 BASE REG. R03 LA R04,2048(R03) LA R04,2048(R04) 2ND BASE REG. R04 LA R05,2048(R04) LA R05,2048(R05) 3RD BASE REG. R05 LA R06,2048(R05) LA R06,2048(R06) 4RD BASE REG. R06 ST R13,SAVEAREA+4 SAVE A(OLD SAVEAREA) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) SAVE A(NEW SAVEAREA) * L R02,0(R01) MVC VOLSER(6),0(R02) VOLSER L R02,4(R01) MVC @DD(2),0(R02) L R02,8(R01) ST R02,NUM#A * L R12,CVTPTR CVT ADDR. ( PSA + X'10' ) USING CVTMAP,R12 * XC UCBWORK,UCBWORK MVI DEVCLASS,UCB3DACC OI PARMUCB,X'80' * UCB_SCAN EQU * LA R01,PARMLIST L R15,CVTUCBSC BALR R14,R15 LTR R15,R15 BNZ END_SCAN USING UCBOB,R11 L R11,UCBPTR * TM UCBSTAT,X'80' BNO UCB_SCAN * CLC UCBVOLI,VOLSER BE UCB_OK B UCB_SCAN DROP R11 DROP R12 ********* UCB_OK EQU * TRKCALC FUNCTN=TRKCAP,UCB=UCBPTR,RKDD=RKDD, * REGSAVE=YES LTR R15,R15 BZ UCB_SAVE ST R15,RC# CALL @RV#6DA,(RC#,ERRMSG01+28,4) TPUT ERRMSG01,L'ERRMSG01 L R15,RC# B @BYE UCB_SAVE EQU * L R01,NUM#A ST R00,0(R01) *** END OF PROCESS *********************************************** @BYE EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=(15) ****************************************************************** END_SCAN EQU * LA R15,16 B @BYE ****************************************************************** MSG DC CL80'********* @@@@@@@@ ********' * DS 0F SAVEAREA DS 18F SAVEAREA VOLSER DS CL6 RKDD DS 0F @R DC X'01' @K DC X'00' @DD DS H * NUM#A DS F BLK# DS F RC# DS F * PARMLIST DS 3F ORG PARMLIST PARMWA DC A(UCBWORK) PARMDEVT DC A(DEVCLASS) PARMUCB DC A(UCBPTR) * DS 0D UCBWORK DS CL100 DEVCLASS DS CL1 UCBPTR DS F * ERRMSG01 DC CL80'*** TRKCALC ERROR HAPPEND !! RC:@@@@@@@@ ***' * LTORG DSECT IEFUCBOB LIST=YES CVT DSECT=YES,LIST=YES R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @RV#6TC /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //*YSPUNCH DD SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0)) //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@RV#6TC),DISP=OLD <- CHECK //L EXEC PGM=IEWL,PARM='MAP,LET,LIST', // REGION=1M,COND=(8,LT) //SYSLIN DD DDNAME=SYSIN //SYSUT1 DD UNIT=SYSALLDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1 //SYSPRINT DD SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509) //LINK DD DSN=isp.sispload,DISP=SHR <- CHECK //OBJ DD DISP=SHR,UNIT=SYSALLDA, // DSN=*.CREATE.OBJECT //SYSLMOD DD DISP=SHR,UNIT=SYSALLDA, // DSN=*.CREATE.LOAD //SYSIN DD * INCLUDE OBJ(@RV#080) INCLUDE OBJ(@RV#6DA) INCLUDE OBJ(@RV#6DC) INCLUDE OBJ(@RV#6HC) INCLUDE OBJ(@RV#6TC) INCLUDE LINK(ISPLINK) ENTRY @RV#080 NAME @RV#0(R) //