zOs/REXX/SV
/* rexx ****************************************************************
sv: editMacro for a backup of the current member
arguments:
noArgs save current member and copy it to saveLib
s<srcDsn> source dsn (ps or pds with member)
m<mbr> memberName in backup and saveLib
n no save in current edit session
l additional copy to zLib
t trace
?, -? this help
backupLib: zzz.save (root) contains index
(s0???) contains contents
saveLib: zLib.????
***********************************************************************/
parse arg arg
call errReset 'h'
backupLib = dsn2Jcl('zzz.save', 1)
saveLibPref = dsn2Jcl('zlib.', 1)
rootMbr = 'root'
editing = 0
eDsn = ''
eMbr = ''
src = ''
call adrIsp 'control errors return'
if arg ^== '' then nop
else if adrEdit("MACRO (arg)", "*") ^= 0 then
say 'no edit marcro rc' rc
else do
editing = 1
call adrEdit "(eDsn) = dataset"
call adrEdit "(eMbr) = member"
end
if (^editing & arg = '') | pos('?', arg) > 0 then
return help()
mbr = eMbr
doSave = editing
doLib = 0
do wx = 1 to words(arg)
w = word(arg, wx)
upper w
do cx=1 to length(w)
if substr(w, cx, 1) == 'N' then
doSave = 0
else if substr(w, cx, 1) == 'L' then
doLib = 1
else if substr(w, cx, 1) == 'T' then
m.trace = 1
else if substr(w, cx, 1) == 'S' then do
src = substr(w, cx + 1)
leave
end
else if substr(w, cx, 1) == 'M' then do
mbr = substr(w, cx + 1)
leave
end
else
call err 'bad option' substr(w, cx) 'word' w 'in' arg
end
end
call trc 'doSave' doSave 'doLib' doLib 'eMbr' eMbr 'eDsn' eDsn
call trc ' ' 'mbr' mbr 'src' src
if src == '' then do
if ^editing then
call err 'src empty'
if doSave then do /* editor save */
if adrEdit("save", '*') ^= 0 then do
say 'could not SAVE, rc=' rc
doSave = 0
end
end
src = dsnSetMbr(eDsn, eMbr)
end
backupDsn = backupRoot(backupLib, dsnSetMbr(src, mbr)) /* root entry */
dd = svBack
call adrTso "alloc dd("dd") shr dsn('"backupDsn"')"
if doLib then
dd = dd svLib(saveLibPref, src, mbr)
if editing & ^doSave then
call copyEdit dd
else
call copyDsn src, dd
call adrTso 'free dd('dd')'
exit
/*--- make a root entry in backlib for name
and return dsn of mbr pointed to -------------------------------*/
backupRoot: procedure expose m.
parse arg backLib, name
backRoot = backlib'(ROOT)'
rs = sysDsn("'"backRoot"'")
if rs == 'OK' then do
call adrTso "ALLOC F(svBack) Dsn('"backRoot"') SHR REUSE"
end
else do
if rs == 'DATASET NOT FOUND' then do
call createLib backLib
rs = sysDsn("'"backRoot"'")
end
if rs ^== 'MEMBER NOT FOUND' then
call err 'backlib' backlib rs
rec.1 = left('root lastRecord 1', 100)'eol'
do i=2 to 1030
rec.i = left('',100)'eol'
end
call adrTso "ALLOC F(svBack) Dsn('"backRoot"') SHR REUSE"
call adrTso "EXECIO" 1000 "DISKW svBack (STEM rec. FINIS)"
end
call adrTSO "EXECIO 1 DISKRU svBack (STEM rootOne.)"
lastRec = strip(substr(rootOne.1, 20, 10))
if left(rootOne.1, 16) <> 'root lastRecord' ,
| ^ dataType(lastRec, 'num') then
call err 'root record 1 bad'
else if lastRec >= 999 then do
say 'overflow'
call adrTSO "EXECIO 0 DISKW svBack (finis )"
call adrTso "FREE F(svBack)"
call renameLib backLib
return backupRoot(backlib, name)
end
lastRec = lastRec + 1
nextMbr = 's'right(lastRec,4,0)
rootOne.1 = overlay(lastRec, rootOne.1, 20, 10)
call adrTSO "EXECIO 1 DISKW svBack (STEM rootOne. )"
call adrTSO "EXECIO 1 DISKRU svBack" lastRec "(STEM rootAct.)"
rootAct.1 = overlay(left(nextMbr,8) date() time() ,
name, rootAct.1)
call adrTSO "EXECIO 1 DISKW svBack (STEM rootAct. finis )"
call adrTso "FREE F(svBack)"
res = dsnSetMbr(backlib, nextMbr)
call trc 'backUpRoot' res 'for' name
return res
endProcedure backupRoot
/*--- open (and create) savelib for PDS src --------------------------*/
svLib: procedure expose m.
parse arg pref, src, mbr
if mbr = '' then
say 'empty member ==> no lib'
else do
llq = substr(src, lastPos('.', src)+1)
suf = ''
if substr(llq, 1, 2) == 'PL' then
suf = PLI
else if substr(llq, 1, 2) == 'RE' then
suf = REXX
else
say 'llq' llq '==> no lib'
if suf ^== '' then do
svLib = pref || suf
if sysDsn(svLib) == 'DATASET NOT FOUND' then
call createLib svLib
call adrTso "alloc dd(svLib)shr dsn('"svLib"("mbr")')"
call trc 'svLib' svLib'('mbr') from' src
return 'svLib'
end
end
return ''
endProcedure svLib
/*--- create library dsn ---------------------------------------------*/
createLib: procedure
parse arg dsn
call adrTso "alloc dd(ddCrea) new catalog dsn('"dsn"')",
'dsntype(library) dsorg(po) recfm(v b) lrecl(32756)' ,
'space(100, 1000) cyl mgmtclas(COM#A092)'
call adrTso 'free dd(ddCrea)'
return
endProcedure createLib
/*--- rename library dsn ---------------------------------------------*/
renameLib: procedure
parse arg dsn
do ix=9999 by -1
if sysDsn("'"dsn"'") == 'OK' then
act = dsn || ix
rc = listdsi("'"act"' norecall")
if rc = 0 then
say 'available' act
else if rc = 16 & sysReason = 9 then
say "migrated" act
else if rc = 16 & sysReason = 5 then
leave
else
call err 'listDsi nc' rc 'reason' sysReason SYSMSGLVL2 dsn x
end
say 'renaming' dsn to act
call adrTso "rename '"dsn"' '"act"'"
return
endProcedure renameLib
/*--- copy frDsn to all the dd's in toDDs ---------------------------*/
copyDsn: procedure
parse arg frDsn, toDDs
call trc 'copyDsn from' frDsn 'to' toDDs
call adrTso "ALLOC dd(svSrc) dsn('"frDsn"') SHR REUSE"
call readDDBegin svSrc
do wx=1 to words(toDDs)
call writeDDBegin word(toDDs, wx)
end
do while readDD(svSrc, s.)
do wx=1 to words(toDDs)
call writeDD word(toDDs, wx), s.
end
end
call readDDEnd svSrc
do wx=1 to words(toDDs)
call writeDDend word(toDDs, wx)
end
return
endProcedure copyDsn
/*--- copy the editors source to all dd's in toDDs -------------------*/
copyEdit: procedure /* copy editor content to an other */
parse arg toDDs
call trc 'copyEdit to' toDDs
do wx=1 to words(toDDs)
call writeDDBegin word(toDDs, wx)
end
limit = 100
call adrEdit '(lastNum) = linenum .zl'
sx = 0
do lx=1 by 1
if lx > lastNum | sx > 100 then do
do wx=1 to words(toDDs)
call writeDD word(toDDs, wx), s, sx
end
sx = 0
if lx > lastNum then
leave
end
sx = sx + 1
call adrEdit '(s'sx') = line' lx
end
do wx=1 to words(toDDs)
call writeDDend word(toDDs, wx)
end
return
endProcedure copyEdit
/* copy adrIsp begin *************************************************/
/**********************************************************************
lmd: catalog read
call sequence: lmdBegin, lmdNext*, lmdEnd
mit lmd service (mit save in file und read,
weil list zu langsam und listcat abstürzt)
1. arg (grp) als group dataset für lmd save
und dd name für file read
***********************************************************************/
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
res = adrIsp('lmdlist listid(&lmdId) option(save) group('grp')', 4)
call adrIsp 'lmdfree listid(&lmdId)'
if res = 0 then do
call trc timing() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' timing() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt, withVolume
if ^ readDD(ggGrp, ggSt) then
return 0
if withVolume ^== 1 then
do ggIx=1 to value(ggSt'0')
x = value(ggSt || ggIx, word(value(ggSt || ggIx), 1))
end
return 1
endSubroutin lmdNext
lmdEnd: procedure
parse arg grp
call readDDEnd grp
call adrTso 'free dd('grp')'
return /* end lmdEnd */
lmd: procedure expose m.
parse arg lev, withVol
call lmdBegin gg1, lev
do while lmdNext(gg1, q., withVol)
do x=1 to q.0
call jOut q.x
end
end
call lmdEnd gg1
return
endProcedure lmd
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmm: procedure expose m.
parse arg dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
call jOut m
end
call lmmEnd id
return
endProcedure lmm
lmmBegin: procedure
parse arg dsn
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET('"pds"') ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
res = lmmId
if mbr <> '' then
res = res 'pattern('mbr')'
return res
endProcedure lmmBegin
lmmEnd: procedure
parse arg lmmId opt
call adrIsp "LMMLIST DATAID("lmmId") option(free)", 8
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
if adrIsp("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
return strip(mbr)
else
return ''
endProcedure lmmNext
lmmRm: procedure
parse arg dsn, mbrs
mbrs = dsnGetMbr(dsn) mbrs
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(OUTPUT) "
err = ''
do wx=1 to words(mbrs)
m1 = word(mbrs, wx)
rr = adrIsp("lmmDel dataid("lmmId") member("m1")", 0 8 12)
if rc = 0 then
say 'removed' m1 'from' pds
else if rc = 8 then
say 'not found' m1 'in' pds
else do
err = 'error deleting' m1 'in' pds 'rc' rr strip(zerrlm)
say err
leave
end
end
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
if err <> '' then
call err err
return
endProcedure lmmRm
/*--- address ispf with error checking -------------------------------*/
adrIsp:
parse arg ggIspCmd, ggRet
address ispexec ggIspCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr ispExec rc' rc 'in' ggIspCmd':' strip(zerrlm)
endSubroutine adrIsp
/*--- address editor with error checking -----------------------------*/
adrEdit:
parse arg ggEditCmd, ggRet
address isrEdit ggEditCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr isrEdit rc' rc 'for' ggEditCmd
endSubroutine adrEdit
/* copy adrIsp end *************************************************/
/* copy adrTso begin *************************************************/
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
parse arg ggTsoCmd, ggRet
address tso ggTsoCmd
if rc == 0 then return 0
else if ggRet == '*' then return rc
else if wordPos(rc, ggRet) > 0 then return rc
else
call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn ., addPrefix
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
sp = sysvar('SYSPREF')
if sp == '' then
sp = userid()
cx = pos('~', dsn)
if cx < 1 & addPrefix == 1 then
return sp'.'dsn
do while cx ^== 0
le = left(dsn, cx-1)
ri = substr(dsn, cx+1)
if right(le, 1) == '.' | left(ri, 1) == '.' then
dsn = le || sp || ri
else
dsn = le || left('.', le ^== '') || sp ,
|| left('.', ri ^== '') || ri
cx = pos('~', spec, cx)
end
return dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
jcl2dsn: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure
parse arg dsn, mbr
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
return dsn
endProcedure dsnSetMbr
dsnGetMbr: procedure
parse arg dsn
lx = pos('(', dsn)
rx = pos(')', dsn, lx+1)
if lx < 1 then
return ''
else if lx < rx then
return substr(dsn, lx+1, rx-lx-1)
else
return strip(substr(dsn,lx+1))
endProcedure dsnGetMbr
/**********************************************************************
io: read or write a dataset with the following callsequences:
read: readDDBegin, readDD*, readDDEnd
write: writeBegin, writeDD*, writeEnd
readDD returns true if data read, false at eof
***********************************************************************/
/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure
return /* end readDDBegin */
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt = '' then
ggCnt = 100
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
return (value(ggSt'0') > 0)
return /* end readDD */
/*--- finish reading DD ggDD ----------------------------------------*/
readDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure
parse arg ggDD
/* ensure file is erased, if no records are written */
call adrTso 'execio' 0 'diskw' ggDD '(open)'
return /* end writeDDBegin */
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt == '' then
ggCnt = value(ggst'0')
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
return
endSubroutine writeDD
/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskw' ggDD '(finis)'
return /* end writeDDEnd */
/*--- alloc a dsn or a dd
spec '-'<ddName>
datasetName? disposition? '.'? attributes? (':' newAtts)?
disp default disposition
dd default dd name
retRc erlaubte ReturnCodes (leer = 0)
returns if ok then ddName <rexx for free> otherwise rc -----*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd, retRc
ds = ''
m.dsnAlloc.dsn = ds
if left(spec, 1) = '-' then
return strip(substr(spec, 2))
if left(spec, 1) = '&' then /* external spec is handled ok */
spec = strip(substr(spec, 2))
do wx=1 by 1
w = word(spec, wx)
if w = '' | abbrev(w, '.') | abbrev(w, ':') then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if w = 'CATALOG' then
disp = disp w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if abbrev(w, 'DSN(') then
ds = strip(substr(w, 5, length(w)-5))
else if ds = '' then
ds = dsn2jcl(w)
else
leave
end
rest = subword(spec, wx)
if abbrev(rest, '.') then
rest = substr(rest, 2)
parse var rest rest ':' nn
if dd <> '' & ds = '' & rest = '' & ^ abbrev(disp, 'SYSO') then
call err "'return" dd"' no longer supported please use ="dd
if dd = '' then do
if symbol('m.adrTso.ddNum') = 'VAR' then
dd = m.adrTso.ddNum + 1
else
dd = 1
m.adrTso.ddNum = dd
dd = 'DD' || dd
end
if disp = '' then
disp = 'SHR'
else if pos('(', ds) < 1 then
nop
else if disp = 'MOD' then
call err 'disp mod for' ds
else
disp = 'SHR'
m.dsnAlloc.dsn = ds
if pos('/', ds) > 0 then
return csmAlloc(dd, disp, ds, rest, nn, retRc)
else
return tsoAlloc(dd, disp, ds, rest, nn, retRc)
endProcedure dsnAlloc
tsoAlloc: procedure expose m.
parse arg dd, disp, dsn, rest, nn, retRc
c = 'alloc dd('dd')' disp
if dsn <> '' then
c = c "DSN('"dsn"')"
if retRc <> '' | nn = '' then do
alRc = adrTso(c rest, retRc)
if alRc <> 0 then
return alRc
return dd 'call adrTso "free dd('dd')";'
end
do retry=0 to 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
leave
say 'tsoAlloc rc' alRc 'for' c rest '...trying to create'
call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(dsn, nn)
call adrTso 'free dd('dd')'
end
call err 'tsoAlloc rc' alRc 'for' c rest
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
atts = 'recfm(f b) lrecl('rl')' ,
'block(' (32760 - 32760 // rl)')'
end
else do
if rl = '' then
rl = 32756
atts = 'recfm('substr(atts, 2, 1) 'b) lrecl('rl')' ,
'block(32760)'
end
end
if pos('(', dsn) > 0 then
atts = atts 'dsntype(library) dsorg(po)' ,
"dsn('"dsnSetMbr(dsn)"')"
else
atts = atts "dsn('"dsn"')"
return atts 'mgmtclas(COM#A091) space(10, 1000) cyl'
endProcedure dsnCreateAtts
/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/
readDSN:
parse arg ggDsnSpec, ggSt
ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN')
call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)'
interpret subword(ggAlloc, 2)
return
endSubroutine readDsn
/*--- write the dataset specified in ggDsnSpec from stem ggSt
write ggCnt records if not empty otherwise ggst0
if ggSay 1 then say ... records written to ... -------------*/
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
if ggCnt == '' then
ggCnt = value(ggst'0')
ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
'(stem' ggSt 'open finis)'
interpret subword(ggAlloc, 2)
if ggSay == 1 | m.debug == 1 then
say ggCnt 'records written to' ggDsnSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
parse arg oo, ha
if pos('I', translate(oo)) > 0 then
call adrIsp 'control errors return'
m.err.opt = translate(oo, 'h', 'H')
if ha == '' then
drop m.err.handler
else
m.err.handler = ha
return
endSubroutine errReset
/*--- error routine: abend with message ------------------------------*/
err:
parse arg ggTxt, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret m.err.handler
call errSay ggTxt
parse source . . ggS3 . /* current rexx */
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if pos('h', ggOpt) > 0 then do
say 'fatal error in' ggS3': divide by zero to show stackHistory'
x = 1 / 0
end
say 'fatal error in' ggS3': exit(12)'
exit errSetRc(12)
endSubroutine err
/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
interpret 'assertRes =' arg(1)
if ^ assertRes then
call err 'assert failed' arg(1)':' arg(2)
return
endProcedure assert
/*--- say an errorMessage msg with pref pref
split message in lines at '/n'
say addition message in stem st ---------------------------*/
errSay: procedure expose m.
parse arg msg, st, pref
parse source . . ggS3 . /* current rexx */
if pref == 'e' | (pref == '' & st == '') then
msg = 'fatal error:' msg
else if pref == 'w' then
msgf = 'warning:' msg
else if pref == 0 then
nop
else if right(pref, 1) ^== ' ' then
msg = pref':' msg
else
msg = pref || msg
sx = 0
bx = -1
do lx=1 until bx >= length(msg)
ex = pos('\n', msg, bx+2)
if ex < 1 then
ex = length(msg)+1
if st == '' then do
say substr(msg, bx+2, ex-bx-2)
end
else do
sx = sx+1
m.st.sx = substr(msg, bx+2, ex-bx-2)
m.st.0 = sx
end
bx = ex
end
return
endProcedure errSay
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
say 'fatal error:' msg
call help
call err msg, op
endProcedure errHelp
/*--- set rc for ispf: -------------------------------------------------
if a cmd is run by ispStart, its RC is ignored,
but ISPF passes the value of the shared varible 3IspfRc
back as return code
----------------------------------------------------------------------*/
errSetRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure errSetRc
/*--- output a trace message if m.trace is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
say 'trc:' msg
return
endProcedure trc
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure
parse arg txt, qu
if qu = '' then
qu = '"'
res = qu
ix = 1
do forever
qx = pos(qu, txt, ix)
if qx = 0 then
return res || substr(txt, ix) || qu
res = res || substr(txt, ix, qx-ix) || qu || qu
ix = qx + length(qu)
end
endProcedure quote
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
say 'debug' msg
return
endProcedure debug
/*--- return current time and cpu usage ------------------------------*/
timing: procedure
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say right(' help for rexx' s3, 79, '*')
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
say 'initial commentblock not found for help'
return
end
end
do lx=lx+1 by 1
li = strip(sourceLine(lx), 't', ' ')
if pos('*/', li) > 0 then
leave
say li
end
say right(' end help for rexx' s3, 79, '*')
return 4
endProcedure help
/* copy err end *****************************************************/