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;