PRINT NOGEN GBLC &ASLCPY &ASLCPY SETC 'ABBYDALE SYSTEMS LLC.' MACRO &LAB EYECATCH GBLB &EYECAT AIF (&EYECAT).ERROR &EYECAT SETB 1 * ******************************************************************* * * * * E Y E C A T C H * * * * PUT INFORMATION INTO THE LOAD MODULE SO THAT IT CAN BE EASILY * * IDENTIFIED IN A DUMP ETC. * * * B END_EYECATCHER SKIP THE CONSTANTS * * * * ASSEMBLY INFORMATION - DATE, TIME AND CSECT NAME FOLLOW * * * DC CL8'&LAB' *** CSECT Name * DC C'VERSION 7.0' *** Version Identifier * * * DC CL24'WRITTEN BY K E FERGUSON ' * DC C'Copyright Abbydale Systems LLC. 1997 - ' * * * DC CL8'&SYSDATC' **** ASSEMBLY DATE (YYYYMMDD) **** * DC CL6' &SYSTIME' ***** ASSEMBLY TIME (HH.MM) ****** * DS 0H Align * * * END_EYECATCHER DS 0H * * K.E.F. * * ******************************************************************* * MEXIT .ERROR MNOTE *,'EYECATCH MACRO ALREADY ISSUED' MEND MACRO &NAME JOBNAME &A 00000200 LCLC &LAB AIF (K'&A NE 0).LABOK &LAB SETC 'ASLJOBNM' MNOTE 0,'***** NO AREA NAME SPECIFIED, ASLJOBNM USED ********' AGO .LABCNT .LABOK ANOP &LAB SETC '&A' .LABCNT ANOP * ******************************************************************* * * * * J O B N A M E * * * * GET CURRENT JOBNAME INTO STORAGE AREA * * * &NAME L 1,16 CVT ADDRESS * 00000300 L 1,0(0,1) TCB WORDS ADDRESS * 00000400 L 1,4(0,1) OUR TCB ADDRESS * 00000500 L 1,12(0,1) TIOT ADDRESS * 00000600 MVC &LAB,0(1) MOVE IN JOBNAME * B $JOBEXIT AND EXIT * AIF ('&LAB' EQ 'ASLJOBNM').SKIPA &LAB DS CL8 * .SKIPA ANOP $JOBEXIT DS 0H * * * * K.E.F * * ******************************************************************* * MEND 00000700 ASLBR14 TITLE 'IEFBR14 REPLACEMENT - &ASLCPY' ASLBR14 CSECT ASLBR14 AMODE 31 ASLBR14 RMODE ANY USING ASLBR14,R15 Temporary base ASLBR14 EYECATCH * ******************************************************************* * * * * PURPOSE - TO WAIT FOR XX SECONDS THEN END COND CODE WITH PASSED * * CONDITION CODE * * * * ******************************************************************* * START BAKR 14,0 LR R12,R15 DROP R15 USING ASLBR14,R12 <=== Program base register L R4,0(R1) Save address of pass parameters LA R2,WORKAREA_LENGTH Set length for workarea STORAGE OBTAIN,ADDR=(1),SP=0,LENGTH=(R2),LOC=BELOW LTR R15,R15 Did we work? BNZ CRUNCH If not - Go to abend LR R13,R1 Set up save area address USING WORKAREA,R13 MVC 4(4,R13),=CL4'F1SA' Stack Identifier * ** Handle the parms now * MVC DELAY,DELAYC Set default delay interval MVC WTOLIST,WTODUM move in skeleton XC ABEND_CODE(4),ABEND_CODE JOBNAME JOBNAME Find our jobname JOB01 XC FLAG,FLAG Clear flags LR R2,R4 R2 => Parms ST R2,SAVER2 Save it for safety MVI FIRST_TIME,c'Y' DEVTYPE =CL8'STARTMSG',CVBAREA Check for INPUT LTR R15,R15 Did we find one? BZ Process_dd Yes - Go and process messages DEVTYPE =CL8'PRESYSIN',CVBAREA Check for INPUT LTR R15,R15 Did we find one? BNZ Reload_R2 Yes - Go and process messages Process_dd DS 0H BAS R10,MESSAGE Go to process the messages Reload_R2 DS 0H MVI FIRST_TIME,c'N' L R2,SAVER2 Reload R2 LH R4,0(R2) Load R4 with length XR R7,R7 Clear R7 LTR R4,R4 any PARMS passed? BZ SETDEFLT NO - Go and set the defaults LA R2,2(R2) Point to start of parms PARMLOOP DS 0H <========+ CLI 0(R2),X'00' ¦ * BE PARM_END ¦ ** Are we at end of parms yet? CLI 0(R2),X'FF' ¦ ** Yes - Go wait then end BE PARM_END ¦ * CLC 0(3,R2),=C'RC=' ¦ Was "RC=" passed ? BE SETRC ¦ YES - Go to return code process CLC 0(3,R2),=C'CC=' ¦ Was "CC=" passed ? BE SETRC ¦ YES - Go to return code process CLC 0(5,R2),=C'COND=' ¦ Was "COND=" passed ? BE SETRC ¦ YES - Go to return code process CLC 0(5,R2),=C'CODE=' ¦ Was "CODE=" passed ? BE SETRC ¦ YES - Go to return code process CLC 0(6,R2),=C'ABEND=' ¦ Was "ABEND=" passed? BE SETABEND ¦ YES - Go to ABEND Processing CLC 0(6,R2),=C'NOWAIT' ¦ Was "NOWAIT" passed ? BE CLEAR_WAIT ¦ Yes - Clear delay CLC 0(5,R2),=C'WAIT=' ¦ Was "WAIT=" passed ? BNE PARM_INVALID ¦ Error it out CLi 5(R2),c'0' bne SET_THE_WAIT CLI 6(R2),x'00' be CLEAR_WAIT CLI 6(R2),x'ff' be CLEAR_WAIT SET_THE_WAIT DS 0H BAS R9,SETWAIT ¦ Go and process the WAIT= B PARMLOOP =======>+ Loop return Clear_wait DS 0H XC DELAY,DELAY LA R2,6(R2) B PARMLOOP * ** End of Parm Checking * PARM_INVALID DS 0H WTO 'BSLBR01E - INVALID PARMS SPECIFIED - WAIT 20 USED' WTO 'BSLBR01E - INVALID PARMS SPECIFIED - RETURN CODE 0000 UX SED' SETDEFLT DS 0H set default values MVC DELAY,DELAYC Set default delay NOPARM DS 0H PARM_END DS 0H CLC ABEND_CODE,=X'00000000' BNE ABENDIT BAS R9,STIMER Go and issue the STIMER BAS R10,MESSAGE Go to process the messages L R5,Abend_code EXIT DS 0H LA R2,WORKAREA_LENGTH Set length for Release LR 1,13 Restore savearea L 13,4(1) STORAGE RELEASE,ADDR=(1),SP=0,LENGTH=(R2) LR 15,7 Set condition code & PR , Exit * ** Program End * *********************************************************************** *** M E S S A G E S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - CHECK FOR ANY SYSIN AND ISSUE MESSAGES FROM IT *** *** EXIT - VIA REGISTER 10 *** *********************************************************************** MESSAGE DS 0H OI FLAG,X'04' Set flag XR R5,R5 Clear R5 for a work register MVC MQN_EXTRACT(MQN_EXTLEN),MQN_EXTRACT_SKEL LA R3,MQN_TIOTADDR Address for the TIOT EXTRACT (R3),FIELDS=TIOT,MF=(E,MQN_EXTRACT) L R6,MQN_TIOTADDR Load R6 with returned address USING TIOT,R6 Addressability to the TIOT NEXT_TIOT_ENTRY DS 0H <====+ ICM R5,1,TIOELNGH ¦ Was there one? BZ END_OF_TIOT ¦ No - Exit TIOT loop CLI FIRST_TIME,C'N' ¦ First time? BE SKIP_PRE ¦ CLC TIOEDDNM,=C'STARTMSG' ¦ Is it an INPUT? BE OPEN_SYSIN =========>+ ¦ Yes - Go open it CLC TIOEDDNM,=C'PRESYSIN' ¦ Is it an INPUT? BE OPEN_SYSIN =========>+ ¦ Yes - Go open it B UP_THE_TIOT ¦ Drop out SKIP_PRE DS 0H ¦ CLC TIOEDDNM,=C'INPUT ' ¦ Is it an INPUT? BE OPEN_SYSIN =========>+ ¦ Yes - Go open it CLC TIOEDDNM,=C'MSGS ' ¦ ¦ Is it an MSGS? BE OPEN_SYSIN =========>+ ¦ Yes - Go open it CLC TIOEDDNM,=C'SYSIN ' ¦ ¦ Is it a SYSIN? BE OPEN_SYSIN ==========+ ¦ Yes - Go open it UP_THE_TIOT DS 0H ¦ ¦ LA R6,0(R5,R6) ¦ ¦ Next one B NEXT_TIOT_ENTRY ======¦==+ Loop back OPEN_SYSIN DS 0H <=========+ MVC SYSIN(SKELEN),SYSINK MVC SYSINX(SKELENX),SYSINXK MVC SYSIN+40(8),TIOEDDNM Move in the actual ddname DROP R6 LA R6,SYSIN OPEN ((6),(INPUT)),MODE=31 AND OPEN IT LTR R15,R15 Did we work? BNZ NOMORE No - branch to return CRDIN DS 0H <===========+ Read SYSIN LA R6,SYSIN ¦ Point to DCB GET (6) ¦ Get message LR R2,R1 ¦ Save returned address in R2 CLI FIRST_TIME,c'Y' BE SKIP_WAIT CLC 0(5,R2),=C'WAIT=' ¦ WAIT= ? BE SETSWAIT ¦ YES - GO and set wait CLC 0(6,R2),=C'NOWAIT' ¦ NOWAIT ? BNE IS_A_GO ¦ YES - GO and skip wait XC DELAY,DELAY B GO_TO_LOOP_RETURN ¦ YES - GO and skip wait * BE SKIP_WAIT ¦ YES - GO and skip wait IS_A_GO DS 0H BAS R9,STIMER ¦ Else Go to STIMER routine SKIP_WAIT DS 0H MVC WTOLIST+4(80),0(R2) ¦ move message to WTO BAS R9,REPLACE_JOBNAME JOB02 Leave_alone DS 0H ¦ JOB01 WTO MF=(E,WTOLIST) ¦ and then issue it MVI WTOLIST+4,C' ' ¦ Clear wto MVC WTOLIST+5(79),WTOLIST+4 ¦ GO_TO_LOOP_RETURN DS 0H ¦ B CRDIN ==========>+ Loop return for GET SETSWAIT DS 0H BAS R9,SETWAIT Go and wait again B GO_TO_LOOP_RETURN Go and read next card CARDEND DS 0H LA R6,SYSIN Point to DCB CLOSE ((6)),MODE=31 and close it NOMORE DS 0H END_OF_TIOT DS 0H NI FLAG,B'11111011' Turn flag off BR R10 and return *** END OF SUBROUTINE MESSAGE ***************************************** SPACE 4 *********************************************************************** *** S T I M E R S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - TO WAIT FOR 20 SECONDS *** *** EXIT - VIA REGISTER 9 *** *********************************************************************** STIMER DS 0H STIMER WAIT,BINTVL=DELAY WAIT for a while BR R9 Return to caller *** END OF SUBROUTINE STIMER ****************************************** SPACE 4 *********************************************************************** *** V A L I D A T E S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - TO VALIDATE PARAMETERS *** *** EXIT - VIA REGISTER 11 *** *********************************************************************** VALIDATE DS 0H XR R6,R6 Clear R6 LR R5,R2 Point to start XC DOUBLE,DOUBLE Clear work area LA R3,WORK+4 Set where to put it VALIDATE_LOOP DS 0H <=======+ CLI 0(R2),X'00' ¦ * BE ENDPARM ¦ ** CLI 0(R2),C',' ¦ *** Are we at end of parm BE ENDPARM_2 ¦ **** yet? CLI 0(R2),C' ' ¦ **** BE ENDPARM ¦ *** CLI 0(R2),X'FF' ¦ ** BE ENDPARM ¦ * CLI 0(R2),C'0' ¦ * BL INVALID ¦ ** If not, validate for numerics CLI 0(R2),C'9' ¦ ** BH INVALID ¦ * LA R2,1(R2) ¦ Up to the next character LA R6,1(R6) ¦ add one to counter BCTR R3,0 ¦ Down the destination field B VALIDATE_LOOP ==>+ Loop return ENDPARM_2 DS 0H LA R2,1(R2) Skip the comma ENDPARM DS 0H TM FLAG,x'10' are we doing WAIT? BO TEST_FOR_DUPLICATE_WAIT TM FLAG,X'20' are we doing RC=? BO TEST_FOR_DUPLICATE_RC ALLS_WELL DS 0H LTR R6,R6 Did we find a wait interval? BZ INVALID If not - write error message C R6,=F'4' If length specified > 4 then BH INVALID go write out error message BCTR R6,0 Subtract 1 for move EX R6,MOVE_WORK Move the parm PACK WORK,WORK Pack it TM FLAG,b'00100000' Are we doing RC ? BO SET_PACK If yes - just set pack digit L R5,WORK Load wait interval into R5 SRL R5,4 Drop the F SLL R5,12 Now multiply by 100 ST R5,WORK and resave it SET_PACK DS 0H OI WORK+3,X'0F' Force the pack digit in CVB R5,DOUBLE Convert wait time to binary XR R15,R15 Set Condition code LEAVE_VALIDATE DS 0h BR R11 & Return to caller INVALID DS 0H LA R15,8 Set RC = 8 B LEAVE_VALIDATE TEST_FOR_DUPLICATE_WAIT DS 0H TM FLAG,X'01' Have we had one? BO IGNORE_WAIT Yes - ignore it then B ALLS_WELL TEST_FOR_DUPLICATE_RC DS 0H TM FLAG,X'02' Have we had one? BO IGNORE_RC Yes - ignore it then B ALLS_WELL *** END OF SUBROUTINE VALIDATE **************************************** SPACE 4 *********************************************************************** *** W A I T V A L I D A T E S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - TO VALIDATE PASSED WAIT PARAMETER *** *** EXIT - VIA R9 *** *********************************************************************** SETWAIT DS 0H LA R2,5(R2) Skip "WAIT=" OI FLAG,X'10' Indicate we are doing WAIT BAS R11,VALIDATE NI FLAG,B'11101111' Turn it off * ** Come to here at end of WAIT parameter * LTR R15,R15 Did it work? BNZ INVWAIT No - Issue message STORE_DELAY DS 0H ST R5,DELAY Save Delay TM FLAG,X'04' Are we process the SYSIN? BO IGNORE_IT Yes - Skip setting the flag OI FLAG,X'01' Flag that we have had one IGNORE_IT DS 0H * BR R9 Return to caller * INVWAIT WTO 'BSLBR02E - INVALID WAIT TIME PASSED - WAIT 20 USED' MVC DELAY,DELAYC Set default delay interval B IGNORE_IT and loop back IGNORE_WAIT DS 0H WTO 'BSLBR09E - DUPLICATE PARM WAIT= FOUND. FIRST VALUE USED' B IGNORE_IT and loop back *** END OF SUBROUTINE MESSAGE ***************************************** SPACE 4 *********************************************************************** *** R E T U R N C O D E S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - TO VALIDATE PASSED RETURN CODE *** *********************************************************************** SETRC DS 0H CLC 0(2,R2),=C'CO' Was "COND=" or "CODE=" passed ? BNE SKIP_THREE YES - Go to return code process LA R2,2(R2) Skip "CO" SKIP_THREE DS 0H LA R2,3(R2) Skip "CC=", RC=, DE= or ND= OI FLAG,X'20' Indicate we are doing RC BAS R11,VALIDATE Validate it * LR R0,R15 NI FLAG,B'11011111' Turn it off LTR R15,R15 Did it work? BZ SKIP_INVALID No - Issue message RCINV WTO 'BSLBR03I - NO RETURN CODE SPECIFIED 0000 USED' B PARMLOOP Go to PARM_END Processing * ** At this point we have got to the end of the RC passed * SKIP_INVALID DS 0H LTR R6,R6 Have we had a return code numeric? BM RCINV If not - write error message C R6,=F'4' Was it > 4 characters in length? BH RC_INVALID If yes - write error message BCTR R6,0 Subtract one for execute LR R7,R5 Move it to R7 OI FLAG,X'02' Set flag B PARMLOOP <===== Go back to parm processing RC_INVALID DS 0H WTO 'BSLBR04E - INVALID NUMERICS IN RC= PARAMETER. PARM IGNOX RED' CRUNCH EX 15,CRUNCH Bomb out S0C3 IGNORE_RC DS 0H WTO 'BSLBR08E - DUPLICATE PARM RC= FOUND. FIRST VALUE USED' B PARMLOOP <===== Go back to parm processing *** END OF RETURN CODE SUBROUTINE ************************************* SPACE 4 *********************************************************************** *** A B E N D C O D E S U B R O U T I N E *** ***-----------------------------------------------------------------*** *** PURPOSE - TO VALIDATE ABEND CODE PASSED AS PARAMETER *** *********************************************************************** SETABEND DS 0H LA R2,6(R2) Skip "ABEND=" * ** Now validate Abend code * GETABEND DS 0H XR R5,R5 Clear R5 ready for Abend Code CLI 0(R2),C'U' User ABEND ? BE USRABEND Yes - Process it CLI 0(R2),C'S' System ABEND ? BE USRABEND Yes - Process SYSTEM ABEND Invalid_Abend DS 0H WTO 'BSLBR06E - INVALID ABEND CODE SPECIFIED U0001 USED' LA R5,1 Set default of USER 0001 ST R5,ABEND_CODE ABENDIT DS 0H BAS R9,STIMER Go wait BAS R10,MESSAGE Go to process the messages * LR R1,R5 Now set Abend code & L R1,ABEND_CODE Now set Abend code & SVC 13 Issue ABEND SVC USRABEND DS 0H LA R3,1(R2) Point to start of code XR R1,R1 Clear counter LA R4,4 CLI 0(R2),C'S' BE SKIP_ADD LA R4,1(R4) Skip_Add DS 0H LA R5,WORK+3 MVC WORK,=C'0000' Prime WORK area Loop_For DS 0H CLI 0(R3),C',' Comma? BE Leave_Loop_For CLI 0(R3),X'00' Low value? BE Leave_Loop_For CLI 0(R3),X'FF' High value? BE Leave_Loop_For CLI 0(R3),c'0' High value? BL CHeck_SABEND CLI 0(R3),c'9' High value? BH Invalid_Abend Abend_OK DS 0H LA R1,1(R1) Increase counter LA R3,1(R3) Next character BCTR R5,0 Back up work area BCT R4,Loop_for Loop return B Invalid_abend Check_SABEND DS 0H CLI 0(R2),c'S' BNE Invalid_Abend CLI 0(R3),c'A' BL Invalid_Abend CLI 0(R3),c'F' BH Invalid_Abend B Abend_ok Leave_Loop_For DS 0H BCTR R1,0 LA R5,1(r5) EX R1,Move_to_work CLI 0(R2),c'S' System Abend? BE SYSTEM_ABEND PACK WORK,WORK PACK THE RETURN CODE CVB R5,DOUBLE CONVERT IT TO BINARY Store_abend DS 0H ST R5,ABEND_CODE CLI 0(R3),c',' More parms? BNE ABENDIT LR R2,R3 LA R2,1(R2) Skip the comma B PARMLOOP ABINV WTO 'BSLBR05E - NO ABEND CODE SPECIFIED - IGNORED' B PARMLOOP and return to PARM processing SYSTEM_ABEND DS 0H MVC WORK+0(1),=X'00' LA R10,WORK TR 0(4,R10),TRTABLE TEST FOR VALID START CHARACTER L R5,WORK SLL R5,12 ST R5,WORK LA R10,WORK OC DUMMY+0(1),0(R10) L R5,WORK SLL R5,4 ST R5,WORK OC DUMMY+0(1),0(R10) L R5,WORK SLL R5,12 ST R5,WORK OC DUMMY+1(1),0(R10) L R5,DUMMY SRL R5,8 ST R5,ABEND_CODE B Store_Abend ST R5,WORK BAS R9,STIMER L R1,WORK SVC 13 ISSUE ABEND SVC *** END OF ABEND CODE SUBROUTINE ************************************* SPACE 4 *********************************************************************** *** REPLACE_JOBNAME Subroutine *** ***-----------------------------------------------------------------*** *** Use: Replaces all @JOBNAME variables to the jobname of *** *** the job running the program *** *** Exit: Exit via R9 *** *********************************************************************** REPLACE_JOBNAME DS 0H STM R2,r5,SAVE_R5 LA R5,71 LA R2,71 LA R3,WTOLIST+4 Test_again equ * XR R1,R1 Clear R1 ready for TRT EX R2,SCAN_FOR_AT Scan for @ BZ NO_AT If zero - skip MVC STORE_JOB,0(R1) Save our found @ OC STORE_JOB,=X'4040404040404040' Fold to Upper case CLC STORE_JOB+1(7),=C'JOBNAME' Now check for @JOBNAME BNE Skip_First_at if not it skip MVC 0(8,R1),JOBNAME SR R1,R3 LA R3,0(R1,R3) Skip if required LR R2,R5 LR R4,R3 SR R2,R1 Take it off the length B Test_again NO_AT DS 0H LM R2,R5,SAVE_R5 BR R9 Skip_First_at DS 0H SR R1,R3 LA R3,0(R1,R3) Skip if required LR R2,R5 LR R4,R3 SR R2,R1 Take it off the length bctr r2,0 LR R5,R2 Take it off the length la r3,1(r3) B Test_Again * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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 R E G E Q S * 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 * ********************************************************************* * Executes * ********************************************************************* MOVE_WORK MVC 0(*-*,R3),0(R5) Move WORK to workarea MOVE_TO_WORK MVC 0(*-*,R5),1(R2) Move WORK to workarea SCAN_FOR_AT TRT 0(*-*,R3),TRTABLE2 Scan for @Jobname ********************************************************************* * Constants and skeletons * ********************************************************************* SYSIND DCB DDNAME=SYSIN,DSORG=PS,MACRF=(GL),EODAD=CARDEND, X SYNAD=CARDEND DCB_LENGTH EQU *-SYSIND *---------------------------------------------------------------------* * SYSIN DCB. * *---------------------------------------------------------------------* SYSINK DCB DDNAME=DUMMY, Standard SYSIN DD. C DCBE=SYSINXK, Standard SYSIN DCB extension. C LRECL=80, 80 Byte input cards. C DSORG=PS, Physical sequential organization. C RECFM=FB, Fixed, blocked. C MACRF=(GL) Get macro, locate mode. Skelen EQU *-SYSINK *---------------------------------------------------------------------* * SYSIN DCB Extension. * *---------------------------------------------------------------------* SYSINXK DCBE EODAD=CARDEND, 31-Bit End of Data address. C SYNAD=CARDEND, 31-Bit End of Data address. C RMODE31=BUFF 31-Bit Buffer addressing. Skelenx EQU *-SYSINXK MQN_EXTRACT_SKEL EXTRACT MF=L MQN_EXTLEN EQU *-MQN_EXTRACT_SKEL WTODUM WTO '1234567890123456789012345678901234567890123456789012345x 6789012345678901234567890',ROUTCDE=(2,11),MF=L TRTABLE DC XL193'00' DC X'0A0B0C0D0E0F' DC XL41'00' DC X'00010203040506070809' DC XL2'00' ORG TRTABLE2 DC 256XL1'00' ORG TRTABLE2+C'@' DC CL1'@' ORG TRTABLE3 DC 256XL1'00' ORG TRTABLE3+C',' DC CL1',' ORG TRTABLE3+C' ' DC CL1',' ORG TRTABLE3+x'00' DC CL1',' ORG *********************************************************************** * ¦ THIS IS THE DEFAULT WAIT TIME * V DELAYC DC F'2000' WAIT 20 SECONDS *********************************************************************** LTORG TIOT DSECT IEFTIOT1 , WORKAREA DSECT WORKAREA_LENGTH EQU WORKAREA_END-WORKAREA SAVEAREA DS 18F DOUBLE DS 0D CVBAREA EQU DOUBLE,8 DS F WORK DS F ABEND_CODE DS F SAVER2 DS F SAVE_R5 DS 4F FZONES DC (4)C'0' FLAG DS CL1 FIRST_TIME DS CL1 STORE_JOB DS CL8 *---------------------------------------------------------------------* * SYSIN DCB. * *---------------------------------------------------------------------* SYSIN DCB DDNAME=DUMMY, Standard SYSIN DD. C DCBE=SYSINX, Standard SYSIN DCB extension. C LRECL=80, 80 Byte input cards. C DSORG=PS, Physical sequential organization. C RECFM=FB, Fixed, blocked. C MACRF=(GL) Get macro, locate mode. *---------------------------------------------------------------------* * SYSIN DCB Extension. * *---------------------------------------------------------------------* SYSINX DCBE EODAD=CARDEND, 31-Bit End of Data address. C SYNAD=CARDEND, 31-Bit End of Data address. C RMODE31=BUFF 31-Bit Buffer addressing. DDNAME EQU SYSIN+40,8 DELAY DS F DUMMY DS F MQN_TIOTADDR DS F MQN_EXTRACT EXTRACT MF=L WTOLIST WTO '1234567890123456789012345678901234567890123456789012345x 6789012345678901234567890',ROUTCDE=(2,11),MF=L WORKAREA_END EQU * DCBD DSORG=(PS) IHADCBE END ASLBR14 End of Assembly. PUNCH ' MODE AMODE(31)' Binder AMODE statement. PUNCH ' MODE RMODE(ANY)' Binder RMODE statement. PUNCH ' ENTRY ASLBR14' Binder Module Entry Point. PUNCH ' ALIAS BSLBR14' Binder Module Entry Point. PUNCH ' NAME ASLBR14(R)' Binder Module Name. END , End of Binder Input.