PRINT NOGEN MACRO &N BEGIN &R,&R2,&RENT=N,&VER= * ******************************************************************* * * * * B E G I N * * * * GENERATE A CSECT STATEMENT, SPECIFY AND LOAD THE BASE * * REGISTERS, GENERATE STANDARD LINKAGE WITH SAVE AREA. * * * LCLC ®,&LAB,®2,®3,®4,&BASE2,&VERSION GBLC &RENTGBL AIF (K'&VER GT 8).VERERR AIF (K'&VER NE 0).VEROK &VERSION SETC '1.0' AGO .VERCNT .VEROK ANOP &VERSION SETC '&VER' .VERCNT ANOP AIF (K'&N NE 0).LABOK &LAB SETC 'NONAME' MNOTE 4,'***** NO CSECT NAME SPECIFIED, NONAME USED *********' AGO .LABCNT .LABOK ANOP &LAB SETC '&N' .LABCNT ANOP AIF (K'&R NE 0).REGOK ® SETC '12' MNOTE 4,'***** NO BASE REGISTER SPECIFIED, 12 USED **********' AGO .REGCNT .REGOK ANOP AIF ('&R'(1,1) NE 'R').NUMB ® SETC '&R'(2,2) AGO .COMP .NUMB ANOP ® SETC '&R' .COMP ANOP AIF ('®' LT '2').E1 AIF ('®' GT '12').E1 ® SETC '&R' .REGCNT ANOP ®2 SETC '® USE ® AS BASE REGISTER' &BASE2 SETC '1' AIF (K'&R2 EQ 0).BASE1 &BASE2 SETC '2' AIF ('&R2'(1,1) NE 'R').NUMB2 ®3 SETC '&R2'(2,2) AGO .COMP2 .NUMB2 ANOP ®3 SETC '&R2' .COMP2 ANOP AIF ('®3' LT '2').E12 AIF ('®3' GT '12').E12 ®3 SETC '&R2' AIF ('®3' EQ '®').E12 ®4 SETC '®3 USE ®3 AS 2ND BASE REGISTER' MNOTE '***** THIS PROGRAM WILL HAVE 2 BASE REGISTERS ******' .BASE1 ANOP &RENTGBL SETC 'N' AIF ('&RENT'(1,1) NE 'Y').NOTRENT &RENTGBL SETC 'Y' .NOTRENT ANOP &LAB CSECT * BAKR R14,R0 LINKAGE STACK LAE ®,0(R15,0) SET ® AS BASE USING &LAB,®2 ADDRESS IT STM 14,12,12(13) SAVE REGISTERS IN CALLERS AREA * * LR ®,15 * * * USING &LAB,®2 * AIF ('&BASE2' EQ '1').AONE LAE ®3,2048(R15,0) SET ®3 AS SECOND BASE LAE ®3,2048(®3,0) SET ®3 AS SECOND BASE USING &LAB+4096,®4 * * LA ®3,2048(®) * * LA ®3,2048(®3) * .AONE ANOP AIF ('&RENTGBL' EQ 'N').ANOTR GETMAIN R,LV=72,LOC=BELOW STORAGE FOR SAVE AREA * ST 13,4(1) PUT ADDRESS OF HIS SAVE AREA IN YOURS * ST 1,8(13) PUT ADDRESS OF YOUR SAVE AREA IN HIS * XR 13,1 * * XR 1,13 *EXCHANGE REGISTERS 1 AND R13 * XR 13,1 * * BAS 1,PRGMSAVE BRANCH PASSED ASSEMBLY INFORMATION * * * MNOTE '====> RE-ENTRANT VERSION OF EOJ WILL BE USED <==== *' * * AGO .INFO .ANOTR ANOP LR 15,13 * BAS 13,PRGMSAVE+END_EYECATCHER * PRGMSAVE DC 18F'0' * .INFO ANOP * * * ASSEMBLY INFORMATION - DATE, TIME AND CSECT NAME FOLLOW * * * ASLCSECT DC CL8'&LAB' ********* CSECT NAME *********** * ASLMODV DC CL8'&VERSION' **** VERSION INFORMATION **** * * * DC CL24'WRITTEN BY K E FERGUSON ' * DC CL36'COPYRIGHT - ABBYDALE SYSTEMS LLC. ' * * * ASLASMD DC CL8'&SYSDATE' **** ASSEMBLY DATE (MM/DD/YY) **** * ASLASMT DC CL6' &SYSTIME' **** ASSEMBLY TIME (HH.MM) **** * * * END_EYECATCHER EQU *-PRGMSAVE * * * AIF ('&RENTGBL' EQ 'N').ANOTR2 PRGMSAVE L 1,4(13) RELOAD ADDRESS OF HIS SAVE AREA * LM 0,1,20(1) RESET REGISTERS 0 AND 1 * AGO .EXIT .ANOTR2 ANOP ST 13,8(15) * ST 15,4(13) * .EXIT ANOP * K.F. * * ******************************************************************* * SPACE 1 MEXIT .E12 MNOTE 8,' -- VALUE FOR SECOND BASE REGISTER INVALID -- ' .E1 MNOTE 8,'IMPROPER REGISTER SPECIFIED, NO STATEMENTS GENERATED' .VERERR MNOTE 8,'LENGTH ERROR FOR THE VER PARAMETER > 8' MEND MACRO &N EOJ &C=0 LCLC &A,&B GBLC &RENTGBL *---------------------------------------------------------------------* * E O J * *---------------------------------------------------------------------* * * * Generate standard return linkage and return code. * * * AIF ('&N' EQ '').GO &N DS 0H .GO AIF ('&C'(1,1) EQ '(').REGCODE LA 15,&C Condition code into R15 * AGO .RESTORE .REGCODE ANOP AIF ('&C'(3,1) EQ ')').MOVE1 AIF ('&C'(4,1) EQ ')').MOVE2 AIF ('&C'(5,1) EQ ')').MOVE3 .MERROR ANOP MNOTE 16,'*** INVALID REGISTER PASSED AS RETURN CODE REGISTER' MEXIT .MOVE3 ANOP &A SETC '&C'(2,3) AGO .CONT .MOVE2 ANOP &A SETC '&C'(2,2) AGO .CONT .MOVE1 ANOP &A SETC '&C'(2,1) .CONT ANOP AIF ('&A'(1,1) EQ 'R').RVALUE AIF ('&A' GT '15').MERROR AGO .LOADIT .RVALUE ANOP &B SETC '&A'(2,2) AIF ('&B' GT '15').MERROR .LOADIT ANOP LR 15,&A Load R15 with condition code * .RESTORE ANOP AIF ('&RENTGBL' EQ 'Y').YESRENT PR Return to caller * AGO .EXIT .YESRENT ANOP LR 2,15 Save R15 for now * LR 1,13 Put address of save area into R1 * L 13,4(1) Put their save araea address in R13* FREEMAIN R,LV=72,A=(1) Free storage * LR 15,2 Reload R15 (Return code) * PR Return to caller * .EXIT ANOP * *---------------------------------------------------------------------* ** ©Copyright Abbydale Systems LLC. 2017 - 2021 ** *---------------------------------------------------------------------* MEND MACRO &NAME GETPARM * ******************************************************************* * * * * G E T P A R M * * * * Put the address of the passed parameter (if one is passed) * * into R1 and the length into R15 * * * &NAME DS 0H * L 15,4(13) Previous save area address * L 14,4(15) Next previous area address * LTR 14,14 Are we at the OS area? * BZ *+10 Yes - Go and check the parm * LR 15,14 Make r15 same as r14 and go try next * B *-12 Branch back to main loop * L 14,24(15) Are we in the OS yet? * L 14,0(14) Load the address of the address * XR 1,1 Clear register 1 for parm address * XR 15,15 Clear length counter * LH 15,0(14) Put length into r15 * LTR 15,15 Do we have a parm? * BZ *+8 No - Skip putting addreaa into r1 * LA 1,2(14) Load address of parm * * * * R15 contain the length of the passed parmeter, * * If R15 is zero (no parm) then r1 will also contain zero, * * otherwise R1 contains the length of the parameter and R15 * * contains the length of the passed parameter. * * * * Copyright - Abbydale Systems LLC. * * ******************************************************************* * MEND ASLUCAT START 0 ASLUCAT AMODE 24 ASLUCAT RMODE 24 GBLC &ASLCPY,&ASLCPL,&ASLVER &ASLCPL SETC 'This product contains restricted materials of Abbydale SX ystems LLC.' &ASLCPY SETC 'Abbydale Systems LLC.' &ASLVER SETC 'VERSION 2.0' *********************************************************************** * A S L E Q U C * *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DCB Offsets in ASLDCBS * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SYSPRINT_OFFSET EQU 0 Offset to SYSPRINT DCB * SYSIN_OFFSET EQU 4 Offset to SYSIN DCB * INPUT_OFFSET EQU 8 Offset to INPUT DCB * DIRIN_OFFSET EQU 12 Offset to DIRIN DCB * SNAP_OFFSET EQU 16 Offset to SNAP DCB * ASLPRINT_OFFSET EQU 20 Offset to ASLPRINT DCB * CORRELID_OFFSET EQU 24 Offset to CORRELID DCB * LONGMSG_OFFSET EQU 28 Offset to LONGMSG DCB * INTRDR_OFFSET EQU 32 Offset to INTRDR DCB * * K.E.F. * * ******************************************************************* * * COPY ASLEQUC Register equates IEFJSSIB IEFSSOBH ASLUCAT TITLE 'ASLUCAT - Copyright Abbydale Systems LLC' *---------------------------------------------------------------------* * ASLUCAT * *---------------------------------------------------------------------* * * * Description : Reads through a VTOC and identifies any incorrectly * * or uncataloged datasets. * * * * Created on : 24 Aug 2022 * * Created by : Kevin Ferguson * * : Userid(MIT001) * * : Using ABBYDALE.DEVL.SOURCE(ASLUCAT ) * * * * Called by : Nothing * * * * Calls : Nothing * * * * Change Activity : * * * *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* ASLUCAT BEGIN R12,VER=2.0 GETPARM LTR R15,R15 Any parameter? BZ Issue_Message1 No - Go and crap out C R15,=F'6' Is the length 6? BNE Issue_Message2 No - Go and crap out MVC VOLSER,0(R1) Move in volume serial number MVI Print_It,C'N' Set default for WTO DEVTYPE =CL8'SYSPRINT',CVB_Area LTR R15,R15 Did we have a SYSPRINT? BNZ Move_Volser No - Go move the volume in MVI Print_It,C'Y' Set flag for SYSPRINT OPEN (SYSPRINT,OUTPUT) Open SYSPRINT BAS R10,Clear_Print MVC Print_mess+40(36),=c'List of mis/uncataloged datasets on ' MVC Print_mess+76(6),VOLSER PUT SYSPRINT,Print_Mess BAS R10,Clear_Print MVI Print_mess+40,c'-' MVC Print_Mess+41(41),Print_mess+40 PUT SYSPRINT,Print_Mess BAS R10,Clear_Print PUT SYSPRINT,Print_Mess Move_Volser DS 0H * XC CAMLIST_Work,CAMLIST_Work MVC S99VOL,VOLSER Move volume to SVC99 MVC S99DD,=XL8'40' Set DD Name to blanks MVC S99DDLEN,=X'0008' Set DD name length yo 8 LA R1,S99RBPTR Address of request block into R1 DYNALLOC Allocate the volume LTR R15,R15 Did it work? BZ Keep_Going Yes - Keep on going CLC S99ERROR,=X'0218' Volume not mounted? BE Not_Mounted Yes - Issue message CLC S99ERROR,=X'9700' Volume not mounted? BE Not_Mounted Yes - Issue message L R4,S99ERROR Move error code it R4 before abend B SVC99_Error ... and then go and crap out Keep_Going DS 0H MVC DISKDD,S99DD Get the DDNAME RDJFCB (DISK) Read the JFCB MVC JFCB(44),F4KEY Move in VTOC name MVC F4VOLSER,VOLSER Move in the Volume serial number OBTAIN DSCB4 Get the FORAMT 4 DSCB LTR R15,R15 Did it work? BNZ Bad_Format4 No - Go and issue message. CLI F4DSCB,C'4' Is it really the format4? BNE Bad_Format4 No - Go and issue the message. MVC LASTF1,F4DSCB+1 Save address of last FORMAT1 in VTOC OPEN (DISK),TYPE=J Open VTOC TM DISKOPEN,X'10' Did the open work O.K? BNO VTOC_Error No - Go and issue the message Read_VTOC DS 0H READ DISKDECB,SF,DISK,F1DSCB,'S' XC DSCB,DSCB Clear DSCB area CHECK DISKDECB CLC DSKCCHHR,LASTF1 Has the last format 1 been read? BH EOF Yes - Go to close file CLI F1FMT,C'1' Is the returned DSCB a format1? BNE Read_VTOC No - Go and read the VTOC again LOCATE CAMLIST Find CATALOG entry LTR R15,R15 Is it catalogued? BNZ List_UNCAT No - go and list it XR R2,R2 Clear R2 as a work register LH R2,CAMLIST_Work Get # of volumes returned by CAMLIST LA R3,CAMLIST_Work+2 Address of volume list Volume_Loop DS 0H CLC 4(6,R3),VOLSER Is it our volume? BE Read_VTOC Yes - Go and display it LA R3,12(,R3) Skip to next entry ... BCT R2,Volume_Loop ... and go back to test it MVC tempwt+56(6),=C'NO VOL' B List_it Now list it. List_UNCAT DS 0H MVC tempwt+56(6),=C'UNCAT ' List_It DS 0H MVC tempwt+8(44),F1DSNAME CLI Print_It,C'N' SYSPRINT being used? BE tempwt BAS R10,Clear_Print MVC Print_mess+1(132),Print_mess MVC Print_mess+1(58),tempwt+8 PUT SYSPRINT,Print_Mess B Read_VTOC tempwt WTO '12345678901234567890123456789012345678901234 ' B Read_VTOC EOF DS 0H CLOSE DISK Close the VTOC ... CLI Print_It,C'N' SYSPRINT processing? BNE End_Of_Program No - Skip to end of program CLOSE (SYSPRINT) Close SYSPRINT End_Of_Program DS 0H EOJ C=(R15) Return to caller *---------------------------------------------------------------------* * Clear Print subroutine * *---------------------------------------------------------------------* Clear_Print DS 0H MVi Print_mess,C' ' MVC Print_mess+1(132),Print_mess BR R10 Return *---------------------------------------------------------------------* * End of Clear Print subroutine * *---------------------------------------------------------------------* Issue_Message1 DS 0H WTO 'ASLUC01E - Missing parameter. Abend SOC3' DUMP EX R15,DUMP Issue_Message2 DS 0H WTO 'ASLUC02E - Parameter length error. Abend S0C3' B DUMP Not_Mounted DS 0H WTO 'ASLUC03E - Volume not online. Abend S0C3' B DUMP SVC99_Error DS 0H WTO 'ASLUC04E - Dynamic allocate failed. Reason code in R4' B DUMP Bad_Format4 DS 0H MVC WTO1VOL,VOLSER No - Put VOLSER in error message WTO1 WTO 'ASLUC05E - Bad FORMAT4 found on XXXXXX' WTO1VOL EQU WTO1+39,6 B DUMP VTOC_Error DS 0H MVC WTO4VOL,VOLSER No - Put VOLSER in error message WTO4 WTO 'ASLUC06E - UNABLE TO OPEN VTOC ON XXXXXX' WTO4VOL EQU WTO4+42,6 B DUMP *---------------------------------------------------------------------* * CAMLIST List Skeleton and work araes * *---------------------------------------------------------------------* Print_It DS CL1 Print_Mess DS Cl133 SYSPRINT DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS, X LRECL=133,RECFM=FBA CVB_Area DS D CAMList CAMLST NAME,F1DSNAME,,CAMLIST_Work CAMLIST CAMLIST_Work DS 0D Double word align DS 265C CAMLIST work area SCANWORK EQU CAMLIST_Work,100 UCB Scan work area UCBPTR EQU CAMLIST_Work+100,4 UCB Pointer LASTF1 DS CL5 Addres of last Format1 in the VTOC DSCB4 CAMLST SEARCH,F4KEY,F4VOLSER,F4DSCB F4KEY DC 44X'04' F4VOLSER DS CL6 F4DSCB EQU DSCBS,140 FORMAT4 DSCB F4NOEXT EQU F1DSCB+59,1 F4EXT1 EQU F1DSCB+105,10 F4DEVDT EQU F1DSCB+74,1 F4DSREC EQU F1DSCB+50,2 VOLSER DS CL6 Volume Serial Number DSCBS DC CL140' ' AREA FOR INPUTTING DSCBS F1DSCB EQU DSCBS,140 FORMAT1 DSCB F1DSNAME EQU F1DSCB,44 DSNAME F1FMT EQU F1DSCB+44,1 FORMAT IDENTIFIER F1CREDAT EQU F1DSCB+53,3 CREATE DATE F1EXPDAT EQU F1DSCB+56,3 EXPIRY DATE F1NUMEXT EQU F1DSCB+59,1 NUMBER OF EXTENTS ON VOL F1OPNDAT EQU F1DSCB+75,3 DATE LAST OPEN F1DSORG EQU F1DSCB+82,1 DSORG F1VSAM EQU F1DSCB+83,1 VSAM INDICATOR F1LRECL EQU F1DSCB+88,2 F1BLKL EQU F1DSCB+86,2 F1KEYL EQU F1DSCB+90,1 F1RKP EQU F1DSCB+91,2 F1IND EQU F1DSCB+93,1 F1LSTAR EQU F1DSCB+98,3 F1RECFM EQU F1DSCB+84,1 F1EXT1 EQU F1DSCB+105,10 DESCRIPTION OF 1ST EXTENT * * Dynamic allocation Parms * DS 0D ALIGN S99RBPTR DC X'80' HIGH ORDER BIT ON DC AL3(S99RB) POINTER TO S99RB S99RB EQU * SVC99 REQUEST BLOCK DC X'14' LENGTH OF RB DC X'01' DSNAME ALLOCATION VERB DC X'6000' S99NOMNT FLAGS1 - S99NOCNV ON S99ERROR DC H'0' RETURN CODES - ERROR DC H'0' RETURN CODES - REASON DC A(S99TUPL) POINTER TO S99TUPL DC F'0' RESERVED SPACE DC F'0' FLAGS2 S99TUPL EQU * TEXT UNIT POINTERS * DC A(S99TU1) POINTER TO TU1 * DC A(S99TU2) POINTER TO TU2 DC A(S99TU3) POINTER TO TU3 DC A(S99TU4) POINTER TO TU4 DC X'80' END-OF-LIST MARKER DC AL3(S99TU5) POINTER TO TU5 * SPACE ALLOCATION BY TRACK S99TU1 DC X'0007',X'0000',X'0000',X'0000' * NO PRIMARY SPACE ALLOCATED S99TU2 DC X'000A',X'0001',X'0003',X'000000' * VOLUME = ...... (VARIABLE) S99TU3 DC X'0010',X'0001',X'0006',CL6' ' * UNIT = SYSDA (DEFAULT) S99TU4 DC X'0015',X'0001',X'0008',CL8'SYSALLDA' * RETURN DDNAME S99TU5 DC X'0055',X'0001',X'0008',CL8' ' S99VOL EQU S99TU3+6,6 VOLSER S99SYSD EQU S99TU4+6,5 SYSD TYPE (UNIT) S99DDLEN EQU S99TU5+4,2 DDNAME LENGTH S99DD EQU S99TU5+6,8 DDNAME DISK DCB DDNAME=SYSDA,DSORG=PS,LRECL=96,BLKSIZE=96,KEYLEN=44, * EXLST=EXITLIST,EODAD=EOF,MACRF=(R),RECFM=F DSKCCHHR EQU DISK+8,5 ADDRS (CCHHR) OF LAST FORMAT1 DSCB READ DISKDD EQU DISK+40,8 DCB DDNAME DISKOPEN EQU DISK+48,1 DCB OPEN FLAGS EXITLIST DC X'87',AL3(JFCB) * LTORG DS 0D ALIGNMENT CATINFO DS CL265 SPACE FOR READING IN CAT INFO JFCB EQU CATINFO,176 DSCB DS CL140 AREA FOR BUILDING OUTPUT PSEUDO-DSCB ORG DSCB *---------------------------------------------------------------------* * End of ASLUCAT * *---------------------------------------------------------------------* END ASLUCAT PUNCH ' MODE AMODE(24)' BINDER AMODE STATEMENT. PUNCH ' MODE RMODE(24)' BINDER RMODE STATEMENT. PUNCH ' ENTRY ASLUCAT ' MODULE ENTRY POINT. PUNCH ' NAME ASLUCAT(R)' MODULE NAME. END