forked from hercules-390/hyperion
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathCMPSC.txt
431 lines (431 loc) · 17.4 KB
/
CMPSC.txt
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
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
* $$ JOB JNM=CMPSC,USER='FISH',CLASS=0,DISP=D
* $$ LST CLASS=A,DISP=D
// JOB CMPSC ASSEMBLE COMPRESSION CALL TEST PROGRAM
// OPTION XREF,NORLD
// EXEC ASSEMBLY
TITLE 'CMPSC Test CMPSC instruction'
*--------------------------------------------------------------------
* Entry point and housekeeping routine
*--------------------------------------------------------------------
SPACE
CMPSC START X'200' entry point ...
START EQU X'200' entry point ...
WKSTLOC EQU X'800' working storage
*
BASR R12,0 set up base register
BCTR R12,0 set up base register
BCTR R12,0 set up base register
USING CMPSC,R12 set up base register
USING LOWCORE,0 low core area
*
LM R0,R5,CMPR0 load starting values
*
LR R6,R2 R6 -> beg o/p buffer
LA R7,0(R3,R2) R7 -> end o/p buffer
ST R7,ENDOUTBF save end o/p buffer
BAS R14,PROTECT protect o/p buffer
*
LA R6,4095(,R7) round to next page
SRL R6,12 round to next page
SLL R6,12 round to next page
SLR R6,R7 calculate leftover
ST R6,LEFTOVER for PADOFLOW routine
*
LR R6,R4 R6 -> beg i/p buffer
LA R7,0(R5,R4) R7 -> end i/p buffer
BAS R14,PROTECT protect i/p buffer
*
LR R6,R1 R6 -> dictionaries
SRL R6,12 remove stt && cbn
SLL R6,12 remove stt && cbn
LR R7,R6 calculate end..
AL R7,DICTSIZE ..of dictionaries
BAS R14,PROTECT protect dictionaries
EJECT
*
** Check for CMPSC Enhancement Facility...
*
MVC SVPGMNEW,ZPINPSW save pgm new PSW
LA R10,DIDSTFLE R10 -> continue address
STCM R10,B'0111',ZPINPSW+16-3 plug into pgm new PSW
NI ZPINPSW+1,X'FF'-X'02' turn off PSW wait bit
LR R10,R0 save R0
LA R0,1 need 1 dblwrd of facilities
STFLE FACILITY Store Facility List Extended
DIDSTFLE DS 0H pgm chk *MAY* have occurred
MVC ZPINPSW,SVPGMNEW restore pgm new PSW
LR R0,R10 restore R0
*
** Get started...
*
L R10,CMPINLEN i/p "file" length
L R11,CMPOTLEN o/p "file" length
*
SLR R5,R5 i/p buffer residual
*
B COMPRESS *** START TEST ***
SPACE 4
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
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
EJECT
*--------------------------------------------------------------------
* Protect storage range subroutine
*--------------------------------------------------------------------
SPACE
PROTECT DS 0H R6 -> beg, R7 = end
*
SRL R6,12 first page
SLL R6,12 first page
*
LR R13,R7 last page
LA R13,4095(,R13) round up
SRL R13,12 next page
SLL R13,12 prot page
*
LA R10,CMPSCKEY allowed access key
LA R15,NOACCKEY protected page key
*
PROTLOOP DS 0H
SSKE R10,R6 allow page access
*
LA R6,2048(,R6) bump to..
LA R6,2048(,R6) ..next page
*
CLR R6,R13 past last page yet?
BL PROTLOOP no, keep allowing
*
SSKE R15,R6 protect fence page
BR R14 return to caller
EJECT
*--------------------------------------------------------------------
* Perform CMPSC compression test
*--------------------------------------------------------------------
SPACE
COMPRESS DS 0H
BAS R14,CMPGETIN get input "file" data
BAS R14,PADOFLOW set overflow pattern
*
SPKA CMPSCKEY set problem psw key
CMPAGAIN DS 0H compress loop
CMPSC R2,R4 compress data
BC B'0001',CMPAGAIN cc=3, keep going
SPKA 0 set kernel psw key
*
BC B'0010',BADCC2 cc=2 s/b impossible
MVI CC,X'00' guess CC=0
BC B'1000',CMPOKAY good guess
MVI CC,X'01' nope, CC=1
CMPOKAY DS 0H
*
BAS R14,CKZEROPD check zero padding
BAS R14,CHKOFLOW check overflow pattern
BAS R14,CMPFLUSH flush output to "file"
*
LTR R10,R10 i/p "file" at EOF?
BNZ COMPRESS no, keep compressing
CLI CC,X'00' condition code zero?
BNE COMPRESS no, keep compressing
*
N R0,GR0EXBIT is this expansion?
BNZ CMPDONE yes then we're done
N R1,CBNBITS extra compress bits?
BZ CMPDONE no then we're done
*
L R8,CMPR2 R8 -> output buffer
L R6,CMPOUTPT R6 -> output "file"
MVC 0(1,R6),0(R8) save those bits too
LA R11,1(,R11) count those bits too
CMPDONE DS 0H
ST R11,CMPOTLEN save o/p "file" len
LPSWE DONEPSW test complete
*
BADCC2 LPSWE BADCCPSW invalid condition code
EJECT
*--------------------------------------------------------------------
* Fill input buffer with input "file"
*
* Input: R4/R5 next i/p buff pos buff resid from cmpsc
* R10 current input "file" remaining
*
* Output: R4/R5 beg i/p buffer and its length for cmpsc
* R10 updated input "file" remaining
*--------------------------------------------------------------------
SPACE
CMPGETIN DS 0H
LTR R9,R10 any i/p remaining?
BZR R14 no, return
*
LM R6,R7,CMPR4 R6 -> i/p buff, R7 = len
LR R13,R7 R13 = i/p buffer length
*
LTR R7,R5 R7 = input residual
BZ CMPGET10 no residual to save
*
LR R8,R4 R8 -> unused input
LR R9,R7 R9 = unused amount
MVCL R6,R8 save unused input
*
CMPGET10 DS 0H
LR R7,R13 len of i/p buffer
SLR R7,R5 amt used = needed
*
L R8,CMPINPUT R8 -> input "file"
LR R9,R10 R9 = len of "file"
*
CLR R9,R7 enough i/p remain?
BNL CMPGET20 yes, length okay
LR R7,R9 no, use shortest
*
CMPGET20 DS 0H
MVCL R6,R8 "read" i/p "file"
*
ST R8,CMPINPUT update i/p "file" location
ST R9,CMPINLEN update i/p "file" remaining
LR R10,R9 R10 = i/p "file" remaining
*
L R4,CMPR4 R4 -> input buffer
LR R5,R6 R5 -> past input data
SLR R5,R4 calc i/p data amount
*
BR R14 return to caller
EJECT
*--------------------------------------------------------------------
* Check proper handling of CMPSC-Enhancement Facility zero padding
*
* Input: R2 next o/p buffer position from cmpsc
*--------------------------------------------------------------------
SPACE
CKZEROPD DS 0H check correct zero padding handling
LR R6,R2 R6 -> next output buffer position
LM R7,R8,CMPR2 R7 -> o/p buff, R8 = o/p buff len
ALR R7,R8 R7 -> end of o/p buffer
SLR R7,R6 R7 = bytes remaining in o/p buffer
LTR R7,R7 any bytes remaining in o/p buffer?
BZR R14 if none remain then nothing to do
*
L R8,CMPR0 get CMPSC option bits
N R8,GR0EXBIT was this an expansion?
BNZ ZPLENOK yes then no partial byte
BCTR R7,0 R7 = bytes remain in o/p buffer
LTR R7,R7 if no bytes remain ...
BZR R14 ... then nothing to do
*
LA R6,1(,R6) otherwise get past partial byte
ZPLENOK DS 0H
LH R13,ZPHBYTES calculate ...
ALR R13,R6 ... where ...
BCTR R13,0 ... zeropad ...
N R13,ZPMASK ... should end
*
SLR R13,R6 R13 = zeropad alignment amount
LTR R13,R13 test zeropad alignment amount
BNM ZPPADOK not minus pad amount is okay
*
SLR R13,R13 otherwise pad amount is zero
ZPPADOK DS 0H
LTR R13,R13 is zero padding needed?
BZ NZEROPAD no then no zero padding
CLR R13,R7 enough room for padding?
BH NZEROPAD no then no zero padding
TM FACCMPSC,CMPSCENH CMPSC-Enhancement Facility?
BZ NZEROPAD no then no zero padding
L R8,CMPR0 get CMPSC option bits
N R8,GR0ZPBIT zero padding requested?
BZ NZEROPAD no then no zero padding
*
CLI 0(R6),X'00' did they maybe zero pad?
BE YZEROPAD yes it looks like maybe
*
LR R8,R6 R8=R6 -> next o/p buff pos
SLR R9,R9 R9 = length 0, pad = x'00'
ICM R9,B'1000',PADBYTE R9 = length 0, pad = x'FF'
B NZEROPAD continue
EJECT
YZEROPAD DS 0H some zero padding DID occur
LR R15,R7 save o/p buffer bytes remain
LR R7,R13 R7 = zeropad alignment amount
LR R8,R6 R8=R6 -> next o/p buff pos
SLR R9,R9 R9 = length 0, pad = x'00'
*
CLCL R6,R8 zero padding bytes all x'00'?
BNE EZEROPAD no then zero padding error
*
LR R7,R15 restore o/p buff bytes remain
SLR R7,R13 get new o/p buff bytes remain
LR R8,R6 R8=R6 -> next o/p buff pos
SLR R9,R9 R9 = length 0, pad = x'00'
ICM R9,B'1000',PADBYTE R9 = length 0, pad = x'FF'
*
CLCL R6,R8 all remainder all pad chars?
BER R14 yes okay return to caller
B EZEROPAD no then zero padding error
*
NZEROPAD DS 0H zero padding should NOT occur
CLCL R6,R8 all remainder all pad chars?
BER R14 yes okay return to caller
B EZEROPAD no then zero padding error
*
EZEROPAD DS 0H zero padding error detected
LPSWE ZPERRPSW zero padding error detected
EJECT
*--------------------------------------------------------------------
* Flush output buffer to output "file"
*
* Input: R2/R3 next o/p buff pos buff resid from cmpsc
* R11 current output "file" length
*
* Output: R2/R3 beg o/p buffer and its length for cmpsc
* R11 updated output "file" length
*--------------------------------------------------------------------
SPACE
CMPFLUSH DS 0H
LM R8,R9,CMPR2 o/p buffer begin and size
SLR R9,R3 calc R9 = o/p data amount
*
L R6,CMPOUTPT R6 -> output "file"
LR R7,R9 R7 = o/p data amount
ALR R11,R9 update o/p "file" length
LR R13,R8 save o/p buff begin
*
MVCL R6,R8 flush o/p to "file"
ST R6,CMPOUTPT update o/p "file" addr
*
MVC 0(1,R13),0(R2) keep partial byte, if any
LM R2,R3,CMPR2 reset o/p buffer
BR R14 return to caller
SPACE 3
*--------------------------------------------------------------------
* Check the output buffer for any possible buffer overflows
*--------------------------------------------------------------------
SPACE
CHKOFLOW DS 0H check buffer overflow
LM R6,R7,PADPARMS end of buff, pad amt
*
LTR R7,R7 any padding to check?
BZR R14 no, return to caller
*
SLR R9,R9 zero operand-2 len
ICM R9,B'1000',PADBYTE get padding character
*
CLCL R6,R8 any buffer overflow?
BNE BUFOFLOW yes, load 0C4 PSW
*
BR R14 no, return to caller
*
BUFOFLOW LPSWE OFLOWPSW o/p buffer overflow!
EJECT
*--------------------------------------------------------------------
* Pad output buffer with pad char to catch buffer overflows
*
* Input: R0 compression parameters ready for cmpsc
* R1 dictionary addr and CBN ready for cmpsc
* R2/R3 beg o/p buff and length ready for cmpsc
*--------------------------------------------------------------------
SPACE
PADOFLOW DS 0H catch cmp cbn errors
LA R13,X'FF' R13 = all bits of byte set on
LR R8,R0 R8 = cmpsc parameters
N R8,GR0EXBIT is this expansion?
BNZ PADOFLW2 yes then forget it
*
** Set unused bits in partial-byte to catch CBN errors
*
LR R8,R1 R8 = dictionary addr + cbn
N R8,CBNBITS just the cbn field please
SRL R13,0(R8) R13 = unused partial byte bits
*
IC R8,0(,R2) get partial byte
OR R8,R13 turn on unused bits
LR R13,R8 R13 = partial byte
*
** Pad output buffer to catch improper cmpsc o/p buffer use
*
PADOFLW2 DS 0H pad the output buffer
STC R13,0(,R2) catch compress cbn errors
LA R6,1(,R2) R6 -> o/p buffer + 1
LR R8,R6 R8 -> o/p buffer + 1
LR R7,R3 R7 = o/p length
BCTR R7,0 R7 = o/p length - 1
SLR R9,R9 R9 = source length == 0
ICM R9,B'1000',PADBYTE padding character
MVCL R6,R8 pad output buffer
*
** Pad remainder of o/p buffer to catch buffer-overflow errors
*
LM R6,R7,PADPARMS end of buff, pad amt
LTR R7,R7 any padding needed?
BZR R14 no, return to caller
*
MVCL R6,R8 pad output buffer
BR R14 return to caller
EJECT
*--------------------------------------------------------------------
* Working Storage ...
*--------------------------------------------------------------------
SPACE
ORG CMPSC+(WKSTLOC-START) working storage
SPACE
FACILITY DC D'0' facilities list
FACCMPSC EQU FACILITY+5 CMPSC Enh. Facility byte
CMPSCENH EQU X'01' CMPSC Enh. Facility bit
SVPGMNEW DC XL16'00' original program new PSW
*
DONEPSW DC XL16'00020000800000000000000000000000'
BADCCPSW DC XL16'000220008000000000000000000BADCC'
OFLOWPSW DC XL16'000200008000000000000000000000C4'
ZPERRPSW DC XL16'00020000800000000000000000002616'
*
CMPR0 DC A(0) $(GR0)
CMPR1 DC A(0) $(cmp_dict_addr)
CMPR2 DC A(0) $(out_buffer_addr)
CMPR3 DC A(0) $(out_buffer_size)
CMPR4 DC A(0) $(in_buffer_addr)
CMPR5 DC A(0) $(in_buffer_size)
*
DICTSIZE DC A(0) $(dicts_size)
CMPINPUT DC A(0) $(in_file_addr)
CMPINLEN DC A(0) $(in_file_size)
CMPOUTPT DC A(0) $(out_file_addr)
CMPOTLEN DC A(0) starting o/p "file" length = 0
*
CBNBITS DC A(7) R1 cbn bits mask
PADPARMS DC 0D'0' o/p buffer padding
ENDOUTBF DC A(0) end of o/p buffer
LEFTOVER DC A(0) leftover page bytes
GR0EXBIT DC A(X'100') R0 'E'xpansion bit
*
GR0ZPBIT DC A(X'20000') GR0 request zero padding bit
ZPBYTES EQU 256 zero padding alignment bytes
ZPMASK DC A(-1-ZPBYTES+1) $(zp_mask)
ZPHBYTES DC AL2(ZPBYTES) $(zp_bytes)
*
CMPSCKEY EQU X'10' cmpsc testing psw key
NOACCKEY EQU X'38' no-access storage key
PADCHAR EQU X'FF' buffer pad character
PADBYTE DC AL1(PADCHAR) buffer padding byte
CC DC X'00' condition code flag
EJECT
*--------------------------------------------------------------------
* Low Core layout
*--------------------------------------------------------------------
SPACE
LOWCORE ,
SPACE
END
/*
/&
* $$ EOJ