PRINT NOGEN ASLSUBCM START 0 ASLSUBCM AMODE 31 ASLSUBCM RMODE ANY ASLSUBCM TITLE 'Issue Subsystem Commands - Abbydale Systems LLC.' *---------------------------------------------------------------------* * ASLSUBCM * *---------------------------------------------------------------------* * * * Description : This will list MQ Subsystems as a list for selecting * * an MQ Subsystem to shutdown or start up * * * * Created on : 16 Apr 1999 * * Created by : Kevin Ferguson * * : Userid(MIT001) * * : Using ABBYDALE.DEVL.SOURCE(ASLSUBCM) * * * * Called by : * * * * Calls : * * * * Register Usage: * * * * R0 - Standard Usage * * R1 - Standard Usage * * R2 - Work register * * R3 - Work register * * R4 - Work register * * R5 - CVT Addressability then SSCT Addressabilty * * R6 - Work register for SSVT * * R7 - Work register * * R8 - Subsystem counter and return code * * R9 - Not used * * R10 - Subroutine linkage * * R11 - JESCT Addressability * * R12 - Base Register * * R13 - Save area linkage * * R0 - Standard Usage * * R1 - Standard Usage * * * * Change Activity : * * * *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* ASLSUBCM CSECT BAKR R14,R0 Linkage stack LAE R12,0(R15,0) Set R12 as base register and ... USING ASLSUBCM,R12 ... establish addressability STM R14,R12,12(R13) Save callers registers LR R15,R13 Load R15 with passed save area. BAS R13,PRGMSAVE+END_EYECATCHER Skip eyecatchers PRGMSAVE DC 18F'0' Register save area *---------------------------------------------------------------------* * E Y E C A T C H E R * *---------------------------------------------------------------------* ASLCSECT DC CL8'ASLSUBCM' ********* CSECT Name *********** ASLMODV DC CL8'3.1' **** Version Information **** DC CL24'Written BY K E Ferguson ' DC C'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 *---------------------------------------------------------------------* ST R13,8(R15) Cross save save areas ST R15,4(R13) Cross save save areas L R2,0(R1) Point to passed parms XR R4,R4 CLear R4 ready for Length LH R4,0(R2) Length of parms LTR R4,R4 Any parm? BZ Normal No - Jump to normal processing C R4,=F'4' Is it the correct length BNE Parm_Error MVC Reply,2(R2) Move in our reply OC Reply,=4X'40' Fold to upper case OI Flag,Parm_on Set the flag for parm processing Normal DS 0H XR R5,R5 Clear r5 ST R5,Active Initialise counter ST R5,Inactive Initialise counter DEVTYPE =CL8'NOCHECK ',CVBAREA Check for NOCHECK DD Card BXH R15,R15,Skip_Check If we don't OI Flag,NOCheck Set flag for no jobname check DEVTYPE =CL8'DB2 ',CVBAREA DB2 DD? BXH R15,R15,No_DB2 If we don't OI Flag,DB2 Set flag for DB2 command MVC LISTWTO+4(L'DB2WTO),DB2WTO Move in DB2 message MVC myCommand+6(10),=C'STOP DB2 ' Set to STOP DB2 No_DB2 DS 0H DEVTYPE =CL8'START ',CVBAREA START DD? BXH R15,R15,No_Start If we don't OI Flag,STARTDD Set flag for START command MVC STOP,=C'STAR' Indicate start No_Start DS 0H DEVTYPE =CL8'STOP ',CVBAREA STOP DD? BXH R15,R15,No_Stop If we don't TM Flag,STARTDD Have we had a STARTDD? BO Conflict1 Yes - Go and issue message. OI Flag,STOPDD Set flag for STOP command MVC STOP,=C'STOP' Set to STOP No_Stop DS 0H L R8,ACTIVE Set counter type TM Flag,STOPDD Stop command? BO Get_It Go and start processing TM Flag,STARTDD Start command? BO Set_4_Start Go and start processing B NoDD Go and issue message then fail Skip_Check DS 0H * ** The following code between these two comment blocks will *** determine if the current jobname is valid for the execution *** if you need to change the names do so here or use a NOCHECK ** DD card. You can also uncomment the line below. * * B Set_4_Start ***** Uncomment this line to skip ***** * L R5,CVTPTR Point to CVT ... USING CVT,R5 ... and establish addressability L R1,0(0,R5) TCB Address L R1,4(0,R1) Get our TCB Address L R1,12(0,R1) TIOT Address MVC Jobname,0(R1) Move in our jobname L R8,ACTIVE Set counter type CLC Stop,=c'STOP' Stopping? BE GET_It LA R8,8 Set condition code 8 CLC Stop,=c'STAR' Starting? BNE Job_Error No - go and exit * ** End of jobname check * Set_4_Start DS 0H L R8,Inactive Set inactive counter TM Flag,DB2 DB2 systems? BNO Set_StartQM MVC myCommand+5(10),=C'START DB2 ' Change to start MVC LISTWTO+37(9),=c'inactive:' J Get_It Set_StartQM DS 0H MVC myCommand+5(10),=C'START QMGR' Change to start MVC LISTWTO+37(9),=c'inactive:' Get_It DS 0H L R5,CVTPTR Point to CVT ... BAS R10,Get_Subsys LR R3,R8 Copy R8 into R3 XR R2,R2 Clear R2 for multiply M R2,=F'10' Multiply by 10 ST R3,Area_Size Save area size STORAGE OBTAIN,ADDR=(1),LENGTH=(3) LTR R15,R15 Did it work? BNZ Obtain_Failed No - Error otu ST R1,Gotten_Addr Save the address ST R8,MyCount Save R8 as count XR R8,R8 OI Flag,Fill_It Set flag L R4,Gotten_Addr Get Address of save area L R5,CVTPTR Point to CVT ... USING CVT,R5 ... and establish addressability BAS R10,Get_Subsys TM Flag,Parm_on Did we have a passed parm? BO Skip_WTO Yes - Skip WTO L R8,MyCount Check the count LTR R8,R8 Any? BZ No_Match No - Issue message * ** This will account for the title line and the line of Qmgrs * LR R3,R8 Counter to qmgrs XR R2,R2 Clear for divide D R2,=F'8' Divide by 8 LA R3,1(R3) Add one ST R3,Quotient Save R3 LA R3,1(R3) Add number of WTO lines XR R9,R9 Clear R9 for wto line count ICM R9,B'0001',WTO_COUNT Get the count CR R3,R9 Check to see if we have room BH Too_Small If not - get out ST R3,WTO_CNT Save the count in the WTO L R3,Quotient Reload R3 with quotient L R4,Gotten_Addr Get Address of save area LA R10,WTO_Line1 Point at first usable WTO line Add_Loop DS 0H LR R5,R2 Use R5 for Qmgrs per line C R3,=F'1' Is it only one line needed? BE Skip_Setting Yes - Don't set LA R5,8 Queue managers per line Skip_Setting DS 0H MVC 0(4,R10),0(R4) Move in subsystem name MVI 4(R10),c',' Comma LA R10,6(R10) Up the WTO LA R4,10(R4) Up the table too BCT R5,Skip_Setting C R3,=F'1' Is it the last one? BNE Skip_up No - Go up to the next WTO line BCTR R10,0 Reduce BCTR R10,0 Reduce again MVI 0(R10),c' ' Drop the last comma ... B Not_Next ... and move on Skip_up DS 0H LA R10,4(R10) Up to next WTO line ... BCT R3,Add_Loop ... and process it again Not_Next DS 0H MVC WTO_Count,Count_Int Move the list in L R3,Quotient Reload quotient LA R10,WTO_Line1 Point at start of WTO BCTR R3,0 Reduce by 1 LTR R3,R3 Zero? BZ Drop_Out No - process it Go_Along DS 0H LA R10,52(R10) Next one BCT R3,Go_Along Bubble up Drop_out DS 0H BCTR R10,0 Reduce by 1 ... BCTR R10,0 ... and again. MVC 0(2,R10),Flag_End Indicate end of list WTO MF=(E,LISTWTO) ... and then issue it ST R1,msgAddr Store message address Re_issue DS 0H MVC Reply,=C' ' Clear the reply field WTOR 'Enter subsystem name or Quit',Reply,4,MyECB WAIT ECB=MyECB Wait for reply XC MyECB,MyECB Reset ECB OC Reply,=4X'40' Fold to upper case CLC Reply,=c'QUIT' Quit? BE Exit_Out Yes - Go and exit the program CLC Reply,=c'END ' Support for END added BE Exit_Out Yes - Go and exit the program CLC Reply,=c'EXIT' EXIT? BE Exit_Out Yes - Go and exit the program Skip_Wto DS 0H L R4,Gotten_Addr Get table address L R3,MyCount Count of subsystems Check_Loop DS 0H CLC Reply,0(r4) Subsys match? BE Go_For_it Yes - Try and close it * LA R4,10(R4) Next one ... BCT R3,Check_Loop ... and check next subsystem TM Flag,Parm_on Did we have a passed parm? BO Parm_Wrong Yes - go issue message WTO 'ASLSB01E - Invalid subsystem name. Retry', x ROUTCDE=(2),DESC=(1),MF=L B Re_issue Go_For_it DS 0H MVC myCommand(5),5(R4) Move in subsystem name MODESET KEY=ZERO,MODE=SUP Get into supervisor state XR R0,R0 Get ready for SVC 34 LA R1,CMDL Point to command SVC 34 MODESET KEY=NZERO,MODE=PROB Back to problem state Exit_Out DS 0H L R1,MsgAddr Get ready for DOM DOM MSG=(R1) Delete the messages XR R8,R8 Set condition code to 0 Exit_out2 DS 0H L R1,Gotten_Addr Save the address L R3,Area_Size Size of area to release STORAGE RELEASE,ADDR=(1),LENGTH=(3) Exit_out3 DS 0H LR R15,R8 Condition code into R15 PR , Return to caller *---------------------------------------------------------------------* * GET_SUBSYS Subroutine * *---------------------------------------------------------------------* Get_SUBSYS DS 0H L R11,CVTJESCT Get CVT entry for JESCT ... USING JESCT,R11 ... and address it DROP R5 L R5,JESSSCT Get SSCT address ... USING SSCT,R5 ... and establish addressability SSCT_Loop DS 0H CLC SSCTID,=C'SSCT' Make sure we point to SSCT BNE Logic_error Error out if we don't L R6,SSCTSUSE Load user area LTR R6,R6 Do we have one? BZ Next_SSCT No - branch to step up SSCT TM SSCTSUSE,B'10000000' Is the SSCTSUSE usable? BO Next_SSCT No - go get next SSCT CLC 4(4,R6),=C'ERLY' Is it early load code? BNE Next_SSCT No - branch to step up SSCT TM Flag,DB2 Processing DB2? BNO Do_MQ CLC 84(8,R6),=C'DSN3EPX ' Is it DB2 Series early load? BNE Next_SSCT No - Forget it and get next SSCT B Process_DB2 Now jump to process DB2 Do_MQ DS 0H CLC 84(8,R6),=C'CSQ3EPX ' Is it MQ Series early load? BNE Next_SSCT No - Forget it and get next SSCT Process_DB2 DS 0H TM Flag,Parm_on Did we have a passed parm? BNO Get_SSVT No - Go get next SSVT CLC REPLY,SSCTSNAM Ours? BNE Get_SSVT No - Go get next SSVT OI Flag,Good_Sys Yes - Set the flag Get_SSVT DS 0H L R7,SSCTSSVT Get the SSVT address L R3,4(R7) Is it active? LTR R3,R3 Is it active? BNZ Active_MQ Yes - Skip CLC Stop,=c'STOP' Stopping? BE Next_SSCT Yes - Skip to next SSCT LA R8,1(R8) Add one B Check_Fill Go check to see if we are filling Active_MQ DS 0H CLC Stop,=c'STOP' Stopping? BNE Next_SSCT Yes - Skip to next SSCT LA R8,1(R8) Add one Check_Fill DS 0H TM Flag,Fill_it Filling it? BNO Next_SSCT No - Go and get next SSCT MVC 0(4,R4),SSCTSNAM Move subsystem name to save area MVC 5(5,R4),102(R6) Move is subsystem recognition TM Flag,DB2 Process DB2? BNO Incr_R10 No - Jump to go up R10 MVC 5(5,R4),112(R6) Move is subsystem recognition Incr_R10 DS 0H LA R4,10(R4) Bubble up to next entry Next_SSCT DS 0H L R5,SSCTSCTA Next SSCT LTR R5,R5 Do we have one? BNZ SSCT_Loop Yes - Loop back to process it BR R10 Return to caller *---------------------------------------------------------------------* * End of GET_SUBSYS Subroutine * *---------------------------------------------------------------------* * Error Routines * *---------------------------------------------------------------------* Job_Error DS 0H MVC JOBWTO+19(8),Jobname Move jobname to message MVC JOBWTO+50(8),ASLCSECT Move program name to message JOBWTO WTO 'ASLSB11E - xxxxxxxx invalid for executing ASLCSECT', x ROUTCDE=(2),DESC=(1) B Dump Too_Small DS 0H WTO 'ASLSB12E - Insufficient WTO lines available', x ROUTCDE=(2),DESC=(1) Support DS 0H WTO 'ASLSB12C - Contact site support staff', x ROUTCDE=(2),DESC=(1) B Dump Conflict1 DS 0H WTO 'ASLSB10E - Both START and STOP DD cards found.', x ROUTCDE=(2),DESC=(1) B Dump NoDD DS 0H WTO 'ASLSB02E - Invalid run. No STOP or START DD card', x ROUTCDE=(2),DESC=(1) LA R8,20 Set return code 20 ... B Exit_Out3 ... and then go and end Parm_Wrong DS 0H TM Flag,Good_Sys Was it a valid subsystem? BNO Not_Valid No - go and issue the message LA R8,4 Set Condition code 4 CLC Stop,=C'STOP' Stopping? BE Already_Stopped Yes - Go and issue message MVC WTO2+19(4),REPLY Move in subsystem name WTO2 WTO 'ASLSB03W - already started', x ROUTCDE=(2),DESC=(1) B Exit_Out2 Now go out Already_Stopped DS 0H MVC WTO3+19(4),REPLY Move in subsystem name WTO3 WTO 'ASLSB04W - already stopped', x ROUTCDE=(2),DESC=(1) B Exit_Out2 Now go out Not_Valid DS 0H MVC WTOK+29(4),REPLY Move passed name to WTO WTOK WTO 'ASLSB05E - Subsystem xxxx not defined on system. RC=12' LA R8,12 Set condition code 12 B Exit_Out2 Go and get out No_Match DS 0H WTO 'ASLSB06E - No applicable subsystems. RC=16' LA R8,16 Set condition code 16 B Exit_Out3 Now go and bug out Parm_Error DS 0H WTO 'ASLSB07E - Invalid parameter length. Abend S0C3' B Dump Now go and bug out Obtain_Failed DS 0H WTO 'ASLSB08E - Storage obtain failed. Contact site support x staff' B Dump Now go and bug out Logic_Error DS 0H MVC WTO_Logic+19(4),SSCTID Put what we found into WTO ... WTO_Logic WTO 'ASLSB09E - xxxx found where SSCT should be' Dump DS 0H WTO 'ASLSB99E - Program abend S0C3',ROUTCDE=(2),DESC=(1) Dumper EX R15,Dumper Crash out *---------------------------------------------------------------------* *-* Storage Areas *-* *---------------------------------------------------------------------* CVBAREA DS D Workarea for DEVTYPE Quotient DS F For WTO line calculation and loop MsgAddr DS F Message area for DOM Active DS F Count of active subsystems Inactive DS F Count of Inactive subsystems Gotten_Addr DS F Obtained storage address Area_Size DS F Size of Obtained area MyCount DS F Count of how many QMgrs we have MyECB DS F ECB for WTOR Reply DS CL4 For WTOR reply Flag DS CL1 Flag Parm_on EQU B'00000001' Parameter Flag Fill_It EQU B'00000010' Fill the subsystem table flag Good_Sys EQU B'00000100' Subsystem found flag NOCheck EQU B'00001000' NOCHECK DD card found flag STOPDD EQU B'00010000' STOP DD card found flag STARTDD EQU B'00100000' START DD card found flag DB2 EQU B'01000000' DB@ DD card found flag WTO_CNT DS F Count of WTO lines Count_int EQU WTO_CNT+3,1 Real count of lines Flag_End DC XL2'3000' CMDL DS 0F Command Format for SVC 34 DC AL2(CMDLEN),AL2(00) Length of string myCommand DC C'%xxxx STOP QMGR ' Command CMDLEN EQU *-CMDL Length of command string CMDAREA DS 0F,XL(CMDLEN) Area for command JOBNAME DS CL8 Our Jobname STOP EQU Jobname+0,4 Stop or start DB2WTO DC C'The following DB2 subsystems are active: ' LISTWTO WTO (' The following MQ subsystems are active: ',D), X (' ',D), X (' ',D), X (' ',D), X (' ',D), X (' ',DE), X ROUTCDE=(2),DESC=(1),MF=L Wto_Line1 EQU LISTWTO+58,52 Line 1 text area Wto_end1 EQU LISTWTO+56,2 End for 1 line of WTO Wto_Line2 EQU LISTWTO+110,52 Line 2 text area Wto_end2 EQU LISTWTO+108,2 End for 2 lines of WTO Wto_Line3 EQU LISTWTO+162,52 Line 3 text area Wto_end3 EQU LISTWTO+160,2 End for 3 lines of WTO Wto_Line4 EQU LISTWTO+214,52 Line 4 text area Wto_end4 EQU LISTWTO+212,2 End for 3 lines of WTO Wto_Line5 EQU LISTWTO+266,52 Text area for line 5 Wto_Count EQU LISTWTO+53,1 Count of WTO lines used *---------------------------------------------------------------------* 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 * *---------------------------------------------------------------------* * End of ASLSUBCM * *---------------------------------------------------------------------* LTORG IEFJSCVT CVT DSECT=YES IEFJESCT TYPE=DSECT END ASLSUBCM PUNCH ' MODE AMODE(31)' BINDER AMODE STATEMENT. PUNCH ' MODE RMODE(ANY)' BINDER RMODE STATEMENT. PUNCH ' ENTRY ASLSUBCM' MODULE ENTRY POINT. PUNCH ' NAME ASLSUBCM(R)' MODULE NAME. END