zOs/REXX.O08/CSMSERE
/* REXX -----------------------------------------------------------*/
/* */
/*-----------------------------------------------------------------*/
/* */
/* Function : Send terminal input to a remote REXX procedure */
/* CSMAP02R */
/*_________________________________________________________________*/
system = 'RZ2'
exec= 'A540769.WK.REXX'
parse arg fun
say 'csmSeRe' fun
if fun = '' then do
call adrTso "CSMAPPC Start Pgm(CSMEXEC) ",
"Parm(""Select Tsocmd('EXEC ''"exec"(CSMSeRe)'' ''send''')"")"
exit
end
if fun <> 'send' then
call err 'fun' fun
Parse Source . . procname .
GLOBAL_TRACE = 'Y'
GLOBAL_TRACE = 'N'
"ALLOC F(SYSPRINT) DA(*)"
Parse Value '' with tsddn
"CSMEXEC ALLOCATE SYSTEM("system") RMTDDN(SYSTSPRT) LRECL(133)",
" RECFM(FB) DATASET('&') DISP(NEW) ",
" SPACE(5,20) CYLINDER NEWINIT TIMEOUT(123)"
If rc ^= 0 Then Exit 20
tsddn = subsys_ddname
lc = CSM_Allocate('*.'tsddn,'SYSROUTE','')
If lc ^= 0 Then Call Epilog lc
cvid = appc_cvid
cmd.0 = 1
cmd.1 = "EXEC '"exec"(CSMSERE)'"
say 'sending' cmd.1
trace ?R
lc = CSM_Send_Data(cvid,'cmd.',2)
say 'after sending' lc
If lc ^= 0 Then Call Epilog lc
Parse pull cmd
Do While Translate(cmd) ^= 'END' & cmd ^= ''
cmd.0 = Words(cmd)
Do i = 1 to cmd.0
cmd.i = Word(cmd,i)
End
lc = CSM_Send_Data(cvid,'cmd.',3)
If lc ^= 0 Then Call Epilog lc
lc = CSM_Receive(cvid,'response.')
If lc ^= 0 Then Call Epilog lc
Do j = 1 To response.0
Say Strip(response.j,'T')
End
Parse pull cmd
End
lc = CSM_Dealloc(cvid,0)
Call Epilog 0
/* --------------------------------------------------------------------
Procedure Epilog
----------------------------------------------------------------- */
Epilog:
Do i = 1 To appc_msg.0 While (Arg(1) ^= 0)
Say appc_msg.i
End
Say '----------------- remote output ------------------------'
"CSMEXEC COPY INDD("tsddn") OUTDD(SYSPRINT)"
"Free File("tsddn" SYSPRINT)"
Exit Arg(1)
/* $INCLUDE IRPAPPC */
/* $START IRPAPPC */
/*------------------------------------------------------------------*/
/* */
/* Include : Service functions for cross system communication */
/* Mlv : CS138X59 */
/* */
/*__________________________________________________________________*/
/********************************************************************/
/* */
/* Procedure : CSM_Get_Conversation */
/* */
/* Get Conversation */
/* */
/********************************************************************/
CSM_Get_Conversation:
appc_tracex = '00'
appc_msg.0 = 0
appc_reason = '?'
appc_rc = '?'
"CSMAPPC GET CVIDVAR("Arg(1)")"
appc_getrc = Rc
If global_trace = 'Y' Then Do
Say 'GETC_RC :'appc_rc
Say 'REASON :'appc_reason
Say 'MSG.0 :'appc_msg.0
End
If appc_getrc = 0 Then Do
appc_tracex = C2x(Substr(appc_trace,1,1))
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'CVID :'appc_cvid
Say 'SLVL :'appc_slvl
Say 'PLU :'appc_plu
Say 'LLU :'appc_llu
Say 'DDNAME :'appc_ddname
Say 'MODENAME:'appc_modename
Say 'USER :'appc_user
Say 'TPNAME :'appc_tpname
Say 'STATE_C :'appc_state_c
Say 'STATE_F :'appc_state_f
End
If appc_modename ^= 'CSMREXX1' Then Do
Say 'Invalid Conversation Mode:'appc_modename
Say 'CSMREXX1 expected'
appc_getrc = 1
End
End
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Do appc_i = 1 To appc_msg.0
Say 'APPC_GETC_MSG:'appc_msg.appc_i
End
End
Return appc_getrc
/********************************************************************/
/* */
/* Procedure : CSM_Allocate */
/* */
/* Allocate CSM APPC Session */
/* */
/********************************************************************/
CSM_Allocate:
appc_tracex = '00'
appc_msg.0 = 0
appc_reason = '?'
appc_rc = '?'
"CSMAPPC ALLOCATE PLU("Arg(1)") ",
"TPNAME("Arg(2)") MODENAME(CSMREXX1) "Arg(3)
appc_allocrc = Rc
If global_trace = 'Y' Then Do
Say 'ALLOC_RC:'appc_rc
Say 'REASON :'appc_reason
Say 'MSG.0 :'appc_msg.0
End
If appc_allocrc = 0 Then Do
appc_tracex = C2x(Substr(appc_trace,1,1))
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'CVID :'appc_cvid
Say 'PLU :'appc_partner_lu
Say 'LLU :'appc_local_lu
Say 'DDNAME :'appc_ddname
Say 'STATE_C :'appc_state_c
Say 'STATE_F :'appc_state_f
"CSMEXEC QUERY DDNAME("appc_ddname")"
Do appc_j = 2 to Words(subsys_vnames)
appc_name = Word(subsys_vnames,appc_j)
appc_value = Value(appc_name)
Say Left(appc_name,20)'Len:' ,
Right(Length(appc_value),2)' Value:'appc_value
End
End
End
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Do appc_i = 1 To appc_msg.0
Say 'APPC_ALLOCATE_MSG:'appc_msg.appc_i
End
End
Return appc_allocrc
/********************************************************************/
/* */
/* Procedure : CSM_Receive */
/* */
/* Receive Data into Stem */
/* */
/********************************************************************/
CSM_Receive:
appc_msg.0 = 0
appc_reason = '?'
csm_dummy = Value(Arg(2)'0',0)
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'Start -- CSM_Receive --'
End
csm_buffer = ''
appc_datarcv = 3
appc_rc = 0
appc_bndx = 0
appc_state_c = ''
/* 0123456789ABCDEF */
appc_ch = ' ' ||, /* 0 */
' ' ||, /* 1 */
' ' ||, /* 2 */
' ' ||, /* 3 */
' [.<(+|' ||, /* 4 */
'& ]$*);^' ||, /* 5 */
'-/ !,%_>?' ||, /* 6 */
' `:# ''="'||, /* 7 */
' abcdefghi ' ||, /* 8 */
' jklmnopqr ' ||, /* 9 */
' ~stuvwxyz ' ||, /* A */
' ' ||, /* B */
'{ABCDEFGHI ' ||, /* C */
'}JKLMNOPQR ' ||, /* D */
'\ STUVWXYZ ' ||, /* E */
'0123456789 ' /* F */
Do While((appc_datarcv = 3 | appc_state_c='RCVW') & appc_rc = 0)
appc_rc = 99
"CSMAPPC RECEIVE CVID(X'"Arg(1)"')BUFFER('appc_buff')"
appc_rcvrc = Rc
If (appc_tracex ^= '00' | ,
global_trace = 'Y') Then Do
Say 'RCVW_RC :'appc_rc
Say 'REASON :'appc_reason
Say 'MSG.0 :'appc_msg.0
End
If appc_rcvrc = 0 Then Do
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'CVID :'Arg(1)
Say 'STATE_C :'appc_state_c
Say 'STATE_F :'appc_state_f
Say 'DATARCV :'appc_datarcv
End
If appc_datarcv = 0 Then ,
Return 0
csm_buffer = csm_buffer || appc_buff
Drop appc_buff
If appc_datarcv ^= 3 Then Do
appc_bndx = appc_bndx + 1
csm_buffer.appc_bndx = csm_buffer
csm_buffer = ''
End
End
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Do appc_i = 1 To appc_msg.0
Say 'CSM_Receive_Msg:'appc_msg.appc_i
End
End
End
Do appc_i = 1 To appc_bndx
csm_bl = Length(csm_buffer.appc_i)
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
csm_buffer = substr(,
csm_buffer.appc_i,1,min(length(csm_buffer.appc_i),1000))
Say 'Buffer :'translate(csm_buffer,appc_ch)
Say 'Buffer(x):'C2x(csm_buffer)
End
csm_buffer.0 = csm_buffer.appc_i
If csm_bl < 4 Then Do
appc_msg.0 = 4
appc_msg.1 = 'CVID :'Arg(1)
appc_msg.2 = 'Invalid Buffer received. Index:'appc_i
appc_msg.3 = 'Buffer Length (too small) :'csm_bl
appc_msg.4 = 'Buffer :'C2x(csm_buffer.0)
Return 16
End
Do While(Length(csm_buffer.appc_i) >= 4)
csm_bufferlen = C2d(Substr(csm_buffer.appc_i,1,4))
If csm_bl-4 < csm_bufferlen Then Do
appc_msg.0 = 6
appc_msg.1 = 'CVID :'Arg(1)
appc_msg.2 = 'Invalid Buffer received. Index:'appc_i
appc_msg.3 = 'Buffer Length - 4 < than :'csm_bl
appc_msg.4 = 'Buffer Record Length Field :'csm_bufferlen
appc_msg.5 = 'Current Buffer :' ||,
C2x(csm_buffer.appc_i)
appc_msg.6 = 'Complete Buffer :' || ,
C2x(csm_buffer.0)
Return 16
End
csm_ndx = Value(Arg(2)'0') + 1
csm_dummy = Value(Arg(2)'0',csm_ndx)
csm_dummy = Value(Arg(2) || csm_ndx,,
Substr(csm_buffer.appc_i,5,csm_bufferlen))
csm_buffer.appc_i = Substr(csm_buffer.appc_i,5+csm_bufferlen)
csm_bl = Length(csm_buffer.appc_i)
End
If csm_bl <> 0 Then Do
appc_msg.0 = 5
appc_msg.1 = 'CVID :'Arg(1)
appc_msg.2 = 'Invalid Buffer received. Index:'appc_i
appc_msg.3 = 'Remaining Bufferlen. too short:'csm_bl
appc_msg.4 = 'Remaining Buffer :' ||,
C2x(csm_buffer.appc_i)
appc_msg.5 = 'Complete Buffer :' ||,
C2x(csm_buffer.0)
Return 16
End
End
Drop csm_buffer.
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'End -- CSM_Receive --'
End
Return appc_rc
/********************************************************************/
/* */
/* Procedure : CSM_Send_Data */
/* */
/* Send Data from Stemvar */
/* */
/********************************************************************/
CSM_Send_Data:
appc_msg.0 = 0
appc_reason = '?'
appc_rc = '?'
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'Start -- CSM_Send_Data --'
Say 'Buffervar:'Arg(2)
End
csm_sb = ''
Do appc_i = 1 To Value(Arg(2)'0')
csm_bf = Value(Arg(2) || appc_i)
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
/* 0123456789ABCDEF */
appc_ch = ' ' ||, /* 0 */
' ' ||, /* 1 */
' ' ||, /* 2 */
' ' ||, /* 3 */
' [.<(+|' ||, /* 4 */
'& ]$*);^' ||, /* 5 */
'-/ !,%_>?' ||, /* 6 */
' `:# ''="'||, /* 7 */
' abcdefghi ' ||, /* 8 */
' jklmnopqr ' ||, /* 9 */
' ~stuvwxyz ' ||, /* A */
' ' ||, /* B */
'{ABCDEFGHI ' ||, /* C */
'}JKLMNOPQR ' ||, /* D */
'\ STUVWXYZ ' ||, /* E */
'0123456789 ' /* F */
Say 'Buffer :'translate(csm_bf,appc_ch)
Say 'Buffer(x):'C2x(csm_bf)
End
csm_sb = csm_sb || D2c(Length(csm_bf),4) || csm_bf
End
"CSMAPPC SEND CVID(X'"Arg(1)"')",
"BUFFER(csm_sb) TYPE("Arg(3)")"
appc_sndrc = rc
If (appc_tracex ^= '00' | ,
global_trace = 'Y') Then Do
Say 'SEND_RC :'appc_rc
Say 'REASON :'appc_reason
Say 'MSG.0 :'appc_msg.0
End
If appc_sndrc = 0 Then Do
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'CVID :'Arg(1)
Say 'STATE_C :'appc_state_c
Say 'STATE_F :'appc_state_f
End
End
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Do appc_i = 1 To appc_msg.0
Say 'CSM_Send_Msg:'Translate(appc_msg.appc_i,appc_ch)
End
Say 'End -- CSM_Send_Data --'
End
Return appc_sndrc
/********************************************************************/
/* */
/* Procedure : CSM_Dealloc */
/* */
/* Deallocate Session */
/* */
/********************************************************************/
CSM_Dealloc:
appc_msg.0 = 0
appc_reason = '?'
appc_rc = '?'
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Say 'Start -- CSM_Dealloc --'
End
"CSMAPPC DEALLOC CVID(X'"Arg(1)"') TYPE("Arg(2)")"
appc_dealrc = rc
If (appc_tracex ^= '00' | ,
global_trace = 'Y') Then Do
Say 'DEAL_RC :'appc_rc
Say 'REASON :'appc_reason
Say 'MSG.0 :'appc_msg.0
End
If (appc_tracex ^= '00' | global_trace = 'Y') Then Do
Do appc_i = 1 To appc_msg.0
Say 'CSM_Deal_Msg:'appc_msg.appc_i
End
Say 'End -- CSM_Dealloc --'
End
Return appc_dealrc
/* --------------------------------------------------------------------
Procedure X_Dc
----------------------------------------------------------------- */
X_Dc:
/* 0123456789ABCDEF */
appc_ch = ' ' ||, /* 0 */
' ' ||, /* 1 */
' ' ||, /* 2 */
' ' ||, /* 3 */
' [.<(+|' ||, /* 4 */
'& ]$*);^' ||, /* 5 */
'-/ !,%_>?' ||, /* 6 */
' `:# ''="'||, /* 7 */
' abcdefghi ' ||, /* 8 */
' jklmnopqr ' ||, /* 9 */
' ~stuvwxyz ' ||, /* A */
' ' ||, /* B */
'{ABCDEFGHI ' ||, /* C */
'}JKLMNOPQR ' ||, /* D */
'\ STUVWXYZ ' ||, /* E */
'0123456789 ' /* F */
Return Translate(Arg(1),appc_ch)
/* $END IRPAPPC */
/* 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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))
rest = ''
do wx=1 by 1
w = word(spec, wx)
if w = '' then
leave
if abbrev(w, '.') then do
rest = substr(subword(spec, wx), 2)
leave
end
if abbrev(w, ':') then do
nn = substr(subword(spec, wx), 2)
leave
end
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
if dd <> '' & ds = '' & rest = '' then
return dd
if dd = '' then
dd = 'DD' || ooNew()
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 ds <> '' then
ds = "DSN('"ds"')"
alRc = adrTso('alloc dd('dd')' disp ds rest, '*')
if alRc ^== 0 then do
if nn = 'NN' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for alloc dd('dd')' disp ds rest
say 'tsoAlloc rc' alRc 'for alloc dd('dd')' disp ds rest ,
'...trying to create'
call dsnAllocCreate m.dsnAlloc.dsn, nn
call adrTso 'alloc dd('dd')' disp ds rest
end
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
dsnAllocCreate: 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
if pos('(', dsn) > 0 then
atts = atts 'dsntype(library) dsorg(po)' ,
"dsn('"dsnSetMbr(dsn)"')"
else
atts = atts "dsn('"dsn"')"
atts = 'new catalog' atts 'mgmtclas(s005y000) space(10, 1000)'
end
call adrTso 'alloc dd(dsnAlloc)' atts
call adrTso 'free dd(dsnAlloc)'
return
endProcedure dsnAllocCreate
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
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 '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:
interpret 'assertRes =' arg(1)
if ^ assertRes then
call err 'assert failed' arg(1)':' arg(2)
return
endProcedure assert
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
/*--- 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 *****************************************************/