-
Notifications
You must be signed in to change notification settings - Fork 51
/
Copy pathextract.asm
145 lines (145 loc) · 11.5 KB
/
extract.asm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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