-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathhostcmd.assemble
372 lines (372 loc) · 25.2 KB
/
hostcmd.assemble
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
TITLE 'HOSTCMD - Issue commands from REXX programs' 00010000
HOSTCMD CSECT 00020000
*------------------------------------------------------------*
* This programs issues commands and subcommands in CMS for * 00040000
* REXX programs. The REXX Address statement defines the * 00050000
* command or subcommand environment that will receive and * 00060000
* execute the command character string. * 00070000
* * 00080000
* It also implements the entry point to the EXECCOMM * 00090000
* subcommand entry into the interpretor. Programs like * 00100000
* EXECIO issue the EXECCOMM subcommand to set values for, * 00110000
* retrieve values from, and drop REXX variables. * 00120000
*------------------------------------------------------------*
USING CMSCRAB,R13 00140000
USING HOSTCMD,R12 00150000
USING NUCON,0 00160000
@@HOSTCM PDPPRLG CINDEX=0,FRAME=WKAREALN,BASER=12,ENTRY=YES 00170000
LA R15,@@HOSTCM-HOSTCMD 00180000
SLR R12,R15 00190000
USING HOSTCMD,R12 00200000
*------------------------------------------------------------*
* Retrieve parameters. Entry R1 points to a two word parm *
* list. The first word is the address of an LSTR structure *
* (defined below) for the command line to be executed, and *
* word two is the address of an LSTR structure for the name *
* of the REXX address environment. *
* The LSTR structure is defined in the LSTR DSECT below. *
*------------------------------------------------------------*
LM R4,R5,0(R1) Ptr to cmd, Ptr to env name 00290000
* 00300000
*------------------------------------------------------------*
* Build a tokenized plist and an extended plist from *
* the input command line string. *
*------------------------------------------------------------*
USING LSTR,R4 Command line 00350000
L R1,LSTRPSTR Address of command line 00360000
L R0,LSTRLEN Length of command line 00370000
DROP R4 00380000
* 00390000
IPK , 00400000
SPKA 0 Key 0 00410000
SSM *+1 Disable 00420000
L R15,ASCANN Build tokenied plist 00430000
BALR R14,R15 and extended plist 00440000
LTR R15,R15 00450000
BNZ BADARG 00460000
* 00470000
L R15,NUCUPPER Standard uppercase table 00480000
LR R4,R1 Tokenized plist pointer 00490000
LR R3,R0 Tokenized plist length 00500000
* 00510000
CH R3,*+10 Less than or equal to max? 00520000
BNH *+8 OK 00530000
LA R3,256 Else use max 00540000
* 00550000
BCTR R3,0 00560000
EX R3,UPTRANS Uppercase this section 00570000
* 00580000
SPKA 0(R2) Enable 00590000
SSM =X'FF' User key 00600000
B SETENVNM Go set environment name 00610000
UPTRANS TR 0(*-*,R4),0(R15) 00620000
*------------------------------------------------------------*
* Create an 8 byte uppercase version of the environment name *
*------------------------------------------------------------*
SETENVNM DS 0H 00660000
USING LSTR,R5 Environment name 00670000
MVC ENVNAME,=CL8'COMMAND' Assume standard env. 00680000
MVC ENVNAME+8(8),=8X'FF' CMS command fence 00690000
L R2,LSTRPSTR Address of environment name 00700000
L R3,LSTRLEN Length of environment name 00710000
LTR R3,R3 Null string is 00720000
* another way to specify 00730000
* address 'COMMAND' 00740000
BZ ENVSET 00750000
CH R3,*+10 Truncate length 00760000
BNH *+8 to 8 bytes 00770000
LA R3,8 00780000
* 00790000
MVI ENVNAME,C' ' Set Environment 00800000
MVC ENVNAME+1(8-1),ENVNAME Name and 00810000
OC ENVNAME(*-*),0(R2) uppercase 00820000
EX R3,*-6 00830000
ENVSET DS 0H 00840000
DROP R5 00850000
*------------------------------------------------------------* 00860000
* Setup EXECCOMM subcommand environment * 00870000
*------------------------------------------------------------* 00880000
MVC SBSL(SBSLLEN),SBSP Set MF=L pattern 00900000
SUBCOM SET,NAME='EXECCOMM',ENTRY=EXECCOMM, *00910000
UWORD=(R13),INTTYPE=ALL,KEY=USER, *00920000
MF=(E,SBSL) 00930000
*------------------------------------------------------------* 00940000
* address COMMAND is called with a call type X'01' plist * 00950000
*------------------------------------------------------------* 00960000
CLC ENVNAME,=CL8'COMMAND' Standard environment? 00970000
BNE CHKSUBCM Try subcommand environments 00980000
LA R1,CMNDLIST 00990000
LA R0,NUCPLIST Point to contructed EPLIST 01000000
ICM R1,B'1000',=X'01' 01010000
SVC 202 Run command now 01020000
DC AL4(1) 01030000
B GOBACK Pass back the return code 01040000
*------------------------------------------------------------* 01050000
* Special command environment. Look for a subcommand * 01060000
* processor to handle it. * 01070000
*------------------------------------------------------------* 01080000
CHKSUBCM DS 0H 01090000
MVC SBQL(SBQLLEN),SBQP Set MF=L pattern 01100000
SUBCOM QUERY,NAME=ENVNAME,MF=(E,SBQL) 01110000
LTR R15,R15 01120000
BNZ ENVUNKN Unknown environment 01130000
*------------------------------------------------------------*
* For a subcommand call, R1 point to the subcommand *
* environment name, followed by a plist fence *
*------------------------------------------------------------*
LA R1,ENVNAME 01160000
*------------------------------------------------------------*
* The extended plist 1st word points to the subcommand name *
* The 2nd word points to the beginning of the argument *
* string. The third word points past the last argument. *
*------------------------------------------------------------*
MVC EPLIST(16),NUCPLIST Copy EPLIST from ASCANN 01200000
MVC EPLIST+4(4),EPLIST Adjust second word of EP 01210000
ST R1,EPLIST Adjust first word 01220000
LA R0,EPLIST and extended plist 01230000
ICM R1,B'1000',=X'02' Subcommand call 01240000
SVC 202 Call the subcommand 01250000
DC AL4(1) 01260000
B GOBACK Pass back the return code 01270000
* 01280000
BADARG DS 0H 01290000
ENVUNKN DS 0H 01300000
L R15,=F'-3' 01310000
GOBACK DS 0H 01320000
LR R3,R15 Hold the command return code 01330000
MVC SBCL(SBCLLEN),SBCP Set MF=L pattern 01340000
SUBCOM CLR,NAME='EXECCOMM',MF=(E,SBCL) 01350000
LR R15,R3 Get back the command RC 01360000
PDPEPIL Return to caller
*------------------------------------------------------------*
* This entry point is called to issue a type X'05' call to *
* an external function. R0 and R1 must be already prepared *
* with the function call arguments. A function called by *
* using this entry point can issue calls to EXECCOMM. *
*------------------------------------------------------------*
@@HOST05 PDPPRLG CINDEX=0,FRAME=WKAREALN,BASER=12,ENTRY=YES
LA R15,@@HOST05-HOSTCMD
SLR R12,R15
USING HOSTCMD,R12
*------------------------------------------------------------*
* Retrieve parameters. Entry R0 and R1 are set up for a *
* type X'05' call to an external function. *
*------------------------------------------------------------*
LR R4,R0 Hold entry parameters
LR R5,R1
*
*------------------------------------------------------------*
* Setup EXECCOMM subcommand environment *
*------------------------------------------------------------*
MVC SBSL(SBSLLEN),SBSP Set MF=L pattern
SUBCOM SET,NAME='EXECCOMM',ENTRY=EXECCOMM, *
UWORD=(R13),INTTYPE=ALL,KEY=USER, *
MF=(E,SBSL)
*
LR R0,R4 Reload entry parameters
LR R1,R5
SVC 202 Call the function
DC AL4(*)
*
LR R3,R15 Hold the command return code
MVC SBCL(SBCLLEN),SBCP Set MF=L pattern
SUBCOM CLR,NAME='EXECCOMM',MF=(E,SBCL)
LR R15,R3 Get back the command RC
PDPEPIL Return to caller
* 01380000
*------------------------------------------------------------* 01390000
* This is the entry point for the EXECCOMM REXX subcommand. * 01420000
* It is reached via an SVC 202 from a program called from * 01430000
* a REXX EXEC. It reconnects to the GCC runtime environment * 01440000
* of the REXX program. * 01450000
*------------------------------------------------------------*
ENTRY EXECCOMM 01470000
EXECCOMM DS 0D 01480000
STM R14,R12,12(R13) Save entry regs 01490000
LR R12,R15 01500000
LA R15,EXECCOMM-HOSTCMD 01510000
SLR R12,R15 Establish common base 01520000
LR R3,R13 Hold EXECCOMM R13 01530000
USING HOSTCMD,R12 01540000
USING SCBLOCK,R2 01550000
L R13,SCBWKWRD Load HOSTCMD R13 01560000
* 01570000
* Now R13 points to the GCC savearea in use when HOSTCOM 01580000
* called the external program with address COMMAND, or 01590000
* with an address call to a subcommand environment. 01600000
* Since we have a C runtime environment now, we can call 01610000
* any C program CSECTs in the BREXX module. 01620000
* 01630000
LR R5,R0 EXECCOMM EPLIST Word 4 01640000
CLC 4(4,R5),8(R5) BEGARGS must equal ENDARGS 01650000
L R15,=F'-1' 01660000
BNE RXERRXIT Error exit if not 01670000
* 01680000
L R5,12(,R5) Fetch a pointer to a chain 01690000
USING SHVBLOCK,R5 chain of SHVBLOCKS 01700000
*------------------------------------------------------------*
* *
* Main loop for processing SHVBLOCKs starts here *
* *
*------------------------------------------------------------*
MAINLOOP DS 0H Process next SHVBLOCK 01710000
*------------------------------------------------------------*
* EXECIO only uses calls for SHVFETCH and SHVSTORE. *
* *** We will implement others later if the need arises. *
*------------------------------------------------------------*
CLI SHVCODE,SHVSTORE Is it?
BE EXCSET
CLI SHVCODE,SHVFETCH Is it?
BE EXCFETCH
*
MVI SHVRET,SHVBADF Bad function code
B RXERET Tell the caller bad function
*------------------------------------------------------------*
* Processing for SHVSTORE *
*------------------------------------------------------------*
EXCSET DS 0H
LA R0,1 Set call
ST R0,RXECALLT Set call type
LA R15,SHVVALL Set address of the
ST R15,RXEBUFFL variable length
B EXCSETUP Go finish plist setup
*------------------------------------------------------------*
* Processing for SHVFETCH *
*------------------------------------------------------------*
EXCFETCH DS 0H
SR R0,R0 Fetch call
ST R0,RXECALLT Set call type
MVC SHVVALL,SHVBUFL Set buffer length as
* value length
LA R15,SHVVALL Set address of the
ST R15,RXEBUFFL buffer length
*------------------------------------------------------------*
* Processing common to SHVFETCH and SHVSTORE *
*------------------------------------------------------------*
EXCSETUP DS 0H
MVI SHVRET,0 01720000
L R15,SHVNAML Length of the variable name 01730000
C R15,=F'255' 01740000
BNH NAMEOK Bif name is not too long
MVI SHVRET,SHVBADN 01760000
B RXERET Return to EXECCOMM caller 01770000
*
NAMEOK DS 0H 01780000
L R14,SHVNAMA Address of the name 01790000
LA R0,VARNAME 01800000
LA R1,1(,R15) Output 1 longer than input 01810000
MVCL R0,R14 Copy name and append a null 01820000
L R15,SHVNAML Length of name 01830000
BCTR R15,0 -1 for execute 01840000
L R14,NUCUPPER 01850000
B *+10 01860000
TR VARNAME(*-*),0(R14) Uppercase the var name 01870000
EX R15,*-6 Now we have a C string 01880000
*------------------------------------------------------------*
* Call "RXE" to implement the data transfers specified in *
* the SHVBLOCK structure passed as an argument to EXECCOMM. *
*------------------------------------------------------------*
LA R0,VARNAME
ST R0,RXENAME Set variable name Lstr ptr
*
MVC RXEBUFFA,SHVVALA Set caller buffer address
*------------------------------------------------------------*
* Call RXEXCM in RXEXCOMM C for processing *
*------------------------------------------------------------*
LA R1,RXEPLIST Plist address 02490000
L R15,=V(RXEXCM) Call RXEXCOMM C 02500000
BALR R14,R15 to perform operation 02510000
LTR R15,R15 OK?
BZ RXERET Done if so
*
C R15,=F'4' Truncated?
BNE NOTRUNC No, skip
OI SHVRET,SHVTRUNC Tell the caller
B RXERET Done
NOTRUNC DS 0H
*
C R15,=F'2' REXX name not found
BNE NOBADNM No, skip
CLI SHVCODE,SHVSTORE Is it?
BE RXERET We created the variable
OI SHVRET,SHVBADN Tell the caller
B RXERET Done
NOBADNM DS 0H
LA R15,100 Unknown error
*------------------------------------------------------------*
* Now restore the EXECCOMM runtime and return to the caller *
* of EXECCOMM. *
*------------------------------------------------------------*
RXERET DS 0H 02610000
SR R15,R15 Set the return code 02620000
IC R15,SHVRET 02630000
LTR R15,R15 Success with this SHVNLOK? 02640000
BNZ RXERRXIT Sadly, no. Return to caller 02650000
ICM R5,B'1111',SHVNEXT More SHVBLOCKs to process? 02660000
BNZ MAINLOOP If so go do that 02670000
RXERRXIT DS 0H Enter here with rc in R15 02680000
LR R13,R3 Back to EXECCOMM R13 02690000
L R14,12(,R13) 02700000
LM R0,R12,20(R13) 02710000
BR R14 02720000
TITLE 'HOSTCMD: Constants and literals' 02730000
*------------------------------------------------------------* 02740000
SBQP SUBCOM QUERY,NAME='EXECCOMM',MF=L 02750000
SBSP SUBCOM SET,NAME='EXECCOMM',ENTRY=EXECCOMM,MF=L 02760000
SBCP SUBCOM CLR,NAME='EXECCOMM',MF=L 02770000
LTORG , 02780000
TITLE 'HOSTCMD: Savearea and variables' 02790000
* 02800000
* The LSTR data structure is used throughout BREXX to define 02810000
* BREXX variables. 02820000
* 02830000
LSTR DSECT 02840000
LSTRPSTR DS A Pointer to data 02850000
LSTRLEN DS F Current length of the data 02860000
LSTRLMAX DS F Max data bytes allocated 02870000
LSTRTYPE DS H Data type 02880000
LSTRING EQU 0 Character string data 02890000
LINTEGER EQU 1 Integer fata 02900000
LREAL EQU 2 Floating point data 02910000
LSTRSIZE EQU *-LSTR 02920000
* 02930000
* This is the HOSTCMD dynamic storage area addressed by R13 02940000
* 02950000
CMSCRAB 02960000
ORG MAINSTK 02970000
SUBCOML SUBCOM QUERY,NAME='ENV',MF=L 02980000
SUBCOMLL EQU *-SUBCOML 02990000
SBQL SUBCOM QUERY,NAME='EXECCOMM',MF=L 03000000
SBQLLEN EQU *-SBQL 03010000
SBSL SUBCOM SET,NAME='EXECCOMM',ENTRY=EXECCOMM,MF=L 03020000
SBSLLEN EQU *-SBSL 03030000
SBCL SUBCOM CLR,NAME='EXECCOMM',MF=L 03040000
SBCLLEN EQU *-SBCL 03050000
* 03060000
ENVNAME DS CL8 Environment name 03070000
DS 8X'FF' FENCE 03080000
* 03090000
EPLIST DS 0D 03100000
DS 6A Extended plist 03110000
* 03120000
RXEPLIST DS 0A 03130000
RXECALLT DS F 0 = fetch value
* 1 = set value
RXENAME DS A Ptr to VARNAME string
RXEBUFFA DS A Ptr to user buffer
* copied from SHVVALA
RXEBUFFL DS A Address of SHVVALL. A FETCH
* operation copies the calue
* from SHVBUFL to SHVVALL
* before calling RXEXCM
* 03230000
VARNAME DS CL256 Uppercased variable name 03240000
* Assumes variable name
* length <= 255
WKAREALN EQU *-CMSCRAB 03250000
SVCSAVE , 03260000
REGEQU , 03270000
SCBLOCK , 03280000
SHVBLOCK , 03290000
NUCON , 03300000
END 03310000