ESASLRB REXX
/* ESASLR REXX pipe stages */
Parse arg function args
Select;
When(function = 'SEGUPDT) Call SEGUPDT args
When(function = 'SEGCOLL) Call SEGCOLL args
When(function = 'RUNCOLL) Call RUNCOLL args
When(function = 'SEGGEN ) Call SEGGEN args
Otherwise Say 'Invalid rexx request:' function args
End;
Return;
SEGUPDT:
/* Generate a segment file definition */
Parse Upper Arg histfn histft
seghlen = 8 /* Segment header length */
opt = Substr(histfn,4)
If opt = 'USER' Then opt = 'USR'
offset = 52 - 4*(opt = 'CPU')
'callpipe < segment list |',
'locate 10-12 /'opt'/ |',
'locate /*/ |',
'spec w1 1 w4 8 w4 13 |',
'xlate 15 0-1 8-9 2-7 A-F |',
'spec /(sep !) < tblupdt skelfile ! change \segname\/ 1',
'w1 next /\ ! change \segl\/ next',
'w2 next /\ ! change \segs\/ next',
'w3 next /\ ! > / next',
'w1 next / TBLUPDT A/ next |',
'runpipe |',
'console'
Return;
SEGCOLL:
/* Generate a segment file definition */
Parse Upper Arg histfn histft
seghlen = 8 /* Segment header length */
opt = Substr(histfn,4)
If opt = 'USER' Then opt = 'USR'
offset = 52 - 4*(opt = 'CPU')
'callpipe < segment list |',
'locate 10-12 /'opt'/ |',
'locate /*/ |',
'stem seglist.'
'callpipe',
'stem seglist. |',
'spec /? FO: ! locate \/ 1 1.6 next /\ ! take 1 !',
'not chop before string \/ next 1.6 next /\!',
'spec 1.6 1 7.2 c2d nw ! FI: / next |',
'literal FI: faninany ! stem segl. |',
'literal <' histfn histft '! FO: fanout ? |',
'literal (sep ! end ?) |',
'join * |',
'runpipe |',
'console'
'callpipe',
'stem segl. |',
'spec / ? FO: ! CH/ 1 1.6 next /: chop' offset,
'! JU/ next 1.6 next /: juxtapose ! > / next 1.6 next',
'/' histft 'a3 ? CH/ next 1.6 next /:',
'! not chop before string \/ next 1.6 next /\',
'! chop / next w2 next / ! JU/ next 1.6 next /:/ next |',
'literal ! change 1-2 / /19/ ! FO: fanout |',
'literal ! spec 1.8 1.8 right \.\ 9 w3 10 25-* 25 |',
'literal (sep ! end ?) <' histfn histft '|',
'join * |',
'runpipe |',
'console'
Return;
RUNCOLL:
/* Punch the necessary deck to run a COLLECT job */
Parse Arg histfn histft .
Do Forever
'peekto record'
If Rc <> 0 Then Exit (Rc<>12)*Rc
segname = Left(record,6)
Address CMS 'punch ESASLRJ'Substr(histfn,4,1) 'JCL * (NOH'
Address CMS 'punch ESASLRPR JCL * (NOH'
'callpipe literal DATASET(ESASLR.LOG.'segname')|',
'punch 00D'
Address CMS 'punch ESASLREJ JCL * (NOH'
'callpipe literal //ESALOG DD *,DLM='??'|',
'punch 00D'
Address CMS 'netdata send' segname histft '* to * at *',
'(nospool notype nolog'
Address CMS 'punch ESASLREF JCL * (NOH'
Address CMS 'punch ESASLRPS JCL * (NOH'
'callpipe < ESASLRCS JCL |',
'change /segname/'segname'/ |',
'punch 00D'
Address CMS 'punch ESASLREJ JCL * (NOH'
Address CMS 'SPOOL PUN CLOSE'
'readto'
End
Return;
SEGGEN:
/* Generate a segment file definition */
Parse Upper Arg histfn histft
seghlen = 8 /* Segment header length */
opt = Substr(histfn,4)
If opt = 'USER' Then opt = 'USR'
offset = 52 - 4*(opt = 'CPU')
'Callpipe < history keywords | histkwds | Stem hkwds.'
'Callpipe < segment list | locate 10-12 /'opt'/ | Stem segments.'
Do Forever
'peekto record'
If Rc <> 0 Then Call Exit (Rc<>12)*Rc
header = Left(record,offset)
rec = Substr(record,offset+1)
Do While rec <> ''
segname = Left(rec,6)
seglen = C2d(Substr(rec,7,2))
'Callpipe Stem segments. |',
'find' segname'|',
'locate /*/ |',
'var segrec |',
'count lines |',
'var doseg'
If doseg Then Do
'Callpipe (end $) < ESASLR'||Left(opt,1)||'L ASMSTART |',
'T1: take 5 |',
'change /DREGDA/'segname'/ |',
'change /ESA'opt'/'segname'/ |',
'F: faninany |',
'pad 80 |',
'>' segname'L ASSEMBLE A F',
'$',
'T1: |',
'T2: take 1 |',
'spec 1-18 1 /'Word(segrec,4)',/ next /*/ 72 |',
'F:',
'$',
'T2: |',
'F:'
'Callpipe (end $) < ESASLRS'||Left(opt,1)||' ASMSTART |',
'T1: take 6 |',
'change /DREGDA/'segname'/ |',
'change /ESA'opt'/'segname'/ |',
'F: faninany |',
'Stem sumfile.',
'$',
'T1: |',
'T2: take 1 |',
'spec 1-18 1',
'/'D2x(128 + X2d(Word(segrec,4)))',/ next',
'/*/ 72 |',
'F:',
'$',
'T2: |',
'F:'
sumstub = sumfile.0
segment = Left(rec,seglen)
segdata = Substr(segment,seghlen+1)
'Callpipe Stem hkwds. | find 'segname'| stem segdef.'
doff = 0
Do i = 1 To segdef.0 While seglen > doff+seghlen
doff = Substr(segdef.i,22,2)
If doff = '' Then Do /* If no offset field, then */
doff = 0 /* this isn't a data field */
Iterate i /* Take no action */
End
type = Strip(Substr(segdef.i,37,5)) /* Cvt from ESAMAP */
desc = Substr(segdef.i,43) /* format to SLR macro */
desc = Strip(Left(Strip(desc,,''''),30))
If type = 'FLT' Then Do
fldlen = 4
type = 'FLOAT'
End
Else If type = 'BIN15' Then Do
fldlen = 2
type = 'FIXED'
End
Else If type = 'BIN' Then Do
fldlen = 4
type = 'FIXED'
End
Else If type = 'CHAR' Then
fldlen = Strip(Substr(segdef.i,30,2))
name = Translate(Strip(Substr(segdef.i,8,8)))
/*
Build the macro and push it into the output stream.
*/
r.1 = ' ALLDATA NAME='name
r.1 = r.1||',OFFSET='offset+seghlen+doff||','
r.1 = Left(r.1,71)'*'
r.2 = ' INTYPE='type',LENGTH='fldlen','
r.2 = Left(r.2,71)'*'
r.3 = ' DESC='''desc''''
r.3 = Left(r.3,72)
r.0 = 3
'Callpipe Stem r. |',
'pad 80 |',
'>>' segname'L ASSEMBLE A F'
If type <> 'CHAR' Then Do
/*
Build the macro and push it into the output stream.
*/
r.1 = ' SUMDATA NAME='name
r.1 = r.1||',VALUE=SUM('||name||'),'
r.1 = Left(r.1,71)'*'
r.2 = ' EDIT=F(8),UNIT=''Count'','
r.2 = Left(r.2,71)'*'
r.3 = ' DESC='''desc''''
r.3 = Left(r.3,72)
r.4 = '*'
r.0 = 4
'Callpipe Stem r. | stem sumfile. append'
End
doff = doff + fldlen /* For the "While" clause */
End i /* Do i = 1... */
'Callpipe',
'append literal TABEND |',
'append literal END|',
'pad 80 |',
'>>' segname'L ASSEMBLE A F'
If sumstub <> sumfile.0 Then Do
'Callpipe',
'Stem sumfile. |',
'append literal TABEND |',
'append literal END|',
'pad 80 |',
'>' segname'S ASSEMBLE A F'
End
End /* If doseg */
rec = Substr(rec,seglen+1)
'Callpipe Stem segments. | nfind' segname'| stem segments.'
If segments.0 = 0 Then Call Exit 0 /* We're done */
End /* Do While rec <> '' */
'readto'
End /* Do Forever */
Return;
