diff --git a/extract.asm b/extract.asm new file mode 100644 index 0000000..cf7fe8a --- /dev/null +++ b/extract.asm @@ -0,0 +1,145 @@ +//HERC01X JOB (HERC01), 00000100 +// 'MODIFY QEDIT EX ', 00000200 +// CLASS=A, 00000300 +// MSGCLASS=A,COND=(4,LT), 00000401 +// REGION=4M, 00000500 +// MSGLEVEL=(1,1) 00000600 +//********************************************************************* 00000700 +//* 00000800 +//PIC1 EXEC ASMFCG,PARM.ASM=(OBJ,NODECK),PARM.GO='/MODPGM2', 00000900 +// MAC1='SYS1.AMODGEN', 00001000 +// MAC2='SYS1.MACLIB' 00001100 +//ASM.SYSIN DD * 00001200 +MODPGM2 START 0 00001300 +* 00001400 +* WHERE I GOT MY CODE EXAMPLE: 00001500 +* 00001600 +* HTTPS://WWW.IBM.COM/DOCS/EN/ZOS/2.2.0?TOPIC=CONTROL-COMMUNICATING- 00001700 +* PROGRAM-EXTRACT-QEDIT 00001800 +* 00001900 +R0 EQU 0 00002000 +R1 EQU 1 00002100 +R2 EQU 2 00002200 +R3 EQU 3 00002300 +R4 EQU 4 00002400 +R5 EQU 5 00002500 +R6 EQU 6 00002600 +R7 EQU 7 00002700 +R8 EQU 8 00002800 +R9 EQU 9 00002900 +R10 EQU 10 00003000 +R11 EQU 11 00003100 +R12 EQU 12 00003200 +R13 EQU 13 00003300 +R14 EQU 14 00003400 +R15 EQU 15 00003500 + SPACE 3 00003600 + DS 0H 00003700 + STM R14,R12,12(R13) SAVE CALLERS REGISTERS 00003800 + BALR R12,0 COPY BASE REGISTER 00003900 + USING *,R12 TELL ASMBLR BASE REGISTER 00004000 + ST R13,SAVEAREA+4 SAVE CALLERS SAP 00004100 + LA R13,SAVEAREA POINT TO OUR SAVE AREA 00004200 + LR R4,R1 SAVE PARM POINTER 00004300 + SPACE 3 00004400 + LA R9,COMADDR GET COMMUNICATIONS AREA 00004500 +* ADDRESS AT COMADDR 00004600 +*------------------------------------------------------------------* 00004700 +* OBTAIN ADDRESS OF THE CIB * 00004800 +*------------------------------------------------------------------* 00004900 + EXTRACT (R9),FIELDS=COMM,MF=(E,EXTRACT) 00005000 +* EXTRACT THE COMMUNICATIONS AREA 00005100 + L R9,COMADDR GET ADDRESS OF THE AREA 00005200 + USING COM,R9 USE R9 AS BASE ADDRESS OF COMM AREA 00005300 + ICM R7,15,COMCIBPT GET CIB ADDRESS FROM COM AREA 00005400 + BZ NOCIB NO CIB, TASK WAS NOT STARTED 00005500 + BAL R14,DOCIB PROCESS THE CIB 00005600 +NOCIB DS 0H 00005700 + QEDIT ORIGIN=COMCIBPT,CIBCTR=5 SET MODIFY LIMIT TO 5 00005800 + L R1,COMECBPT GET ADDRESS OF THE COMMUNICATION ECB 00005900 + O R1,HIBITON SET HIGH BIT - LAST ECB IN LIST 00006000 + ST R1,MODECB PUT ADDR OF MODIFY ECB IN LIST 00006100 +* 00006200 +* 00006300 +* 00006400 +WAIT DS 0H 00006500 + WAIT 1,ECBLIST=ECBS WAIT FOR A MODIFY/STOP 00006600 +* 00006700 +* WHEN POSTED HERE, A MODIFY OR STOP HAS BEEN ISSUED 00006800 +* 00006900 + ICM R7,15,COMCIBPT GET CIB ADDRESS FROM COM AREA 00007000 + USING CIB,R7 BASE CIB MAPPING 00007100 + CLI CIBVERB,CIBMODFY WAS IT A MODIFY? 00007200 + BNE NOTMDFY NO, GO FREE CIB 00007300 + BAL R14,DOCIB IT WAS A MODIFY, GO PROCESS COMMAND 00007400 +* 00007500 +* 00007600 +* 00007700 +*------------------------------------------------------------------ * 00007800 +* FREE THE CIB * 00007900 +*------------------------------------------------------------------ * 00008000 +NOTMDFY DS 0H 00008100 + BAL R14,DELCIB FREE CIB 00008200 + CLI CIBVERB,CIBSTOP WAS IT A STOP? 00008300 + BE EXITRTN BRANCH TO ROUTINE HANDLING ERRORS 00008400 + B WAIT WAIT FOR ANOTHER MODIFY 00008500 +* . 00008600 +EXITRTN DS 0H 00008700 + WTO 'BYE BYE...' 00008800 + L R13,SAVEAREA+4 RELOAD CALLERS SAP 00008900 + LM R14,R12,12(R13) RELOAD CALLERS REGISTERS 00009000 + SR R15,R15 ZERO RETURN CODE 00009100 + BR R14 RETURN TO CALLER 00009200 + LTORG 00009300 +SAVEAREA DS 18F 00009400 +DELCIB DS 0H 00009500 +* USE QEDIT TO FREE THE CIB 00009600 +* QEDIT WILL ALSO CLEAR THE ECB 00009700 +* 00009800 + QEDIT ORIGIN=COMCIBPT,BLOCK=(R7) FREE THE CIB 00009900 + BR R14 00010000 +DOCIB DS 0H 00010100 +* WTO 'OUTPUT FROM MODIFY',ROUTCDE=(2,11) 00010200 +* 00010300 + LH R1,CIBDATLN LENGTH 00010400 + BCTR R1,R0 DECREMENT FOR EX MOVE 00010500 + EX R1,TARGET EXECUTE MOVE 00010600 + LA R2,MSGTAB 00010700 + L R1,0(,2) 00010800 + WTO MF=(E,(1)) 00010900 + BR 14 00011000 +TARGET MVC MSG1A(0),CIBDATA 00011100 +*-------------------------------------------------------------------* 00011200 +* YOUR ROUTINE TO HANDLE CIB PROCESSING WOULD GO HERE. * 00011300 +*-------------------------------------------------------------------* 00011400 +* 00011500 +* 00011600 +* 00011700 +*-------------------------------------------------------------------* 00011800 +* CONSTANTS * 00011900 +*-------------------------------------------------------------------* 00012000 + DS 0F FULLWORD ALIGNMENT 00012100 +HIBITON DC X'80000000' USED TO TURN HIGH ORDER BIT ON 00012200 +MSGTAB DC A(MSG1) 00012300 +MSG1 WTO (' '), X00012400 + ROUTCDE=(2),DESC=(7),MF=L 00012500 +MSG1A EQU MSG1+4 OFFSET OVER LEN AND DES CODES 00012600 +*-------------------------------------------------------------------* 00012700 +* FIELDS REQUIRED IN DYNAMIC STORAGE * 00012800 +*-------------------------------------------------------------------* 00012900 + DS 0F FULLWORD ALIGNMENT OR S201 ABEND 00013000 +ECBS DS 0CL4 ECB LIST FOR WAIT 00013100 +MODECB DS A ADDR(MODIFY/STOP ECB) 00013200 +STIMECB DS A ADDR(STIMER ECB) 00013300 +COMADDR DS F ADDR(COMAREA) FROM EXTRACT 00013400 +EXTRACT EXTRACT MF=L EXTRACT PARAMETER LIST 00013500 +*-------------------------------------------------------------------* 00013600 +* REQUIRED DSECTS * 00013700 +*-------------------------------------------------------------------* 00013800 +COM DSECT 00013900 + IEZCOM , COM AREA 00014000 +CIB DSECT 00014100 + IEZCIB , CIB 00014200 + END 00014300 +//GO.SYSPRINT DD SYSOUT=* 00014400 +//GO.SYSUDUMP DD SYSOUT=* 00014500